diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,16 @@ Brick changelog --------------- +0.33 +---- + +API changes: + * Forms: added support for external validation of form fields using + `setFieldValid`. See the Haddock, User Guide, and FormDemo.hs for + details. + * Borders: removed all attribute names except `borderAttr` to simplify + border attribute assignment. + 0.32.1 ------ diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 0.32.1 +version: 0.33 synopsis: A declarative terminal user interface library description: Write terminal applications painlessly with 'brick'! You write an diff --git a/docs/guide.rst b/docs/guide.rst --- a/docs/guide.rst +++ b/docs/guide.rst @@ -1418,6 +1418,16 @@ list of any fields which had invalid values can be retrieved with the ``Brick.Forms.invalidFields`` function. +While each form field type provides a validator function to validate +its current user input value, that function is pure. As a result it's +not suitable for doing validation that requires I/O such as searching +a database or making network requests. If your application requires +that kind of validation, you can use the ``Brick.Forms.setFieldValid`` +function to set the validation state of any form field as you see +fit. The validation state set by that function will be considered by +``allFieldsValid`` and ``invalidFields``. See ``FormDemo.hs`` for an +example of this API. + 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 diff --git a/programs/BorderDemo.hs b/programs/BorderDemo.hs --- a/programs/BorderDemo.hs +++ b/programs/BorderDemo.hs @@ -10,7 +10,7 @@ import qualified Graphics.Vty as V import qualified Brick.Main as M -import Brick.Util (fg, bg, on) +import Brick.Util (fg, on) import qualified Brick.AttrMap as A import Brick.Types ( Widget @@ -18,6 +18,7 @@ import Brick.Widgets.Core ( (<=>) , (<+>) + , withAttr , vLimit , hLimit , hBox @@ -66,22 +67,19 @@ C.vCenter $ txt $ " " <> styleName <> " style " +titleAttr :: A.AttrName +titleAttr = "title" + borderMappings :: [(A.AttrName, V.Attr)] borderMappings = [ (B.borderAttr, V.yellow `on` V.black) - , (B.vBorderAttr, V.green `on` V.red) - , (B.hBorderAttr, V.white `on` V.green) - , (B.hBorderLabelAttr, fg V.blue) - , (B.tlCornerAttr, bg V.red) - , (B.trCornerAttr, bg V.blue) - , (B.blCornerAttr, bg V.yellow) - , (B.brCornerAttr, bg V.green) + , (titleAttr, fg V.cyan) ] colorDemo :: Widget () colorDemo = updateAttrMap (A.applyAttrMappings borderMappings) $ - B.borderWithLabel (str "title") $ + B.borderWithLabel (withAttr titleAttr $ str "title") $ hLimit 20 $ vLimit 5 $ C.center $ diff --git a/programs/FormDemo.hs b/programs/FormDemo.hs --- a/programs/FormDemo.hs +++ b/programs/FormDemo.hs @@ -3,6 +3,7 @@ module Main where import qualified Data.Text as T +import Lens.Micro ((^.)) import Lens.Micro.TH import Data.Monoid ((<>)) @@ -13,6 +14,7 @@ , newForm , formState , formFocus + , setFieldValid , renderForm , handleFormEvent , invalidFields @@ -114,7 +116,13 @@ -- 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 + _ -> do + s' <- handleFormEvent ev s + + -- Example of external validation: + -- Require age field to contain a value that is at least 18. + continue $ setFieldValid ((formState s')^.age >= 18) AgeField s' + , appChooseCursor = focusRingCursor formFocus , appStartEvent = return , appAttrMap = const theMap @@ -134,7 +142,8 @@ , _ridesBike = False , _password = "" } - f = mkForm initialUserInfo + f = setFieldValid False AgeField $ + mkForm initialUserInfo f' <- customMain buildVty Nothing app f diff --git a/src/Brick/Forms.hs b/src/Brick/Forms.hs --- a/src/Brick/Forms.hs +++ b/src/Brick/Forms.hs @@ -48,6 +48,7 @@ , (@@=) , allFieldsValid , invalidFields + , setFieldValid -- * Simple form field constructors , editTextField @@ -99,8 +100,18 @@ -- ^ 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'. + -- an 'Editor' state value by parsing its text contents s + -- aan integer and return 'Maybe' 'Int'. This is for pure + -- avalue validation; if additional validation is required + -- a(e.g. via 'IO'), use this field's state value in an + -- aexternal validation routine and use 'setFieldValid' to + -- afeed the result back into the form. + , 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'. , formFieldRender :: Bool -> b -> Widget n -- ^ A function to render this form field. Parameters are -- whether the field is currently focused, followed by the @@ -235,7 +246,7 @@ handleEvent _ s = return s in FormFieldState { formFieldState = initVal - , formFields = [ FormField name Just + , formFields = [ FormField name Just True (renderCheckbox label name) handleEvent ] @@ -284,6 +295,7 @@ mkOptionField (val, name, label) = FormField name Just + True (renderRadio val name label) (handleEvent val) @@ -350,6 +362,7 @@ in FormFieldState { formFieldState = initVal , formFields = [ FormField n (val . getEditContents) + True (\b e -> wrapEditor $ renderEditor renderText b e) handleEvent ] @@ -451,10 +464,36 @@ invalidFields :: Form s e n -> [n] invalidFields f = concat $ getInvalidFields <$> formFieldStates 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 v n form = + let go1 [] = [] + go1 (s:ss) = + let s' = case s of + FormFieldState st l fs rh -> + let go2 [] = [] + go2 (f@(FormField fn val _ r h):ff) + | n == fn = FormField fn val v r h : ff + | otherwise = f : go2 ff + in FormFieldState st l (go2 fs) rh + in s' : go1 ss + + in form { formFieldStates = go1 (formFieldStates form) } + getInvalidFields :: FormFieldState s e n -> [n] getInvalidFields (FormFieldState st _ fs _) = - let gather (FormField n validate _ _) = - if (isNothing $ validate st) then [n] else [] + let gather (FormField n validate extValid _ _) = + if (not extValid || (isNothing $ validate st)) then [n] else [] in concat $ gather <$> fs -- | Render a form. @@ -462,7 +501,10 @@ -- 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 '@@='). +-- 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. -- -- The augmented field renderings are then placed in a 'vBox' and -- returned. @@ -476,8 +518,8 @@ -> Widget n renderFormFieldState fr (FormFieldState st _ fields helper) = let renderFields [] = [] - renderFields ((FormField n validate renderField _):fs) = - let maybeInvalid = if isJust $ validate st + renderFields ((FormField n validate extValid renderField _):fs) = + let maybeInvalid = if (isJust $ validate st) && extValid then id else forceAttr invalidFormInputAttr foc = Just n == focusGetCurrent fr @@ -503,10 +545,13 @@ -- * 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. +-- 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 -> Form s e n -> EventM n (Form s e n) handleFormEvent (VtyEvent (EvKey (KChar '\t') [])) f = return $ f { formFocus = focusNext $ formFocus f } @@ -584,7 +629,7 @@ let findField [] = return Nothing findField (field:rest) = case field of - FormField n' validate _ handleFunc | n == n' -> do + 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. diff --git a/src/Brick/Widgets/Border.hs b/src/Brick/Widgets/Border.hs --- a/src/Brick/Widgets/Border.hs +++ b/src/Brick/Widgets/Border.hs @@ -18,20 +18,11 @@ -- * Drawing single border elements , borderElem - -- * Border attribute names + -- * Attribute names , borderAttr - , vBorderAttr - , hBorderAttr - , hBorderLabelAttr - , tlCornerAttr - , trCornerAttr - , blCornerAttr - , brCornerAttr ) where -import Data.Monoid ((<>)) - #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif @@ -49,34 +40,6 @@ borderAttr :: AttrName borderAttr = "border" --- | The vertical border attribute name. -vBorderAttr :: AttrName -vBorderAttr = borderAttr <> "vertical" - --- | The horizontal border attribute name. -hBorderAttr :: AttrName -hBorderAttr = borderAttr <> "horizontal" - --- | The attribute used for horizontal border labels. -hBorderLabelAttr :: AttrName -hBorderLabelAttr = hBorderAttr <> "label" - --- | The attribute used for border box top-left corners. -tlCornerAttr :: AttrName -tlCornerAttr = borderAttr <> "corner" <> "tl" - --- | The attribute used for border box top-right corners. -trCornerAttr :: AttrName -trCornerAttr = borderAttr <> "corner" <> "tr" - --- | The attribute used for border box bottom-left corners. -blCornerAttr :: AttrName -blCornerAttr = borderAttr <> "corner" <> "bl" - --- | The attribute used for border box bottom-right corners. -brCornerAttr :: AttrName -brCornerAttr = borderAttr <> "corner" <> "br" - -- | Draw the specified border element using the active border style -- using 'borderAttr'. borderElem :: (BorderStyle -> Char) -> Widget n @@ -108,19 +71,14 @@ border_ :: Maybe (Widget n) -> Widget n -> Widget n border_ label wrapped = Widget (hSize wrapped) (vSize wrapped) $ do - bs <- ctxBorderStyle <$> getContext c <- getContext middleResult <- render $ hLimit (c^.availWidthL - 2) $ vLimit (c^.availHeightL - 2) $ wrapped - let top = (withAttr tlCornerAttr $ str [bsCornerTL bs]) - <+> hBorder_ label <+> - (withAttr trCornerAttr $ str [bsCornerTR bs]) - bottom = (withAttr blCornerAttr $ str [bsCornerBL bs]) - <+> hBorder <+> - (withAttr brCornerAttr $ str [bsCornerBR bs]) + let top = (borderElem bsCornerTL) <+> hBorder_ label <+> (borderElem bsCornerTR) + bottom = (borderElem bsCornerBL) <+> hBorder <+> (borderElem bsCornerBR) middle = vBorder <+> (Widget Fixed Fixed $ return middleResult) <+> vBorder total = top <=> middle <=> bottom @@ -143,12 +101,12 @@ hBorder_ label = Widget Greedy Fixed $ do bs <- ctxBorderStyle <$> getContext - let msg = maybe (str [bsHorizontal bs]) (withAttr hBorderLabelAttr) label - render $ vLimit 1 $ withAttr hBorderAttr $ hCenterWith (Just $ bsHorizontal bs) msg + let msg = maybe (str [bsHorizontal bs]) id label + render $ vLimit 1 $ withAttr borderAttr $ hCenterWith (Just $ bsHorizontal bs) msg -- | A vertical border. Fills all vertical space. vBorder :: Widget n vBorder = Widget Fixed Greedy $ do bs <- ctxBorderStyle <$> getContext - render $ hLimit 1 $ withAttr vBorderAttr $ fill (bsVertical bs) + render $ hLimit 1 $ withAttr borderAttr $ fill (bsVertical bs)