{-# LANGUAGE OverloadedStrings, RankNTypes #-}
module UI.BrickHelpers where
import Text.Wrap
import Brick
import Brick.Forms
import Brick.Widgets.Border
import Brick.Widgets.Center
import Data.Char (isDigit)
import Data.Maybe
import Data.Text (pack)
import Graphics.Vty (imageWidth, imageHeight, charFill)
import Lens.Micro
import Text.Read (readMaybe)
import UI.Attributes
import qualified Data.Text as T
import qualified Graphics.Vty as V
hCenteredStrWrap :: String -> Widget n
hCenteredStrWrap = hCenteredStrWrapWithAttr id
hCenteredStrWrapWithAttr :: (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr attr p = Widget Greedy Fixed $ do
c <- getContext
let w = c^.availWidthL
let result = vBox $ map (hCenter . attr . txt) $ wrapTextToLines (WrapSettings {preserveIndentation=False, breakLongWords=True}) w (pack p)
render result
centerPopup :: Widget n -> Widget n
centerPopup widget = Widget Fixed Fixed $ do
c <- getContext
result <- render widget
let w = result^.imageL.to imageWidth
h = result^.imageL.to imageHeight
x = (c^.availWidthL - w) `div` 2
y = (c^.availHeightL - h) `div` 2
render $ translateBy (Location (x, y)) widget
drawException :: Maybe String -> Widget n
drawException Nothing = emptyWidget
drawException (Just e) =
centerPopup $
borderWithLabel (str "Error") $
withAttr exceptionAttr $ str e
hFill :: Char -> Widget n
hFill = vLimit 1 . fill
vFill :: Char -> Widget n
vFill = hLimit 1 . fill
atLeastV :: Int -> Widget n -> Widget n
atLeastV n widget = Widget Fixed Fixed $ do
c <- getContext
result <- render widget
let h = result^.imageL.to imageHeight
dh = n - h
if dh > 0 then render $ vLimit n (widget <=> vFill ' ') else render widget
yesnoField :: (Ord n, Show n) => Bool -> Lens' s Bool -> n -> T.Text -> s -> FormFieldState s e n
yesnoField rightAlign stLens name label initialState =
let initVal = initialState ^. stLens
handleEvent (MouseDown n _ _ _) s | n == name = return $ not s
handleEvent (VtyEvent (V.EvKey (V.KChar ' ') [])) s = return $ not s
handleEvent (VtyEvent (V.EvKey V.KEnter [])) s = return $ not s
handleEvent _ s = return s
in FormFieldState { formFieldState = initVal
, formFields = [ FormField name Just True
(renderYesno rightAlign label name)
handleEvent ]
, formFieldLens = stLens
, formFieldRenderHelper = id
, formFieldConcat = vBox }
renderYesno :: Bool -> T.Text -> n -> Bool -> Bool -> Widget n
renderYesno rightAlign label n foc val =
let addAttr = if foc then withDefAttr focusedFormInputAttr else id
in clickable n $
(if val
then addAttr (txt "Yes")
else if rightAlign
then txt " " <+> addAttr (txt "No")
else addAttr (txt "No") <+> txt " ") <+> txt label
naturalNumberField :: (Ord n, Show n) => Int -> Lens' s Int -> n -> T.Text -> s -> FormFieldState s e n
naturalNumberField bound stLens name postfix initialState =
let initVal = initialState ^. stLens
handleEvent (VtyEvent (V.EvKey (V.KChar c) [])) s | isDigit c =
let newValue = read (show s ++ [c])
in return $ if newValue <= bound then newValue else bound
handleEvent (VtyEvent (V.EvKey V.KBS [])) s = return $ case show s of
"" -> 0
xs -> fromMaybe 0 (readMaybe (init xs))
handleEvent _ s = return s
in FormFieldState { formFieldState = initVal
, formFields = [ FormField name Just True
(renderNaturalNumber bound postfix name)
handleEvent ]
, formFieldLens = stLens
, formFieldRenderHelper = id
, formFieldConcat = vBox }
renderNaturalNumber :: Int -> T.Text -> n -> Bool -> Int -> Widget n
renderNaturalNumber bound postfix n foc val =
let addAttr = if foc then withDefAttr focusedFormInputAttr else id
val' = show val
csr = if foc then showCursor n (Location (length val',0)) else id
in if T.null postfix
then hLimit (length (show bound)) (csr (addAttr (str val')) <+> hFill ' ')
else csr (addAttr (str val')) <+> txt postfix