{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Brick.Widgets.FileTree.Internal.Actions
( moveUp
, moveDown
, pageUp
, pageDown
, moveToTop
, moveToBottom
, ascendDir
, descendDir
, getCurrentFilePath
, getCurrentDir
, toggleFlagged
, getFlagged
, toggleFlaggedVisible
) where
import qualified Graphics.Vty.Input as V
import Brick.Main
import Brick.Types
import Brick.Widgets.List
import Data.Foldable
import Control.Comonad.Cofree as CF
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import Brick.Widgets.FileTree.Internal.Types
import Brick.Widgets.FileTree.Internal.Render
import Control.Monad.IO.Class
import Control.Comonad
import Data.Maybe
overCurrentList
:: (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 a -> EventM String (FileTree a))
pressKey k = overCurrentList (handleListEvent (V.EvKey k []))
moveDown :: FileTree a -> EventM String (FileTree a)
moveDown = pressKey V.KDown
moveUp :: FileTree a -> EventM String (FileTree a)
moveUp = pressKey V.KUp
pageDown :: FileTree a -> EventM String (FileTree a)
pageDown = pressKey V.KPageDown
pageUp :: FileTree a -> EventM String (FileTree a)
pageUp = pressKey V.KPageDown
moveToTop :: FileTree a -> EventM String (FileTree a)
moveToTop = pressKey V.KHome
moveToBottom :: FileTree a -> EventM String (FileTree a)
moveToBottom = pressKey V.KEnd
ascendDir :: FileTree a -> EventM String (FileTree a)
ascendDir (FT { parents = Seq.Empty, context = tree@((extract -> path -> p)), selection, valLoader, ..})
= do
fz <- liftIO $ buildParent p valLoader tree
return $ fz { selection = selection }
ascendDir (FT { parents = (ps Seq.:|> (f :< pList)), context, ..}) = do
invalidateCacheEntry (cacheKey f)
return
$ FT {parents = ps, context = (f :< listModify (const context) pList), ..}
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 } :< _)) -> FT
{ parents = (parents Seq.|> (f :< children))
, context = nextChildren
, ..
}
Just _ -> fz
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)
getCurrentDir :: FileTree a -> FilePath
getCurrentDir (FT { context = extract -> path -> p }) = p
toggleFlagged :: FileTree a -> EventM String (FileTree a)
toggleFlagged fz@(FT { context = (fc :< lst), selection, ..}) = do
invalidateCacheEntry selectionCacheKey
return . fromMaybe fz $ do
((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 { flagged = not isSelected } :< rest))
lst
return $ FT {context = (fc :< newList), selection = newSelection, ..}
getFlagged :: FileTree a -> [FilePath]
getFlagged = toList . selection
toggleFlaggedVisible :: FileTree a -> FileTree a
toggleFlaggedVisible fz@(FT { config }) =
fz { config = config { showSelection = not $ showSelection config } }