diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,16 @@ Brick changelog --------------- +0.32 +---- + +API changes: + * This release adds the new `Brick.Forms` module, which provides an API + for type-safe input forms with automatic rendering, event handling, + and state management! See the Haddock and the "Input Forms" section + of the Brick User Guide for information on this killer feature! Many + thanks to Kevin Quick for feedback on this new functionality. + 0.31 ---- diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015, Jonathan Daugherty. +Copyright (c) 2015-2018, Jonathan Daugherty. All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,4 @@ -brick ------ +![](logo/brick-final-clearbg-with-text.svg) [![Build Status](https://travis-ci.org/jtdaugherty/brick.svg?branch=master)](https://travis-ci.org/jtdaugherty/brick) @@ -95,8 +94,10 @@ Feature Overview ---------------- -`brick` comes with a bunch of widget types to get you started: +`brick` comes with a bunch of batteries included: +Low-level stuff: + * Vertical and horizontal box layout widgets * Basic single- and multi-line text editor widgets * List widget @@ -104,17 +105,12 @@ * Simple dialog box widget * Border-drawing widgets (put borders around or in between things) * Generic scrollable viewports - * Extensible widget-building API - * User-customizable attribute themes * (And many more general-purpose layout control combinators) -In addition, some of `brick`'s more powerful features may not be obvious -right away: - - * All widgets can be arranged in predictable layouts so you don't have - to worry about terminal resizes. - * Attribute management is flexible and can be customized at runtime on - a per-widget basis. +Other killer features: + * Extensible widget-building API + * User-customizable attribute themes + * Type-safe, validated input form API (see the `Brick.Forms` module) Brick-Users Discussion ---------------------- diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 0.31 +version: 0.32 synopsis: A declarative terminal user interface library description: Write terminal applications painlessly with 'brick'! You write an @@ -31,7 +31,7 @@ license-file: LICENSE author: Jonathan Daugherty maintainer: Jonathan Daugherty -copyright: (c) Jonathan Daugherty 2015-2016 +copyright: (c) Jonathan Daugherty 2015-2018 category: Graphics build-type: Simple cabal-version: >=1.18 @@ -62,6 +62,7 @@ Brick.AttrMap Brick.BChan Brick.Focus + Brick.Forms Brick.Main Brick.Markup Brick.Themes @@ -111,6 +112,21 @@ build-depends: base, brick, text + +executable brick-form-demo + if !flag(demos) + Buildable: False + hs-source-dirs: programs + ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 + default-language: Haskell2010 + default-extensions: CPP + main-is: FormDemo.hs + build-depends: base, + brick, + text, + microlens, + microlens-th, + vty executable brick-text-wrap-demo if !flag(demos) diff --git a/docs/guide.rst b/docs/guide.rst --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1207,6 +1207,231 @@ Violating this restriction will result in a runtime exception. +Input Forms +=========== + +While it's possible to construct interfaces with editors and other +interactive inputs manually, this process is somewhat tedious: all of +the event dispatching has to be written by hand, a focus ring or other +construct needs to be managed, and most of the rendering code needs to +be written. Furthermore, this process makes it difficult to follow some +common patterns: + +* We typically want to validate the user's input, and only collect it + once it has been validated. +* We typically want to notify the user when a particular field's + contents are invalid. +* It is often helpful to be able to create a new data type to represent + the fields in an input interface, and use it to initialize the input + elements and later collect the (validated) results. +* A lot of the rendering and event-handling work to be done is + repetitive. + +The ``Brick.Forms`` module provides a high-level API to automate all of +the above work in a type-safe manner. + +A Form Example +-------------- + +Let's look at an example data type that we'd want to use as the +basis for an input interface. This example comes directly from the +``FormDemo.hs`` demonstration program. + +.. code:: haskell + + data UserInfo = + FormState { _name :: T.Text + , _age :: Int + , _address :: T.Text + , _ridesBike :: Bool + , _handed :: Handedness + , _password :: T.Text + } deriving (Show) + + data Handedness = LeftHanded + | RightHanded + | Ambidextrous + deriving (Show, Eq) + +Suppose we want to build an input form for the above data. We might want +to use an editor to allow the user to enter a name and an age. We'll +need to ensure that the user's input for age is a valid integer. For +``_ridesBike`` we might want a checkbox-style input, and for ``_handed`` +we might want a radio button input. For ``_password``, we'd definitely +like a password input box that conceals the input. + +If we were to build an interface for this data manually, we'd need to +deal with converting the data above to the right types for inputs. For +example, for ``_age`` we'd need to convert an initial age value to +``Text``, put it in an editor with ``Brick.Widgets.Edit.editor``, and +then at a later time, parse the value and reconstruct an age from the +editor's contents. We'd also need to tell the user if the age value was +invalid. + +Brick's ``Forms`` API provides input field types for all of the above +use cases. Here's the form that we can use to allow the user to edit a +``UserInfo`` value: + +.. code:: haskell + + mkForm :: UserInfo -> Form UserInfo e Name + mkForm = + newForm [ editTextField name NameField (Just 1) + , editTextField address AddressField (Just 3) + , editShowableField age AgeField + , editPasswordField password PasswordField + , radioField handed [ (LeftHanded, LeftHandField, "Left") + , (RightHanded, RightHandField, "Right") + , (Ambidextrous, AmbiField, "Both") + ] + , checkboxField ridesBike BikeField "Do you ride a bicycle?" + ] + +A form is represented using a ``Form s e n`` value and is parameterized +with some types: + +* ``s`` - the type of *form state* managed by the form (in this case + ``UserInfo``) +* ``e`` - the event type of the application (must match the event type + used with ``App``) +* ``n`` - the resource name type of the application (must match the + resource name type used with ``App``) + +First of all, the above code assumes we've derived lenses for +``UserInfo`` using ``Lens.Micro.TH.makeLenses``. Once we've done +that, each field that we specify in the form must provide a lens into +``UserInfo`` so that we can declare the particular field of ``UserInfo`` +that will be edited by the field. For example, to edit the ``_name`` +field we use the ``name`` lens to create a text field editor with +``editTextField``. All of the field constructors above are provided by +``Brick.Forms``. + +Each form field also needs a resource name (see `Resource Names`_). The +resource names are assigned to the individual form inputs so the form +can automatically track input focus and handle mouse click events. + +The form carries with it the value of ``UserInfo`` that reflects the +contents of the form. Whenever an input field in the form handles an +event, its contents are validated and rewritten to the form state (in +this case, a ``UserInfo`` record). + +The ``mkForm`` function takes a ``UserInfo`` value, which is really +just an argument to ``newForm``. This ``UserInfo`` value will be used +to initialize all of the form fields. Each form field will use the lens +provided to extract the initial value from the ``UserInfo`` record, +convert it into an appropriate state type for the field in question, and +later validate that state and convert it back into the approprate type +for storage in ``UserInfo``. + +For example, if the initial ``UserInfo`` value's ``_age`` field has the +value ``0``, the ``editShowableField`` will call ``show`` on ``0``, +convert that to ``Text``, and initialize the editor for ``_age`` with +the text string ``"0"``. Later, if the user enters more text -- changing +the editor contents to ``"10"``, say -- the ``Read`` instance for +``Int`` (the type of ``_age``) will be used to parse ``"10"``. The +successfully-parsed value ``10`` will then be written to the ``_age`` +field of the form's ``UserInfo`` state using the ``age`` lens. The use +of ``Show`` and ``Read`` here is a feature of the field type we have +chosen for ``_age``, ``editShowableField``. + +For other field types we may have other needs. For instance, +``Handedness`` is a data type representing all the possible choices +we want to provide for a user's handedness. We wouldn't want the user +to have to type in a text string for this option. A more appropriate +input interface is a list of radio buttons to choose from amongst +the available options. For that we have ``radioField``. This field +constructor takes a list of all of the available options, and updates +the form state with the value of the currently-selected option. + +Rendering Forms +--------------- + +Rendering forms is done easily using the ``Brick.Forms.renderForm`` +function. However, as written above, the form will not look especially +nice. We'll see a few text editors followed by some radio buttons and a +check box. But we'll need to customize the output a bit to make the form +easier to use. For that, we have the ``Brick.Forms.@@=`` operator. This +operator lets us provide a function to augment the ``Widget`` generated +by the field's rendering function so we can do things like add labels, +control layout, or change attributes: + +.. code:: haskell + + (str "Name: " <+>) @@= + editTextField name NameField (Just 1) + +Now when we invoke ``renderForm`` on a form using the above example, +we'll see a ``"Name:"`` label to the left of the editor field for +the ``_name`` field of ``UserInfo``. + +Brick provides this interface to controlling per-field rendering because +many form fields either won't have labels or will have different layout +requirements, so an alternative API such as building the label into the +field API doesn't always make sense. + +Form Attributes +--------------- + +The ``Brick.Forms`` module uses and exports two attribute names (see +`How Attributes Work`_): + +* ``focusedFormInputAttr`` - this attribute is used to render the form + field that has the focus. +* ``invalidFormInputAttr`` - this attribute is used to render any form + field that has user input that has valid validation. + +Your application should set both of these. Some good mappings in the +attribute map are: + +* ``focusedFormInputAttr`` - ``black `on` yellow`` +* ``invalidFormInputAttr`` - ``white `on` red`` + +Handling Form Events +-------------------- + +Handling form events is easy: we just call +``Brick.Forms.handleFormEvent`` with the ``BrickEvent`` and the +``Form``. This automatically dispatches input events to the +currently-focused input field, and it also manages focus changes with +``Tab`` and ``Shift-Tab`` keybindings. (For details on all of its +behaviors, see the Haddock documentation for ``handleFormEvent``.) It's +still up to the application to decide when events should go to the form +in the first place. + +Since the form field handlers take ``BrickEvent`` values, that means +that custom fields could even handle application-specific events (of the +type ``e`` above). + +Once the application has decided that the user should be done with the +form editing session, the current state of the form can be obtained +with ``Brick.Forms.formState``. In the example above, this would +return a ``UserInfo`` record containing the values for each field in +the form *as of the last time it was valid input*. This means that +the user might have provided invalid input to a form field that is +not reflected in the form state due to failing validation. + +Since the ``formState`` is always a valid set of values, it might +be surprising to the user if the values used do not match the last +values they saw on the screen; the ``Brick.Forms.allFieldsValid`` +can be used to determine if the last visual state of the form had +any invalid entries and doesn't match the value of ``formState``. A +list of any fields which had invalid values can be retrieved with the +``Brick.Forms.invalidFields`` function. + +Note that if mouse events are enabled in your application (see `Mouse +Support`_), all built-in form fields will respond to mouse interaction. +Radio buttons and check boxes change selection on mouse clicks and +editors change cursor position on mouse clicks. + +Writing Custom Form Field Types +------------------------------- + +If the built-in form field types don't meet your needs, ``Brick.Forms`` +exposes all of the data types needed to implement your own field types. +For more details on how to do this, see the Haddock documentation for +the ``FormFieldState`` and ``FormField`` data types along with the +implementations of the built-in form field types. + The Rendering Cache =================== diff --git a/programs/FormDemo.hs b/programs/FormDemo.hs new file mode 100644 --- /dev/null +++ b/programs/FormDemo.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import qualified Data.Text as T +import Lens.Micro.TH +import Data.Monoid ((<>)) + +import qualified Graphics.Vty as V +import Brick +import Brick.Forms + ( Form + , newForm + , formState + , formFocus + , renderForm + , handleFormEvent + , invalidFields + , allFieldsValid + , focusedFormInputAttr + , invalidFormInputAttr + , checkboxField + , radioField + , editShowableField + , editTextField + , editPasswordField + , (@@=) + ) +import Brick.Focus + ( focusGetCurrent + , focusRingCursor + ) +import qualified Brick.Widgets.Edit as E +import qualified Brick.Widgets.Border as B +import qualified Brick.Widgets.Center as C + +data Name = NameField + | AgeField + | BikeField + | HandedField + | PasswordField + | LeftHandField + | RightHandField + | AmbiField + | AddressField + deriving (Eq, Ord, Show) + +data Handedness = LeftHanded | RightHanded | Ambidextrous + deriving (Show, Eq) + +data UserInfo = + UserInfo { _name :: T.Text + , _age :: Int + , _address :: T.Text + , _ridesBike :: Bool + , _handed :: Handedness + , _password :: T.Text + } + deriving (Show) + +makeLenses ''UserInfo + +-- This form is covered in the Brick User Guide; see the "Input Forms" +-- section. +mkForm :: UserInfo -> Form UserInfo e Name +mkForm = + let label s w = padBottom (Pad 1) $ + (vLimit 1 $ hLimit 15 $ str s <+> fill ' ') <+> w + in newForm [ label "Name" @@= + editTextField name NameField (Just 1) + , label "Address" @@= + B.borderWithLabel (str "Mailing") @@= + editTextField address AddressField (Just 3) + , label "Age" @@= + editShowableField age AgeField + , label "Password" @@= + editPasswordField password PasswordField + , label "Dominant hand" @@= + radioField handed [ (LeftHanded, LeftHandField, "Left") + , (RightHanded, RightHandField, "Right") + , (Ambidextrous, AmbiField, "Both") + ] + , label "" @@= + checkboxField ridesBike BikeField "Do you ride a bicycle?" + ] + +theMap :: AttrMap +theMap = attrMap V.defAttr + [ (E.editAttr, V.white `on` V.black) + , (E.editFocusedAttr, V.black `on` V.yellow) + , (invalidFormInputAttr, V.white `on` V.red) + , (focusedFormInputAttr, V.black `on` V.yellow) + ] + +draw :: Form UserInfo e Name -> [Widget Name] +draw f = [C.vCenter $ C.hCenter form <=> C.hCenter help] + where + form = B.border $ padTop (Pad 1) $ hLimit 50 $ renderForm f + help = padTop (Pad 1) $ B.borderWithLabel (str "Help") body + body = str $ "- Name is free-form text\n" <> + "- Age must be an integer (try entering an\n" <> + " invalid age!)\n" <> + "- Handedness selects from a list of options\n" <> + "- The last option is a checkbox\n" <> + "- Enter/Esc quit, mouse interacts with fields" + +app :: App (Form UserInfo e Name) e Name +app = + App { appDraw = draw + , appHandleEvent = \s ev -> + case ev of + VtyEvent (V.EvResize {}) -> continue s + VtyEvent (V.EvKey V.KEsc []) -> halt s + -- Enter quits only when we aren't in the multi-line editor. + VtyEvent (V.EvKey V.KEnter []) + | focusGetCurrent (formFocus s) /= Just AddressField -> halt s + _ -> continue =<< handleFormEvent ev s + , appChooseCursor = focusRingCursor formFocus + , appStartEvent = return + , appAttrMap = const theMap + } + +main :: IO () +main = do + let buildVty = do + v <- V.mkVty =<< V.standardIOConfig + V.setMode (V.outputIface v) V.Mouse True + return v + + initialUserInfo = UserInfo { _name = "" + , _address = "" + , _age = 0 + , _handed = RightHanded + , _ridesBike = False + , _password = "" + } + f = mkForm initialUserInfo + + f' <- customMain buildVty Nothing app f + + putStrLn "The starting form state was:" + print initialUserInfo + + putStrLn "The final form state was:" + print $ formState f' + + if allFieldsValid f' + then putStrLn "The final form inputs were valid." + else putStrLn $ "The final form had invalid inputs: " <> show (invalidFields f') diff --git a/src/Brick/Forms.hs b/src/Brick/Forms.hs new file mode 100644 --- /dev/null +++ b/src/Brick/Forms.hs @@ -0,0 +1,605 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +-- | NOTE: This API is experimental and will probably change. Please try +-- it out! Feedback is very much appreciated, and your patience in the +-- face of breaking API changes is also appreciated! +-- +-- 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. +-- +-- This module provides the API to create forms, populate them with some +-- basic input field types, render forms, handle form events, and create +-- custom input field types. +-- +-- 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). +-- +-- 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 + , (@@=) + , allFieldsValid + , invalidFields + + -- * Simple form field constructors + , editTextField + , editShowableField + , editPasswordField + , radioField + , checkboxField + + -- * Advanced form field constructors + , editField + + -- * Attributes + , formAttr + , invalidFormInputAttr + , focusedFormInputAttr + ) +where + +import Graphics.Vty +import Data.Monoid +import Data.Maybe (isJust, isNothing) +import Data.List (elemIndex) + +import Brick +import Brick.Focus +import Brick.Widgets.Edit +import qualified Data.Text.Zipper as Z + +import qualified Data.Text as T +import Text.Read (readMaybe) + +import Lens.Micro + +-- | 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 { formFieldName :: n + -- ^ The name identifying this form field. + , 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'. + , 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. + , formFieldHandleEvent :: BrickEvent n e -> b -> EventM n b + -- ^ An event handler for this field. This receives the + -- event and the field state and returns a new field + -- state. + } + +-- | 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. + , formFields :: [FormField a b e n] + -- ^ The form fields, in order, that the user will + -- interact with to manipulate this state value. + , 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. + } -> FormFieldState s e n + +-- | A form: a sequence of input fields that manipulate the fields of an +-- underlying state that you choose. +-- +-- 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 { formFieldStates :: [FormFieldState s e n] + , formFocus :: FocusRing n + -- ^ The focus ring for the form, indicating which form field + -- has input focus. + , 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@. + } + +-- | 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 +(@@=) h mkFs s = + let v = mkFs s + in v { formFieldRenderHelper = h . (formFieldRenderHelper v) } + +-- | 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 mkEs s = + let es = mkEs <*> pure s + in Form { formFieldStates = es + , formFocus = focusRing $ concat $ formFieldNames <$> es + , formState = s + } + +formFieldNames :: FormFieldState s e n -> [n] +formFieldNames (FormFieldState _ _ fields _) = formFieldName <$> 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 stLens name label initialState = + let initVal = initialState ^. stLens + + handleEvent (MouseDown n _ _ _) s | n == name = return $ not s + handleEvent (VtyEvent (EvKey (KChar ' ') [])) s = return $ not s + handleEvent _ s = return s + + in FormFieldState { formFieldState = initVal + , formFields = [ FormField name Just + (renderCheckbox label name) + handleEvent + ] + , formFieldLens = stLens + , formFieldRenderHelper = id + } + +renderCheckbox :: T.Text -> n -> Bool -> Bool -> Widget n +renderCheckbox label n foc val = + let addAttr = if foc then withDefAttr focusedFormInputAttr else id + in clickable n $ + addAttr $ + (str $ "[" <> (if val then "X" else " ") <> "] ") <+> txt label + +-- | 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 stLens options initialState = + let initVal = initialState ^. stLens + + lookupOptionValue n = + let results = filter (\(_, n', _) -> n' == n) options + in case results of + [(val, _, _)] -> Just val + _ -> Nothing + + handleEvent _ (MouseDown n _ _ _) s = + case lookupOptionValue n of + Nothing -> return s + Just v -> return v + handleEvent new (VtyEvent (EvKey (KChar ' ') [])) _ = return new + handleEvent _ _ s = return s + + optionFields = mkOptionField <$> options + mkOptionField (val, name, label) = + FormField name + Just + (renderRadio val name label) + (handleEvent val) + + in FormFieldState { formFieldState = initVal + , formFields = optionFields + , formFieldLens = stLens + , formFieldRenderHelper = id + } + +renderRadio :: (Eq a) => a -> n -> T.Text -> Bool -> a -> Widget n +renderRadio val name label foc cur = + let addAttr = if foc + then withDefAttr focusedFormInputAttr + else id + isSet = val == cur + in clickable name $ + addAttr $ + hBox [ str "[" + , str $ if isSet then "*" else " " + , txt $ "] " <> 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 editors + -- 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 stLens n limit ini val renderText wrapEditor initialState = + let initVal = applyEdit gotoEnd $ + editor n limit initialText + gotoEnd = let ls = T.lines initialText + pos = (length ls - 1, T.length (last ls)) + in if null ls + then id + else Z.moveCursor pos + initialText = ini $ initialState ^. stLens + handleEvent (VtyEvent e) ed = handleEditorEvent e ed + handleEvent _ ed = return ed + + in FormFieldState { formFieldState = initVal + , formFields = [ FormField n + (val . getEditContents) + (\b e -> wrapEditor $ renderEditor renderText b e) + handleEvent + ] + , formFieldLens = stLens + , formFieldRenderHelper = id + } + +-- | 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 stLens n = + let ini = T.pack . show + val = readMaybe . T.unpack . T.intercalate "\n" + limit = Just 1 + renderText = txt . T.unlines + in editField stLens n limit ini val renderText 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 stLens n limit = + let ini = id + val = Just . T.intercalate "\n" + renderText = txt . T.intercalate "\n" + in editField stLens n limit ini val renderText 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 stLens n = + let ini = id + val = Just . T.concat + limit = Just 1 + renderText = toPassword + in editField stLens n limit ini val renderText id + +toPassword :: [T.Text] -> Widget a +toPassword s = txt $ T.replicate (T.length $ T.concat s) "*" + +-- | The namespace for the other form attributes. +formAttr :: AttrName +formAttr = "brickForm" + +-- | The attribute for form input fields with invalid values. +invalidFormInputAttr :: AttrName +invalidFormInputAttr = formAttr <> "invalidInput" + +-- | The attribute for form input fields that have the focus. +focusedFormInputAttr :: AttrName +focusedFormInputAttr = formAttr <> "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 = null . 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 f = concat $ getInvalidFields <$> formFieldStates f + +getInvalidFields :: FormFieldState s e n -> [n] +getInvalidFields (FormFieldState st _ fs _) = + let gather (FormField n validate _ _) = + if (isNothing $ validate st) then [n] else [] + in concat $ gather <$> 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 +-- vertically concatenated with 'vBox' and then augmented using the form +-- field's rendering augmentation function (see '@@='). +-- +-- The augmented field renderings are then placed in a 'vBox' and +-- returned. +renderForm :: (Eq n) => Form s e n -> Widget n +renderForm (Form es fr _) = + vBox $ renderFormFieldState fr <$> es + +renderFormFieldState :: (Eq n) + => FocusRing n + -> FormFieldState s e n + -> Widget n +renderFormFieldState fr (FormFieldState st _ fields helper) = + let renderFields [] = [] + renderFields ((FormField n validate renderField _):fs) = + let maybeInvalid = if isJust $ validate st + then id + else forceAttr invalidFormInputAttr + foc = Just n == focusGetCurrent fr + in maybeInvalid (renderField foc st) : renderFields fs + in helper $ vBox $ renderFields fields + +-- | Dispatch an event to the appropriate form field and return a new +-- form. 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 after the event has been +-- handled. If the form field's input state succeeds validation, its +-- value is immediately stored in the form state using the form field's +-- state lens. +handleFormEvent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n) +handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) f = + return $ f { formFocus = focusNext $ formFocus f } +handleFormEvent (VtyEvent (EvKey KBackTab [])) f = + return $ f { formFocus = focusPrev $ formFocus f } +handleFormEvent e@(MouseDown n _ _ _) f = + handleFormFieldEvent n e $ f { formFocus = focusSetCurrent n (formFocus f) } +handleFormEvent e@(MouseUp n _ _) f = + handleFormFieldEvent n e $ f { formFocus = focusSetCurrent n (formFocus f) } +handleFormEvent e@(VtyEvent (EvKey KUp [])) f = + case focusGetCurrent (formFocus f) of + Nothing -> return f + Just n -> + case getFocusGrouping f n of + Nothing -> forwardToCurrent e f + Just grp -> return $ f { formFocus = focusSetCurrent (entryBefore grp n) (formFocus f) } +handleFormEvent e@(VtyEvent (EvKey KDown [])) f = + case focusGetCurrent (formFocus f) of + Nothing -> return f + Just n -> + case getFocusGrouping f n of + Nothing -> forwardToCurrent e f + Just grp -> return $ f { formFocus = focusSetCurrent (entryAfter grp n) (formFocus f) } +handleFormEvent e@(VtyEvent (EvKey KLeft [])) f = + case focusGetCurrent (formFocus f) of + Nothing -> return f + Just n -> + case getFocusGrouping f n of + Nothing -> forwardToCurrent e f + Just grp -> return $ f { formFocus = focusSetCurrent (entryBefore grp n) (formFocus f) } +handleFormEvent e@(VtyEvent (EvKey KRight [])) f = + case focusGetCurrent (formFocus f) of + Nothing -> return f + Just n -> + case getFocusGrouping f n of + Nothing -> forwardToCurrent e f + Just grp -> return $ f { formFocus = focusSetCurrent (entryAfter grp n) (formFocus f) } +handleFormEvent e f = forwardToCurrent e f + +getFocusGrouping :: (Eq n) => Form s e n -> n -> Maybe [n] +getFocusGrouping f n = findGroup (formFieldStates f) + where + findGroup [] = Nothing + findGroup (e:es) = + let ns = formFieldNames e + in if n `elem` ns && length ns > 1 + then Just ns + else findGroup es + +entryAfter :: (Eq a) => [a] -> a -> a +entryAfter as a = + let Just i = elemIndex a as + i' = if i == length as - 1 then 0 else i + 1 + in as !! i' + +entryBefore :: (Eq a) => [a] -> a -> a +entryBefore as a = + let Just i = elemIndex a as + i' = if i == 0 then length as - 1 else i - 1 + in as !! i' + +forwardToCurrent :: (Eq n) => BrickEvent n e -> Form s e n -> EventM n (Form s e n) +forwardToCurrent e f = + case focusGetCurrent (formFocus f) of + Nothing -> return f + Just n -> handleFormFieldEvent n e f + +handleFormFieldEvent :: (Eq n) => n -> BrickEvent n e -> Form s e n -> EventM n (Form s e n) +handleFormFieldEvent n ev f = findFieldState [] (formFieldStates f) + where + findFieldState _ [] = return f + findFieldState prev (e:es) = + case e of + FormFieldState st stLens fields helper -> do + let findField [] = return Nothing + findField (field:rest) = + case field of + FormField n' validate _ handleFunc | n == n' -> do + nextSt <- handleFunc ev st + -- If the new state validates, go ahead and update + -- the form state with it. + case validate nextSt of + Nothing -> return $ Just (nextSt, Nothing) + Just newSt -> return $ Just (nextSt, Just newSt) + _ -> findField rest + + result <- findField fields + case result of + Nothing -> findFieldState (prev <> [e]) es + Just (newSt, maybeSt) -> + let newFieldState = FormFieldState newSt stLens fields helper + in return $ f { formFieldStates = prev <> [newFieldState] <> es + , formState = case maybeSt of + Nothing -> formState f + Just s -> formState f & stLens .~ s + }