hcdu/app/Main.hs

{-# LANGUAGE BlockArguments #-}
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           Brick.Widgets.Edit
import           Graphics.Vty
import           Data.List.Extra
import qualified Data.Ord
import           Data.Maybe


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

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

listSym :: FilePath -> IO [FilePath]
listSym dir = filterM pathIsSymbolicLink =<< listContents dir

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

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 AppS e ()
app =
    App { appDraw = pure . browse
        , appHandleEvent = resizeOrQuit
        , appStartEvent = pure ()
        , appAttrMap = attributeMap
        , appChooseCursor = showFirstCursor
        }

attributeMap :: AppS -> AttrMap
attributeMap = const $ attrMap defAttr
                  [ (attrName "selected", withStyle defAttr reverseVideo)
                  , (editAttr, fg brightBlack)
                  ]

select :: Widget () -> Widget ()
select = withAttr (attrName "selected")

browse :: AppS -> Widget ()
browse s =
  str "Path" <+> padLeft Max (str "Size") <=>
  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

pathWidget :: (FilePath, Integer) -> Widget ()
pathWidget (f, s) = str (show f) <+> padLeft Max (str (show s))

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

changeDir :: AppS -> IO AppS
changeDir so
  | isJust $ _appFocus so =
    let s = so {
            _appCWD = fromJust $ _appFocus so
          , _appSubFiles = []
          } in
    sizeDir s
  | otherwise             = pure so

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

initialState :: FilePath -> AppS
initialState f = AppS {
                        _appCWD = f
                      , _appCursor = 0
                      , _appFocus = pure f
                      , _appSubFiles = []
                      }


main :: IO ()
main = do
  a <- getWorkingDirectory
  b <- changeDir $ initialState a
  _ <- defaultMain app b
  return ()