Parametrize form builders by UI representation (#79)

* Add wrap combinator to form DSL

Remove type parameter from Tree and Forest

* Add FormDefaults instance to NonEmptyArray

* Fix LabeledField label overflowing

* Parametrize FormBuilder by UI representation

* Allow users to use custom ModifyValidated mappings

* Make setModified work on types other than records

* Add functions for mapping over form UIs

Author: arthurxavierx

src/Lumi/Components/Details.purs

@@ -4,7 +4,6 @@ import Prelude
 
 import Effect.Unsafe (unsafePerformEffect)
 import JSS (JSS, jss)
-import Lumi.Components.Icon (icon_)
 import Lumi.Components.Text (body_)
 import React.Basic.DOM as R
 import React.Basic.Hooks (JSX, component, element)

src/Lumi/Components/Form.purs

@@ -3,6 +3,8 @@ module Lumi.Components.Form
   , module Internal
   , module Validation
   , build
+  , build'
+  , defaultRenderForm
   , static
   , section
   , inputBox
@@ -36,7 +38,10 @@ module Lumi.Components.Form
   , withProps
   , withValue
   , mapProps
+  , mapUI
+  , mapUI_
   , indent
+  , wrap
   , filterWithProps
   , withKey
   , styles
@@ -66,8 +71,8 @@ import Lumi.Components.Color (colors)
 import Lumi.Components.Column (column)
 import Lumi.Components.FetchCache as FetchCache
 import Lumi.Components.Form.Defaults (formDefaults) as Defaults
-import Lumi.Components.Form.Internal (FormBuilder(..), SeqFormBuilder, Tree(..), formBuilder, formBuilder_, invalidate, pruneTree, sequential)
-import Lumi.Components.Form.Internal (FormBuilder, SeqFormBuilder, formBuilder, formBuilder_, invalidate, listen, parallel, revalidate, sequential) as Internal
+import Lumi.Components.Form.Internal (Forest, FormBuilder'(..), FormBuilder, SeqFormBuilder, Tree(..), formBuilder, formBuilder_, invalidate, pruneTree, sequential)
+import Lumi.Components.Form.Internal (Forest, FormBuilder', FormBuilder, SeqFormBuilder', SeqFormBuilder, formBuilder, formBuilder_, invalidate, listen, parallel, revalidate, sequential) as Internal
 import Lumi.Components.Form.Validation (Validated(..), Validator, _Validated, fromValidated, mustBe, mustEqual, nonEmpty, nonEmptyArray, nonNull, validNumber, validInt, validDate, optional, setFresh, setModified, validated, warn) as Validation
 import Lumi.Components.Input (alignToInput)
 import Lumi.Components.Input as Input
@@ -94,68 +99,117 @@ import Unsafe.Coerce (unsafeCoerce)
 -- |
 -- | _Note_: this function should be fully applied, to avoid remounting
 -- | the component on each render.
+
 build
   :: forall props unvalidated result
-   . FormBuilder { readonly :: Boolean | props } unvalidated result
+   . Union
+      ( forceTopLabels :: Boolean
+      , inlineTable :: Boolean
+      )
+      ( readonly :: Boolean
+      | props
+      )
+      ( forceTopLabels :: Boolean
+      , inlineTable :: Boolean
+      , readonly :: Boolean
+      | props
+      )
+  => FormBuilder { readonly :: Boolean | props } unvalidated result
   -> { value :: unvalidated
      , onChange :: (unvalidated -> unvalidated) -> Effect Unit
-     , inlineTable :: Boolean
      , forceTopLabels :: Boolean
+     , inlineTable :: Boolean
      , readonly :: Boolean
      | props
      }
   -> JSX
-build editor = makeStateless (createComponent "Form") render where
-  render props@{ value, onChange, inlineTable, forceTopLabels, readonly } =
-
-    let forest = Array.mapMaybe pruneTree $ edit onChange
-          where
-            props' = contractProps props
-            { edit } = un FormBuilder editor props' value
-
-        contractProps
-          :: { value :: unvalidated
-             , onChange :: (unvalidated -> unvalidated) -> Effect Unit
-             , inlineTable :: Boolean
-             , forceTopLabels :: Boolean
-             , readonly :: Boolean
-             | props
-             }
-          -> { readonly :: Boolean
-             | props
-             }
-        contractProps = unsafeCoerce
-
-        fieldDivider = R.hr { className: "lumi field-divider" }
-
-        toRow = case _ of
-          Child { key, child } ->
-            maybe identity keyed key $ child
-          Wrapper { key, children } ->
-            R.div
-              { key: fromMaybe "" key
-              , children: [ intercalate fieldDivider (map toRow children) ]
-              }
-          Node { label, key, required, validationError, children } ->
-            maybe identity keyed key $ labeledField
-              { label: text body
-                  { children = [ label ]
-                  , className = toNullable (pure "field-label")
-                  }
-              , value: intercalate fieldDivider (map toRow children)
-              , validationError: validationError
-              , required: required
-              , forceTopLabel: forceTopLabels
-              , style: R.css {}
-              }
+build = build' defaultRenderForm
 
-     in element (R.unsafeCreateDOMComponent "lumi-form")
-          { "class": String.joinWith " " $ fold
-                       [ guard inlineTable ["inline-table"]
-                       , guard readonly ["readonly"]
-                       ]
-          , children: surround fieldDivider (map toRow forest)
-          }
+-- | Create a React component for a form from a `FormBuilder'` and a custom
+-- | rendering function.
+-- |
+-- | _Note_: this function should be fully applied, to avoid remounting
+-- | the component on each render.
+build'
+  :: forall ui renderProps formProps props unvalidated result
+   . Union renderProps formProps props
+  => ({| props } -> ui -> JSX)
+  -> FormBuilder' ui {| formProps } unvalidated result
+  -> { value :: unvalidated
+     , onChange :: (unvalidated -> unvalidated) -> Effect Unit
+     | props
+     }
+  -> JSX
+build' render editor =
+  makeStateless (createComponent "Form") \props@{ value, onChange } ->
+    let
+      { edit } = un FormBuilder editor (contractFormProps props) value
+    in
+      render (contractProps props) (edit onChange)
+  where
+    contractFormProps
+      :: { value :: unvalidated
+         , onChange :: (unvalidated -> unvalidated) -> Effect Unit
+         | props
+         }
+      -> {| formProps }
+    contractFormProps = unsafeCoerce
+
+    contractProps
+      :: { value :: unvalidated
+         , onChange :: (unvalidated -> unvalidated) -> Effect Unit
+         | props
+         }
+      -> {| props }
+    contractProps = unsafeCoerce
+
+-- | The default Lumi implementation for rendering a forest of JSX
+-- | form fields.
+defaultRenderForm
+  :: forall props
+   . { forceTopLabels :: Boolean
+     , inlineTable :: Boolean
+     , readonly :: Boolean
+     | props
+     }
+  -> Forest
+  -> JSX
+defaultRenderForm { inlineTable, forceTopLabels, readonly } forest =
+  element (R.unsafeCreateDOMComponent "lumi-form")
+    { class:
+        String.joinWith " " $ fold
+          [ guard inlineTable ["inline-table"]
+          , guard readonly ["readonly"]
+          ]
+    , children:
+        surround fieldDivider (map toRow (Array.mapMaybe pruneTree forest))
+    }
+  where
+    fieldDivider = R.hr { className: "lumi field-divider" }
+
+    toRow :: Tree -> JSX
+    toRow = case _ of
+      Child { key, child } ->
+        maybe identity keyed key $ child
+      Wrapper { key, wrap: f, children } ->
+        maybe identity keyed key
+          $ f
+          $ intercalate [fieldDivider]
+          $ map (pure <<< toRow)
+          $ children
+      Node { label, key, required, validationError, children } ->
+        maybe identity keyed key $
+          labeledField
+            { label: text body
+                { children = [ label ]
+                , className = toNullable (pure "field-label")
+                }
+            , value: intercalate fieldDivider (map toRow children)
+            , validationError
+            , required
+            , forceTopLabel: forceTopLabels
+            , style: R.css {}
+            }
 
 -- | Create an always-valid `FormBuilder` that renders the supplied `JSX`.
 static :: forall props value. JSX -> FormBuilder props value Unit
@@ -518,7 +572,7 @@ array
   -> FormBuilder { readonly :: Boolean | props } (Array u) (Array a)
 array { label, addLabel, defaultValue, editor } = FormBuilder \props@{ readonly } xs ->
   let editAt i f xs' = fromMaybe xs' (Array.modifyAt i f xs')
-      wrapper children = Array.singleton $ Wrapper { key: Nothing, children }
+      wrapper children = Array.singleton $ Wrapper { key: Nothing, wrap: R.div_, children }
    in { edit: \onChange ->
           wrapper $ xs # Array.mapWithIndex (\i x ->
                 Node
@@ -620,7 +674,7 @@ arrayModal
   -> FormBuilder { readonly :: Boolean | props } (Array a) (Array a)
 arrayModal { label, addLabel, defaultValue, summary, component, componentProps } = FormBuilder \props@{ readonly } xs ->
   let editAt i f xs' = fromMaybe xs' (Array.modifyAt i f xs')
-      wrapper children = Array.singleton $ Wrapper { key: Nothing, children }
+      wrapper children = Array.singleton $ Wrapper { key: Nothing, wrap: R.div_, children }
    in { edit : \onChange ->
           wrapper $ xs # Array.mapWithIndex (\i x ->
                 Node
@@ -766,10 +820,10 @@ initializer loader aff =
 -- | Caveat emptor, you get what you pay for if you pass in a dodgy
 -- | `Iso` here.
 via
-  :: forall props s a result
+  :: forall ui props s a result
    . Iso' s a
-  -> FormBuilder props a result
-  -> FormBuilder props s result
+  -> FormBuilder' ui props a result
+  -> FormBuilder' ui props s result
 via i e = FormBuilder \props s ->
   let { edit, validate } = un FormBuilder e props (view i s)
    -- TODO: make this point-free
@@ -779,10 +833,10 @@ via i e = FormBuilder \props s ->
 
 -- | Focus a `FormBuilder` on a smaller piece of state, using a `Lens`.
 focus
-  :: forall props s a result
+  :: forall ui props s a result
    . Lens' s a
-  -> FormBuilder props a result
-  -> FormBuilder props s result
+  -> FormBuilder' ui props a result
+  -> FormBuilder' ui props s result
 focus l e = FormBuilder \props s ->
   let { edit, validate } = un FormBuilder e props (view l s)
    in { edit: \k -> edit (k <<< l)
@@ -792,22 +846,24 @@ focus l e = FormBuilder \props s ->
 -- | Focus a `FormBuilder` on a possible type of state, using a `Prism`,
 -- | ignoring validation.
 match_
-  :: forall props s a
-   . Prism' s a
-  -> FormBuilder props a a
-  -> FormBuilder props s s
+  :: forall ui props s a
+   . Monoid ui
+  => Prism' s a
+  -> FormBuilder' ui props a a
+  -> FormBuilder' ui props s s
 match_ p = match p p
 
 -- | Focus a `FormBuilder` on a possible type of state, using a `Prism`.
 -- |
 -- | We need two `Prism`s in order to change the result type for
 -- | validation purposes.
 match
-  :: forall props result s t a
-   . Prism s s a a
+  :: forall ui props result s t a
+   . Monoid ui
+  => Prism s s a a
   -> Prism s t a result
-  -> FormBuilder props a result
-  -> FormBuilder props s t
+  -> FormBuilder' ui props a result
+  -> FormBuilder' ui props s t
 match p1 p2 e = FormBuilder \props s ->
   case matching p2 s of
     Left t -> { edit: mempty, validate: pure t }
@@ -819,24 +875,48 @@ match p1 p2 e = FormBuilder \props s ->
 
 -- | Change the props type.
 mapProps
-  :: forall p q u a
+  :: forall ui p q u a
   . (q -> p)
-  -> FormBuilder p u a
-  -> FormBuilder q u a
+  -> FormBuilder' ui p u a
+  -> FormBuilder' ui q u a
 mapProps f form = FormBuilder (un FormBuilder form <<< f)
 
+-- | Change the UI type of a form.
+mapUI_
+  :: forall ui ui' props value result
+   . (ui -> ui')
+  -> FormBuilder' ui props value result
+  -> FormBuilder' ui' props value result
+mapUI_ f = mapUI \_ _ _ -> f
+
+-- | Change the UI type of a form based on the props, the current value and the
+-- | validated result.
+mapUI
+  :: forall ui ui' props value result
+   . (props -> value -> Maybe result -> ui -> ui')
+  -> FormBuilder' ui props value result
+  -> FormBuilder' ui' props value result
+mapUI f form =
+  FormBuilder \props value ->
+    let
+      { edit, validate } = un FormBuilder form props value
+    in
+      { edit: f props value validate <<< edit
+      , validate
+      }
+
 -- | Make the props available, for convenience.
 withProps
-  :: forall props unvalidated result
-   . (props -> FormBuilder props unvalidated result)
-  -> FormBuilder props unvalidated result
+  :: forall ui props unvalidated result
+   . (props -> FormBuilder' ui props unvalidated result)
+  -> FormBuilder' ui props unvalidated result
 withProps f = FormBuilder \props value -> un FormBuilder (f props) props value
 
 -- | Make the value available, for convenience.
 withValue
-  :: forall props unvalidated result
-   . (unvalidated -> FormBuilder props unvalidated result)
-  -> FormBuilder props unvalidated result
+  :: forall ui props unvalidated result
+   . (unvalidated -> FormBuilder' ui props unvalidated result)
+  -> FormBuilder' ui props unvalidated result
 withValue f = FormBuilder \props value -> un FormBuilder (f value) props value
 
 -- | Indent a `Forest` of editors by one level, providing a label.
@@ -859,18 +939,38 @@ indent label required editor = FormBuilder \props val ->
       , validate
       }
 
--- | Filter parts of the form based on the current value (and the props).
-filterWithProps
+wrap
   :: forall props u a
-   . (props -> u -> Boolean)
+   . (Array JSX -> JSX)
   -> FormBuilder props u a
   -> FormBuilder props u a
+wrap f form =
+  FormBuilder \props value ->
+    let
+      { edit, validate } = un FormBuilder form props value
+    in
+      { edit: \k ->
+          pure $ Wrapper
+            { key: Nothing
+            , wrap: f
+            , children: edit k
+            }
+      , validate
+      }
+
+-- | Filter parts of the form based on the current value (and the props).
+filterWithProps
+  :: forall ui props u a
+   . Monoid ui
+  => (props -> u -> Boolean)
+  -> FormBuilder' ui props u a
+  -> FormBuilder' ui props u a
 filterWithProps p editor = FormBuilder \props value ->
   let { edit, validate } = un FormBuilder editor props value
    in { edit: \onChange ->
           if p props value
             then edit onChange
-            else []
+            else mempty
       , validate
       }