diff --git a/app/Main.hs b/app/Main.hs index 94d6ee9..8978d99 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,6 +7,8 @@ import Data.Functor ( (<&>) ) import Control.Monad ( filterM ) import System.Directory.Extra ( listContents ) import Brick +import Graphics.Vty +import Data.List.Extra listNonSymFiles :: FilePath -> IO [FilePath] listNonSymFiles dir = filterM (fmap not . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir @@ -19,9 +21,61 @@ getSizeSubpaths x = do sub <- listNonSymDirectories x subby <- mapM (\y -> (y,) . sum . map snd <$> getSizeSubpaths y) sub local <- listNonSymFiles x >>= (\y -> mapM getFileSize y <&> zip y) - return $ local ++ subby + pure $ local ++ subby + +data AppS = AppS + { + _appCWD :: FilePath + , _appCursor :: Int + , _appFocus :: Maybe FilePath + , _appSubFiles :: [(FilePath, Integer)] + } + +data ScrollDirection where + SUp :: ScrollDirection + SDown :: ScrollDirection + +ui :: Widget () +ui = viewport () Vertical $ str "Svamp är gott" + +app :: App () e () +app = + App { appDraw = const [ui] + , appHandleEvent = resizeOrQuit + , appStartEvent = pure () + , appAttrMap = const $ attrMap (white `on` blue) [] + , appChooseCursor = neverShowCursor + } + +sizeDir :: AppS -> IO AppS +sizeDir s = do + subFiles <- getSizeSubpaths $ _appCWD s + pure $ s {_appSubFiles = subFiles} + +changeDir :: AppS -> FilePath -> IO AppS +changeDir so f = + let s = so { + _appCWD = f + , _appSubFiles = [] + } in + sizeDir s + +scroll :: ScrollDirection -> AppS -> AppS +scroll d s = s { + _appCursor = newCursor + , _appFocus = maybeNewPath + } + where cursor = + _appCursor s + + case d of + SUp -> (-1) + SDown -> 1 + newCursor = max 0 (min ((-) 1 . length $ _appSubFiles s) cursor) + maybeNewPath = fst <$> _appSubFiles s !? newCursor + main :: IO () main = do a <- getWorkingDirectory print =<< getSizeSubpaths a + defaultMain app () diff --git a/hcdu.cabal b/hcdu.cabal index f9ba179..c1755bf 100644 --- a/hcdu.cabal +++ b/hcdu.cabal @@ -74,9 +74,13 @@ executable hcdu , unix , extra , directory + , vty -- Directories containing source files. hs-source-dirs: app -- Base language which the package is written in. default-language: GHC2021 + + ghc-options: + -threaded