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

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

-- | Fill all available space with the specified character. Grows only
-- horizontally.
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

-- | Fill all available space with the specified character. Grows only
-- vertically.
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