{-# LANGUAGE LambdaCase #-} module Main where import Brick.Widgets.List.Skip -- base import Control.Monad (void) -- Third party libraries import Lens.Micro import Data.Vector hiding ((++), map, modify) -- brick & vty import Brick.Main import Brick.AttrMap import Brick.Types import Brick.Widgets.Core import Brick.Util import Brick.Widgets.Border import Brick.Widgets.List import Brick.Widgets.Center import Graphics.Vty (defAttr, Event(..), Key(..), Modifier(..), black, white) data Name = TheList deriving (Eq, Ord, Show) data ListElem = Sep (Maybe String) | Str String deriving Show isSep :: ListElem -> Bool isSep = \case Str _ -> False Sep _ -> True handleEvent :: BrickEvent Name () -> EventM Name (GenericList Name Vector ListElem) () handleEvent e = do case e of VtyEvent (EvKey KEsc []) -> halt VtyEvent (EvKey (KChar 'q') []) -> halt _ -> listSkip isSep $ case e of VtyEvent (EvKey KUp []) -> Move One Bwd VtyEvent (EvKey KDown []) -> Move One Fwd VtyEvent (EvKey KHome []) -> Move Most Bwd VtyEvent (EvKey KEnd []) -> Move Most Fwd VtyEvent (EvKey KPageUp []) -> Move Page Bwd VtyEvent (EvKey KPageDown []) -> Move Page Fwd VtyEvent (EvKey (KChar 'u') [MCtrl]) -> Move HalfPage Bwd VtyEvent (EvKey (KChar 'd') [MCtrl]) -> Move HalfPage Fwd _ -> NoMove renderListElement :: Bool -> ListElem -> Widget Name renderListElement lf e = case e of Str s -> padRight Max $ str s Sep Nothing -> hBorder Sep (Just title) -> hBorderWithLabel $ str title drawUi :: GenericList Name Vector ListElem -> [Widget Name] drawUi l = let msgs = [ "Press q or Esc to quit" , "Press Up arrow to move up" , "Press Down arrow to move down" , "Press Home to move to the beginning" , "Press End to move to the end" , "Press PageUp to move up one page" , "Press PageDown to move down one page" , "Press Ctrl+u to move up half page" , "Press Ctrl+d to move down half page" ] in [vCenter $ vBox $ hCenter (border $ vLimit 20 $ hLimit 30 $ renderList renderListElement True l) : map (hCenter . str) msgs] listElems :: Vector ListElem listElems = fromList $ [Sep (Just "First separator"), Str "New account", Sep (Just "Accounts")] ++ map (Str . ("Account "<>) . show) [1..1000] ++ [Sep Nothing, Str "Show account statistics.", Sep (Just "Yet Another Separator"), Str "Last list element", Sep (Just "Last separator")] theList :: GenericList Name Vector ListElem theList = list TheList listElems 1 main :: IO () main = do let app = App { appDraw = drawUi , appChooseCursor = neverShowCursor , appHandleEvent = handleEvent -- If the first element is a separator, searching forward for an item from the first element is necessary. , appStartEvent = listSearchFromCurrent isSep Fwd , appAttrMap = const $ attrMap defAttr [(listSelectedAttr, black `on` white)] } void $ defaultMain app theList