hcdu/app/Main.hs

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           Graphics.Vty
import           Data.List.Extra
import qualified Data.Ord

listNonSymFiles :: FilePath -> IO [FilePath]
listNonSymFiles dir = filterM (fmap not . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir

listNonSymDirectories :: FilePath -> IO [FilePath]
listNonSymDirectories dir = filterM (fmap not . pathIsSymbolicLink) =<< filterM doesDirectoryExist =<< listContents dir

getSizeSubpaths :: FilePath -> IO [(FilePath, Integer)]
getSizeSubpaths x = do
  sub   <- listNonSymDirectories x
  subby <- mapM (\y -> (y,) . sum . map snd <$> getSizeSubpaths y) sub
  local <- listNonSymFiles x >>= (\y -> mapM getFileSize y <&> zip y)
  pure $ sortOn (Data.Ord.Down . snd) $ local ++ subby

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 () e ()
app =
    App { appDraw = const [ui]
        , appHandleEvent = resizeOrQuit
        , appStartEvent = pure ()
        , appAttrMap = const $ attrMap (white `on` blue) []
        , appChooseCursor = neverShowCursor
        }

sizeDir :: AppS -> IO AppS
sizeDir s = do
  subFiles <- getSizeSubpaths $ _appCWD s
  pure $ s {_appSubFiles = subFiles}

changeDir :: AppS -> FilePath -> IO AppS
changeDir so f =
  let s = so {
          _appCWD = f
        , _appSubFiles = []
        } in
   sizeDir s

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


main :: IO ()
main = do
  a <- getWorkingDirectory
  print =<< getSizeSubpaths a
  defaultMain app ()