diff --git a/app/Main.hs b/app/Main.hs index 0bc017d..92ca3f2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 = - let s = so { - _appCWD = f - , _appSubFiles = [] - } in - sizeDir s +changeDir :: AppS -> IO AppS +changeDir so + | isJust $ _appFocus so = + let s = so { + _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 ()