82 lines
2.2 KiB
Haskell
82 lines
2.2 KiB
Haskell
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
|
|
|
|
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 $ 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 ()
|