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,9 +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]
@@ -31,19 +36,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 x = do
+getSizeSubpaths :: FilePath -> IORef (IOHashMap FilePath [(FilePath, Integer)]) -> IO [(FilePath, Integer)]
+getSizeSubpaths x i = do
+  memo <- readIORef i
+  val <- lookup x memo
+  case val of
+    Just b -> pure b
+    _      -> do
         sub   <- listNonSymDirectories x
         subby <- mapM
                   (\y -> (y,) . sum . map snd <$>
-               getSizeSubpaths y)
+                    getSizeSubpaths y i)
                 sub
         syms  <- listSym x
         local <- listNonSymFiles x >>=
           (\y -> mapM
             (flip catchIOError handlePermissionError . getFileSize) y <&>
             zip y)
-  pure $ sortOn (Data.Ord.Down . snd) $ local ++ subby ++ zip syms [0..0]
+        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 +69,7 @@ data AppS = AppS
   , appCursor :: Int
   , appFocus :: Maybe FilePath
   , appSubFiles :: [(FilePath, Integer)]
+  , appMemo  :: IORef (IOHashMap FilePath [(FilePath, Integer)])
   }
 
 app :: App AppS e ()
@@ -109,7 +123,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 +147,16 @@ changeDir so
   | otherwise             = pure so
   where path = fromJust $ appFocus so
 
-overDir :: IO AppS
-overDir = do
+overDir :: AppS -> IO AppS
+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 +183,8 @@ eventHandler (VtyEvent (EvKey k _)) = do
       (KChar 'k') -> put $ scroll SUp s
       KUp         -> put $ scroll SUp s
 
-      (KChar 'h') -> put =<< liftIO overDir
-      KLeft       -> put =<< liftIO overDir
+      (KChar 'h') -> put =<< liftIO (overDir s)
+      KLeft       -> put =<< liftIO (overDir s)
 
       (KChar ' ') -> put =<< liftIO (changeDir s)
       KEnter      -> put =<< liftIO (changeDir s)
@@ -173,21 +192,23 @@ eventHandler (VtyEvent (EvKey k _)) = do
       KRight      -> put =<< liftIO (changeDir s)
 
       _           -> continueWithoutRedraw
-
+eventHandler (VtyEvent (EvResize _ _)) = pure ()
 eventHandler _ = undefined
 
-initialState :: FilePath -> AppS
-initialState f =
+initialState :: FilePath -> IORef (IOHashMap FilePath [(FilePath, Integer)]) -> AppS
+initialState f i =
   AppS {
           appCWD = f
         , appCursor = 0
         , appFocus = pure f
         , appSubFiles = []
+        , appMemo = i
         }
 
 main :: IO ()
 main = do
   a <- getWorkingDirectory
-  b <- changeDir $ initialState a
-  _ <- defaultMain app b
+  b <- newIORef =<< empty
+  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