brick-filetree 0.1.0.2 → 0.1.0.3

raw patch · 6 files changed

+185/−111 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +24/−1
• brick-filetree.cabal +2/−2
• src/Brick/Widgets/FileTree.hs +8/−1
• src/Brick/Widgets/FileTree/Internal/Actions.hs +31/−31
• src/Brick/Widgets/FileTree/Internal/Render.hs +46/−30
• src/Brick/Widgets/FileTree/Internal/Types.hs +74/−46

@@ -11,6 +11,29 @@  A brick widget for exploring file trees. +You can dig through my unfinished cli file browser+[Delve](https://github.com/ChrisPenner/delve) for a few examples if you like.++Note that this works relatively well, but I give no guarantees about future+maintenance or feature requests.++Allows selecting multiple files/directories from anywhere in your filesystem+which can be viewed from your brick app and used for whatever you like.++Note, this uses lazy IO to build the file tree, which will be run iteratively+as you use the UI to explore it; this allows better performance, but all the+usual lazyIO caveats apply; shouldn't cause you too much trouble though.++## Usage:++-   Create a FileTree using `newFileTree`+-   Store this FileTree in your Brick State somewhere+-   Render the FileTree using `renderFileTree`+-   Wire up handlers for brick events to trigger FileTree actions, e.g.+    `moveUp`, `toggleFlagged`, etc.+-   At some point you'll want to get the selected object with+    `getCurrentFilePath` or get all flagged items with `getFlagged`.+ See [Hackage](https://hackage.haskell.org/package/brick-filetree) for docs. -[![asciicast](https://asciinema.org/a/BegqABw8NlGfEJqFfbOIVVozr.svg)](https://asciinema.org/a/BegqABw8NlGfEJqFfbOIVVozr)+![screencast](./screencast.gif)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: a1c35f4807a2c1fe8338398832ea28f66d6766999d7cc199b0f806d2a59daf21+-- hash: 60b970266b5b619a343adbc75e45bb7b94ca7d210c2f956ceca11f0af49ecfc7  name:           brick-filetree-version:        0.1.0.2+version:        0.1.0.3 description:    Please see the README on GitHub at <https://github.com/ChrisPenner/brick-filetree#readme> homepage:       https://github.com/ChrisPenner/brick-filetree#readme bug-reports:    https://github.com/ChrisPenner/brick-filetree/issues

@@ -2,6 +2,12 @@   (   -- * Types   FileTree+  , FileContext+  , flagged+  , val+  , path+  , name+  , kind    -- Initialization   , newFileTree@@ -25,7 +31,8 @@    -- * Rendering   , renderFileTree-  , renderSelection+  , renderFileTreeCustom+  , renderFileContext    -- ** Attributes   , flaggedItemAttr

@@ -35,59 +35,59 @@ import Data.Maybe  overCurrentList-  :: (List String SubTree -> EventM String (List String SubTree))-  -> FileTree-  -> EventM String FileTree-overCurrentList f fz@(FZ { context = x :< lst }) = do+  :: (List String (SubTree a) -> EventM String (List String (SubTree a)))+  -> FileTree a+  -> EventM String (FileTree a)+overCurrentList f fz@(FT { context = x :< lst }) = do   newLst <- f lst   return fz { context = x :< newLst } -pressKey :: V.Key -> (FileTree -> EventM String FileTree)+pressKey :: V.Key -> (FileTree a -> EventM String (FileTree a)) pressKey k = overCurrentList (handleListEvent (V.EvKey k []))  -- | Move the cursor down one item-moveDown :: FileTree -> EventM String FileTree+moveDown :: FileTree a -> EventM String (FileTree a) moveDown = pressKey V.KDown  -- | Move the cursor up one item-moveUp :: FileTree -> EventM String FileTree+moveUp :: FileTree a -> EventM String (FileTree a) moveUp = pressKey V.KUp  -- | Move the cursor down a page-pageDown :: FileTree -> EventM String FileTree+pageDown :: FileTree a -> EventM String (FileTree a) pageDown = pressKey V.KPageDown  -- | Move the cursor up a page-pageUp :: FileTree -> EventM String FileTree+pageUp :: FileTree a -> EventM String (FileTree a) pageUp = pressKey V.KPageDown  -- | Move the cursor the the top of the file list-moveToTop :: FileTree -> EventM String FileTree+moveToTop :: FileTree a -> EventM String (FileTree a) moveToTop = pressKey V.KHome  -- | Move the cursor the the bottom of the file list-moveToBottom :: FileTree -> EventM String FileTree+moveToBottom :: FileTree a -> EventM String (FileTree a) moveToBottom = pressKey V.KEnd  -- | Move the cursor up a directory in the file tree-ascendDir :: FileTree -> EventM String FileTree-ascendDir (FZ { parents = Seq.Empty, context = tree@((extract -> path -> p)), selection, ..})+ascendDir :: FileTree a -> EventM String (FileTree a)+ascendDir (FT { parents = Seq.Empty, context = tree@((extract -> path -> p)), selection, valLoader, ..})   = do-    fz <- liftIO $ buildParent p tree+    fz <- liftIO $ buildParent p valLoader tree     return $ fz { selection = selection }-ascendDir (FZ { parents = (ps Seq.:|> (f :< pList)), context, ..}) = do+ascendDir (FT { parents = (ps Seq.:|> (f :< pList)), context, ..}) = do   invalidateCacheEntry (cacheKey f)   return-    $ FZ {parents = ps, context = (f :< listModify (const context) pList), ..}+    $ FT {parents = ps, context = (f :< listModify (const context) pList), ..}  -- | If the cursor is on a directory then descend the cursor into that dir -- If the cursor is on a file nothing happens-descendDir :: FileTree -> EventM String FileTree-descendDir fz@(FZ { parents, context = (f :< children), ..}) = do+descendDir :: FileTree a -> EventM String (FileTree a)+descendDir fz@(FT { parents, context = (f :< children), ..}) = do   invalidateCacheEntry (cacheKey f)   return $ case listSelectedElement children of     Nothing -> fz-    Just (_, nextChildren@(FC { kind = Dir } :< _)) -> FZ+    Just (_, nextChildren@(FC { kind = Dir } :< _)) -> FT       { parents = (parents Seq.|> (f :< children))       , context = nextChildren       , ..@@ -95,37 +95,37 @@     Just _ -> fz  -- | Get the absolute path of the object (dir or file) under the cursor -getCurrentFilePath :: FileTree -> Maybe FilePath-getCurrentFilePath (FZ { context = unwrap -> children }) =+getCurrentFilePath :: FileTree a -> Maybe FilePath+getCurrentFilePath (FT { context = unwrap -> children }) =   case listSelectedElement children of     Nothing                            -> Nothing     Just (_, FC { kind = Error } :< _) -> Nothing     Just (_, fc :< _                 ) -> Just (path fc)  -- | Get the absolute path of the directory where the cursor currently is.-getCurrentDir :: FileTree -> FilePath-getCurrentDir (FZ { context = extract -> path -> p }) = p+getCurrentDir :: FileTree a -> FilePath+getCurrentDir (FT { context = extract -> path -> p }) = p  -- | Flag or unflag the current file or dir-toggleFlagged :: FileTree -> EventM String FileTree-toggleFlagged fz@(FZ { context = (fc :< lst), selection, ..}) = do+toggleFlagged :: FileTree a -> EventM String (FileTree a)+toggleFlagged fz@(FT { context = (fc :< lst), selection, ..}) = do   invalidateCacheEntry selectionCacheKey   return . fromMaybe fz $ do-    ((selectedContext@FC { selected = isSelected, path }) :< rest) <- snd+    ((selectedContext@FC { flagged = isSelected, path }) :< rest) <- snd       <$> listSelectedElement lst     let newSelection = if isSelected           then S.delete path selection           else S.insert path selection     let newList = listModify-          (const (selectedContext { selected = not isSelected } :< rest))+          (const (selectedContext { flagged = not isSelected } :< rest))           lst-    return $ FZ {context = (fc :< newList), selection = newSelection, ..}+    return $ FT {context = (fc :< newList), selection = newSelection, ..}  -- | Get all flagged file paths. All paths are absolute-getFlagged :: FileTree -> [FilePath]+getFlagged :: FileTree a -> [FilePath] getFlagged = toList . selection  -- | Hide/Show a list of all flagged files-toggleFlaggedVisible :: FileTree -> FileTree-toggleFlaggedVisible fz@(FZ { config }) =+toggleFlaggedVisible :: FileTree a -> FileTree a+toggleFlaggedVisible fz@(FT { config }) =   fz { config = config { showSelection = not $ showSelection config } }

@@ -10,8 +10,9 @@   , cacheKey   , renderHeader   , renderFileTree+  , renderFileTreeCustom   , selectionCacheKey-  , renderSelection+  , renderFileContext   ) where @@ -28,6 +29,10 @@ import           Data.Bool import qualified Data.Sequence                 as S +-- | Custom rendering function for a file+-- Note that the resulting widget must be exactly 1 row high.+type CustomFCRender a = FileContext a -> Widget String+ -- | Flagged items are rendered with this attr flaggedItemAttr :: AttrName flaggedItemAttr = "flaggedItemAttr"@@ -44,33 +49,43 @@ errorAttr :: AttrName errorAttr = "errorAttr" -cacheKey :: FileContext -> String+cacheKey :: FileContext a -> String cacheKey = path -renderHeader :: SubTree -> Widget String-renderHeader ((path -> p) :< _) = withAttr titleAttr (str p) <=> hBorder+renderHeader :: SubTree a -> Widget String+renderHeader ((path -> p) :< _) =+  withAttr titleAttr (str $ p <> "/") <=> hBorder -renderFileTree :: FileTree -> Widget String-renderFileTree fz@(FZ { parents, context, config }) =+renderFileTreeCustom :: CustomFCRender a -> FileTree a -> Widget String+renderFileTreeCustom customFCRender fz@(FT { parents, context, config }) =   (   renderHeader context-  <=> (renderParents parents <+> renderNode context <+> previewW)+  <=> (   renderParents customFCRender parents+      <+> renderNode customFCRender True context+      <+> previewW+      )   <=> selectionW   )  where   selectionW = if showSelection config then renderSelection fz else emptyWidget-  previewW   = if previewDir config then renderPreview context else emptyWidget+  previewW   = if previewDir config+    then renderPreview customFCRender context+    else emptyWidget -renderPreview :: SubTree -> Widget String-renderPreview (_ :< lst) = do+renderFileTree :: FileTree a -> Widget String+renderFileTree = renderFileTreeCustom renderFileContext++renderPreview :: CustomFCRender a -> SubTree a -> Widget String+renderPreview customFCRender (_ :< lst) = do   case listSelectedElement lst of-    Just (_, node@(FC { kind = Dir } :< _)) -> vBorder <+> renderNode node+    Just (_, node@(FC { kind = Dir } :< _)) ->+      vBorder <+> renderNode customFCRender False node     _ -> emptyWidget  selectionCacheKey :: String selectionCacheKey = "delve!selection" -renderSelection :: FileTree -> Widget String-renderSelection (FZ { selection })+renderSelection :: FileTree a -> Widget String+renderSelection (FT { selection })   | null selection   = emptyWidget   | otherwise@@ -80,34 +95,35 @@             . fmap (withAttr flaggedItemAttr . str)             . toList             $ selection-    in  hBorder <=> withAttr titleAttr (str "Selected") <=> selectionsW+    in  hBorder <=> withAttr titleAttr (str "flagged") <=> selectionsW -renderParents :: S.Seq SubTree -> Widget String-renderParents S.Empty                    = emptyWidget-renderParents parents@(_ S.:|> (p :< _)) = cached+renderParents :: CustomFCRender a -> S.Seq (SubTree a) -> Widget String+renderParents _              S.Empty                    = emptyWidget+renderParents customFCRender parents@(_ S.:|> (p :< _)) = cached   (cacheKey p)-  (hBox . toList $ (renderParent <$> S.drop ind parents))+  (hBox . toList $ (renderParent customFCRender <$> S.drop ind parents))  where   len = S.length parents   ind = max 0 (len - 2) -renderNode :: SubTree -> Widget String-renderNode (_ :< ls) = renderList-  (\b -> bool id (forceAttr listSelectedAttr) b . renderFileContext . extract)-  True+renderNode :: CustomFCRender a -> Bool -> SubTree a -> Widget String+renderNode customFCRender focused (_ :< ls) = renderList+  (\b -> bool id (forceAttr listSelectedAttr) b . customFCRender . extract)+  focused   ls -renderParent :: SubTree -> Widget String-renderParent = (<+> vBorder) . hLimit 20 . renderNode+renderParent :: CustomFCRender a -> SubTree a -> Widget String+renderParent customFCRender =+  (<+> vBorder) . hLimit 20 . renderNode customFCRender False -renderFileContext :: FileContext -> Widget String-renderFileContext (FC { kind = File, name, selected }) =+renderFileContext :: FileContext a -> Widget String+renderFileContext (FC { kind = File, name, flagged }) =   let (attr', modStr) =-        if selected then (flaggedItemAttr, "* ") else (fileAttr, "")+        if flagged then (flaggedItemAttr, "* ") else (fileAttr, "")   in  withAttr attr' . str $ modStr <> name renderFileContext (FC { kind = Error, name, path }) =   withAttr errorAttr . str $ "! " <> path <> ": " <> name-renderFileContext (FC { kind = Dir, name, selected }) =+renderFileContext (FC { kind = Dir, name, flagged }) =   let (attr', modStr) =-        if selected then (flaggedItemAttr, "* ") else (dirAttr, "")-  in  withAttr attr' . str $ modStr <> name <> "/"+        if flagged then (flaggedItemAttr, "* ") else (dirAttr, "")+  in  withAttr attr' . str $ modStr <> name

@@ -2,6 +2,7 @@ {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} module Brick.Widgets.FileTree.Internal.Types   ( FileKind(..)   , FileContext(..)@@ -22,15 +23,21 @@ import           System.FilePath.Posix import           System.Directory import qualified Data.Set                      as S+import Data.List+import System.IO.Unsafe  data FileKind = Dir | File | Error+  deriving (Eq, Ord, Show) -data FileContext =+type ValueLoader a = FileKind -> FilePath -> IO a++data FileContext a =   FC-    { selected :: Bool+    { flagged :: Bool     , path :: FilePath     , name :: String     , kind :: FileKind+    , val :: a     }  data Config =@@ -42,64 +49,85 @@ defaultConfig :: Config defaultConfig = Config {showSelection = True, previewDir = False} -type SubTree = Cofree (GenericList String V.Vector) FileContext+type SubTree a = Cofree (GenericList String V.Vector) (FileContext a)  -- | Represents all the state required to interact with or display a filetree-data FileTree = FZ-  { parents :: S.Seq SubTree+data FileTree a = FT+  { parents :: S.Seq (SubTree a)   , selection :: S.Set FilePath-  , context :: SubTree+  , context :: SubTree a   , config :: Config+  , valLoader :: ValueLoader a   } -buildParent :: FilePath -> SubTree -> IO FileTree-buildParent p child = do-  FZ { context = (c :< ls), ..} <- newFileTree (takeDirectory p)+buildParent :: FilePath -> ValueLoader a -> SubTree a -> IO (FileTree a)+buildParent p valLoader' child = do+  FT { context = (c :< ls), ..} <- newFileTree valLoader' (takeDirectory p)   let newChildren = fmap (replace p child) ls-  return $ FZ {context = c :< newChildren, ..}+  return $ FT {context = c :< newChildren, ..}  where   replace pth fc@((path -> pth') :< _) new | pth == pth' = new                                            | otherwise   = fc  -- | Create a new 'FileTree' situated at the given 'FilePath'-newFileTree :: FilePath -> IO FileTree-newFileTree currentDir = do+--+-- The given 'ValueLoader' will be used to load additional context for each+-- filepath (dirs AND files). It will be called lazily using 'unsafeInterleaveIO'+-- when the value itself is accessed (if ever).+newFileTree :: ValueLoader a -> FilePath -> IO (FileTree a)+newFileTree valLoader' currentDir = do   absRoot        <- makeAbsolute (normalise currentDir)-  (_ FT.:/ tree) <- FT.buildL absRoot-  return $ convert (takeDirectory absRoot) tree+  (_ FT.:/ tree) <- FT.readDirectoryWithL (interleavedValLoader File) absRoot+  convert interleavedValLoader (takeDirectory absRoot) tree+  where interleavedValLoader fk fp = unsafeInterleaveIO $ valLoader' fk fp -convert :: FilePath -> FT.DirTree FilePath -> FileTree-convert root tree =-  let subTree = go (normalise root) $ tree-  in  FZ-        { parents   = []-        , selection = mempty-        , config    = defaultConfig-        , context   = subTree-        }+convert+  :: forall a . ValueLoader a -> FilePath -> FT.DirTree a -> IO (FileTree a)+convert valLoader' root tree = do+  subTree <- go (normalise root) tree+  pure $ FT+    { parents   = []+    , selection = mempty+    , config    = defaultConfig+    , context   = subTree+    , valLoader = valLoader'+    }  where-  go :: FilePath -> FT.DirTree FilePath -> SubTree-  go root' (FT.Failed { FT.name, FT.err }) =-    FC-        { name     = show err-        , path     = normalise (root' </> name)-        , selected = False-        , kind     = Error-        }+  go :: FilePath -> FT.DirTree a -> IO (SubTree a)+  go root' (FT.Failed { FT.name, FT.err }) = do+    val <- valLoader' Error name+    pure+      $  FC+           { name    = show err+           , path    = normalise (root' </> name)+           , flagged = False+           , kind    = Error+           , val     = val+           }       :< list name mempty 1-  go root' (FT.File { FT.name }) =-    FC-        { name     = name-        , path     = normalise (root' </> name)-        , selected = False-        , kind     = File-        }+  go root' (FT.File { FT.name, FT.file }) =+    pure+      $  FC+           { name    = name+           , path    = normalise (root' </> name)+           , flagged = False+           , kind    = File+           , val     = file+           }       :< list name mempty 1-  go root' (FT.Dir path contents) =-    FC-        { name     = path-        , path     = normalise (root' </> path)-        , kind     = Dir-        , selected = False-        }-      :< list path (V.fromList . fmap (go (root' </> path)) $ contents) 1+  go root' (FT.Dir path contents) = do+    let absPath = normalise (root' </> path)+    val      <- valLoader' Dir absPath+    children <- traverse (go absPath) contents+    pure+      $  FC+           { name    = path <> "/"+           , path    = absPath+           , kind    = Dir+           , flagged = False+           , val     = val+           }+      :< list path (V.fromList . sortOn byFileType $ children) 1++byFileType :: SubTree a -> (FileKind, String)+byFileType (FC { kind, name } :< _) = (kind, name)