What am I doing!?

app/Main.hs

@@ -1,12 +1,14 @@
 {-# LANGUAGE BlockArguments #-}
 module Main where
 
+import           Prelude         hiding ( lookup )
 import           System.Posix.Directory ( getWorkingDirectory, changeWorkingDirectory )
 import           System.Directory       ( pathIsSymbolicLink
                                         , doesFileExist
                                         , getFileSize
                                         , doesDirectoryExist )
 import           Data.Functor           ( (<&>) )
+import           Data.IORef
 import           Control.Monad          ( filterM )
 import           Control.Monad.IO.Class
 import           System.Directory.Extra ( listContents )
@@ -14,10 +16,12 @@ import           System.IO.Error
 import           Brick
 import           Brick.Widgets.Edit
 import           Graphics.Vty
-import           Data.List.Extra
+import           Data.List.Extra        ( sortOn
+                                        , (!?))
 import qualified Data.Ord
 import           Data.Maybe
-
+import           Data.IOHashMap hiding ( foldr
+                                       , (!?) )
 
 listNonSymFiles :: FilePath -> IO [FilePath]
 listNonSymFiles dir = filterM ((not <$>) . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir
@@ -31,19 +35,27 @@ 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 :: FilePath -> IORef (IOHashMap FilePath [(FilePath, Integer)]) -> IO [(FilePath, Integer)]
-getSizeSubpaths x = do
+getSizeSubpaths x i = do
-  sub   <- listNonSymDirectories x
+  memo <- readIORef i
-  subby <- mapM
+  val <- lookup x memo
-             (\y -> (y,) . sum . map snd <$>
+  case val of
-               getSizeSubpaths y)
+    Just b -> pure b
-           sub
+    _      -> do
-  syms  <- listSym x
+        sub   <- listNonSymDirectories x
-  local <- listNonSymFiles x >>=
+        subby <- mapM
-    (\y -> mapM
+                  (\y -> (y,) . sum . map snd <$>
-      (flip catchIOError handlePermissionError . getFileSize) y <&>
+                    getSizeSubpaths y i)
-       zip y)
+                sub
-  pure $ sortOn (Data.Ord.Down . snd) $ local ++ subby ++ zip syms [0..0]
+        syms  <- listSym x
+        local <- listNonSymFiles x >>=
+          (\y -> mapM
+            (flip catchIOError handlePermissionError . getFileSize) y <&>
+            zip y)
+        let temp = sortOn (Data.Ord.Down . snd) $ local ++ subby ++ zip syms [0..0]
+        insert x temp memo
+        writeIORef i memo
+        pure temp
 
 
 data ScrollDirection where
@@ -56,6 +68,7 @@ data AppS = AppS
   , appCursor :: Int
   , appFocus :: Maybe FilePath
   , appSubFiles :: [(FilePath, Integer)]
+  , appMemo  :: IORef (IOHashMap FilePath [(FilePath, Integer)])
   }
 
 app :: App AppS e ()
@@ -109,7 +122,7 @@ pathWidget (f, s) = str (show f) <+> padLeft Max (str (unitSize s))
 
 sizeDir :: AppS -> IO AppS
 sizeDir s = do
-  subFiles <- getSizeSubpaths $ appCWD s
+  subFiles <- getSizeSubpaths (appCWD s) (appMemo s)
   pure $
     s {
         appCursor = 0
@@ -133,11 +146,16 @@ changeDir so
   | otherwise             = pure so
   where path = fromJust $ appFocus so
 
-overDir :: IO AppS
+overDir :: AppS -> IO AppS
-overDir = do
+overDir s = do
   changeWorkingDirectory ".."
   a <- getWorkingDirectory
-  changeDir $ initialState a
+  changeDir $ s {
+                  appCWD = a
+                , appCursor = 0
+                , appFocus = pure a
+                , appSubFiles = []
+                }
 
 scroll :: ScrollDirection -> AppS -> AppS
 scroll d s = s {
@@ -164,8 +182,8 @@ eventHandler (VtyEvent (EvKey k _)) = do
       (KChar 'k') -> put $ scroll SUp s
       KUp         -> put $ scroll SUp s
 
-      (KChar 'h') -> put =<< liftIO overDir
+      (KChar 'h') -> put =<< liftIO (overDir s)
-      KLeft       -> put =<< liftIO overDir
+      KLeft       -> put =<< liftIO (overDir s)
 
       (KChar ' ') -> put =<< liftIO (changeDir s)
       KEnter      -> put =<< liftIO (changeDir s)
@@ -173,21 +191,23 @@ eventHandler (VtyEvent (EvKey k _)) = do
       KRight      -> put =<< liftIO (changeDir s)
 
       _           -> continueWithoutRedraw
-
+eventHandler (VtyEvent (EvResize _ _)) = pure ()
 eventHandler _ = undefined
 
-initialState :: FilePath -> AppS
+initialState :: FilePath -> IORef (IOHashMap FilePath [(FilePath, Integer)]) -> AppS
-initialState f =
+initialState f i =
   AppS {
           appCWD = f
         , appCursor = 0
         , appFocus = pure f
         , appSubFiles = []
+        , appMemo = i
         }
 
 main :: IO ()
 main = do
   a <- getWorkingDirectory
-  b <- changeDir $ initialState a
+  b <- newIORef =<< empty
-  _ <- defaultMain app b
+  c <- changeDir $ initialState a b
+  _ <- defaultMain app c
   return ()

hcdu.cabal

@@ -75,6 +75,7 @@ executable hcdu
                     , extra
                     , directory
                     , vty
+                    , hashmap-io
 
     -- Directories containing source files.
     hs-source-dirs:   app