brick-list-skip-0.1.0.0: demo/BrickListSkip.hs

{-# 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