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 module Main where
import System.Posix.Directory ( getWorkingDirectory ) import System.Posix.Directory ( getWorkingDirectory )
@ -9,22 +10,29 @@ import Data.Functor ( (<&>) )
import Control.Monad ( filterM ) import Control.Monad ( filterM )
import System.Directory.Extra ( listContents ) import System.Directory.Extra ( listContents )
import Brick import Brick
import Brick.Widgets.Edit
import Graphics.Vty import Graphics.Vty
import Data.List.Extra import Data.List.Extra
import qualified Data.Ord import qualified Data.Ord
import Data.Maybe
listNonSymFiles :: FilePath -> IO [FilePath] 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 :: 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 :: FilePath -> IO [(FilePath, Integer)]
getSizeSubpaths x = do getSizeSubpaths x = do
sub <- listNonSymDirectories x sub <- listNonSymDirectories x
subby <- mapM (\y -> (y,) . sum . map snd <$> getSizeSubpaths y) sub subby <- mapM (\y -> (y,) . sum . map snd <$> getSizeSubpaths y) sub
syms <- listSym x
local <- listNonSymFiles x >>= (\y -> mapM getFileSize y <&> zip y) 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 data AppS = AppS
{ {
@ -41,27 +49,51 @@ data ScrollDirection where
ui :: Widget () ui :: Widget ()
ui = viewport () Vertical $ str "Svamp är gott" ui = viewport () Vertical $ str "Svamp är gott"
app :: App () e () app :: App AppS e ()
app = app =
App { appDraw = const [ui] App { appDraw = pure . browse
, appHandleEvent = resizeOrQuit , appHandleEvent = resizeOrQuit
, appStartEvent = pure () , appStartEvent = pure ()
, appAttrMap = const $ attrMap (white `on` blue) [] , appAttrMap = attributeMap
, appChooseCursor = neverShowCursor , 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 :: AppS -> IO AppS
sizeDir s = do sizeDir s = do
subFiles <- getSizeSubpaths $ _appCWD s subFiles <- getSizeSubpaths $ _appCWD s
pure $ s {_appSubFiles = subFiles} pure $ s {_appSubFiles = subFiles}
changeDir :: AppS -> FilePath -> IO AppS changeDir :: AppS -> IO AppS
changeDir so f = changeDir so
| isJust $ _appFocus so =
let s = so { let s = so {
_appCWD = f _appCWD = fromJust $ _appFocus so
, _appSubFiles = [] , _appSubFiles = []
} in } in
sizeDir s sizeDir s
| otherwise = pure so
scroll :: ScrollDirection -> AppS -> AppS scroll :: ScrollDirection -> AppS -> AppS
scroll d s = s { scroll d s = s {
@ -76,9 +108,18 @@ scroll d s = s {
newCursor = max 0 (min ((-) 1 . length $ _appSubFiles s) cursor) newCursor = max 0 (min ((-) 1 . length $ _appSubFiles s) cursor)
maybeNewPath = fst <$> _appSubFiles s !? newCursor maybeNewPath = fst <$> _appSubFiles s !? newCursor
initialState :: FilePath -> AppS
initialState f = AppS {
_appCWD = f
, _appCursor = 0
, _appFocus = pure f
, _appSubFiles = []
}
main :: IO () main :: IO ()
main = do main = do
a <- getWorkingDirectory a <- getWorkingDirectory
print =<< getSizeSubpaths a b <- changeDir $ initialState a
defaultMain app () _ <- defaultMain app b
return ()