{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable#-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Brick.Widgets.List
( List
, list
, renderList
, handleListEvent
, handleListEventVi
, listElementsL
, listSelectedL
, listNameL
, listItemHeightL
, listElements
, listName
, listSelectedElement
, listSelected
, listItemHeight
, listMoveBy
, listMoveTo
, listMoveUp
, listMoveDown
, listMoveByPages
, listMovePageUp
, listMovePageDown
, listInsert
, listRemove
, listReplace
, listClear
, listReverse
, listModify
, listAttr
, listSelectedAttr
, listSelectedFocusedAttr
)
where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>),(<*>),pure)
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
#endif
import Lens.Micro ((^.), (&), (.~), (%~), _2)
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import qualified Data.Vector as V
import Brick.Types
import Brick.Main (lookupViewport)
import Brick.Widgets.Core
import Brick.Util (clamp)
import Brick.AttrMap
data List n e =
List { listElements :: !(V.Vector e)
, listSelected :: !(Maybe Int)
, listName :: n
, listItemHeight :: Int
} deriving (Functor, Foldable, Traversable, Show)
suffixLenses ''List
instance Named (List n e) n where
getName = listName
handleListEvent :: (Ord n) => Event -> List n e -> EventM n (List n 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 (V.length $ listElements theList) theList
EvKey KPageDown [] -> listMovePageDown theList
EvKey KPageUp [] -> listMovePageUp theList
_ -> return theList
handleListEventVi :: (Ord n)
=> (Event -> List n e -> EventM n (List n e))
-> Event
-> List n e
-> EventM n (List n 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 (V.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 :: n
-> V.Vector e
-> Int
-> List n e
list name es h =
let selIndex = if V.null es then Nothing else Just 0
safeHeight = max 1 h
in List es selIndex name safeHeight
renderList :: (Ord n, Show n)
=> (Bool -> e -> Widget n)
-> Bool
-> List n e
-> Widget n
renderList drawElem foc l =
withDefAttr listAttr $
drawListElements foc l drawElem
drawListElements :: (Ord n, Show n) => Bool -> List n e -> (Bool -> e -> Widget n) -> Widget n
drawListElements foc l drawElem =
Widget Greedy Greedy $ do
c <- getContext
let es = V.slice start num (l^.listElementsL)
idx = fromMaybe 0 (l^.listSelectedL)
start = max 0 $ idx - numPerHeight + 1
num = min (numPerHeight * 2) (V.length (l^.listElementsL) - start)
initialNumPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL)
numPerHeight = initialNumPerHeight +
if initialNumPerHeight * (l^.listItemHeightL) == c^.availHeightL
then 0
else 1
off = start * (l^.listItemHeightL)
drawnElements = flip V.imap es $ \i e ->
let isSelected = Just (i + start) == l^.listSelectedL
elemWidget = drawElem 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 $ V.toList drawnElements
listInsert :: Int
-> e
-> List n e
-> List n e
listInsert pos e l =
let safePos = clamp 0 (V.length es) pos
es = l^.listElementsL
newSel = case l^.listSelectedL of
Nothing -> 0
Just s -> if safePos <= s
then s + 1
else s
(front, back) = V.splitAt safePos es
in l & listSelectedL .~ Just newSel
& listElementsL .~ (front V.++ (e `V.cons` back))
listRemove :: Int
-> List n e
-> List n e
listRemove pos l | V.null (l^.listElementsL) = l
| pos /= clamp 0 (V.length (l^.listElementsL) - 1) 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, back) = V.splitAt pos es
es' = front V.++ V.tail back
es = l^.listElementsL
in l & listSelectedL .~ (if V.null es' then Nothing else Just newSel)
& listElementsL .~ es'
listReplace :: V.Vector e -> Maybe Int -> List n e -> List n e
listReplace es idx l =
let newSel = if V.null es then Nothing else clamp 0 (V.length es - 1) <$> idx
in l & listSelectedL .~ newSel
& listElementsL .~ es
listMoveUp :: List n e -> List n e
listMoveUp = listMoveBy (-1)
listMovePageUp :: (Ord n) => List n e -> EventM n (List n e)
listMovePageUp theList = listMoveByPages (-1::Double) theList
listMoveDown :: List n e -> List n e
listMoveDown = listMoveBy 1
listMovePageDown :: (Ord n) => List n e -> EventM n (List n e)
listMovePageDown theList = listMoveByPages (1::Double) theList
listMoveByPages :: (Ord n, RealFrac m) => m -> List n e -> EventM n (List n e)
listMoveByPages pages theList = do
v <- lookupViewport (theList^.listNameL)
case v of
Nothing -> return theList
Just vp -> let
nElems = round $ pages * (fromIntegral $ vp^.vpSize._2) / (fromIntegral $ theList^.listItemHeightL)
in
return $ listMoveBy nElems theList
listMoveBy :: Int -> List n e -> List n e
listMoveBy amt l =
let newSel = clamp 0 (V.length (l^.listElementsL) - 1) <$> (amt +) <$> (l^.listSelectedL)
in l & listSelectedL .~ newSel
listMoveTo :: Int -> List n e -> List n e
listMoveTo pos l =
let len = V.length (l^.listElementsL)
newSel = clamp 0 (len - 1) $ if pos < 0 then len - pos else pos
in l & listSelectedL .~ if len > 0
then Just newSel
else Nothing
listSelectedElement :: List n e -> Maybe (Int, e)
listSelectedElement l = do
sel <- l^.listSelectedL
return (sel, (l^.listElementsL) V.! sel)
listClear :: List n e -> List n e
listClear l = l & listElementsL .~ V.empty & listSelectedL .~ Nothing
listReverse :: List n e -> List n e
listReverse theList = theList & listElementsL %~ V.reverse & listSelectedL .~ newSel
where n = V.length (listElements theList)
newSel = (-) <$> pure (n-1) <*> listSelected theList
listModify :: (e -> e) -> List n e -> List n e
listModify f l = case listSelectedElement l of
Nothing -> l
Just (n,e) -> let es = V.update (l^.listElementsL) (return (n, f e))
in listReplace es (Just n) l