126 lines
3.8 KiB
Haskell
126 lines
3.8 KiB
Haskell
{-# 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 ()
|