diff options
| -rw-r--r-- | daffm.cabal | 6 | ||||
| -rw-r--r-- | exe/Main.hs | 94 | ||||
| -rw-r--r-- | lib/Daffm.hs | 127 | ||||
| -rw-r--r-- | lib/Daffm/Attrs.hs | 17 | ||||
| -rw-r--r-- | lib/Daffm/Types.hs | 29 | ||||
| -rw-r--r-- | lib/Daffm/View.hs | 25 |
6 files changed, 209 insertions, 89 deletions
diff --git a/daffm.cabal b/daffm.cabal index 850b40a..5f74735 100644 --- a/daffm.cabal +++ b/daffm.cabal @@ -19,6 +19,7 @@ common common-config NamedFieldPuns OverloadedStrings QuasiQuotes + MultiWayIf TemplateHaskell default-language: Haskell2010 build-depends: @@ -28,6 +29,8 @@ common common-config containers, data-default <= 0.8.0.1, directory <= 1.3.9.0, + filepath <= 1.5.4.0, + unix-compat <= 0.7.4.1, mtl == 2.3.1, temporary, text, @@ -52,6 +55,9 @@ library lib-daffm hs-source-dirs: lib exposed-modules: Daffm + Daffm.View + Daffm.Types + Daffm.Attrs test-suite specs import: common-config, warnings diff --git a/exe/Main.hs b/exe/Main.hs index 9d4f1ae..5e71066 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -1,92 +1,14 @@ module Main where -import qualified Brick.AttrMap as A import qualified Brick.Main as M -import Brick.Types (Widget) -import qualified Brick.Types as T -import Brick.Util (fg) -import Brick.Widgets.Core - ( str, - vBox, - vLimit, - withAttr, - (<+>), - ) -import qualified Brick.Widgets.List as L import Control.Monad (void) -import Control.Monad.State (gets, modify) -import Data.Maybe (fromMaybe) -import qualified Data.Vector as Vec -import qualified Graphics.Vty as V - -drawUI :: (Show a) => L.List () a -> [Widget ()] -drawUI l = [ui] - where - ui = - vBox - [ box, - vLimit 1 label - ] - label = str "Item " <+> cur <+> str " of " <+> total - cur = case L.listSelected l of - Nothing -> str "-" - Just i -> str (show (i + 1)) - total = str $ show $ Vec.length $ L.listElements l - box = - L.renderList listDrawElement True l - -appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) () -appEvent (T.VtyEvent e) = - case e of - V.EvKey (V.KChar '+') [] -> do - els <- gets L.listElements - let el = nextElement els - pos = Vec.length els - modify $ L.listInsert pos el - V.EvKey (V.KChar '-') [] -> do - sel <- gets L.listSelected - case sel of - Nothing -> pure () - Just i -> modify $ L.listRemove i - V.EvKey V.KEsc [] -> M.halt - ev -> L.handleListEvent ev - where - nextElement :: Vec.Vector Char -> Char - nextElement v = fromMaybe '?' $ Vec.find (`Vec.notElem` v) (Vec.fromList ['a' .. 'z']) -appEvent _ = pure () - -listDrawElement :: (Show a) => Bool -> a -> Widget () -listDrawElement sel a = - let selStr s = - if sel - then withAttr customAttr (str $ "<" <> s <> ">") - else str s - in str "Item " <+> selStr (show a) - -initialState :: L.List () Char -initialState = L.list () (Vec.fromList ['a', 'b', 'c']) 1 - -customAttr :: A.AttrName -customAttr = L.listSelectedAttr <> A.attrName "custom" - -theMap :: A.AttrMap -theMap = - A.attrMap - V.defAttr - [ (L.listAttr, fg V.blue), - (L.listSelectedAttr, fg V.white), - (customAttr, fg V.cyan) - ] - -theApp :: M.App (L.List () Char) e () -theApp = - M.App - { M.appDraw = drawUI, - M.appChooseCursor = M.showFirstCursor, - M.appHandleEvent = appEvent, - M.appStartEvent = pure (), - M.appAttrMap = const theMap - } +import qualified Daffm +import System.Directory (getCurrentDirectory) +import System.FilePath (takeDirectory) main :: IO () -main = void $ M.defaultMain theApp initialState +main = do + cwd <- getCurrentDirectory + let parentDir = takeDirectory cwd + initialState <- Daffm.loadDirInAppState cwd parentDir Daffm.mkEmptyAppState + void $ M.defaultMain Daffm.app initialState diff --git a/lib/Daffm.hs b/lib/Daffm.hs index 44d3655..39a43d0 100644 --- a/lib/Daffm.hs +++ b/lib/Daffm.hs @@ -1,5 +1,126 @@ module Daffm where -run :: IO () -run = do - putStrLn "wow" +import qualified Brick.Main as M +import qualified Brick.Types as T +import qualified Brick.Widgets.List as L +import Control.Monad (forM) +import Control.Monad.State (MonadIO (liftIO), get, gets, modify) +import Daffm.Attrs (appAttrMap) +import Daffm.Types (AppState (..), FileInfo (..), FileType (..)) +import Daffm.View (appView) +import Data.Char (toLower) +import Data.List (sortBy) +import Data.Maybe (fromMaybe) +import Data.Vector ((!?)) +import qualified Data.Vector as Vec +import qualified Graphics.Vty as V +import System.Directory (listDirectory, makeAbsolute, setCurrentDirectory) +import System.FilePath (takeDirectory) +import qualified System.PosixCompat as Posix + +openSelectedFile :: T.EventM () AppState () +openSelectedFile = do + state <- get + let indexM = L.listSelected . stateFiles $ state + let files = L.listElements . stateFiles $ state + let fileM = indexM >>= (files !?) + case fileM of + Just (FileInfo {filePath, fileType = Directory}) -> do + let parentDir = stateCwd state + nextState <- liftIO $ loadDirInAppState filePath parentDir state + modify (const nextState) + pure () + Just (FileInfo {filePath, fileType}) -> do + liftIO . putStrLn $ "Opening " <> show fileType <> ": " <> filePath + pure () + Nothing -> pure () + pure () + +goBackToParentDir :: T.EventM () AppState () +goBackToParentDir = do + state <- get + let dir = stateParentDir state + let parentDir = takeDirectory dir + nextState <- liftIO $ loadDirInAppState dir parentDir state + modify (const nextState) + +appEvent :: T.BrickEvent () e -> T.EventM () AppState () +appEvent (T.VtyEvent e) = + case e of + V.EvKey V.KEsc [] -> M.halt + V.EvKey (V.KChar 'q') [] -> M.halt + V.EvKey (V.KChar 'l') [] -> openSelectedFile + V.EvKey (V.KChar 'h') [] -> goBackToParentDir + V.EvKey V.KEnter [] -> openSelectedFile + V.EvKey V.KBS [] -> goBackToParentDir + ev -> do + files <- gets stateFiles + newFiles <- T.nestEventM' files (L.handleListEventVi L.handleListEvent ev) + modify (\appState -> appState {stateFiles = newFiles}) +appEvent _ = pure () + +app :: M.App AppState e () +app = + M.App + { M.appDraw = appView, + M.appChooseCursor = M.showFirstCursor, + M.appHandleEvent = appEvent, + M.appStartEvent = pure (), + M.appAttrMap = const appAttrMap + } + +fileTypeFromStatus :: Posix.FileStatus -> Maybe FileType +fileTypeFromStatus s = + if + | Posix.isBlockDevice s -> Just BlockDevice + | Posix.isCharacterDevice s -> Just CharacterDevice + | Posix.isNamedPipe s -> Just NamedPipe + | Posix.isRegularFile s -> Just RegularFile + | Posix.isDirectory s -> Just Directory + | Posix.isSocket s -> Just UnixSocket + | Posix.isSymbolicLink s -> Just SymbolicLink + | otherwise -> Nothing + +getFileInfo :: FilePath -> IO FileInfo +getFileInfo name = do + path <- makeAbsolute name + stat <- Posix.getSymbolicLinkStatus path + pure $ + FileInfo + { filePath = path, + fileName = name, + fileSize = Posix.fileSize stat, + fileType = fromMaybe RegularFile $ fileTypeFromStatus stat + } + +fileSorter :: FileInfo -> FileInfo -> Ordering +fileSorter (FileInfo {fileType = Directory, fileName = fa}) (FileInfo {fileType = Directory, fileName = fb}) = + compare (toLower <$> fa) (toLower <$> fb) +fileSorter (FileInfo {fileType = Directory}) _ = LT +fileSorter _ (FileInfo {fileType = Directory}) = GT +fileSorter (FileInfo {fileName = fa}) (FileInfo {fileName = fb}) = + compare (toLower <$> fa) (toLower <$> fb) + +listFilesInDir :: FilePath -> IO [FileInfo] +listFilesInDir dir = do + files <- listDirectory dir + sortBy fileSorter <$> forM files getFileInfo + +loadDirInAppState :: FilePath -> FilePath -> AppState -> IO AppState +loadDirInAppState dir parentDir appState = do + setCurrentDirectory dir + files <- listFilesInDir dir + pure $ + appState + { stateFiles = L.list () (Vec.fromList files) 1, + stateCwd = dir, + stateParentDir = parentDir + } + +mkEmptyAppState :: AppState +mkEmptyAppState = + AppState + { stateFiles = L.list () (Vec.fromList []) 1, + stateCwd = "", + stateParentDir = "" + } diff --git a/lib/Daffm/Attrs.hs b/lib/Daffm/Attrs.hs new file mode 100644 index 0000000..93a4163 --- /dev/null +++ b/lib/Daffm/Attrs.hs @@ -0,0 +1,17 @@ +module Daffm.Attrs where + +import qualified Brick.AttrMap as A +import Brick.Util (fg) +import qualified Brick.Widgets.List as L +import qualified Graphics.Vty as V + +selectedFileAttr :: A.AttrName +selectedFileAttr = A.attrName "selected-file" + +appAttrMap :: A.AttrMap +appAttrMap = + A.attrMap + V.defAttr + [ (L.listAttr, fg V.white), + (selectedFileAttr, fg V.cyan) + ] diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs new file mode 100644 index 0000000..2a8e97d --- /dev/null +++ b/lib/Daffm/Types.hs @@ -0,0 +1,29 @@ +module Daffm.Types where + +import qualified Brick.Widgets.List as L +import System.Posix.Types (FileOffset) + +data FileType + = RegularFile + | BlockDevice + | CharacterDevice + | NamedPipe + | Directory + | SymbolicLink + | UnixSocket + deriving (Show) + +data FileInfo = FileInfo + { fileName :: String, + filePath :: FilePath, + fileSize :: FileOffset, + fileType :: FileType + } + deriving (Show) + +data AppState = AppState + { stateFiles :: L.List () FileInfo, + stateCwd :: FilePath, + stateParentDir :: FilePath + } + deriving (Show) diff --git a/lib/Daffm/View.hs b/lib/Daffm/View.hs new file mode 100644 index 0000000..02529ac --- /dev/null +++ b/lib/Daffm/View.hs @@ -0,0 +1,25 @@ +module Daffm.View where + +import Brick.Types (Widget) +import Brick.Widgets.Core (str, vBox, vLimit, withAttr, (<+>)) +import qualified Brick.Widgets.List as L +import Daffm.Attrs (selectedFileAttr) +import Daffm.Types (AppState (..), FileInfo (..)) +import qualified Data.Vector as Vec + +appView :: AppState -> [Widget ()] +appView (AppState {stateFiles, stateCwd}) = [ui] + where + ui = vBox [vLimit 1 header, box, vLimit 1 cmdline] + header = str stateCwd + cmdline = str "Item " <+> cur <+> str " of " <+> total + cur = case L.listSelected stateFiles of + Nothing -> str "-" + Just i -> str (show (i + 1)) + total = str $ show $ Vec.length $ L.listElements stateFiles + box = L.renderList fileItemView True stateFiles + +fileItemView :: Bool -> FileInfo -> Widget () +fileItemView sel (FileInfo {fileName, fileSize, fileType}) = + let wrap w = if sel then withAttr selectedFileAttr w else w + in wrap (str fileName) <+> str (" : " <> show fileSize <> " | " <> show fileType) |