{-# LANGUAGE LambdaCase #-} module Main where -- 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 Brick.Widgets.List.Search 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 isItem :: ListElem -> Bool isItem = \case Str _ -> True Sep _ -> False handleEvent :: BrickEvent Name () -> EventM Name (GenericList Name Vector ListElem) () handleEvent e = case e of VtyEvent (EvKey KEsc []) -> halt VtyEvent (EvKey (KChar 'q') []) -> halt VtyEvent (EvKey KUp []) -> modify $ listSearchUp isItem VtyEvent (EvKey KDown []) -> modify $ listSearchDown isItem VtyEvent (EvKey KHome []) -> modify $ listSearchFromBeginning isItem VtyEvent (EvKey KEnd []) -> modify $ listSearchFromEnd isItem VtyEvent (EvKey KPageUp []) -> listSearchPageUp isItem VtyEvent (EvKey KPageDown []) -> listSearchPageDown isItem _ -> return () 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" ] 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 "End of List", 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 is necessary. , appStartEvent = modify $ \l -> case searchListForward True isItem l of Nothing -> l & listSelectedL .~ Nothing Just idx -> l & listSelectedL ?~ idx , appAttrMap = const $ attrMap defAttr [(listSelectedAttr, black `on` white)] } void $ defaultMain app theList