{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
-- | Note - this API is designed to support a narrow (but common!) set
-- of use cases. If you find that you need more customization than this
-- offers, then you will need to consider building your own layout and
-- event handling for input fields.
--
-- For a fuller introduction to this API, see the "Input Forms" section
-- of the Brick User Guide. Also see the demonstration programs for
-- examples of forms in action.
--
-- This module provides an input form API. This API allows you to
-- construct an input interface based on a data type of your choice.
-- Each input in the form corresponds to a field in your data type. This
-- API then automatically dispatches keyboard and mouse input events to
-- each form input field, manages rendering of the form, notifies the
-- user when a form field's value is invalid, and stores valid inputs in
-- your data type when possible.
--
-- A form has both a visual representation and a corresponding data
-- structure representing the latest valid values for that form
-- (referred to as the "state" of the form). A 'FormField' is a single
-- input component in the form and a 'FormFieldState' defines the
-- linkage between that visual input and the corresponding portion
-- of the state represented by that visual; there may be multiple
-- 'FormField's combined for a single 'FormFieldState' (e.g. a radio
-- button sequence).
--
-- To use a 'Form', you must include it within your application state
-- type. You can use 'formState' to access the underlying state whenever
-- you need it. See @programs/FormDemo.hs@ for a complete working
-- example.
--
-- Also note that, by default, forms and their field inputs are
-- concatenated together in a 'vBox'. This can be customized on a
-- per-field basis and for the entire form by using the functions
-- 'setFieldConcat' and 'setFormConcat', respectively.
--
-- Bear in mind that for most uses, the 'FormField' and 'FormFieldState'
-- types will not be used directly. Instead, the constructors for
-- various field types (such as 'editTextField') will be used instead.
module Brick.Forms
  ( -- * Data types
    Form
  , FormFieldState(..)
  , FormField(..)

  -- * Creating and using forms
  , newForm
  , formFocus
  , formState
  , handleFormEvent
  , renderForm
  , renderFormFieldState
  , (@@=)
  , allFieldsValid
  , invalidFields
  , setFieldValid
  , setFormConcat
  , setFieldConcat
  , setFormFocus
  , updateFormState

  -- * Simple form field constructors
  , editTextField
  , editShowableField
  , editShowableFieldWithValidate
  , editPasswordField
  , radioField
  , checkboxField
  , listField

  -- * Advanced form field constructors
  , editField
  , radioCustomField
  , checkboxCustomField

  -- * Attributes
  , formAttr
  , invalidFormInputAttr
  , focusedFormInputAttr
  )
where

import Graphics.Vty hiding (showCursor)
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
import Data.Maybe (fromJust, 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
import Lens.Micro.Mtl

-- | A form field. This represents an interactive input field in the
-- form. Its user input is validated and thus converted into a type of
-- your choosing.
--
-- Type variables are as follows:
--
--  * @a@ - the type of the field in your form state that this field
--    manipulates
--  * @b@ - the form field's internal state type
--  * @e@ - your application's event type
--  * @n@ - your application's resource name type
data FormField a b e n =
    FormField { forall a b e n. FormField a b e n -> n
formFieldName :: n
              -- ^ The name identifying this form field.
              , forall a b e n. FormField a b e n -> b -> Maybe a
formFieldValidate :: b -> Maybe a
              -- ^ A validation function converting this field's state
              -- into a value of your choosing. @Nothing@ indicates a
              -- validation failure. For example, this might validate
              -- an 'Editor' state value by parsing its text contents as
              -- an integer and return 'Maybe' 'Int'. This is for pure
              -- value validation; if additional validation is required
              -- (e.g. via 'IO'), use this field's state value in an
              -- external validation routine and use 'setFieldValid' to
              -- feed the result back into the form.
              , forall a b e n. FormField a b e n -> Bool
formFieldExternallyValid :: Bool
              -- ^ Whether the field is valid according to an external
              -- validation source. Defaults to always being 'True' and
              -- can be set with 'setFieldValid'. The value of this
              -- field also affects the behavior of 'allFieldsValid' and
              -- 'getInvalidFields'.
              , forall a b e n. FormField a b e n -> Bool -> b -> Widget n
formFieldRender :: Bool -> b -> Widget n
              -- ^ A function to render this form field. Parameters are
              -- whether the field is currently focused, followed by the
              -- field state.
              , forall a b e n.
FormField a b e n -> BrickEvent n e -> EventM n b ()
formFieldHandleEvent :: BrickEvent n e -> EventM n b ()
              -- ^ An event handler for this field.
              }

-- | A form field state accompanied by the fields that manipulate that
-- state. The idea is that some record field in your form state has
-- one or more form fields that manipulate that value. This data type
-- maps that state field (using a lens into your state) to the form
-- input fields responsible for managing that state field, along with
-- a current value for that state field and an optional function to
-- control how the form inputs are rendered.
--
-- Most form fields will just have one input, such as text editors, but
-- others, such as radio button collections, will have many, which is
-- why this type supports more than one input corresponding to a state
-- field.
--
-- Type variables are as follows:
--
--  * @s@ - the data type containing the value manipulated by these form
--    fields.
--  * @e@ - your application's event type
--  * @n@ - your application's resource name type
data FormFieldState s e n where
    FormFieldState :: { ()
formFieldState :: b
                      -- ^ The current state value associated with
                      -- the field collection. Note that this type is
                      -- existential. All form fields in the collection
                      -- must validate to this type.
                      , ()
formFieldLens :: Lens' s a
                      -- ^ A lens to extract and store a
                      -- successfully-validated form input back into
                      -- your form state.
                      , ()
formFieldUpdate :: a -> b -> b
                      -- ^ Given a new form state value, update the form
                      -- field state in place.
                      , ()
formFields :: [FormField a b e n]
                      -- ^ The form fields, in order, that the user will
                      -- interact with to manipulate this state value.
                      , forall s e n. FormFieldState s e n -> Widget n -> Widget n
formFieldRenderHelper :: Widget n -> Widget n
                      -- ^ A helper function to augment the rendered
                      -- representation of this collection of form
                      -- fields. It receives the default representation
                      -- and can augment it, for example, by adding a
                      -- label on the left.
                      , forall s e n. FormFieldState s e n -> [Widget n] -> Widget n
formFieldConcat :: [Widget n] -> Widget n
                      -- ^ Concatenation function for this field's input
                      -- renderings.
                      } -> FormFieldState s e n

-- | A form: a sequence of input fields that manipulate the fields of an
-- underlying state that you choose. This value must be stored in the
-- Brick application's state.
--
-- Type variables are as follows:
--
--  * @s@ - the data type of your choosing containing the values
--    manipulated by the fields in this form.
--  * @e@ - your application's event type
--  * @n@ - your application's resource name type
data Form s e n =
    Form { forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates  :: [FormFieldState s e n]
         , forall s e n. Form s e n -> FocusRing n
formFocus :: FocusRing n
         -- ^ The focus ring for the form, indicating which form field
         -- has input focus.
         , forall s e n. Form s e n -> s
formState :: s
         -- ^ The current state of the form. Forms guarantee that only
         -- valid inputs ever get stored in the state, and that after
         -- each input event on a form field, if that field contains a
         -- valid state value then the value is immediately saved to its
         -- corresponding field in this state value using the form
         -- field's lens over @s@.
         , forall s e n. Form s e n -> [Widget n] -> Widget n
formConcatAll :: [Widget n] -> Widget n
         -- ^ Concatenation function for this form's field renderings.
         }

suffixLenses ''Form

-- | Compose a new rendering augmentation function with the one in the
-- form field collection. For example, we might put a label on the left
-- side of a form field:
--
-- > (str "Please check: " <+>) @@= checkboxField alive AliveField "Alive?"
--
-- This can also be used to add multiple augmentations and associates
-- right:
--
-- > (withDefAttr someAttribute) @@=
-- > (str "Please check: " <+>) @@=
-- >   checkboxField alive AliveField "Alive?"
infixr 5 @@=
(@@=) :: (Widget n -> Widget n) -> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= :: forall n s e.
(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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s e n. FormFieldState s e n -> Widget n -> Widget n
formFieldRenderHelper FormFieldState s e n
v) }

-- | Update the state contained in a form.
--
-- This updates all form fields to be consistent with the new form
-- state. Where possible, this attempts to maintain other input state,
-- such as text editor cursor position.
--
-- Note that since this updates the form fields, this means that any
-- field values will be completely overwritten! This may or may not
-- be what you want, since a user actively using the form could get
-- confused if their edits go away. Use carefully.
updateFormState :: s -> Form s e n -> Form s e n
updateFormState :: forall s e n. 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 ->
                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
newStateforall s a. s -> Getting a s a -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates Form s e n
f
         }

-- | Set the focused field of a form.
setFormFocus :: (Eq n) => n -> Form s e n -> Form s e n
setFormFocus :: forall n s e. Eq n => 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 = forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
n forall a b. (a -> b) -> a -> b
$ forall s e n. Form s e n -> FocusRing n
formFocus Form s e n
f }

-- | Set a form field's concatenation function.
setFieldConcat :: ([Widget n] -> Widget n) -> FormFieldState s e n -> FormFieldState s e n
setFieldConcat :: forall n s e.
([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 }

-- | Set a form's concatenation function.
setFormConcat :: ([Widget n] -> Widget n) -> Form s e n -> Form s e n
setFormConcat :: forall n s e. ([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 }

-- | Create a new form with the specified input fields and an initial
-- form state. The fields are initialized from the state using their
-- state lenses and the first form input is focused initially.
newForm :: [s -> FormFieldState s e n]
        -- ^ The form field constructors. This is intended to be
        -- populated using the various field constructors in this
        -- module.
        -> s
        -- ^ The initial form state used to populate the fields.
        -> Form s e n
newForm :: forall s e n. [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 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure s
s
    in Form { formFieldStates :: [FormFieldState s e n]
formFieldStates = [FormFieldState s e n]
es
            , formFocus :: FocusRing n
formFocus       = forall n. [n] -> FocusRing n
focusRing forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall s e n. FormFieldState s e n -> [n]
formFieldNames [FormFieldState s e n]
es
            , formState :: s
formState       = s
s
            , formConcatAll :: [Widget n] -> Widget n
formConcatAll   = forall n. [Widget n] -> Widget n
vBox
            }

formFieldNames :: FormFieldState s e n -> [n]
formFieldNames :: forall s e n. 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
_) = forall a b e n. FormField a b e n -> n
formFieldName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FormField a b e n]
fields

-- | A form field for manipulating a boolean value. This represents
-- 'True' as @[X] label@ and 'False' as @[ ] label@.
--
-- This field responds to `Space` keypresses to toggle the checkbox and
-- to mouse clicks.
checkboxField :: (Ord n, Show n)
              => Lens' s Bool
              -- ^ The state lens for this value.
              -> n
              -- ^ The resource name for the input field.
              -> T.Text
              -- ^ The label for the check box, to appear at its right.
              -> s
              -- ^ The initial form state.
              -> FormFieldState s e n
checkboxField :: forall n s e.
(Ord n, Show n) =>
Lens' s Bool -> n -> Text -> s -> FormFieldState s e n
checkboxField = 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
']'

-- | A form field for manipulating a boolean value. This represents
-- 'True' as @[X] label@ and 'False' as @[ ] label@. This function
-- permits the customization of the @[X]@ notation characters.
--
-- This field responds to `Space` keypresses to toggle the checkbox and
-- to mouse clicks.
checkboxCustomField :: (Ord n, Show n)
                    => Char
                    -- ^ Left bracket character.
                    -> Char
                    -- ^ Checkmark character.
                    -> Char
                    -- ^ Right bracket character.
                    -> Lens' s Bool
                    -- ^ The state lens for this value.
                    -> n
                    -- ^ The resource name for the input field.
                    -> T.Text
                    -- ^ The label for the check box, to appear at its right.
                    -> s
                    -- ^ The initial form state.
                    -> FormFieldState s e n
checkboxCustomField :: forall n s e.
(Ord n, Show n) =>
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 forall s a. s -> Getting a s a -> a
^. Lens' s Bool
stLens

        handleEvent :: BrickEvent n e -> EventM n Bool ()
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 (EvKey (KChar Char
' ') [])) = 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 =>
Char -> Char -> Char -> Text -> n -> Bool -> Bool -> Widget n
renderCheckbox Char
lb Char
check Char
rb Text
label n
name)
                                                 BrickEvent n e -> 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 = forall a. a -> a
id
                      , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = forall n. [Widget n] -> Widget n
vBox
                      }

renderCheckbox :: (Ord n) => Char -> Char -> Char -> T.Text -> n -> Bool -> Bool -> Widget n
renderCheckbox :: forall n.
Ord n =>
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 forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr else forall a. a -> a
id
        csr :: Widget n -> Widget n
csr = if Bool
foc then forall n. n -> Location -> Widget n -> Widget n
putCursor n
n ((Int, Int) -> Location
Location (Int
1,Int
0)) 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
$
       Widget n -> Widget n
addAttr forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
csr forall a b. (a -> b) -> a -> b
$
       (forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
lb forall a. Semigroup a => a -> a -> a
<> (if Bool
val then Char -> Text
T.singleton Char
check else Text
" ") forall a. Semigroup a => a -> a -> a
<>
              Char -> Text
T.singleton Char
rb forall a. Semigroup a => a -> a -> a
<> Text
" ") forall n. Widget n -> Widget n -> Widget n
<+> forall n. Text -> Widget n
txt Text
label

-- | A form field for selecting a single choice from a set of possible
-- choices in a scrollable list. This uses a 'List' internally.
--
-- This field responds to the same input events that a 'List' does.
listField :: forall s e n a . (Ord n, Show n, Eq a)
          => (s -> Vector a)
          -- ^ Possible choices.
          -> Lens' s (Maybe a)
          -- ^ The state lens for the initially/finally selected
          -- element.
          -> (Bool -> a -> Widget n)
          -- ^ List item rendering function.
          -> Int
          -- ^ List item height in rows.
          -> n
          -- ^ The resource name for the input field.
          -> s
          -- ^ The initial form state.
          -> FormFieldState s e n
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
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 forall s a. s -> Getting a s a -> a
^. Lens' s (List n a)
customStLens

        customStLens :: Lens' s (List n a)
        customStLens :: Lens' s (List n a)
customStLens = 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 = 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 forall s a. s -> Getting a s a -> a
^. Lens' s (Maybe a)
stLens of
                               Maybe a
Nothing -> List n a
l
                               Just a
e -> 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 forall a b. a -> (a -> b) -> b
& Lens' s (Maybe a)
stLens forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement List n a
l)

        handleEvent :: BrickEvent n e -> EventM n (GenericList n t e) ()
handleEvent (VtyEvent Event
e) = forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e
        handleEvent BrickEvent n e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

    in FormFieldState { formFieldState :: List n a
formFieldState = List n a
initVal
                      , formFields :: [FormField (List n a) (List n a) 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 (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)
                                                 forall {t :: * -> *} {n} {n} {e} {e}.
(Foldable t, Splittable t, Ord n) =>
BrickEvent n 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 forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
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) -> 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 = forall a. a -> a
id
                      , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = forall n. [Widget n] -> Widget n
vBox
                      }
-- | A form field for selecting a single choice from a set of possible
-- choices. Each choice has an associated value and text label.
--
-- This field responds to `Space` keypresses to select a radio button
-- option and to mouse clicks.
radioField :: (Ord n, Show n, Eq a)
           => Lens' s a
           -- ^ The state lens for this value.
           -> [(a, n, T.Text)]
           -- ^ The available choices, in order. Each choice has a value
           -- of type @a@, a resource name, and a text label.
           -> s
           -- ^ The initial form state.
           -> FormFieldState s e n
radioField :: forall n a s e.
(Ord n, Show n, Eq a) =>
Lens' s a -> [(a, n, Text)] -> s -> FormFieldState s e n
radioField = 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
']'

-- | A form field for selecting a single choice from a set of possible
-- choices. Each choice has an associated value and text label. This
-- function permits the customization of the @[*]@ notation characters.
--
-- This field responds to `Space` keypresses to select a radio button
-- option and to mouse clicks.
radioCustomField :: (Ord n, Show n, Eq a)
                 => Char
                 -- ^ Left bracket character.
                 -> Char
                 -- ^ Checkmark character.
                 -> Char
                 -- ^ Right bracket character.
                 -> Lens' s a
                 -- ^ The state lens for this value.
                 -> [(a, n, T.Text)]
                 -- ^ The available choices, in order. Each choice has a value
                 -- of type @a@, a resource name, and a text label.
                 -> s
                 -- ^ The initial form state.
                 -> FormFieldState s e n
radioCustomField :: 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
lb Char
check Char
rb Lens' s a
stLens [(a, n, Text)]
options s
initialState =
    let initVal :: a
initVal = s
initialState forall s a. s -> Getting a s a -> a
^. Lens' s a
stLens

        lookupOptionValue :: n -> Maybe a
lookupOptionValue n
n =
            let results :: [(a, n, Text)]
results = forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
_, n
n', Text
_) -> n
n' forall a. Eq a => a -> a -> Bool
== n
n) [(a, n, Text)]
options
            in case [(a, n, Text)]
results of
                [(a
val, n
_, Text
_)] -> forall a. a -> Maybe a
Just a
val
                [(a, n, Text)]
_ -> forall a. Maybe a
Nothing

        handleEvent :: a -> BrickEvent n e -> EventM n a ()
handleEvent a
_ (MouseDown n
n Button
_ [Modifier]
_ Location
_) =
            case n -> Maybe a
lookupOptionValue n
n of
                Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just a
v -> forall s (m :: * -> *). MonadState s m => s -> m ()
put a
v
        handleEvent a
new (VtyEvent (EvKey (KChar Char
' ') [])) = forall s (m :: * -> *). MonadState s m => s -> m ()
put a
new
        handleEvent a
_ BrickEvent n e
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

        optionFields :: [FormField a a e n]
optionFields = (a, n, Text) -> FormField a a e n
mkOptionField 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) =
            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 a n.
(Eq a, Ord n) =>
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 -> EventM n a ()
handleEvent a
val)

    in 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 = forall a. a -> a
id
                      , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = forall n. [Widget n] -> Widget n
vBox
                      }

renderRadio :: (Eq a, Ord n) => Char -> Char -> Char -> a -> n -> T.Text -> Bool -> a -> Widget n
renderRadio :: forall a n.
(Eq a, Ord n) =>
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 forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
focusedFormInputAttr
                  else forall a. a -> a
id
        isSet :: Bool
isSet = a
val forall a. Eq a => a -> a -> Bool
== a
cur
        csr :: Widget n -> Widget n
csr = if Bool
foc then forall n. n -> Location -> Widget n -> Widget n
putCursor n
name ((Int, Int) -> Location
Location (Int
1,Int
0)) else forall a. a -> a
id
    in forall n. Ord n => n -> Widget n -> Widget n
clickable n
name forall a b. (a -> b) -> a -> b
$
       Widget n -> Widget n
addAttr forall a b. (a -> b) -> a -> b
$ Widget n -> Widget n
csr forall a b. (a -> b) -> a -> b
$
       forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat
       [ Char -> Text
T.singleton Char
lb
       , if Bool
isSet then Char -> Text
T.singleton Char
check else Text
" "
       , Char -> Text
T.singleton Char
rb forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
label
       ]

-- | A form field for using an editor to edit the text representation of
-- a value. The other editing fields in this module are special cases of
-- this function.
--
-- This field responds to all events handled by 'editor', including
-- mouse events.
editField :: (Ord n, Show n)
          => Lens' s a
          -- ^ The state lens for this value.
          -> n
          -- ^ The resource name for the input field.
          -> Maybe Int
          -- ^ The optional line limit for the editor (see 'editor').
          -> (a -> T.Text)
          -- ^ The initialization function that turns your value into
          -- the editor's initial contents. The resulting text may
          -- contain newlines.
          -> ([T.Text] -> Maybe a)
          -- ^ The validation function that converts the editor's
          -- contents into a valid value of type @a@.
          -> ([T.Text] -> Widget n)
          -- ^ The rendering function for the editor's contents (see
          -- 'renderEditor').
          -> (Widget n -> Widget n)
          -- ^ A rendering augmentation function to adjust the
          -- representation of the rendered editor.
          -> s
          -- ^ The initial form state.
          -> FormFieldState s e n
editField :: 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
renderText Widget n -> Widget n
wrapEditor s
initialState =
    let initVal :: Editor Text n
initVal = forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit TextZipper Text -> TextZipper Text
gotoEnd forall a b. (a -> b) -> a -> b
$
                  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 = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ls forall a. Num a => a -> a -> a
- Int
1, Text -> Int
T.length (forall a. [a] -> a
last [Text]
ls))
                  in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls
                     then forall a. a -> a
id
                     else forall a. Monoid a => (Int, Int) -> TextZipper a -> TextZipper a
Z.moveCursor (Int, Int)
pos
        initialText :: Text
initialText = a -> Text
ini forall a b. (a -> b) -> a -> b
$ s
initialState forall s a. s -> Getting a s a -> a
^. Lens' s a
stLens

    in FormFieldState { formFieldState :: Editor Text n
formFieldState = Editor Text n
initVal
                      , formFields :: [FormField a (Editor Text n) 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
n
                                                 ([Text] -> Maybe a
val forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t n. Monoid t => Editor t n -> [t]
getEditContents)
                                                 Bool
True
                                                 (\Bool
b Editor Text n
e -> Widget n -> Widget n
wrapEditor forall a b. (a -> b) -> a -> b
$ 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)
                                                 forall n t e.
(Eq n, DecodeUtf8 t, Eq t, GenericTextZipper t) =>
BrickEvent n e -> EventM n (Editor t n) ()
handleEditorEvent
                                     ]
                      , 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 forall a. Eq a => a -> a -> Bool
== ([Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall t n. Monoid t => Editor t n -> [t]
getEditContents Editor Text n
e)
                             then Editor Text n
e
                             else forall t n.
(TextZipper t -> TextZipper t) -> Editor t n -> Editor t n
applyEdit (forall a. Monoid a => a -> TextZipper a -> TextZipper a
Z.insertMany Text
newTxt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => TextZipper a -> TextZipper a
Z.clearZipper) Editor Text n
e
                      , formFieldRenderHelper :: Widget n -> Widget n
formFieldRenderHelper = forall a. a -> a
id
                      , formFieldConcat :: [Widget n] -> Widget n
formFieldConcat = forall n. [Widget n] -> Widget n
vBox
                      }

-- | A form field using a single-line editor to edit the 'Show'
-- representation of a state field value of type @a@. This automatically
-- uses its 'Read' instance to validate the input. This field is mostly
-- useful in cases where the user-facing representation of a value
-- matches the 'Show' representation exactly, such as with 'Int'.
--
-- This field responds to all events handled by 'editor', including
-- mouse events.
editShowableField :: (Ord n, Show n, Read a, Show a)
                  => Lens' s a
                  -- ^ The state lens for this value.
                  -> n
                  -- ^ The resource name for the input field.
                  -> s
                  -- ^ The initial form state.
                  -> FormFieldState s e n
editShowableField :: forall n a s e.
(Ord n, Show n, Read a, Show a) =>
Lens' s a -> n -> s -> FormFieldState s e n
editShowableField Lens' s a
stLens n
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 (forall a b. a -> b -> a
const Bool
True)

-- | A form field using a single-line editor to edit the 'Show' representation
-- of a state field value of type @a@. This automatically uses its 'Read'
-- instance to validate the input, and also accepts an additional user-defined
-- pass for validation. This field is mostly useful in cases where the
-- user-facing representation of a value matches the 'Show' representation
-- exactly, such as with 'Int', but you don't want to accept just /any/ 'Int'.
--
-- This field responds to all events handled by 'editor', including
-- mouse events.
editShowableFieldWithValidate :: (Ord n, Show n, Read a, Show a)
                              => Lens' s a
                              -- ^ The state lens for this value.
                              -> n
                              -- ^ The resource name for the input field.
                              -> (a -> Bool)
                              -- ^ Additional validation step for input.
                              -- 'True' indicates that the value is
                              -- valid.
                              -> s
                              -- ^ The initial form state.
                              -> FormFieldState s e n
editShowableFieldWithValidate :: 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 a -> Bool
isValid =
    let ini :: a -> Text
ini = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
        val :: [Text] -> Maybe a
val [Text]
ls = do
            a
v <- forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
            if a -> Bool
isValid a
v
               then forall (m :: * -> *) a. Monad m => a -> m a
return a
v
               else forall a. Maybe a
Nothing
        limit :: Maybe Int
limit = forall a. a -> Maybe a
Just Int
1
        renderText :: [Text] -> Widget n
renderText = forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines
    in 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 forall {n}. [Text] -> Widget n
renderText forall a. a -> a
id

-- | A form field using an editor to edit a text value. Since the value
-- is free-form text, it is always valid.
--
-- This field responds to all events handled by 'editor', including
-- mouse events.
editTextField :: (Ord n, Show n)
              => Lens' s T.Text
              -- ^ The state lens for this value.
              -> n
              -- ^ The resource name for the input field.
              -> Maybe Int
              -- ^ The optional line limit for the editor (see 'editor').
              -> s
              -- ^ The initial form state.
              -> FormFieldState s e n
editTextField :: forall n s e.
(Ord n, Show n) =>
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 = forall a. a -> a
id
        val :: [Text] -> Maybe Text
val = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n"
        renderText :: [Text] -> Widget n
renderText = forall n. Text -> Widget n
txt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n"
    in 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 forall a. a -> a
ini [Text] -> Maybe Text
val forall {n}. [Text] -> Widget n
renderText forall a. a -> a
id

-- | A form field using a single-line editor to edit a free-form text
-- value represented as a password. The value is always considered valid
-- and is always represented with one asterisk per password character.
--
-- This field responds to all events handled by 'editor', including
-- mouse events.
editPasswordField :: (Ord n, Show n)
                  => Lens' s T.Text
                  -- ^ The state lens for this value.
                  -> n
                  -- ^ The resource name for the input field.
                  -> s
                  -- ^ The initial form state.
                  -> FormFieldState s e n
editPasswordField :: forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> s -> FormFieldState s e n
editPasswordField Lens' s Text
stLens n
n =
    let ini :: a -> a
ini = forall a. a -> a
id
        val :: [Text] -> Maybe Text
val = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.concat
        limit :: Maybe Int
limit = forall a. a -> Maybe a
Just Int
1
        renderText :: [Text] -> Widget a
renderText = forall {n}. [Text] -> Widget n
toPassword
    in 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 forall a. a -> a
ini [Text] -> Maybe Text
val forall {n}. [Text] -> Widget n
renderText forall a. a -> a
id

toPassword :: [T.Text] -> Widget a
toPassword :: forall {n}. [Text] -> Widget n
toPassword [Text]
s = forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate (Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text]
s) Text
"*"

-- | The namespace for the other form attributes.
formAttr :: AttrName
formAttr :: AttrName
formAttr = String -> AttrName
attrName String
"brickForm"

-- | The attribute for form input fields with invalid values.
invalidFormInputAttr :: AttrName
invalidFormInputAttr :: AttrName
invalidFormInputAttr = AttrName
formAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"invalidInput"

-- | The attribute for form input fields that have the focus.
focusedFormInputAttr :: AttrName
focusedFormInputAttr :: AttrName
focusedFormInputAttr = AttrName
formAttr forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"focusedInput"

-- | Returns whether all form fields in the form currently have valid
-- values according to the fields' validation functions. This is useful
-- when we need to decide whether the form state is up to date with
-- respect to the form input fields.
allFieldsValid :: Form s e n -> Bool
allFieldsValid :: forall s e n. Form s e n -> Bool
allFieldsValid = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s e n. Form s e n -> [n]
invalidFields

-- | Returns the resource names associated with all form input fields
-- that currently have invalid inputs. This is useful when we need to
-- force the user to repair invalid inputs before moving on from a form
-- editing session.
invalidFields :: Form s e n -> [n]
invalidFields :: forall s e n. Form s e n -> [n]
invalidFields Form s e n
f = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall s e n. FormFieldState s e n -> [n]
getInvalidFields (forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates Form s e n
f)

-- | Manually indicate that a field has invalid contents. This can be
-- useful in situations where validation beyond the form element's
-- validator needs to be performed and the result of that validation
-- needs to be fed back into the form state.
setFieldValid :: (Eq n)
              => Bool
              -- ^ Whether the field is considered valid.
              -> n
              -- ^ The name of the form field to set as (in)valid.
              -> Form s e n
              -- ^ The form to modify.
              -> Form s e n
setFieldValid :: forall n s e. Eq n => 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 -> EventM n b ()
h):[FormField a b e n]
ff)
                                   | n
n forall a. Eq a => a -> a -> Bool
== n
fn = 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
fn b -> Maybe a
val Bool
v Bool -> b -> Widget n
r BrickEvent n e -> EventM n b ()
h forall a. a -> [a] -> [a]
: [FormField a b e n]
ff
                                   | Bool
otherwise = FormField a b e n
f forall a. a -> [a] -> [a]
: [FormField a b e n] -> [FormField a b e n]
go2 [FormField a b e n]
ff
                           in 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' 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 (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 :: forall s e n. 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 -> EventM n b ()
_) =
            if Bool -> Bool
not Bool
extValid Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing (b -> Maybe a
validate b
st) then [n
n] else []
    in forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FormField a b e n -> [n]
gather [FormField a b e n]
fs

-- | Render a form.
--
-- For each form field, each input for the field is rendered using
-- the implementation provided by its 'FormField'. The inputs are
-- then concatenated with the field's concatenation function (see
-- 'setFieldConcat') and are then augmented using the form field's
-- rendering augmentation function (see '@@='). Fields with invalid
-- inputs (either due to built-in validator failure or due to external
-- validation failure via 'setFieldValid') will be displayed using the
-- 'invalidFormInputAttr' attribute.
--
-- Finally, all of the resulting field renderings are concatenated with
-- the form's concatenation function (see 'setFormConcat').
renderForm :: (Eq n) => Form s e n -> Widget n
renderForm :: forall n s e. Eq n => 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 forall a b. (a -> b) -> a -> b
$ forall n s e.
Eq n =>
FocusRing n -> FormFieldState s e n -> Widget n
renderFormFieldState FocusRing n
fr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FormFieldState s e n]
es

-- | Render a single form field collection. This is called internally by
-- 'renderForm' but is exposed in cases where a form field state needs
-- to be rendered outside of a 'Form', so 'renderForm' is probably what
-- you want.
renderFormFieldState :: (Eq n)
                     => FocusRing n
                     -> FormFieldState s e n
                     -> Widget n
renderFormFieldState :: forall n s e.
Eq n =>
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 -> EventM n b ()
_):[FormField a b e n]
fs) =
            let maybeInvalid :: Widget n -> Widget n
maybeInvalid = if (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ b -> Maybe a
validate b
st) Bool -> Bool -> Bool
&& Bool
extValid
                               then forall a. a -> a
id
                               else forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
invalidFormInputAttr
                foc :: Bool
foc = forall a. a -> Maybe a
Just n
n forall a. Eq a => a -> a -> Bool
== 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) 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 forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
concatFields forall a b. (a -> b) -> a -> b
$ [FormField a b e n] -> [Widget n]
renderFields [FormField a b e n]
fields

-- | Dispatch an event to the currently focused form field. This handles
-- the following events in this order:
--
-- * On @Tab@ keypresses, this changes the focus to the next field in
--   the form.
-- * On @Shift-Tab@ keypresses, this changes the focus to the previous
--   field in the form.
-- * On mouse button presses (regardless of button or modifier), the
--   focus is changed to the clicked form field and the event is
--   forwarded to the event handler for the clicked form field.
-- * On @Left@ or @Up@, if the currently-focused field is part of a
--   collection (e.g. radio buttons), the previous entry in the
--   collection is focused.
-- * On @Right@ or @Down@, if the currently-focused field is part of a
--   collection (e.g. radio buttons), the next entry in the collection
--   is focused.
-- * All other events are forwarded to the currently focused form field.
--
-- In all cases where an event is forwarded to a form field, validation
-- of the field's input state is performed immediately after the
-- event has been handled. If the form field's input state succeeds
-- validation using the field's validator function, its value is
-- immediately stored in the form state using the form field's state
-- lens. The external validation flag is ignored during this step to
-- ensure that external validators have a chance to get the intermediate
-- validated value.
handleFormEvent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent :: forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent (VtyEvent (EvKey (KChar Char
'\t') [])) =
    forall s e n. Lens' (Form s e n) (FocusRing n)
formFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusNext
handleFormEvent (VtyEvent (EvKey Key
KBackTab [])) =
    forall s e n. Lens' (Form s e n) (FocusRing n)
formFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. FocusRing n -> FocusRing n
focusPrev
handleFormEvent e :: BrickEvent n e
e@(MouseDown n
n Button
_ [Modifier]
_ Location
_) = do
    forall s e n. Lens' (Form s e n) (FocusRing n)
formFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
n
    forall n e s.
Eq n =>
BrickEvent n e -> n -> EventM n (Form s e n) ()
handleFormFieldEvent BrickEvent n e
e n
n
handleFormEvent e :: BrickEvent n e
e@(MouseUp n
n Maybe Button
_ Location
_) = do
    forall s e n. Lens' (Form s e n) (FocusRing n)
formFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent n
n
    forall n e s.
Eq n =>
BrickEvent n e -> n -> EventM n (Form s e n) ()
handleFormFieldEvent BrickEvent n e
e n
n
handleFormEvent e :: BrickEvent n e
e@(VtyEvent (EvKey Key
KUp [])) =
    forall n e s.
Eq n =>
BrickEvent n e
-> (n -> [n] -> EventM n (Form s e n) ())
-> EventM n (Form s e n) ()
withFocusAndGrouping BrickEvent n e
e forall a b. (a -> b) -> a -> b
$ \n
n [n]
grp ->
        forall s e n. Lens' (Form s e n) (FocusRing n)
formFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (forall a. Eq a => [a] -> a -> a
entryBefore [n]
grp n
n)
handleFormEvent e :: BrickEvent n e
e@(VtyEvent (EvKey Key
KDown [])) =
    forall n e s.
Eq n =>
BrickEvent n e
-> (n -> [n] -> EventM n (Form s e n) ())
-> EventM n (Form s e n) ()
withFocusAndGrouping BrickEvent n e
e forall a b. (a -> b) -> a -> b
$ \n
n [n]
grp ->
        forall s e n. Lens' (Form s e n) (FocusRing n)
formFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (forall a. Eq a => [a] -> a -> a
entryAfter [n]
grp n
n)
handleFormEvent e :: BrickEvent n e
e@(VtyEvent (EvKey Key
KLeft [])) =
    forall n e s.
Eq n =>
BrickEvent n e
-> (n -> [n] -> EventM n (Form s e n) ())
-> EventM n (Form s e n) ()
withFocusAndGrouping BrickEvent n e
e forall a b. (a -> b) -> a -> b
$ \n
n [n]
grp ->
        forall s e n. Lens' (Form s e n) (FocusRing n)
formFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (forall a. Eq a => [a] -> a -> a
entryBefore [n]
grp n
n)
handleFormEvent e :: BrickEvent n e
e@(VtyEvent (EvKey Key
KRight [])) =
    forall n e s.
Eq n =>
BrickEvent n e
-> (n -> [n] -> EventM n (Form s e n) ())
-> EventM n (Form s e n) ()
withFocusAndGrouping BrickEvent n e
e forall a b. (a -> b) -> a -> b
$ \n
n [n]
grp ->
        forall s e n. Lens' (Form s e n) (FocusRing n)
formFocusL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (forall a. Eq a => [a] -> a -> a
entryAfter [n]
grp n
n)
handleFormEvent BrickEvent n e
e =
    forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
forwardToCurrent BrickEvent n e
e

getFocusGrouping :: (Eq n) => Form s e n -> n -> Maybe [n]
getFocusGrouping :: forall n s e. Eq n => Form s e n -> n -> Maybe [n]
getFocusGrouping Form s e n
f n
n = [FormFieldState s e n] -> Maybe [n]
findGroup (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 [] = forall a. Maybe a
Nothing
        findGroup (FormFieldState s e n
e:[FormFieldState s e n]
es) =
            let ns :: [n]
ns = forall s e n. FormFieldState s e n -> [n]
formFieldNames FormFieldState s e n
e
            in if n
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [n]
ns Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length [n]
ns forall a. Ord a => a -> a -> Bool
> Int
1
               then 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 :: forall a. Eq a => [a] -> a -> a
entryAfter [a]
as a
a =
    let i :: Int
i = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
a [a]
as
        i' :: Int
i' = if Int
i forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as forall a. Num a => a -> a -> a
- Int
1 then Int
0 else Int
i forall a. Num a => a -> a -> a
+ Int
1
    in [a]
as forall a. [a] -> Int -> a
!! Int
i'

entryBefore :: (Eq a) => [a] -> a -> a
entryBefore :: forall a. Eq a => [a] -> a -> a
entryBefore [a]
as a
a =
    let i :: Int
i = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
a [a]
as
        i' :: Int
i' = if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 then forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as forall a. Num a => a -> a -> a
- Int
1 else Int
i forall a. Num a => a -> a -> a
- Int
1
    in [a]
as forall a. [a] -> Int -> a
!! Int
i'

withFocusAndGrouping :: (Eq n) => BrickEvent n e -> (n -> [n] -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()
withFocusAndGrouping :: forall n e s.
Eq n =>
BrickEvent n e
-> (n -> [n] -> EventM n (Form s e n) ())
-> EventM n (Form s e n) ()
withFocusAndGrouping BrickEvent n e
e n -> [n] -> EventM n (Form s e n) ()
act = do
    FocusRing n
foc <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall s e n. Form s e n -> FocusRing n
formFocus
    case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing n
foc of
        Maybe n
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just n
n -> do
            Form s e n
f <- forall s (m :: * -> *). MonadState s m => m s
get
            case 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 -> forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
forwardToCurrent BrickEvent n e
e
                Just [n]
grp -> n -> [n] -> EventM n (Form s e n) ()
act n
n [n]
grp

withFocus :: (n -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()
withFocus :: forall n s e.
(n -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()
withFocus n -> EventM n (Form s e n) ()
act = do
    FocusRing n
foc <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall s e n. Form s e n -> FocusRing n
formFocus
    case forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing n
foc of
        Maybe n
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just n
n -> n -> EventM n (Form s e n) ()
act n
n

forwardToCurrent :: (Eq n) => BrickEvent n e -> EventM n (Form s e n) ()
forwardToCurrent :: forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
forwardToCurrent =
    forall n s e.
(n -> EventM n (Form s e n) ()) -> EventM n (Form s e n) ()
withFocus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n e s.
Eq n =>
BrickEvent n e -> n -> EventM n (Form s e n) ()
handleFormFieldEvent

handleFormFieldEvent :: (Eq n) => BrickEvent n e -> n -> EventM n (Form s e n) ()
handleFormFieldEvent :: forall n e s.
Eq n =>
BrickEvent n e -> n -> EventM n (Form s e n) ()
handleFormFieldEvent BrickEvent n e
ev n
n = do
    let findFieldState :: [FormFieldState s e n]
-> [FormFieldState s e n] -> EventM n (Form s e n) ()
findFieldState [FormFieldState s e n]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        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 (Form s e n) (Maybe (b, Maybe a))
findField [] = forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> EventM n b ()
handleFunc | n
n forall a. Eq a => a -> a -> Bool
== n
n' -> do
                                    (b
nextSt, ()) <- forall a n b s. a -> EventM n a b -> EventM n s (a, b)
nestEventM b
st (BrickEvent n e -> EventM n b ()
handleFunc BrickEvent n e
ev)
                                    -- If the new state validates, go ahead and update
                                    -- the form state with it.
                                    case b -> Maybe a
validate b
nextSt of
                                        Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (b
nextSt, forall a. Maybe a
Nothing)
                                        Just a
newSt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (b
nextSt, forall a. a -> Maybe a
Just a
newSt)
                                FormField a b e n
_ -> [FormField a b e n] -> EventM n (Form s e n) (Maybe (b, Maybe a))
findField [FormField a b e n]
rest

                    Maybe (b, Maybe a)
result <- [FormField a b e n] -> EventM n (Form s e 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 forall a. Semigroup a => a -> a -> a
<> [FormFieldState s e n
e]) [FormFieldState s e n]
es
                        Just (b
newSt, Maybe a
maybeSt) -> do
                            let newFieldState :: FormFieldState s e n
newFieldState = 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
                            forall s e n e.
Lens
  (Form s e n)
  (Form s e n)
  [FormFieldState s e n]
  [FormFieldState s e n]
formFieldStatesL forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [FormFieldState s e n]
prev forall a. Semigroup a => a -> a -> a
<> [FormFieldState s e n
newFieldState] forall a. Semigroup a => a -> a -> a
<> [FormFieldState s e n]
es
                            case Maybe a
maybeSt of
                              Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                              Just a
s  -> forall s e n. Lens' (Form s e n) s
formStateLforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' s a
stLens forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= a
s

    [FormFieldState s e n]
states <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall s e n. Form s e n -> [FormFieldState s e n]
formFieldStates
    [FormFieldState s e n]
-> [FormFieldState s e n] -> EventM n (Form s e n) ()
findFieldState [] [FormFieldState s e n]
states