pingu/hcdu
pingu/hcdu
1
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Work is being done?

Browse Source
This commit is contained in:
pingu 2023-10-16 11:07:50 +02:00
parent 0e788c443d
commit 5350a7b2e6
1 changed files with 57 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
app/Main.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE BlockArguments #-}
module Main where
import System.Posix.Directory ( getWorkingDirectory )
@ -9,22 +10,29 @@ import Data.Functor ( (<&>) )
import Control.Monad ( filterM )
import System.Directory.Extra ( listContents )
import Brick
import Brick.Widgets.Edit
import Graphics.Vty
import Data.List.Extra
import qualified Data.Ord
import Data.Maybe
listNonSymFiles :: FilePath -> IO [FilePath]
listNonSymFiles dir = filterM (fmap not . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir
listNonSymFiles dir = filterM ((not <$>) . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir
listNonSymDirectories :: FilePath -> IO [FilePath]
listNonSymDirectories dir = filterM (fmap not . pathIsSymbolicLink) =<< filterM doesDirectoryExist =<< listContents dir
listNonSymDirectories dir = filterM ((not <$>) . pathIsSymbolicLink) =<< filterM doesDirectoryExist =<< listContents dir
listSym :: FilePath -> IO [FilePath]
listSym dir = filterM pathIsSymbolicLink =<< listContents dir
getSizeSubpaths :: FilePath -> IO [(FilePath, Integer)]
getSizeSubpaths x = do
sub <- listNonSymDirectories x
subby <- mapM (\y -> (y,) . sum . map snd <$> getSizeSubpaths y) sub
syms <- listSym x
local <- listNonSymFiles x >>= (\y -> mapM getFileSize y <&> zip y)
pure $ sortOn (Data.Ord.Down . snd) $ local ++ subby
pure $ sortOn (Data.Ord.Down . snd) $ local ++ subby ++ zip syms [0..0]
data AppS = AppS
{
@ -41,27 +49,51 @@ data ScrollDirection where
ui :: Widget ()
ui = viewport () Vertical $ str "Svamp är gott"
app :: App () e ()
app :: App AppS e ()
app =
App { appDraw = const [ui]
App { appDraw = pure . browse
, appHandleEvent = resizeOrQuit
, appStartEvent = pure ()
, appAttrMap = const $ attrMap (white `on` blue) []
, appChooseCursor = neverShowCursor
, appAttrMap = attributeMap
, appChooseCursor = showFirstCursor
}
attributeMap :: AppS -> AttrMap
attributeMap = const $ attrMap defAttr
[ (attrName "selected", withStyle defAttr reverseVideo)
, (editAttr, fg brightBlack)
]
select :: Widget () -> Widget ()
select = withAttr (attrName "selected")
browse :: AppS -> Widget ()
browse s =
str "Path" <+> padLeft Max (str "Size") <=>
viewport () Vertical (foldr (widgetCons s) emptyWidget (_appSubFiles s))
widgetCons :: AppS -> (FilePath, Integer) -> Widget () -> Widget ()
widgetCons s w@(f,_) ws = (<=> ws) if Just f == _appFocus s then
select . visible $ pathWidget w
else pathWidget w
pathWidget :: (FilePath, Integer) -> Widget ()
pathWidget (f, s) = str (show f) <+> padLeft Max (str (show s))
sizeDir :: AppS -> IO AppS
sizeDir s = do
subFiles <- getSizeSubpaths $ _appCWD s
pure $ s {_appSubFiles = subFiles}
changeDir :: AppS -> FilePath -> IO AppS
changeDir so f =
changeDir :: AppS -> IO AppS
changeDir so
| isJust $ _appFocus so =
let s = so {
_appCWD = f
_appCWD = fromJust $ _appFocus so
, _appSubFiles = []
} in
sizeDir s
| otherwise = pure so
scroll :: ScrollDirection -> AppS -> AppS
scroll d s = s {
@ -76,9 +108,18 @@ scroll d s = s {
newCursor = max 0 (min ((-) 1 . length $ _appSubFiles s) cursor)
maybeNewPath = fst <$> _appSubFiles s !? newCursor
initialState :: FilePath -> AppS
initialState f = AppS {
_appCWD = f
, _appCursor = 0
, _appFocus = pure f
, _appSubFiles = []
}
main :: IO ()
main = do
a <- getWorkingDirectory
print =<< getSizeSubpaths a
defaultMain app ()
b <- changeDir $ initialState a
_ <- defaultMain app b
return ()