{-# LANGUAGE BlockArguments #-} module Main where import System.Posix.Directory ( getWorkingDirectory ) import System.Directory ( pathIsSymbolicLink , doesFileExist , getFileSize , doesDirectoryExist ) 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 ((not <$>) . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir listNonSymDirectories :: FilePath -> IO [FilePath] 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 ++ zip syms [0..0] 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 AppS e () app = App { appDraw = pure . browse , appHandleEvent = resizeOrQuit , appStartEvent = pure () , 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 -> 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 { _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 initialState :: FilePath -> AppS initialState f = AppS { _appCWD = f , _appCursor = 0 , _appFocus = pure f , _appSubFiles = [] } main :: IO () main = do a <- getWorkingDirectory b <- changeDir $ initialState a _ <- defaultMain app b return ()