{-# LANGUAGE LambdaCase #-}
module Main where
import Brick.Widgets.List.Search
-- 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
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 []) -> do
modify $ listSearchUp isItem
listShowTheTop isItem
VtyEvent (EvKey KDown []) -> do
modify $ listSearchDown isItem
listShowTheBottom isItem
VtyEvent (EvKey KHome []) -> do
modify $ listSearchFromBeginning isItem
listShowTheTop isItem
VtyEvent (EvKey KEnd []) -> do
modify $ listSearchFromEnd isItem
listShowTheBottom isItem
VtyEvent (EvKey KPageUp []) -> do
listSearchPageUp isItem
listShowTheTop isItem
VtyEvent (EvKey KPageDown []) -> do
listSearchPageDown isItem
listShowTheBottom isItem
VtyEvent (EvKey (KChar 'u') [MCtrl]) -> do
listSearchByPages isItem (-0.5)
listShowTheTop isItem
VtyEvent (EvKey (KChar 'd') [MCtrl]) -> do
listSearchByPages isItem 0.5
listShowTheBottom isItem
VtyEvent (EvKey KUp [MCtrl]) -> do
modify $ listSearchBy isItem (-2)
listShowTheTop isItem
VtyEvent (EvKey KDown [MCtrl]) -> do
modify $ listSearchBy isItem 2
listShowTheBottom 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"
, "Press Ctrl+u to move up half page"
, "Press Ctrl+d to move down half page"
, "Press Ctrl+Up arrow to move up two items"
, "Press Ctrl+Down arrow to move down two items"]
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 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