{-# LANGUAGE 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 Graphics.Vty as V
hCenteredStrWrap :: String -> Widget n
hCenteredStrWrap :: String -> Widget n
hCenteredStrWrap = (Widget n -> Widget n) -> String -> Widget n
forall n. (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr Widget n -> Widget n
forall a. a -> a
id
hCenteredStrWrapWithAttr :: (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr :: (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr Widget n -> Widget n
attr String
p = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
let w :: Int
w = Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n. Lens' (Context n) Int
availWidthL
let result :: Widget n
result = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ (Text -> Widget n) -> [Text] -> [Widget n]
forall a b. (a -> b) -> [a] -> [b]
map (Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
attr (Widget n -> Widget n) -> (Text -> Widget n) -> Text -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Widget n
forall n. Text -> Widget n
txt) ([Text] -> [Widget n]) -> [Text] -> [Widget n]
forall a b. (a -> b) -> a -> b
$ WrapSettings -> Int -> Text -> [Text]
wrapTextToLines (WrapSettings
defaultWrapSettings {preserveIndentation :: Bool
preserveIndentation=Bool
False, breakLongWords :: Bool
breakLongWords=Bool
True}) Int
w (String -> Text
pack String
p)
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
result
centerPopup :: Widget n -> Widget n
Widget n
widget = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
widget
let w :: Int
w = Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageWidth
h :: Int
h = Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageHeight
x :: Int
x = (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n. Lens' (Context n) Int
availWidthL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
w) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
y :: Int
y = (Context n
cContext n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (Context n) Int
forall n. Lens' (Context n) Int
availHeightL Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Location -> Widget n -> Widget n
forall n. Location -> Widget n -> Widget n
translateBy ((Int, Int) -> Location
Location (Int
x, Int
y)) Widget n
widget
drawException :: Maybe String -> Widget n
drawException :: Maybe String -> Widget n
drawException Maybe String
Nothing = Widget n
forall n. Widget n
emptyWidget
drawException (Just String
e) =
Widget n -> Widget n
forall n. Widget n -> Widget n
centerPopup (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (String -> Widget n
forall n. String -> Widget n
str String
"Error") (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
exceptionAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
e
hFill :: Char -> Widget n
hFill :: Char -> Widget n
hFill = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget n -> Widget n) -> (Char -> Widget n) -> Char -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Widget n
forall n. Char -> Widget n
fill
vFill :: Char -> Widget n
vFill :: Char -> Widget n
vFill = Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit Int
1 (Widget n -> Widget n) -> (Char -> Widget n) -> Char -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Widget n
forall n. Char -> Widget n
fill
atLeastV :: Int -> Widget n -> Widget n
atLeastV :: Int -> Widget n -> Widget n
atLeastV Int
n Widget n
widget = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
Result n
result <- Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
widget
let h :: Int
h = Result n
resultResult n -> Getting Int (Result n) Int -> Int
forall s a. s -> Getting a s a -> a
^.(Image -> Const Int Image) -> Result n -> Const Int (Result n)
forall n. Lens' (Result n) Image
imageL((Image -> Const Int Image) -> Result n -> Const Int (Result n))
-> ((Int -> Const Int Int) -> Image -> Const Int Image)
-> Getting Int (Result n) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Image -> Int) -> SimpleGetter Image Int
forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageHeight
dh :: Int
dh = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h
if Int
dh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
vLimit Int
n (Widget n
widget Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<=> Char -> Widget n
forall n. Char -> Widget n
vFill Char
' ') else Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render Widget n
widget
yesnoField :: (Ord n, Show n) => Bool -> Lens' s Bool -> n -> String -> s -> FormFieldState s e n
yesnoField :: Bool -> Lens' s Bool -> n -> String -> s -> FormFieldState s e n
yesnoField Bool
rightAlign Lens' s Bool
stLens n
name String
label s
initialState =
let initVal :: Bool
initVal = s
initialState s -> Getting Bool s Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool s Bool
Lens' s Bool
stLens
handleEvent :: BrickEvent n e -> Bool -> m Bool
handleEvent (MouseDown n
n Button
_ [Modifier]
_ Location
_) Bool
s | n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
name = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
s
handleEvent (VtyEvent (V.EvKey (V.KChar Char
' ') [])) Bool
s = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
s
handleEvent (VtyEvent (V.EvKey Key
V.KEnter [])) Bool
s = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
s
handleEvent BrickEvent n e
_ Bool
s = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
s
in FormFieldState :: forall b s a e n.
b
-> Lens' s a
-> (a -> b -> b)
-> [FormField a b e n]
-> (Widget n -> Widget n)
-> ([Widget n] -> Widget n)
-> FormFieldState s e n
FormFieldState { formFieldState :: Bool
formFieldState = Bool
initVal
, formFields :: [FormField Bool Bool e n]
formFields = [ n
-> (Bool -> Maybe Bool)
-> Bool
-> (Bool -> Bool -> Widget n)
-> (BrickEvent n e -> Bool -> EventM n Bool)
-> FormField Bool Bool e n
forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> b -> EventM n b)
-> FormField a b e n
FormField n
name Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
(Bool -> String -> n -> Bool -> Bool -> Widget n
forall n. Ord n => Bool -> String -> n -> Bool -> Bool -> Widget n
renderYesno Bool
rightAlign String
label n
name)
BrickEvent n e -> Bool -> EventM n Bool
forall (m :: * -> *) e. Monad m => BrickEvent n e -> Bool -> m Bool
handleEvent ]
, formFieldLens :: Lens' s Bool
formFieldLens = Lens' s Bool
stLens
, formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = Widget n -> Widget n
forall a. a -> a
id
, formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox }
renderYesno :: Ord n => Bool -> String -> n -> Bool -> Bool -> Widget n
renderYesno :: Bool -> String -> n -> Bool -> Bool -> Widget n
renderYesno Bool
rightAlign String
label n
n Bool
foc Bool
val =
let addAttr :: Widget n -> Widget n
addAttr = if Bool
foc then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else Widget n -> Widget n
forall a. a -> a
id
in n -> Widget n -> Widget n
forall n. Ord n => n -> Widget n -> Widget n
clickable n
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
(if Bool
val
then Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
"Yes")
else if Bool
rightAlign
then String -> Widget n
forall n. String -> Widget n
str String
" " Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
"No")
else Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
"No") Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
" ") Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
label
naturalNumberField :: (Ord n, Show n) => Int -> Lens' s Int -> n -> String -> s -> FormFieldState s e n
naturalNumberField :: Int -> Lens' s Int -> n -> String -> s -> FormFieldState s e n
naturalNumberField Int
bound Lens' s Int
stLens n
name String
postfix s
initialState =
let initVal :: Int
initVal = s
initialState s -> Getting Int s Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int s Int
Lens' s Int
stLens
handleEvent :: BrickEvent n e -> Int -> m Int
handleEvent (VtyEvent (V.EvKey (V.KChar Char
c) [])) Int
s | Char -> Bool
isDigit Char
c =
let newValue :: Int
newValue = String -> Int
forall a. Read a => String -> a
read (Int -> String
forall a. Show a => a -> String
show Int
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c])
in Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ if Int
newValue Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
bound then Int
newValue else Int
bound
handleEvent (VtyEvent (V.EvKey Key
V.KBS [])) Int
s = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> m Int) -> Int -> m Int
forall a b. (a -> b) -> a -> b
$ case Int -> String
forall a. Show a => a -> String
show Int
s of
String
"" -> Int
0
String
xs -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> String
forall a. [a] -> [a]
init String
xs))
handleEvent BrickEvent n e
_ Int
s = Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
s
in FormFieldState :: forall b s a e n.
b
-> Lens' s a
-> (a -> b -> b)
-> [FormField a b e n]
-> (Widget n -> Widget n)
-> ([Widget n] -> Widget n)
-> FormFieldState s e n
FormFieldState { formFieldState :: Int
formFieldState = Int
initVal
, formFields :: [FormField Int Int e n]
formFields = [ n
-> (Int -> Maybe Int)
-> Bool
-> (Bool -> Int -> Widget n)
-> (BrickEvent n e -> Int -> EventM n Int)
-> FormField Int Int e n
forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> b -> EventM n b)
-> FormField a b e n
FormField n
name Int -> Maybe Int
forall a. a -> Maybe a
Just Bool
True
(Int -> String -> n -> Bool -> Int -> Widget n
forall n. Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber Int
bound String
postfix n
name)
BrickEvent n e -> Int -> EventM n Int
forall (m :: * -> *) n e. Monad m => BrickEvent n e -> Int -> m Int
handleEvent ]
, formFieldLens :: Lens' s Int
formFieldLens = Lens' s Int
stLens
, formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = Widget n -> Widget n
forall a. a -> a
id
, formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox }
renderNaturalNumber :: Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber :: Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber Int
bound String
postfix n
n Bool
foc Int
val =
let addAttr :: Widget n -> Widget n
addAttr = if Bool
foc then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else Widget n -> Widget n
forall a. a -> a
id
val' :: String
val' = Int -> String
forall a. Show a => a -> String
show Int
val
csr :: Widget n -> Widget n
csr = if Bool
foc then n -> Location -> Widget n -> Widget n
forall n. n -> Location -> Widget n -> Widget n
showCursor n
n ((Int, Int) -> Location
Location (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
val',Int
0)) else Widget n -> Widget n
forall a. a -> a
id
in if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
postfix
then Int -> Widget n -> Widget n
forall n. Int -> Widget n -> Widget n
hLimit (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall a. Show a => a -> String
show Int
bound)) (Widget n -> Widget n
csr (Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
val')) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Char -> Widget n
forall n. Char -> Widget n
hFill Char
' ')
else Widget n -> Widget n
csr (Widget n -> Widget n
forall n. Widget n -> Widget n
addAttr (String -> Widget n
forall n. String -> Widget n
str String
val')) Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> String -> Widget n
forall n. String -> Widget n
str String
postfix