module Brick.Widgets.List
( List(listElements, listSelected, listName, listItemHeight)
, list
, renderList
, listElementsL
, listSelectedL
, listNameL
, listItemHeightL
, listMoveBy
, listMoveTo
, listMoveUp
, listMoveDown
, listInsert
, listRemove
, listReplace
, listSelectedElement
, listAttr
, listSelectedAttr
)
where
import Control.Applicative ((<$>))
import Control.Lens ((^.), (&), (.~), _2)
import Data.Monoid ((<>))
import Data.Maybe (fromMaybe)
import qualified Data.Algorithm.Diff as D
import Graphics.Vty (Event(..), Key(..))
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 e =
List { listElements :: !(V.Vector e)
, listSelected :: !(Maybe Int)
, listName :: Name
, listItemHeight :: Int
}
suffixLenses ''List
instance HandleEvent (List e) where
handleEvent e theList = f
where
f = 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 [] -> do
v <- lookupViewport (theList^.listNameL)
case v of
Nothing -> return theList
Just vp -> return $ listMoveBy (vp^.vpSize._2 `div` theList^.listItemHeightL) theList
EvKey KPageUp [] -> do
v <- lookupViewport (theList^.listNameL)
case v of
Nothing -> return theList
Just vp -> return $ listMoveBy (negate $ vp^.vpSize._2 `div` theList^.listItemHeightL) theList
_ -> return theList
listAttr :: AttrName
listAttr = "list"
listSelectedAttr :: AttrName
listSelectedAttr = listAttr <> "selected"
list :: Name
-> V.Vector e
-> Int
-> List e
list name es h =
let selIndex = if V.null es then Nothing else Just 0
in List es selIndex name h
renderList :: List e -> (Bool -> e -> Widget) -> Widget
renderList l drawElem =
withDefAttr listAttr $
drawListElements l drawElem
drawListElements :: List e -> (Bool -> e -> Widget) -> Widget
drawListElements l drawElem =
Widget Greedy Greedy $ do
c <- getContext
let es = V.slice start num (l^.listElementsL)
idx = case l^.listSelectedL of
Nothing -> 0
Just i -> i
start = max 0 $ idx numPerHeight + 1
num = min (numPerHeight * 2) (V.length (l^.listElementsL) start)
numPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL)
off = start * (l^.listItemHeightL)
drawnElements = (flip V.imap) es $ \i e ->
let isSelected = Just (i + start) == l^.listSelectedL
elemWidget = drawElem isSelected e
makeVisible = if isSelected
then (visible . withDefAttr listSelectedAttr)
else id
in makeVisible elemWidget
render $ viewport (l^.listNameL) Vertical $
translateBy (Location (0, off)) $
vBox $ V.toList drawnElements
listInsert :: Int
-> e
-> List e
-> List 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 e
-> List 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 -> if pos == 0
then 0
else if pos == s
then pos 1
else if pos < s
then s 1
else 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 :: Eq e => V.Vector e -> List e -> List e
listReplace es' l | es' == l^.listElementsL = l
| otherwise =
let sel = fromMaybe 0 (l^.listSelectedL)
getNewSel es = case (V.null es, V.null es') of
(_, True) -> Nothing
(True, False) -> Just 0
(False, False) -> Just (maintainSel (V.toList es) (V.toList es') sel)
newSel = getNewSel (l^.listElementsL)
in l & listSelectedL .~ newSel
& listElementsL .~ es'
listMoveUp :: List e -> List e
listMoveUp = listMoveBy (1)
listMoveDown :: List e -> List e
listMoveDown = listMoveBy 1
listMoveBy :: Int -> List e -> List e
listMoveBy amt l =
let newSel = clamp 0 (V.length (l^.listElementsL) 1) <$> (amt +) <$> (l^.listSelectedL)
in l & listSelectedL .~ newSel
listMoveTo :: Int -> List e -> List 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 e -> Maybe (Int, e)
listSelectedElement l = do
sel <- l^.listSelectedL
return (sel, (l^.listElementsL) V.! sel)
maintainSel :: (Eq e) => [e] -> [e] -> Int -> Int
maintainSel xs ys sel = let hunks = D.getDiff xs ys
in merge 0 sel hunks
merge :: (Eq e) => Int -> Int -> [D.Diff e] -> Int
merge _ sel [] = sel
merge idx sel (h:hs) | idx > sel = sel
| otherwise = case h of
D.Both _ _ -> merge sel (idx + 1) hs
D.First _ -> let newSel = if idx < sel
then sel 1
else sel
in merge newSel idx hs
D.Second _ -> let newSel = if idx <= sel
then sel + 1
else sel
in merge newSel (idx + 1) hs