{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable#-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module Brick.Widgets.List
( GenericList
, List
, list
, renderList
, renderListWithIndex
, handleListEvent
, handleListEventVi
, listElementsL
, listSelectedL
, listNameL
, listItemHeightL
, listElements
, listName
, listSelectedElement
, listSelected
, listItemHeight
, listMoveBy
, listMoveTo
, listMoveToElement
, listFindBy
, listMoveUp
, listMoveDown
, listMoveByPages
, listMovePageUp
, listMovePageDown
, listInsert
, listRemove
, listReplace
, listClear
, listReverse
, listModify
, listAttr
, listSelectedAttr
, listSelectedFocusedAttr
, Splittable(..)
, Reversible(..)
)
where
import Prelude hiding (reverse, splitAt)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>), pure)
import Data.Foldable (Foldable, find, toList)
import Data.Traversable (Traversable)
#else
import Data.Foldable (find, toList)
#endif
import Control.Monad.Trans.State (evalState, get, put)
import Lens.Micro ((^.), (^?), (&), (.~), (%~), _2, _head, set)
import Data.Functor (($>))
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Maybe (fromMaybe)
import Data.Semigroup (Semigroup, (<>), sconcat)
import qualified Data.Sequence as Seq
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import qualified Data.Vector as V
import GHC.Generics (Generic)
import Brick.Types
import Brick.Main (lookupViewport)
import Brick.Widgets.Core
import Brick.Util (clamp)
import Brick.AttrMap
data GenericList n t e =
List { listElements :: !(t e)
, listSelected :: !(Maybe Int)
, listName :: n
, listItemHeight :: Int
} deriving (Functor, Foldable, Traversable, Show, Generic)
suffixLenses ''GenericList
type List n e = GenericList n V.Vector e
instance Named (GenericList n t e) n where
getName = listName
class Splittable t where
{-# MINIMAL splitAt #-}
splitAt :: Int -> t a -> (t a, t a)
slice :: Int -> Int -> t a -> t a
slice i n = fst . splitAt n . snd . splitAt i
instance Splittable V.Vector where
splitAt = V.splitAt
instance Splittable Seq.Seq where
splitAt = Seq.splitAt
class Reversible t where
{-# MINIMAL reverse #-}
reverse :: t a -> t a
instance Reversible V.Vector where
reverse = V.reverse
instance Reversible Seq.Seq where
reverse = Seq.reverse
handleListEvent :: (Foldable t, Splittable t, Ord n)
=> Event
-> GenericList n t e
-> EventM n (GenericList n t e)
handleListEvent e theList =
case e of
EvKey KUp [] -> return $ listMoveUp theList
EvKey KDown [] -> return $ listMoveDown theList
EvKey KHome [] -> return $ listMoveTo 0 theList
EvKey KEnd [] -> return $ listMoveTo (length $ listElements theList) theList
EvKey KPageDown [] -> listMovePageDown theList
EvKey KPageUp [] -> listMovePageUp theList
_ -> return theList
handleListEventVi :: (Foldable t, Splittable t, Ord n)
=> (Event -> GenericList n t e -> EventM n (GenericList n t e))
-> Event
-> GenericList n t e
-> EventM n (GenericList n t e)
handleListEventVi fallback e theList =
case e of
EvKey (KChar 'k') [] -> return $ listMoveUp theList
EvKey (KChar 'j') [] -> return $ listMoveDown theList
EvKey (KChar 'g') [] -> return $ listMoveTo 0 theList
EvKey (KChar 'G') [] -> return $ listMoveTo (length $ listElements theList) theList
EvKey (KChar 'f') [MCtrl] -> listMovePageDown theList
EvKey (KChar 'b') [MCtrl] -> listMovePageUp theList
EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double) theList
EvKey (KChar 'u') [MCtrl] -> listMoveByPages (-0.5::Double) theList
_ -> fallback e theList
listAttr :: AttrName
listAttr = "list"
listSelectedAttr :: AttrName
listSelectedAttr = listAttr <> "selected"
listSelectedFocusedAttr :: AttrName
listSelectedFocusedAttr = listSelectedAttr <> "focused"
list :: (Foldable t)
=> n
-> t e
-> Int
-> GenericList n t e
list name es h =
let selIndex = if null es then Nothing else Just 0
safeHeight = max 1 h
in List es selIndex name safeHeight
renderList :: (Traversable t, Splittable t, Ord n, Show n)
=> (Bool -> e -> Widget n)
-> Bool
-> GenericList n t e
-> Widget n
renderList drawElem = renderListWithIndex $ const drawElem
renderListWithIndex :: (Traversable t, Splittable t, Ord n, Show n)
=> (Int -> Bool -> e -> Widget n)
-> Bool
-> GenericList n t e
-> Widget n
renderListWithIndex drawElem foc l =
withDefAttr listAttr $
drawListElements foc l drawElem
imap :: (Traversable t) => (Int -> a -> b) -> t a -> t b
imap f xs =
let act = traverse (\a -> get >>= \i -> put (i + 1) $> f i a) xs
in evalState act 0
drawListElements :: (Traversable t, Splittable t, Ord n, Show n)
=> Bool
-> GenericList n t e
-> (Int -> Bool -> e -> Widget n)
-> Widget n
drawListElements foc l drawElem =
Widget Greedy Greedy $ do
c <- getContext
let es = slice start (numPerHeight * 2) (l^.listElementsL)
idx = fromMaybe 0 (l^.listSelectedL)
start = max 0 $ idx - numPerHeight + 1
initialNumPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL)
numPerHeight = initialNumPerHeight +
if initialNumPerHeight * (l^.listItemHeightL) == c^.availHeightL
then 0
else 1
off = start * (l^.listItemHeightL)
drawnElements = flip imap es $ \i e ->
let j = i + start
isSelected = Just j == l^.listSelectedL
elemWidget = drawElem j isSelected e
selItemAttr = if foc
then withDefAttr listSelectedFocusedAttr
else withDefAttr listSelectedAttr
makeVisible = if isSelected
then visible . selItemAttr
else id
in makeVisible elemWidget
render $ viewport (l^.listNameL) Vertical $
translateBy (Location (0, off)) $
vBox $ toList drawnElements
listInsert :: (Splittable t, Applicative t, Semigroup (t e))
=> Int
-> e
-> GenericList n t e
-> GenericList n t e
listInsert pos e l =
let es = l^.listElementsL
newSel = case l^.listSelectedL of
Nothing -> 0
Just s -> if pos <= s
then s + 1
else s
(front, back) = splitAt pos es
in l & listSelectedL .~ Just newSel
& listElementsL .~ sconcat (front :| [pure e, back])
listRemove :: (Splittable t, Foldable t, Semigroup (t e))
=> Int
-> GenericList n t e
-> GenericList n t e
listRemove pos l | null (l^.listElementsL) = l
| pos /= splitClamp l pos = l
| otherwise =
let newSel = case l^.listSelectedL of
Nothing -> 0
Just s | pos == 0 -> 0
| pos == s -> pos - 1
| pos < s -> s - 1
| otherwise -> s
(front, rest) = splitAt pos es
(_, back) = splitAt 1 rest
es' = front <> back
es = l^.listElementsL
in l & listSelectedL .~ (if null es' then Nothing else Just newSel)
& listElementsL .~ es'
listReplace :: (Foldable t, Splittable t)
=> t e
-> Maybe Int
-> GenericList n t e
-> GenericList n t e
listReplace es idx l =
let l' = l & listElementsL .~ es
newSel = if null es then Nothing else inBoundsOrZero <$> idx
inBoundsOrZero i
| i == splitClamp l' i = i
| otherwise = 0
in l' & listSelectedL .~ newSel
listMoveUp :: (Foldable t, Splittable t)
=> GenericList n t e
-> GenericList n t e
listMoveUp = listMoveBy (-1)
listMovePageUp
:: (Foldable t, Splittable t, Ord n)
=> GenericList n t e -> EventM n (GenericList n t e)
listMovePageUp = listMoveByPages (-1::Double)
listMoveDown :: (Foldable t, Splittable t)
=> GenericList n t e
-> GenericList n t e
listMoveDown = listMoveBy 1
listMovePageDown :: (Foldable t, Splittable t, Ord n)
=> GenericList n t e
-> EventM n (GenericList n t e)
listMovePageDown = listMoveByPages (1::Double)
listMoveByPages :: (Foldable t, Splittable t, Ord n, RealFrac m)
=> m
-> GenericList n t e
-> EventM n (GenericList n t e)
listMoveByPages pages theList = do
v <- lookupViewport (theList^.listNameL)
case v of
Nothing -> return theList
Just vp -> do
let nElems = round $ pages * fromIntegral (vp^.vpSize._2) /
fromIntegral (theList^.listItemHeightL)
return $ listMoveBy nElems theList
listMoveBy :: (Foldable t, Splittable t)
=> Int
-> GenericList n t e
-> GenericList n t e
listMoveBy amt l =
let target = case l ^. listSelectedL of
Nothing
| amt > 0 -> 0
| otherwise -> length (l ^. listElementsL) - 1
Just i -> max 0 (amt + i)
in listMoveTo target l
listMoveTo :: (Foldable t, Splittable t)
=> Int
-> GenericList n t e
-> GenericList n t e
listMoveTo pos l =
let len = length (l ^. listElementsL)
i = if pos < 0 then len - pos else pos
newSel = splitClamp l i
in l & listSelectedL .~ if not (null (l ^. listElementsL))
then Just newSel
else Nothing
splitClamp :: (Foldable t, Splittable t) => GenericList n t e -> Int -> Int
splitClamp l i =
let (_, t) = splitAt i (l ^. listElementsL)
in
clamp 0 (if null t then length (l ^. listElementsL) - 1 else i) i
listMoveToElement :: (Eq e, Foldable t, Splittable t)
=> e
-> GenericList n t e
-> GenericList n t e
listMoveToElement e = listFindBy (== e) . set listSelectedL Nothing
listFindBy :: (Foldable t, Splittable t)
=> (e -> Bool)
-> GenericList n t e
-> GenericList n t e
listFindBy test l =
let start = maybe 0 (+1) (l ^. listSelectedL)
(_, t) = splitAt start (l ^. listElementsL)
result = find (test . snd) . zip [0..] . toList $ t
in maybe id (set listSelectedL . Just . (start +) . fst) result l
listSelectedElement :: (Splittable t, Foldable t)
=> GenericList n t e
-> Maybe (Int, e)
listSelectedElement l = do
sel <- l^.listSelectedL
let (_, xs) = splitAt sel (l ^. listElementsL)
(sel,) <$> toList xs ^? _head
listClear :: (Monoid (t e)) => GenericList n t e -> GenericList n t e
listClear l = l & listElementsL .~ mempty & listSelectedL .~ Nothing
listReverse :: (Reversible t, Foldable t)
=> GenericList n t e
-> GenericList n t e
listReverse l =
l & listElementsL %~ reverse
& listSelectedL %~ fmap (length (l ^. listElementsL) - 1 -)
listModify :: (Traversable t)
=> (e -> e)
-> GenericList n t e
-> GenericList n t e
listModify f l =
case l ^. listSelectedL of
Nothing -> l
Just j -> l & listElementsL %~ imap (\i e -> if i == j then f e else e)