(＠_＠)

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
+  | isJust $ _appFocus so = do
+    allowed <- doesDirectoryExist path
+    if allowed then do
+      changeWorkingDirectory path
+      let s =
+            so {
+                _appCWD       = path
               , _appSubFiles  = []
               } in
-    sizeDir s
+                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,18 +127,42 @@ 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
 
+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 {
+initialState f =
+  AppS {
           _appCWD = f
         , _appCursor = 0
         , _appFocus = pure f
         , _appSubFiles = []
         }
 
-
 main :: IO ()
 main = do
   a <- getWorkingDirectory