{-# LANGUAGE RankNTypes, FlexibleContexts #-}
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 States (Name(SBClick))
import Text.Read (readMaybe)
import UI.Attributes
import qualified Graphics.Vty as V
import qualified Brick.Types as T
hCenteredStrWrap :: String -> Widget n
hCenteredStrWrap :: forall n. String -> Widget n
hCenteredStrWrap = forall n. (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr forall a. a -> a
id
hCenteredStrWrapWithAttr :: (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr :: forall n. (Widget n -> Widget n) -> String -> Widget n
hCenteredStrWrapWithAttr Widget n -> Widget n
attr String
p = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Context n
c <- forall n. RenderM n (Context n)
getContext
let w :: Int
w = Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL
let result :: Widget n
result = forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall n. Widget n -> Widget n
hCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
attr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Text -> Widget n
txt) 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)
forall n. Widget n -> RenderM n (Result n)
render Widget n
result
centerPopup :: Widget n -> Widget n
Widget n
widget = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Context n
c <- forall n. RenderM n (Context n)
getContext
Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
widget
let w :: Int
w = Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageWidth
h :: Int
h = Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageHeight
x :: Int
x = (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availWidthL forall a. Num a => a -> a -> a
- Int
w) forall a. Integral a => a -> a -> a
`div` Int
2
y :: Int
y = (Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL forall a. Num a => a -> a -> a
- Int
h) forall a. Integral a => a -> a -> a
`div` Int
2
forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ 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 :: forall n. Maybe String -> Widget n
drawException Maybe String
Nothing = forall n. Widget n
emptyWidget
drawException (Just String
e) =
forall n. Widget n -> Widget n
centerPopup forall a b. (a -> b) -> a -> b
$
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. String -> Widget n
str String
"Error") forall a b. (a -> b) -> a -> b
$
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
exceptionAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
e
hFill :: Char -> Widget n
hFill :: forall n. Char -> Widget n
hFill = forall n. Int -> Widget n -> Widget n
vLimit Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Char -> Widget n
fill
vFill :: Char -> Widget n
vFill :: forall n. Char -> Widget n
vFill = forall n. Int -> Widget n -> Widget n
hLimit Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n. Char -> Widget n
fill
atLeastV :: Int -> Widget n -> Widget n
atLeastV :: forall n. Int -> Widget n -> Widget n
atLeastV Int
n Widget n
widget = forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Context n
c <- forall n. RenderM n (Context n)
getContext
Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
widget
let h :: Int
h = Result n
resultforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Result n) Image
imageLforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s a. (s -> a) -> SimpleGetter s a
to Image -> Int
imageHeight
dh :: Int
dh = Int
n forall a. Num a => a -> a -> a
- Int
h
if Int
dh forall a. Ord a => a -> a -> Bool
> Int
0 then forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
vLimit Int
n (Widget n
widget forall n. Widget n -> Widget n -> Widget n
<=> forall n. Char -> Widget n
vFill Char
' ') else 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 :: forall n s e.
(Ord n, Show n) =>
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 forall s a. s -> Getting a s a -> a
^. Lens' s Bool
stLens
handleEvent :: BrickEvent n e -> m ()
handleEvent (MouseDown n
n Button
_ [Modifier]
_ Location
_) | n
n forall a. Eq a => a -> a -> Bool
== n
name = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Bool -> Bool
not
handleEvent (VtyEvent (V.EvKey (V.KChar Char
' ') [])) = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Bool -> Bool
not
handleEvent (VtyEvent (V.EvKey Key
V.KEnter [])) = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify Bool -> Bool
not
handleEvent BrickEvent n e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
in FormFieldState { formFieldState :: Bool
formFieldState = Bool
initVal
, formFields :: [FormField Bool Bool e n]
formFields = [ forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> EventM n b ())
-> FormField a b e n
FormField n
name forall a. a -> Maybe a
Just Bool
True
(forall n. Ord n => Bool -> String -> n -> Bool -> Bool -> Widget n
renderYesno Bool
rightAlign String
label n
name)
forall {m :: * -> *} {e}.
MonadState Bool m =>
BrickEvent n e -> m ()
handleEvent ]
, formFieldLens :: Lens' s Bool
formFieldLens = Lens' s Bool
stLens
, formFieldUpdate :: Bool -> Bool -> Bool
formFieldUpdate = forall a b. a -> b -> a
const
, formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = forall a. a -> a
id
, formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = forall n. [Widget n] -> Widget n
vBox
, formFieldVisibilityMode :: FormFieldVisibilityMode
formFieldVisibilityMode = FormFieldVisibilityMode
ShowAugmentedField }
renderYesno :: Ord n => Bool -> String -> n -> Bool -> Bool -> Widget n
renderYesno :: forall n. Ord n => 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 forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else forall a. a -> a
id
in forall n. Ord n => n -> Widget n -> Widget n
clickable n
n forall a b. (a -> b) -> a -> b
$
(if Bool
val
then forall n. Widget n -> Widget n
addAttr (forall n. String -> Widget n
str String
"Yes")
else if Bool
rightAlign
then forall n. String -> Widget n
str String
" " forall n. Widget n -> Widget n -> Widget n
<+> forall n. Widget n -> Widget n
addAttr (forall n. String -> Widget n
str String
"No")
else forall n. Widget n -> Widget n
addAttr (forall n. String -> Widget n
str String
"No") forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str String
" ") forall n. Widget n -> Widget n -> 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 :: forall n s e.
(Ord n, Show n) =>
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 forall s a. s -> Getting a s a -> a
^. Lens' s Int
stLens
handleEvent :: BrickEvent n e -> m ()
handleEvent (VtyEvent (V.EvKey (V.KChar Char
c) [])) | Char -> Bool
isDigit Char
c =
do Int
s <- forall s (m :: * -> *). MonadState s m => m s
get
let newValue :: Int
newValue = forall a. Read a => String -> a
read (forall a. Show a => a -> String
show Int
s forall a. [a] -> [a] -> [a]
++ [Char
c])
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min Int
newValue Int
bound
handleEvent (VtyEvent (V.EvKey Key
V.KBS [])) =
do Int
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ case forall a. Show a => a -> String
show Int
s of
String
"" -> Int
0
String
xs -> forall a. a -> Maybe a -> a
fromMaybe Int
0 (forall a. Read a => String -> Maybe a
readMaybe (forall a. [a] -> [a]
init String
xs))
handleEvent BrickEvent n e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
in FormFieldState { formFieldState :: Int
formFieldState = Int
initVal
, formFields :: [FormField Int Int e n]
formFields = [ forall a b e n.
n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> EventM n b ())
-> FormField a b e n
FormField n
name forall a. a -> Maybe a
Just Bool
True
(forall n. Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber Int
bound String
postfix n
name)
forall {m :: * -> *} {n} {e}.
MonadState Int m =>
BrickEvent n e -> m ()
handleEvent ]
, formFieldLens :: Lens' s Int
formFieldLens = Lens' s Int
stLens
, formFieldUpdate :: Int -> Int -> Int
formFieldUpdate = forall a b. a -> b -> a
const
, formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = forall a. a -> a
id
, formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = forall n. [Widget n] -> Widget n
vBox
, formFieldVisibilityMode :: FormFieldVisibilityMode
formFieldVisibilityMode = FormFieldVisibilityMode
ShowAugmentedField }
renderNaturalNumber :: Int -> String -> n -> Bool -> Int -> Widget n
renderNaturalNumber :: forall n. 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 forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else forall a. a -> a
id
val' :: String
val' = forall a. Show a => a -> String
show Int
val
csr :: Widget n -> Widget n
csr = if Bool
foc then forall n. n -> Location -> Widget n -> Widget n
showCursor n
n ((Int, Int) -> Location
Location (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
val',Int
0)) else forall a. a -> a
id
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
postfix
then forall n. Int -> Widget n -> Widget n
hLimit (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Show a => a -> String
show Int
bound)) (Widget n -> Widget n
csr (forall n. Widget n -> Widget n
addAttr (forall n. String -> Widget n
str String
val')) forall n. Widget n -> Widget n -> Widget n
<+> forall n. Char -> Widget n
hFill Char
' ')
else Widget n -> Widget n
csr (forall n. Widget n -> Widget n
addAttr (forall n. String -> Widget n
str String
val')) forall n. Widget n -> Widget n -> Widget n
<+> forall n. String -> Widget n
str String
postfix
fixedHeightOrViewport :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewport :: forall n. (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewport Int
maxHeight n
vpName Widget n
w =
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
w
if Image -> Int
imageHeight (forall n. Result n -> Image
image Result n
result) forall a. Ord a => a -> a -> Bool
<= Int
maxHeight
then forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
else forall n. Widget n -> RenderM n (Result n)
render (forall n. Int -> Widget n -> Widget n
vLimit Int
maxHeight forall a b. (a -> b) -> a -> b
$
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport n
vpName ViewportType
Vertical forall a b. (a -> b) -> a -> b
$
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result)
fixedHeightOrViewportPercent :: (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewportPercent :: forall n. (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewportPercent Int
percentage n
vpName Widget n
w =
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Fixed Size
Fixed forall a b. (a -> b) -> a -> b
$ do
Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
w
Int
available <- forall n. Context n -> Int
availHeight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall n. RenderM n (Context n)
getContext
if Image -> Int
imageHeight (forall n. Result n -> Image
image Result n
result) forall a. Ord a => a -> a -> Bool
<= Int
percentage forall a. Num a => a -> a -> a
* Int
available forall a. Integral a => a -> a -> a
`div` Int
100
then forall (m :: * -> *) a. Monad m => a -> m a
return Result n
result
else forall n. Widget n -> RenderM n (Result n)
render (forall n. Int -> Widget n -> Widget n
vLimitPercent Int
percentage forall a b. (a -> b) -> a -> b
$
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport n
vpName ViewportType
Vertical Widget n
w)
handleClickScroll :: (Int -> EventM n s ()) -> ClickableScrollbarElement -> EventM n s ()
handleClickScroll :: forall n s.
(Int -> EventM n s ())
-> ClickableScrollbarElement -> EventM n s ()
handleClickScroll Int -> EventM n s ()
scroll ClickableScrollbarElement
el =
case ClickableScrollbarElement
el of
ClickableScrollbarElement
T.SBHandleBefore -> Int -> EventM n s ()
scroll (-Int
1)
ClickableScrollbarElement
T.SBHandleAfter -> Int -> EventM n s ()
scroll Int
1
ClickableScrollbarElement
T.SBTroughBefore -> Int -> EventM n s ()
scroll (-Int
10)
ClickableScrollbarElement
T.SBTroughAfter -> Int -> EventM n s ()
scroll Int
10
ClickableScrollbarElement
T.SBBar -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
scrollableViewportPercent :: Int -> Name -> Widget Name -> Widget Name
scrollableViewportPercent :: Int -> Name -> Widget Name -> Widget Name
scrollableViewportPercent Int
percent Name
n =
forall n.
(ClickableScrollbarElement -> n -> n) -> Widget n -> Widget n
withClickableVScrollBars ClickableScrollbarElement -> Name -> Name
SBClick forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall n. Widget n -> Widget n
withVScrollBarHandles forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall n. VScrollBarOrientation -> Widget n -> Widget n
withVScrollBars VScrollBarOrientation
OnRight forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall n. (Ord n, Show n) => Int -> n -> Widget n -> Widget n
fixedHeightOrViewportPercent Int
percent Name
n forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1)