(・・;)ゞ
This commit is contained in:
parent
95b7cf36aa
commit
966744f709
56
app/Main.hs
56
app/Main.hs
@ -7,6 +7,8 @@ import Data.Functor ( (<&>) )
|
|||||||
import Control.Monad ( filterM )
|
import Control.Monad ( filterM )
|
||||||
import System.Directory.Extra ( listContents )
|
import System.Directory.Extra ( listContents )
|
||||||
import Brick
|
import Brick
|
||||||
|
import Graphics.Vty
|
||||||
|
import Data.List.Extra
|
||||||
|
|
||||||
listNonSymFiles :: FilePath -> IO [FilePath]
|
listNonSymFiles :: FilePath -> IO [FilePath]
|
||||||
listNonSymFiles dir = filterM (fmap not . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir
|
listNonSymFiles dir = filterM (fmap not . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir
|
||||||
@ -19,9 +21,61 @@ getSizeSubpaths x = do
|
|||||||
sub <- listNonSymDirectories x
|
sub <- listNonSymDirectories x
|
||||||
subby <- mapM (\y -> (y,) . sum . map snd <$> getSizeSubpaths y) sub
|
subby <- mapM (\y -> (y,) . sum . map snd <$> getSizeSubpaths y) sub
|
||||||
local <- listNonSymFiles x >>= (\y -> mapM getFileSize y <&> zip y)
|
local <- listNonSymFiles x >>= (\y -> mapM getFileSize y <&> zip y)
|
||||||
return $ local ++ subby
|
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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
a <- getWorkingDirectory
|
a <- getWorkingDirectory
|
||||||
print =<< getSizeSubpaths a
|
print =<< getSizeSubpaths a
|
||||||
|
defaultMain app ()
|
||||||
|
@ -74,9 +74,13 @@ executable hcdu
|
|||||||
, unix
|
, unix
|
||||||
, extra
|
, extra
|
||||||
, directory
|
, directory
|
||||||
|
, vty
|
||||||
|
|
||||||
-- Directories containing source files.
|
-- Directories containing source files.
|
||||||
hs-source-dirs: app
|
hs-source-dirs: app
|
||||||
|
|
||||||
-- Base language which the package is written in.
|
-- Base language which the package is written in.
|
||||||
default-language: GHC2021
|
default-language: GHC2021
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
-threaded
|
||||||
|
Loading…
Reference in New Issue
Block a user