diff --git a/app/Main.hs b/app/Main.hs index 92ca3f2..13565b2 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,14 +1,16 @@ {-# LANGUAGE BlockArguments #-} module Main where -import System.Posix.Directory ( getWorkingDirectory ) +import System.Posix.Directory ( getWorkingDirectory, changeWorkingDirectory ) import System.Directory ( pathIsSymbolicLink , doesFileExist , getFileSize , doesDirectoryExist ) import Data.Functor ( (<&>) ) import Control.Monad ( filterM ) +import Control.Monad.IO.Class import System.Directory.Extra ( listContents ) +import System.IO.Error import Brick import Brick.Widgets.Edit import Graphics.Vty @@ -26,14 +28,28 @@ listNonSymDirectories dir = filterM ((not <$>) . pathIsSymbolicLink) =<< filterM listSym :: FilePath -> IO [FilePath] listSym dir = filterM pathIsSymbolicLink =<< listContents dir +handlePermissionError :: IOError -> IO Integer +handlePermissionError e = if isPermissionError e then pure 0 else ioError e + getSizeSubpaths :: FilePath -> IO [(FilePath, Integer)] getSizeSubpaths x = do 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 + (flip catchIOError handlePermissionError . getFileSize) y <&> + zip y) pure $ sortOn (Data.Ord.Down . snd) $ local ++ subby ++ zip syms [0..0] + +data ScrollDirection where + SUp :: ScrollDirection + SDown :: ScrollDirection + data AppS = AppS { _appCWD :: FilePath @@ -42,17 +58,10 @@ data AppS = AppS , _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 + , appHandleEvent = eventHandler , appStartEvent = pure () , appAttrMap = attributeMap , appChooseCursor = showFirstCursor @@ -73,9 +82,10 @@ browse s = 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 +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)) @@ -87,13 +97,25 @@ sizeDir s = do changeDir :: AppS -> IO AppS changeDir so - | isJust $ _appFocus so = - let s = so { - _appCWD = fromJust $ _appFocus so - , _appSubFiles = [] - } in - sizeDir s + | isJust $ _appFocus so = do + allowed <- doesDirectoryExist path + if allowed then do + changeWorkingDirectory path + let s = + so { + _appCWD = path + , _appSubFiles = [] + } in + sizeDir s else + pure so | otherwise = pure so + where path = fromJust $ _appFocus so + +overDir :: IO AppS +overDir = do + changeWorkingDirectory ".." + a <- getWorkingDirectory + changeDir $ initialState a scroll :: ScrollDirection -> AppS -> AppS scroll d s = s { @@ -105,17 +127,41 @@ scroll d s = s { case d of SUp -> (-1) SDown -> 1 - newCursor = max 0 (min ((-) 1 . length $ _appSubFiles s) cursor) + newCursor = max 0 (min (subtract 1 . length $ _appSubFiles s) cursor) maybeNewPath = fst <$> _appSubFiles s !? newCursor -initialState :: FilePath -> AppS -initialState f = AppS { - _appCWD = f - , _appCursor = 0 - , _appFocus = pure f - , _appSubFiles = [] - } +eventHandler :: BrickEvent () e -> EventM () AppS () +eventHandler (VtyEvent (EvKey k _)) = do + s <- get + case k of + (KChar 'q') -> halt + KEsc -> halt + (KChar 'j') -> put $ scroll SDown s + (KChar 'k') -> put $ scroll SUp s + KDown -> put $ scroll SDown s + KUp -> put $ scroll SUp s + + (KChar 'h') -> put =<< liftIO overDir + KLeft -> put =<< liftIO overDir + + (KChar ' ') -> put =<< liftIO (changeDir s) + KEnter -> put =<< liftIO (changeDir s) + (KChar 'l') -> put =<< liftIO (changeDir s) + KRight -> put =<< liftIO (changeDir s) + + _ -> continueWithoutRedraw + +eventHandler _ = undefined + +initialState :: FilePath -> AppS +initialState f = + AppS { + _appCWD = f + , _appCursor = 0 + , _appFocus = pure f + , _appSubFiles = [] + } main :: IO () main = do