Simple file explorer ui

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)