Work is being done?
This commit is contained in:
		
							
								
								
									
										65
									
								
								app/Main.hs
									
									
									
									
									
								
							
							
						
						
									
										65
									
								
								app/Main.hs
									
									
									
									
									
								
							| @ -1,3 +1,4 @@ | ||||
| {-# LANGUAGE BlockArguments #-} | ||||
| module Main where | ||||
|  | ||||
| import           System.Posix.Directory ( getWorkingDirectory ) | ||||
| @ -9,22 +10,29 @@ 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 (fmap not . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir | ||||
| listNonSymFiles dir = filterM ((not <$>) . pathIsSymbolicLink) =<< filterM doesFileExist =<< listContents dir | ||||
|  | ||||
| listNonSymDirectories :: FilePath -> IO [FilePath] | ||||
| listNonSymDirectories dir = filterM (fmap not . pathIsSymbolicLink) =<< filterM doesDirectoryExist =<< listContents dir | ||||
| 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 | ||||
|   pure $ sortOn (Data.Ord.Down . snd) $ local ++ subby ++ zip syms [0..0] | ||||
|  | ||||
| data AppS = AppS | ||||
|   { | ||||
| @ -41,27 +49,51 @@ data ScrollDirection where | ||||
| ui :: Widget () | ||||
| ui = viewport () Vertical $ str "Svamp är gott" | ||||
|  | ||||
| app :: App () e () | ||||
| app :: App AppS e () | ||||
| app = | ||||
|     App { appDraw = const [ui] | ||||
|     App { appDraw = pure . browse | ||||
|         , appHandleEvent = resizeOrQuit | ||||
|         , appStartEvent = pure () | ||||
|         , appAttrMap = const $ attrMap (white `on` blue) [] | ||||
|         , appChooseCursor = neverShowCursor | ||||
|         , 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 -> FilePath -> IO AppS | ||||
| changeDir so f = | ||||
| changeDir :: AppS -> IO AppS | ||||
| changeDir so | ||||
|   | isJust $ _appFocus so = | ||||
|     let s = so { | ||||
|           _appCWD = f | ||||
|             _appCWD = fromJust $ _appFocus so | ||||
|           , _appSubFiles = [] | ||||
|           } in | ||||
|     sizeDir s | ||||
|   | otherwise             = pure so | ||||
|  | ||||
| scroll :: ScrollDirection -> AppS -> AppS | ||||
| scroll d s = s { | ||||
| @ -76,9 +108,18 @@ scroll d s = s { | ||||
|         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 | ||||
|   print =<< getSizeSubpaths a | ||||
|   defaultMain app () | ||||
|   b <- changeDir $ initialState a | ||||
|   _ <- defaultMain app b | ||||
|   return () | ||||
|  | ||||
		Reference in New Issue
	
	Block a user