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

-- Somewhat inefficient because rendering is done just to

-- determine the width and height. So don't use this if the

-- rendering is expensive.

centerPopup :: Widget n -> Widget n
centerPopup :: forall n. Widget n -> Widget n
centerPopup 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

-- | Fill all available space with the specified character. Grows only

-- horizontally.

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

-- | Fill all available space with the specified character. Grows only

-- vertically.

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

-- https://github.com/jtdaugherty/brick/issues/290#issuecomment-699570168

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
        -- Render the viewport contents in advance

        Result n
result <- forall n. Widget n -> RenderM n (Result n)
render Widget n
w
        -- If the contents will fit in the maximum allowed rows,

        -- just return the content without putting it in a viewport.

        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
            -- Otherwise put the contents (pre-rendered) in a viewport

            -- and limit the height to the maximum allowable height.

            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)