{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Brick.Forms
(
Form
, FormFieldState(..)
, FormField(..)
, newForm
, formFocus
, formState
, handleFormEvent
, renderForm
, renderFormFieldState
, (@@=)
, allFieldsValid
, invalidFields
, setFieldValid
, setFormConcat
, setFieldConcat
, setFormFocus
, updateFormState
, editTextField
, editShowableField
, editShowableFieldWithValidate
, editPasswordField
, radioField
, checkboxField
, listField
, editField
, radioCustomField
, checkboxCustomField
, formAttr
, invalidFormInputAttr
, focusedFormInputAttr
)
where
import Graphics.Vty hiding (showCursor)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Data.Maybe (isJust, isNothing)
import Data.List (elemIndex)
import Data.Vector (Vector)
import Brick
import Brick.Focus
import Brick.Widgets.Edit
import Brick.Widgets.List
import qualified Data.Text.Zipper as Z
import qualified Data.Text as T
import Text.Read (readMaybe)
import Lens.Micro
data FormField a b e n =
FormField { FormField a b e n -> n
formFieldName :: n
, FormField a b e n -> b -> Maybe a
formFieldValidate :: b -> Maybe a
, FormField a b e n -> Bool
formFieldExternallyValid :: Bool
, FormField a b e n -> Bool -> b -> Widget n
formFieldRender :: Bool -> b -> Widget n
, FormField a b e n -> BrickEvent n e -> b -> EventM n b
formFieldHandleEvent :: BrickEvent n e -> b -> EventM n b
}
data FormFieldState s e n where
FormFieldState :: { ()
formFieldState :: b
, ()
formFieldLens :: Lens' s a
, ()
formFieldUpdate :: a -> b -> b
, ()
formFields :: [FormField a b e n]
, FormFieldState s e n -> Widget n -> Widget n
formFieldRenderHelper :: Widget n -> Widget n
, FormFieldState s e n -> [Widget n] -> Widget n
formFieldConcat :: [Widget n] -> Widget n
} -> FormFieldState s e n
data Form s e n =
Form { Form s e n -> [FormFieldState s e n]
formFieldStates :: [FormFieldState s e n]
, Form s e n -> FocusRing n
formFocus :: FocusRing n
, Form s e n -> s
formState :: s
, Form s e n -> [Widget n] -> Widget n
formConcatAll :: [Widget n] -> Widget n
}
infixr 5 @@=
(@@=) :: (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= :: (Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
(@@=) Widget n -> Widget n
h s -> FormFieldState s e n
mkFs s
s =
let v :: FormFieldState s e n
v = s -> FormFieldState s e n
mkFs s
s
in FormFieldState s e n
v { formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = Widget n -> Widget n
h (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormFieldState s e n -> Widget n -> Widget n
forall s e n. FormFieldState s e n -> Widget n -> Widget n
formFieldRenderHelper FormFieldState s e n
v) }
updateFormState :: s -> Form s e n -> Form s e n
updateFormState :: s -> Form s e n -> Form s e n
updateFormState s
newState Form s e n
f =
let updateField :: FormFieldState s e n -> FormFieldState s e n
updateField FormFieldState s e n
fs = case FormFieldState s e n
fs of
FormFieldState b
st Lens' s a
l a -> b -> b
upd [FormField a b e n]
s Widget n -> Widget n
rh [Widget n] -> Widget n
concatAll ->
b
-> Lens' s a
-> (a -> b -> b)
-> [FormField a b e n]
-> (Widget n -> Widget n)
-> ([Widget n] -> Widget n)
-> FormFieldState s e n
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 (a -> b -> b
upd (s
newStates -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^.Getting a s a
Lens' s a
l) b
st) Lens' s a
l a -> b -> b
upd [FormField a b e n]
s Widget n -> Widget n
rh [Widget n] -> Widget n
concatAll
in Form s e n
f { formState :: s
formState = s
newState
, formFieldStates :: [FormFieldState s e n]
formFieldStates = FormFieldState s e n -> FormFieldState s e n
updateField (FormFieldState s e n -> FormFieldState s e n)
-> [FormFieldState s e n] -> [FormFieldState s e n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Form s e n -> [FormFieldState s e n]
forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates Form s e n
f
}
setFormFocus :: (Eq n) => n -> Form s e n -> Form s e n
setFormFocus :: n -> Form s e n -> Form s e n
setFormFocus n
n Form s e n
f = Form s e n
f { formFocus :: FocusRing n
formFocus = n -> FocusRing n -> FocusRing n
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
n (FocusRing n -> FocusRing n) -> FocusRing n -> FocusRing n
forall a b. (a -> b) -> a -> b
$ Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f }
setFieldConcat :: ([Widget n] -> Widget n) -> FormFieldState s e n -> FormFieldState s e n
setFieldConcat :: ([Widget n] -> Widget n)
-> FormFieldState s e n -> FormFieldState s e n
setFieldConcat [Widget n] -> Widget n
f FormFieldState s e n
s = FormFieldState s e n
s { formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = [Widget n] -> Widget n
f }
setFormConcat :: ([Widget n] -> Widget n) -> Form s e n -> Form s e n
setFormConcat :: ([Widget n] -> Widget n) -> Form s e n -> Form s e n
setFormConcat [Widget n] -> Widget n
func Form s e n
f = Form s e n
f { formConcatAll :: [Widget n] -> Widget n
formConcatAll = [Widget n] -> Widget n
func }
newForm :: [s -> FormFieldState s e n]
-> s
-> Form s e n
newForm :: [s -> FormFieldState s e n] -> s -> Form s e n
newForm [s -> FormFieldState s e n]
mkEs s
s =
let es :: [FormFieldState s e n]
es = [s -> FormFieldState s e n]
mkEs [s -> FormFieldState s e n] -> [s] -> [FormFieldState s e n]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> [s]
forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
in Form :: forall s e n.
[FormFieldState s e n]
-> FocusRing n -> s -> ([Widget n] -> Widget n) -> Form s e n
Form { formFieldStates :: [FormFieldState s e n]
formFieldStates = [FormFieldState s e n]
es
, formFocus :: FocusRing n
formFocus = [n] -> FocusRing n
forall n. [n] -> FocusRing n
focusRing ([n] -> FocusRing n) -> [n] -> FocusRing n
forall a b. (a -> b) -> a -> b
$ [[n]] -> [n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[n]] -> [n]) -> [[n]] -> [n]
forall a b. (a -> b) -> a -> b
$ FormFieldState s e n -> [n]
forall s e n. FormFieldState s e n -> [n]
formFieldNames (FormFieldState s e n -> [n]) -> [FormFieldState s e n] -> [[n]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FormFieldState s e n]
es
, formState :: s
formState = s
s
, formConcatAll :: [Widget n] -> Widget n
formConcatAll = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox
}
formFieldNames :: FormFieldState s e n -> [n]
formFieldNames :: FormFieldState s e n -> [n]
formFieldNames (FormFieldState b
_ Lens' s a
_ a -> b -> b
_ [FormField a b e n]
fields Widget n -> Widget n
_ [Widget n] -> Widget n
_) = FormField a b e n -> n
forall a b e n. FormField a b e n -> n
formFieldName (FormField a b e n -> n) -> [FormField a b e n] -> [n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FormField a b e n]
fields
checkboxField :: (Ord n, Show n)
=> Lens' s Bool
-> n
-> T.Text
-> s
-> FormFieldState s e n
checkboxField :: Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField = Char
-> Char
-> Char
-> Lens' s Bool
-> n
-> Text
-> s
-> FormFieldState s e n
forall n s e.
(Ord n, Show n) =>
Char
-> Char
-> Char
-> Lens' s Bool
-> n
-> Text
-> s
-> FormFieldState s e n
checkboxCustomField Char
'[' Char
'X' Char
']'
checkboxCustomField :: (Ord n, Show n)
=> Char
-> Char
-> Char
-> Lens' s Bool
-> n
-> T.Text
-> s
-> FormFieldState s e n
checkboxCustomField :: Char
-> Char
-> Char
-> Lens' s Bool
-> n
-> Text
-> s
-> FormFieldState s e n
checkboxCustomField Char
lb Char
check Char
rb Lens' s Bool
stLens n
name Text
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 -> EventM n 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 -> EventM n Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> EventM n Bool) -> Bool -> EventM n Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
s
handleEvent (VtyEvent (EvKey (KChar Char
' ') [])) Bool
s = Bool -> EventM n Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> EventM n Bool) -> Bool -> EventM n Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
s
handleEvent BrickEvent n e
_ Bool
s = Bool -> EventM n 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
(Char -> Char -> Char -> Text -> n -> Bool -> Bool -> Widget n
forall n.
Char -> Char -> Char -> Text -> n -> Bool -> Bool -> Widget n
renderCheckbox Char
lb Char
check Char
rb Text
label n
name)
BrickEvent n e -> Bool -> EventM n Bool
handleEvent
]
, formFieldLens :: Lens' s Bool
formFieldLens = Lens' s Bool
stLens
, formFieldUpdate :: Bool -> Bool -> Bool
formFieldUpdate =
\Bool
val Bool
_ -> Bool
val
, 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
}
renderCheckbox :: Char -> Char -> Char -> T.Text -> n -> Bool -> Bool -> Widget n
renderCheckbox :: Char -> Char -> Char -> Text -> n -> Bool -> Bool -> Widget n
renderCheckbox Char
lb Char
check Char
rb Text
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
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 (Int
1,Int
0)) else Widget n -> Widget n
forall a. a -> a
id
in n -> Widget n -> Widget n
forall n. n -> Widget n -> Widget n
clickable n
n (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Widget n -> Widget n
addAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
csr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
(Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
lb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
val then Char -> Text
T.singleton Char
check else Text
" ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Char -> Text
T.singleton Char
rb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Text -> Widget n
forall n. Text -> Widget n
txt Text
label
listField :: forall s e n a . (Ord n, Show n, Eq a)
=> (s -> Vector a)
-> Lens' s (Maybe a)
-> (Bool -> a -> Widget n)
-> Int
-> n
-> s
-> FormFieldState s e n
listField :: (s -> Vector a)
-> Lens' s (Maybe a)
-> (Bool -> a -> Widget n)
-> Int
-> n
-> s
-> FormFieldState s e n
listField s -> Vector a
options Lens' s (Maybe a)
stLens Bool -> a -> Widget n
renderItem Int
itemHeight n
name s
initialState =
let optionsVector :: Vector a
optionsVector = s -> Vector a
options s
initialState
initVal :: List n a
initVal = s
initialState s -> Getting (List n a) s (List n a) -> List n a
forall s a. s -> Getting a s a -> a
^. Getting (List n a) s (List n a)
Lens' s (List n a)
customStLens
customStLens :: Lens' s (List n a)
customStLens :: (List n a -> f (List n a)) -> s -> f s
customStLens = (s -> List n a) -> (s -> List n a -> s) -> Lens' s (List n a)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens s -> List n a
getList s -> List n a -> s
setList
where
getList :: s -> List n a
getList s
s = let l :: List n a
l = n -> Vector a -> Int -> List n a
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list n
name Vector a
optionsVector Int
itemHeight
in case s
s s -> Getting (Maybe a) s (Maybe a) -> Maybe a
forall s a. s -> Getting a s a -> a
^. Getting (Maybe a) s (Maybe a)
Lens' s (Maybe a)
stLens of
Maybe a
Nothing -> List n a
l
Just a
e -> a -> List n a -> List n a
forall e (t :: * -> *) n.
(Eq e, Foldable t, Splittable t) =>
e -> GenericList n t e -> GenericList n t e
listMoveToElement a
e List n a
l
setList :: s -> List n a -> s
setList s
s List n a
l = s
s s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (Maybe a -> Identity (Maybe a)) -> s -> Identity s
Lens' s (Maybe a)
stLens ((Maybe a -> Identity (Maybe a)) -> s -> Identity s)
-> Maybe a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Int, a) -> a
forall a b. (a, b) -> b
snd ((Int, a) -> a) -> Maybe (Int, a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List n a -> Maybe (Int, a)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement List n a
l)
handleEvent :: BrickEvent n e -> GenericList n t e -> EventM n (GenericList n t e)
handleEvent (VtyEvent Event
e) GenericList n t e
s = Event -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEvent Event
e GenericList n t e
s
handleEvent BrickEvent n e
_ GenericList n t e
s = GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericList n t e
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 :: List n a
formFieldState = List n a
initVal
, formFields :: [FormField (List n a) (List n a) e n]
formFields = [ n
-> (List n a -> Maybe (List n a))
-> Bool
-> (Bool -> List n a -> Widget n)
-> (BrickEvent n e -> List n a -> EventM n (List n a))
-> FormField (List n a) (List n a) 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 List n a -> Maybe (List n a)
forall a. a -> Maybe a
Just Bool
True
((Bool -> a -> Widget n) -> Bool -> List n a -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList Bool -> a -> Widget n
renderItem)
BrickEvent n e -> List n a -> EventM n (List n a)
forall (t :: * -> *) n n e e.
(Foldable t, Splittable t, Ord n) =>
BrickEvent n e -> GenericList n t e -> EventM n (GenericList n t e)
handleEvent
]
, formFieldLens :: Lens' s (List n a)
formFieldLens = Lens' s (List n a)
customStLens
, formFieldUpdate :: List n a -> List n a -> List n a
formFieldUpdate = \List n a
listState List n a
l ->
case List n a -> Maybe (Int, a)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement List n a
listState of
Maybe (Int, a)
Nothing -> List n a
l
Just (Int
_, a
e) -> a -> List n a -> List n a
forall e (t :: * -> *) n.
(Eq e, Foldable t, Splittable t) =>
e -> GenericList n t e -> GenericList n t e
listMoveToElement a
e List n a
l
, 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
}
radioField :: (Ord n, Show n, Eq a)
=> Lens' s a
-> [(a, n, T.Text)]
-> s
-> FormFieldState s e n
radioField :: Lens' s a -> [(a, n, Text)] -> s -> FormFieldState s e n
radioField = Char
-> Char
-> Char
-> Lens' s a
-> [(a, n, Text)]
-> s
-> FormFieldState s e n
forall n a s e.
(Ord n, Show n, Eq a) =>
Char
-> Char
-> Char
-> Lens' s a
-> [(a, n, Text)]
-> s
-> FormFieldState s e n
radioCustomField Char
'[' Char
'*' Char
']'
radioCustomField :: (Ord n, Show n, Eq a)
=> Char
-> Char
-> Char
-> Lens' s a
-> [(a, n, T.Text)]
-> s
-> FormFieldState s e n
radioCustomField :: Char
-> Char
-> Char
-> Lens' s a
-> [(a, n, Text)]
-> s
-> FormFieldState s e n
radioCustomField Char
lb Char
check Char
rb Lens' s a
stLens [(a, n, Text)]
options s
initialState =
let initVal :: a
initVal = s
initialState s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
Lens' s a
stLens
lookupOptionValue :: n -> Maybe a
lookupOptionValue n
n =
let results :: [(a, n, Text)]
results = ((a, n, Text) -> Bool) -> [(a, n, Text)] -> [(a, n, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
_, n
n', Text
_) -> n
n' n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
n) [(a, n, Text)]
options
in case [(a, n, Text)]
results of
[(a
val, n
_, Text
_)] -> a -> Maybe a
forall a. a -> Maybe a
Just a
val
[(a, n, Text)]
_ -> Maybe a
forall a. Maybe a
Nothing
handleEvent :: a -> BrickEvent n e -> a -> EventM n a
handleEvent a
_ (MouseDown n
n Button
_ [Modifier]
_ Location
_) a
s =
case n -> Maybe a
lookupOptionValue n
n of
Maybe a
Nothing -> a -> EventM n a
forall (m :: * -> *) a. Monad m => a -> m a
return a
s
Just a
v -> a -> EventM n a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
handleEvent a
new (VtyEvent (EvKey (KChar Char
' ') [])) a
_ = a -> EventM n a
forall (m :: * -> *) a. Monad m => a -> m a
return a
new
handleEvent a
_ BrickEvent n e
_ a
s = a -> EventM n a
forall (m :: * -> *) a. Monad m => a -> m a
return a
s
optionFields :: [FormField a a e n]
optionFields = (a, n, Text) -> FormField a a e n
mkOptionField ((a, n, Text) -> FormField a a e n)
-> [(a, n, Text)] -> [FormField a a e n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, n, Text)]
options
mkOptionField :: (a, n, Text) -> FormField a a e n
mkOptionField (a
val, n
name, Text
label) =
n
-> (a -> Maybe a)
-> Bool
-> (Bool -> a -> Widget n)
-> (BrickEvent n e -> a -> EventM n a)
-> FormField a a 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
a -> Maybe a
forall a. a -> Maybe a
Just
Bool
True
(Char -> Char -> Char -> a -> n -> Text -> Bool -> a -> Widget n
forall a n.
Eq a =>
Char -> Char -> Char -> a -> n -> Text -> Bool -> a -> Widget n
renderRadio Char
lb Char
check Char
rb a
val n
name Text
label)
(a -> BrickEvent n e -> a -> EventM n a
handleEvent a
val)
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 :: a
formFieldState = a
initVal
, formFields :: [FormField a a e n]
formFields = [FormField a a e n]
optionFields
, formFieldLens :: Lens' s a
formFieldLens = Lens' s a
stLens
, formFieldUpdate :: a -> a -> a
formFieldUpdate = \a
val a
_ -> a
val
, 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
}
renderRadio :: (Eq a) => Char -> Char -> Char -> a -> n -> T.Text -> Bool -> a -> Widget n
renderRadio :: Char -> Char -> Char -> a -> n -> Text -> Bool -> a -> Widget n
renderRadio Char
lb Char
check Char
rb a
val n
name Text
label Bool
foc a
cur =
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
isSet :: Bool
isSet = a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
cur
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
name ((Int, Int) -> Location
Location (Int
1,Int
0)) else Widget n -> Widget n
forall a. a -> a
id
in n -> Widget n -> Widget n
forall n. n -> Widget n -> Widget n
clickable n
name (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
Widget n -> Widget n
addAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
csr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
[Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [ Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
lb
, Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ if Bool
isSet then Char -> Text
T.singleton Char
check else Text
" "
, Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> Text -> Widget n
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
rb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label
]
editField :: (Ord n, Show n)
=> Lens' s a
-> n
-> Maybe Int
-> (a -> T.Text)
-> ([T.Text] -> Maybe a)
-> ([T.Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField :: Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField Lens' s a
stLens n
n Maybe Int
limit a -> Text
ini [Text] -> Maybe a
val [Text] -> Widget n
renderText Widget n -> Widget n
wrapEditor s
initialState =
let initVal :: Editor Text n
initVal = (TextZipper Text -> TextZipper Text)
-> Editor Text n -> Editor Text n
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
gotoEnd (Editor Text n -> Editor Text n) -> Editor Text n -> Editor Text n
forall a b. (a -> b) -> a -> b
$
n -> Maybe Int -> Text -> Editor Text n
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor n
n Maybe Int
limit Text
initialText
gotoEnd :: TextZipper Text -> TextZipper Text
gotoEnd = let ls :: [Text]
ls = Text -> [Text]
T.lines Text
initialText
pos :: (Int, Int)
pos = ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Text -> Int
T.length ([Text] -> Text
forall a. [a] -> a
last [Text]
ls))
in if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls
then TextZipper Text -> TextZipper Text
forall a. a -> a
id
else (Int, Int) -> TextZipper Text -> TextZipper Text
forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
Z.moveCursor (Int, Int)
pos
initialText :: Text
initialText = a -> Text
ini (a -> Text) -> a -> Text
forall a b. (a -> b) -> a -> b
$ s
initialState s -> Getting a s a -> a
forall s a. s -> Getting a s a -> a
^. Getting a s a
Lens' s a
stLens
handleEvent :: BrickEvent n e -> Editor t n -> EventM n (Editor t n)
handleEvent (VtyEvent Event
e) Editor t n
ed = Event -> Editor t n -> EventM n (Editor t n)
forall t n.
(DecodeUtf8 t, Eq t, Monoid t) =>
Event -> Editor t n -> EventM n (Editor t n)
handleEditorEvent Event
e Editor t n
ed
handleEvent BrickEvent n e
_ Editor t n
ed = Editor t n -> EventM n (Editor t n)
forall (m :: * -> *) a. Monad m => a -> m a
return Editor t n
ed
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 :: Editor Text n
formFieldState = Editor Text n
initVal
, formFields :: [FormField a (Editor Text n) e n]
formFields = [ n
-> (Editor Text n -> Maybe a)
-> Bool
-> (Bool -> Editor Text n -> Widget n)
-> (BrickEvent n e -> Editor Text n -> EventM n (Editor Text n))
-> FormField a (Editor Text n) 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
n
([Text] -> Maybe a
val ([Text] -> Maybe a)
-> (Editor Text n -> [Text]) -> Editor Text n -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Editor Text n -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents)
Bool
True
(\Bool
b Editor Text n
e -> Widget n -> Widget n
wrapEditor (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ ([Text] -> Widget n) -> Bool -> Editor Text n -> Widget n
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
renderEditor [Text] -> Widget n
renderText Bool
b Editor Text n
e)
BrickEvent n e -> Editor Text n -> EventM n (Editor Text n)
forall t n e n.
(DecodeUtf8 t, Eq t, Monoid t) =>
BrickEvent n e -> Editor t n -> EventM n (Editor t n)
handleEvent
]
, formFieldLens :: Lens' s a
formFieldLens = Lens' s a
stLens
, formFieldUpdate :: a -> Editor Text n -> Editor Text n
formFieldUpdate = \a
newVal Editor Text n
e ->
let newTxt :: Text
newTxt = a -> Text
ini a
newVal
in if Text
newTxt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== ([Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Editor Text n -> [Text]
forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text n
e)
then Editor Text n
e
else (TextZipper Text -> TextZipper Text)
-> Editor Text n -> Editor Text n
forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (Text -> TextZipper Text -> TextZipper Text
forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany Text
newTxt (TextZipper Text -> TextZipper Text)
-> (TextZipper Text -> TextZipper Text)
-> TextZipper Text
-> TextZipper Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextZipper Text -> TextZipper Text
forall a. Monoid a => TextZipper a -> TextZipper a
Z.clearZipper) Editor Text n
e
, 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
}
editShowableField :: (Ord n, Show n, Read a, Show a)
=> Lens' s a
-> n
-> s
-> FormFieldState s e n
editShowableField :: Lens' s a -> n -> s -> FormFieldState s e n
editShowableField Lens' s a
stLens n
n =
Lens' s a -> n -> (a -> Bool) -> s -> FormFieldState s e n
forall n a s e.
(Ord n, Show n, Read a, Show a) =>
Lens' s a -> n -> (a -> Bool) -> s -> FormFieldState s e n
editShowableFieldWithValidate Lens' s a
stLens n
n (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
editShowableFieldWithValidate :: (Ord n, Show n, Read a, Show a)
=> Lens' s a
-> n
-> (a -> Bool)
-> s
-> FormFieldState s e n
editShowableFieldWithValidate :: Lens' s a -> n -> (a -> Bool) -> s -> FormFieldState s e n
editShowableFieldWithValidate Lens' s a
stLens n
n a -> Bool
isValid =
let ini :: a -> Text
ini = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
val :: [Text] -> Maybe a
val [Text]
ls = do
a
v <- String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
if a -> Bool
isValid a
v
then a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
else Maybe a
forall a. Maybe a
Nothing
limit :: Maybe Int
limit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
renderText :: [Text] -> Widget n
renderText = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> ([Text] -> Text) -> [Text] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
in Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
forall n s a e.
(Ord n, Show n) =>
Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField Lens' s a
stLens n
n Maybe Int
limit a -> Text
ini [Text] -> Maybe a
val [Text] -> Widget n
forall n. [Text] -> Widget n
renderText Widget n -> Widget n
forall a. a -> a
id
editTextField :: (Ord n, Show n)
=> Lens' s T.Text
-> n
-> Maybe Int
-> s
-> FormFieldState s e n
editTextField :: Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField Lens' s Text
stLens n
n Maybe Int
limit =
let ini :: a -> a
ini = a -> a
forall a. a -> a
id
val :: [Text] -> Maybe Text
val = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Text] -> Text) -> [Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n"
renderText :: [Text] -> Widget n
renderText = Text -> Widget n
forall n. Text -> Widget n
txt (Text -> Widget n) -> ([Text] -> Text) -> [Text] -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n"
in Lens' s Text
-> n
-> Maybe Int
-> (Text -> Text)
-> ([Text] -> Maybe Text)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
forall n s a e.
(Ord n, Show n) =>
Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField Lens' s Text
stLens n
n Maybe Int
limit Text -> Text
forall a. a -> a
ini [Text] -> Maybe Text
val [Text] -> Widget n
forall n. [Text] -> Widget n
renderText Widget n -> Widget n
forall a. a -> a
id
editPasswordField :: (Ord n, Show n)
=> Lens' s T.Text
-> n
-> s
-> FormFieldState s e n
editPasswordField :: Lens' s Text -> n -> s -> FormFieldState s e n
editPasswordField Lens' s Text
stLens n
n =
let ini :: a -> a
ini = a -> a
forall a. a -> a
id
val :: [Text] -> Maybe Text
val = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> ([Text] -> Text) -> [Text] -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat
limit :: Maybe Int
limit = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
renderText :: [Text] -> Widget a
renderText = [Text] -> Widget a
forall n. [Text] -> Widget n
toPassword
in Lens' s Text
-> n
-> Maybe Int
-> (Text -> Text)
-> ([Text] -> Maybe Text)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
forall n s a e.
(Ord n, Show n) =>
Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField Lens' s Text
stLens n
n Maybe Int
limit Text -> Text
forall a. a -> a
ini [Text] -> Maybe Text
val [Text] -> Widget n
forall n. [Text] -> Widget n
renderText Widget n -> Widget n
forall a. a -> a
id
toPassword :: [T.Text] -> Widget a
toPassword :: [Text] -> Widget a
toPassword [Text]
s = Text -> Widget a
forall n. Text -> Widget n
txt (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
s) Text
"*"
formAttr :: AttrName
formAttr :: AttrName
formAttr = AttrName
"brickForm"
invalidFormInputAttr :: AttrName
invalidFormInputAttr :: AttrName
invalidFormInputAttr = AttrName
formAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"invalidInput"
focusedFormInputAttr :: AttrName
focusedFormInputAttr :: AttrName
focusedFormInputAttr = AttrName
formAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"focusedInput"
allFieldsValid :: Form s e n -> Bool
allFieldsValid :: Form s e n -> Bool
allFieldsValid = [n] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([n] -> Bool) -> (Form s e n -> [n]) -> Form s e n -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form s e n -> [n]
forall s e n. Form s e n -> [n]
invalidFields
invalidFields :: Form s e n -> [n]
invalidFields :: Form s e n -> [n]
invalidFields Form s e n
f = [[n]] -> [n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[n]] -> [n]) -> [[n]] -> [n]
forall a b. (a -> b) -> a -> b
$ FormFieldState s e n -> [n]
forall s e n. FormFieldState s e n -> [n]
getInvalidFields (FormFieldState s e n -> [n]) -> [FormFieldState s e n] -> [[n]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Form s e n -> [FormFieldState s e n]
forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates Form s e n
f
setFieldValid :: (Eq n)
=> Bool
-> n
-> Form s e n
-> Form s e n
setFieldValid :: Bool -> n -> Form s e n -> Form s e n
setFieldValid Bool
v n
n Form s e n
form =
let go1 :: [FormFieldState s e n] -> [FormFieldState s e n]
go1 [] = []
go1 (FormFieldState s e n
s:[FormFieldState s e n]
ss) =
let s' :: FormFieldState s e n
s' = case FormFieldState s e n
s of
FormFieldState b
st Lens' s a
l a -> b -> b
upd [FormField a b e n]
fs Widget n -> Widget n
rh [Widget n] -> Widget n
concatAll ->
let go2 :: [FormField a b e n] -> [FormField a b e n]
go2 [] = []
go2 (f :: FormField a b e n
f@(FormField n
fn b -> Maybe a
val Bool
_ Bool -> b -> Widget n
r BrickEvent n e -> b -> EventM n b
h):[FormField a b e n]
ff)
| n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
fn = n
-> (b -> Maybe a)
-> Bool
-> (Bool -> b -> Widget n)
-> (BrickEvent n e -> b -> EventM n b)
-> FormField a b 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
fn b -> Maybe a
val Bool
v Bool -> b -> Widget n
r BrickEvent n e -> b -> EventM n b
h FormField a b e n -> [FormField a b e n] -> [FormField a b e n]
forall a. a -> [a] -> [a]
: [FormField a b e n]
ff
| Bool
otherwise = FormField a b e n
f FormField a b e n -> [FormField a b e n] -> [FormField a b e n]
forall a. a -> [a] -> [a]
: [FormField a b e n] -> [FormField a b e n]
go2 [FormField a b e n]
ff
in b
-> Lens' s a
-> (a -> b -> b)
-> [FormField a b e n]
-> (Widget n -> Widget n)
-> ([Widget n] -> Widget n)
-> FormFieldState s e n
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 b
st Lens' s a
l a -> b -> b
upd ([FormField a b e n] -> [FormField a b e n]
go2 [FormField a b e n]
fs) Widget n -> Widget n
rh [Widget n] -> Widget n
concatAll
in FormFieldState s e n
s' FormFieldState s e n
-> [FormFieldState s e n] -> [FormFieldState s e n]
forall a. a -> [a] -> [a]
: [FormFieldState s e n] -> [FormFieldState s e n]
go1 [FormFieldState s e n]
ss
in Form s e n
form { formFieldStates :: [FormFieldState s e n]
formFieldStates = [FormFieldState s e n] -> [FormFieldState s e n]
go1 (Form s e n -> [FormFieldState s e n]
forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates Form s e n
form) }
getInvalidFields :: FormFieldState s e n -> [n]
getInvalidFields :: FormFieldState s e n -> [n]
getInvalidFields (FormFieldState b
st Lens' s a
_ a -> b -> b
_ [FormField a b e n]
fs Widget n -> Widget n
_ [Widget n] -> Widget n
_) =
let gather :: FormField a b e n -> [n]
gather (FormField n
n b -> Maybe a
validate Bool
extValid Bool -> b -> Widget n
_ BrickEvent n e -> b -> EventM n b
_) =
if (Bool -> Bool
not Bool
extValid Bool -> Bool -> Bool
|| (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ b -> Maybe a
validate b
st)) then [n
n] else []
in [[n]] -> [n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[n]] -> [n]) -> [[n]] -> [n]
forall a b. (a -> b) -> a -> b
$ FormField a b e n -> [n]
gather (FormField a b e n -> [n]) -> [FormField a b e n] -> [[n]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FormField a b e n]
fs
renderForm :: (Eq n) => Form s e n -> Widget n
renderForm :: Form s e n -> Widget n
renderForm (Form [FormFieldState s e n]
es FocusRing n
fr s
_ [Widget n] -> Widget n
concatAll) =
[Widget n] -> Widget n
concatAll ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ FocusRing n -> FormFieldState s e n -> Widget n
forall n s e.
Eq n =>
FocusRing n -> FormFieldState s e n -> Widget n
renderFormFieldState FocusRing n
fr (FormFieldState s e n -> Widget n)
-> [FormFieldState s e n] -> [Widget n]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FormFieldState s e n]
es
renderFormFieldState :: (Eq n)
=> FocusRing n
-> FormFieldState s e n
-> Widget n
renderFormFieldState :: FocusRing n -> FormFieldState s e n -> Widget n
renderFormFieldState FocusRing n
fr (FormFieldState b
st Lens' s a
_ a -> b -> b
_ [FormField a b e n]
fields Widget n -> Widget n
helper [Widget n] -> Widget n
concatFields) =
let renderFields :: [FormField a b e n] -> [Widget n]
renderFields [] = []
renderFields ((FormField n
n b -> Maybe a
validate Bool
extValid Bool -> b -> Widget n
renderField BrickEvent n e -> b -> EventM n b
_):[FormField a b e n]
fs) =
let maybeInvalid :: Widget n -> Widget n
maybeInvalid = if (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ b -> Maybe a
validate b
st) Bool -> Bool -> Bool
&& Bool
extValid
then Widget n -> Widget n
forall a. a -> a
id
else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
invalidFormInputAttr
foc :: Bool
foc = n -> Maybe n
forall a. a -> Maybe a
Just n
n Maybe n -> Maybe n -> Bool
forall a. Eq a => a -> a -> Bool
== FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing n
fr
in Widget n -> Widget n
maybeInvalid (Bool -> b -> Widget n
renderField Bool
foc b
st) Widget n -> [Widget n] -> [Widget n]
forall a. a -> [a] -> [a]
: [FormField a b e n] -> [Widget n]
renderFields [FormField a b e n]
fs
in Widget n -> Widget n
helper (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
concatFields ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ [FormField a b e n] -> [Widget n]
renderFields [FormField a b e n]
fields
handleFormEvent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormEvent :: BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormEvent (VtyEvent (EvKey (KChar Char
'\t') [])) Form s e n
f =
Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFocus :: FocusRing n
formFocus = FocusRing n -> FocusRing n
forall n. FocusRing n -> FocusRing n
focusNext (FocusRing n -> FocusRing n) -> FocusRing n -> FocusRing n
forall a b. (a -> b) -> a -> b
$ Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f }
handleFormEvent (VtyEvent (EvKey Key
KBackTab [])) Form s e n
f =
Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFocus :: FocusRing n
formFocus = FocusRing n -> FocusRing n
forall n. FocusRing n -> FocusRing n
focusPrev (FocusRing n -> FocusRing n) -> FocusRing n -> FocusRing n
forall a b. (a -> b) -> a -> b
$ Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f }
handleFormEvent e :: BrickEvent n e
e@(MouseDown n
n Button
_ [Modifier]
_ Location
_) Form s e n
f =
n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormFieldEvent n
n BrickEvent n e
e (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFocus :: FocusRing n
formFocus = n -> FocusRing n -> FocusRing n
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
n (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) }
handleFormEvent e :: BrickEvent n e
e@(MouseUp n
n Maybe Button
_ Location
_) Form s e n
f =
n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormFieldEvent n
n BrickEvent n e
e (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFocus :: FocusRing n
formFocus = n -> FocusRing n -> FocusRing n
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
n (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) }
handleFormEvent e :: BrickEvent n e
e@(VtyEvent (EvKey Key
KUp [])) Form s e n
f =
case FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) of
Maybe n
Nothing -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return Form s e n
f
Just n
n ->
case Form s e n -> n -> Maybe [n]
forall n s e. Eq n => Form s e n -> n -> Maybe [n]
getFocusGrouping Form s e n
f n
n of
Maybe [n]
Nothing -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forwardToCurrent BrickEvent n e
e Form s e n
f
Just [n]
grp -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFocus :: FocusRing n
formFocus = n -> FocusRing n -> FocusRing n
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent ([n] -> n -> n
forall a. Eq a => [a] -> a -> a
entryBefore [n]
grp n
n) (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) }
handleFormEvent e :: BrickEvent n e
e@(VtyEvent (EvKey Key
KDown [])) Form s e n
f =
case FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) of
Maybe n
Nothing -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return Form s e n
f
Just n
n ->
case Form s e n -> n -> Maybe [n]
forall n s e. Eq n => Form s e n -> n -> Maybe [n]
getFocusGrouping Form s e n
f n
n of
Maybe [n]
Nothing -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forwardToCurrent BrickEvent n e
e Form s e n
f
Just [n]
grp -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFocus :: FocusRing n
formFocus = n -> FocusRing n -> FocusRing n
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent ([n] -> n -> n
forall a. Eq a => [a] -> a -> a
entryAfter [n]
grp n
n) (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) }
handleFormEvent e :: BrickEvent n e
e@(VtyEvent (EvKey Key
KLeft [])) Form s e n
f =
case FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) of
Maybe n
Nothing -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return Form s e n
f
Just n
n ->
case Form s e n -> n -> Maybe [n]
forall n s e. Eq n => Form s e n -> n -> Maybe [n]
getFocusGrouping Form s e n
f n
n of
Maybe [n]
Nothing -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forwardToCurrent BrickEvent n e
e Form s e n
f
Just [n]
grp -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFocus :: FocusRing n
formFocus = n -> FocusRing n -> FocusRing n
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent ([n] -> n -> n
forall a. Eq a => [a] -> a -> a
entryBefore [n]
grp n
n) (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) }
handleFormEvent e :: BrickEvent n e
e@(VtyEvent (EvKey Key
KRight [])) Form s e n
f =
case FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) of
Maybe n
Nothing -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return Form s e n
f
Just n
n ->
case Form s e n -> n -> Maybe [n]
forall n s e. Eq n => Form s e n -> n -> Maybe [n]
getFocusGrouping Form s e n
f n
n of
Maybe [n]
Nothing -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forwardToCurrent BrickEvent n e
e Form s e n
f
Just [n]
grp -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFocus :: FocusRing n
formFocus = n -> FocusRing n -> FocusRing n
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent ([n] -> n -> n
forall a. Eq a => [a] -> a -> a
entryAfter [n]
grp n
n) (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) }
handleFormEvent BrickEvent n e
e Form s e n
f = BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forwardToCurrent BrickEvent n e
e Form s e n
f
getFocusGrouping :: (Eq n) => Form s e n -> n -> Maybe [n]
getFocusGrouping :: Form s e n -> n -> Maybe [n]
getFocusGrouping Form s e n
f n
n = [FormFieldState s e n] -> Maybe [n]
findGroup (Form s e n -> [FormFieldState s e n]
forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates Form s e n
f)
where
findGroup :: [FormFieldState s e n] -> Maybe [n]
findGroup [] = Maybe [n]
forall a. Maybe a
Nothing
findGroup (FormFieldState s e n
e:[FormFieldState s e n]
es) =
let ns :: [n]
ns = FormFieldState s e n -> [n]
forall s e n. FormFieldState s e n -> [n]
formFieldNames FormFieldState s e n
e
in if n
n n -> [n] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [n]
ns Bool -> Bool -> Bool
&& [n] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [n]
ns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
then [n] -> Maybe [n]
forall a. a -> Maybe a
Just [n]
ns
else [FormFieldState s e n] -> Maybe [n]
findGroup [FormFieldState s e n]
es
entryAfter :: (Eq a) => [a] -> a -> a
entryAfter :: [a] -> a -> a
entryAfter [a]
as a
a =
let Just Int
i = a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
a [a]
as
i' :: Int
i' = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 then Int
0 else Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
in [a]
as [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
i'
entryBefore :: (Eq a) => [a] -> a -> a
entryBefore :: [a] -> a -> a
entryBefore [a]
as a
a =
let Just Int
i = a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
a [a]
as
i' :: Int
i' = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in [a]
as [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
i'
forwardToCurrent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forwardToCurrent :: BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forwardToCurrent BrickEvent n e
e Form s e n
f =
case FocusRing n -> Maybe n
forall n. FocusRing n -> Maybe n
focusGetCurrent (Form s e n -> FocusRing n
forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f) of
Maybe n
Nothing -> Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return Form s e n
f
Just n
n -> n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
forall n e s.
Eq n =>
n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormFieldEvent n
n BrickEvent n e
e Form s e n
f
handleFormFieldEvent :: (Eq n) => n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormFieldEvent :: n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n)
handleFormFieldEvent n
n BrickEvent n e
ev Form s e n
f = [FormFieldState s e n]
-> [FormFieldState s e n] -> EventM n (Form s e n)
findFieldState [] (Form s e n -> [FormFieldState s e n]
forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates Form s e n
f)
where
findFieldState :: [FormFieldState s e n]
-> [FormFieldState s e n] -> EventM n (Form s e n)
findFieldState [FormFieldState s e n]
_ [] = Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return Form s e n
f
findFieldState [FormFieldState s e n]
prev (FormFieldState s e n
e:[FormFieldState s e n]
es) =
case FormFieldState s e n
e of
FormFieldState b
st Lens' s a
stLens a -> b -> b
upd [FormField a b e n]
fields Widget n -> Widget n
helper [Widget n] -> Widget n
concatAll -> do
let findField :: [FormField a b e n] -> EventM n (Maybe (b, Maybe a))
findField [] = Maybe (b, Maybe a) -> EventM n (Maybe (b, Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (b, Maybe a)
forall a. Maybe a
Nothing
findField (FormField a b e n
field:[FormField a b e n]
rest) =
case FormField a b e n
field of
FormField n
n' b -> Maybe a
validate Bool
_ Bool -> b -> Widget n
_ BrickEvent n e -> b -> EventM n b
handleFunc | n
n n -> n -> Bool
forall a. Eq a => a -> a -> Bool
== n
n' -> do
b
nextSt <- BrickEvent n e -> b -> EventM n b
handleFunc BrickEvent n e
ev b
st
case b -> Maybe a
validate b
nextSt of
Maybe a
Nothing -> Maybe (b, Maybe a) -> EventM n (Maybe (b, Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (b, Maybe a) -> EventM n (Maybe (b, Maybe a)))
-> Maybe (b, Maybe a) -> EventM n (Maybe (b, Maybe a))
forall a b. (a -> b) -> a -> b
$ (b, Maybe a) -> Maybe (b, Maybe a)
forall a. a -> Maybe a
Just (b
nextSt, Maybe a
forall a. Maybe a
Nothing)
Just a
newSt -> Maybe (b, Maybe a) -> EventM n (Maybe (b, Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (b, Maybe a) -> EventM n (Maybe (b, Maybe a)))
-> Maybe (b, Maybe a) -> EventM n (Maybe (b, Maybe a))
forall a b. (a -> b) -> a -> b
$ (b, Maybe a) -> Maybe (b, Maybe a)
forall a. a -> Maybe a
Just (b
nextSt, a -> Maybe a
forall a. a -> Maybe a
Just a
newSt)
FormField a b e n
_ -> [FormField a b e n] -> EventM n (Maybe (b, Maybe a))
findField [FormField a b e n]
rest
Maybe (b, Maybe a)
result <- [FormField a b e n] -> EventM n (Maybe (b, Maybe a))
findField [FormField a b e n]
fields
case Maybe (b, Maybe a)
result of
Maybe (b, Maybe a)
Nothing -> [FormFieldState s e n]
-> [FormFieldState s e n] -> EventM n (Form s e n)
findFieldState ([FormFieldState s e n]
prev [FormFieldState s e n]
-> [FormFieldState s e n] -> [FormFieldState s e n]
forall a. Semigroup a => a -> a -> a
<> [FormFieldState s e n
e]) [FormFieldState s e n]
es
Just (b
newSt, Maybe a
maybeSt) ->
let newFieldState :: FormFieldState s e n
newFieldState = b
-> Lens' s a
-> (a -> b -> b)
-> [FormField a b e n]
-> (Widget n -> Widget n)
-> ([Widget n] -> Widget n)
-> FormFieldState s e n
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 b
newSt Lens' s a
stLens a -> b -> b
upd [FormField a b e n]
fields Widget n -> Widget n
helper [Widget n] -> Widget n
concatAll
in Form s e n -> EventM n (Form s e n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Form s e n -> EventM n (Form s e n))
-> Form s e n -> EventM n (Form s e n)
forall a b. (a -> b) -> a -> b
$ Form s e n
f { formFieldStates :: [FormFieldState s e n]
formFieldStates = [FormFieldState s e n]
prev [FormFieldState s e n]
-> [FormFieldState s e n] -> [FormFieldState s e n]
forall a. Semigroup a => a -> a -> a
<> [FormFieldState s e n
newFieldState] [FormFieldState s e n]
-> [FormFieldState s e n] -> [FormFieldState s e n]
forall a. Semigroup a => a -> a -> a
<> [FormFieldState s e n]
es
, formState :: s
formState = case Maybe a
maybeSt of
Maybe a
Nothing -> Form s e n -> s
forall s e n. Form s e n -> s
formState Form s e n
f
Just a
s -> Form s e n -> s
forall s e n. Form s e n -> s
formState Form s e n
f s -> (s -> s) -> s
forall a b. a -> (a -> b) -> b
& (a -> Identity a) -> s -> Identity s
Lens' s a
stLens ((a -> Identity a) -> s -> Identity s) -> a -> s -> s
forall s t a b. ASetter s t a b -> b -> s -> t
.~ a
s
}