brick/programs/ListDemo.hs
Jonathan Daugherty 6f1b62ae53 AttrName: remove IsString instance
This change is motivated by the API wart that results from the
overloading of both "<>" and string literals that resulted in code like
this:

  a :: AttrName
  a = "blah" <> "things"

While this worked to create an AttrName with two segments, it is far too
easy to read this as two strings concatenated. The overloading hides
what is really going on with the segments of the attribute name. The way
to write the above example after this change is:

  a :: AttrName
  a = attrName "blah" <> attrName "things"
2022-08-04 18:44:57 -07:00

106 lines
3.0 KiB
Haskell

{-# LANGUAGE CPP #-}
module Main where
import Lens.Micro ((^.))
import Lens.Micro.Mtl
import Control.Monad (void)
import Control.Monad.State (modify)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Data.Maybe (fromMaybe)
import qualified Graphics.Vty as V
import qualified Brick.Main as M
import qualified Brick.Types as T
import qualified Brick.Widgets.Border as B
import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.Center as C
import qualified Brick.AttrMap as A
import qualified Data.Vector as Vec
import Brick.Types
( Widget
)
import Brick.Widgets.Core
( (<+>)
, str
, vLimit
, hLimit
, vBox
, withAttr
)
import Brick.Util (fg, on)
drawUI :: (Show a) => L.List () a -> [Widget ()]
drawUI l = [ui]
where
label = str "Item " <+> cur <+> str " of " <+> total
cur = case l^.(L.listSelectedL) of
Nothing -> str "-"
Just i -> str (show (i + 1))
total = str $ show $ Vec.length $ l^.(L.listElementsL)
box = B.borderWithLabel label $
hLimit 25 $
vLimit 15 $
L.renderList listDrawElement True l
ui = C.vCenter $ vBox [ C.hCenter box
, str " "
, C.hCenter $ str "Press +/- to add/remove list elements."
, C.hCenter $ str "Press Esc to exit."
]
appEvent :: T.BrickEvent () e -> T.EventM () (L.List () Char) ()
appEvent (T.VtyEvent e) =
case e of
V.EvKey (V.KChar '+') [] -> do
els <- use L.listElementsL
let el = nextElement els
pos = Vec.length els
modify $ L.listInsert pos el
V.EvKey (V.KChar '-') [] -> do
sel <- use L.listSelectedL
case sel of
Nothing -> return ()
Just i -> modify $ L.listRemove i
V.EvKey V.KEsc [] -> M.halt
ev -> L.handleListEvent ev
where
nextElement :: Vec.Vector Char -> Char
nextElement v = fromMaybe '?' $ Vec.find (flip Vec.notElem v) (Vec.fromList ['a' .. 'z'])
appEvent _ = return ()
listDrawElement :: (Show a) => Bool -> a -> Widget ()
listDrawElement sel a =
let selStr s = if sel
then withAttr customAttr (str $ "<" <> s <> ">")
else str s
in C.hCenter $ str "Item " <+> (selStr $ show a)
initialState :: L.List () Char
initialState = L.list () (Vec.fromList ['a','b','c']) 1
customAttr :: A.AttrName
customAttr = L.listSelectedAttr <> A.attrName "custom"
theMap :: A.AttrMap
theMap = A.attrMap V.defAttr
[ (L.listAttr, V.white `on` V.blue)
, (L.listSelectedAttr, V.blue `on` V.white)
, (customAttr, fg V.cyan)
]
theApp :: M.App (L.List () Char) e ()
theApp =
M.App { M.appDraw = drawUI
, M.appChooseCursor = M.showFirstCursor
, M.appHandleEvent = appEvent
, M.appStartEvent = return ()
, M.appAttrMap = const theMap
}
main :: IO ()
main = void $ M.defaultMain theApp initialState