Merge pull request #36 from thomashoneyman/query-update

Update `*All` helpers for better ergononmics

example/App/Validation.purs

@@ -44,6 +44,7 @@ derive newtype instance showName :: Show Name
 
 newtype Email = Email String
 derive instance newtypeEmail :: Newtype Email _
+derive newtype instance eqEmail :: Eq Email
 derive newtype instance showEmail :: Show Email
 
 -- | Unpacks errors to render as a string

example/Main.purs

@@ -7,6 +7,7 @@ import Data.Tuple (Tuple(..))
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Example.Basic.Component as Basic
+import Example.Nested.Component as Nested
 import Example.ExternalComponents.Component as ExternalComponents
 import Example.App.Home as Home
 import Example.RealWorld.Component as RealWorld
@@ -18,9 +19,10 @@ import Halogen.Storybook (Stories, runStorybook, proxy)
 stories :: Stories Aff
 stories = Object.fromFoldable
   [ Tuple "" $ proxy Home.component
-  , Tuple "basic" $ proxy Basic.component
-  , Tuple "external-components" $ proxy ExternalComponents.component
-  , Tuple "real-world" $ proxy RealWorld.component
+  , Tuple "Basic" $ proxy Basic.component
+  , Tuple "External Components" $ proxy ExternalComponents.component
+  , Tuple "Nested" $ proxy Nested.component
+  , Tuple "Real World" $ proxy RealWorld.component
   ]
 
 main :: Effect Unit

example/nested-array/Component.purs

@@ -0,0 +1,238 @@
+module Example.Nested.Component where
+
+import Prelude
+
+import Data.Array (filter, snoc)
+import Data.Const (Const)
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype)
+import Data.Symbol (SProxy(..))
+import Data.Traversable (for, traverse)
+import Effect.Aff (Aff)
+import Effect.Console as Console
+import Example.App.UI.Element as UI
+import Example.App.Validation as V
+import Formless as F
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
+
+data Query a
+  = HandleMemberForm Int (F.Message Query MemberForm) a
+  | HandleEventForm (F.Message Query EventForm) a
+  | AddMemberForm a
+  | RemoveMemberForm Int a
+  | SubmitAll a
+
+type CQ = F.Query Query EventCQ EventCS EventForm Aff
+type CS = Unit
+
+type EventCQ = F.Query Query (Const Void) Void MemberForm Aff
+type EventCS = Int
+
+type State = { formIds :: Array Int, nextId :: Int }
+
+component :: H.Component HH.HTML Query Unit Void Aff
+component = H.parentComponent
+  { initialState: const { formIds: [], nextId: 1 }
+  , render
+  , eval
+  , receiver: const Nothing
+  }
+  where
+
+  render :: State -> H.ParentHTML Query CQ CS Aff
+  render st =
+    UI.section_
+      [ UI.h1_ [ HH.text "Formless" ]
+      , UI.h2_ [ HH.text "A form with a dynamic array of nested sub-forms." ]
+      , UI.p_ $
+          "It is possible to nest sub-forms within Formless like any other external component. This "
+          <> "allows you to create an arbitrary number of forms within other forms while preserving the "
+          <> "type safety provided by the Formless library. Try submitting the form with no sub-forms, and "
+          <> "review the output in the console. Next, try adding one or more sub-forms and submitting them "
+          <> "when valid or invalid."
+      , HH.br_
+      , HH.slot unit F.component
+          { initialInputs: F.wrapInputFields { name: "", location: "", members: Nothing }
+          , validators: eventFormValidation
+          , render: renderEventForm st
+          }
+          (HE.input HandleEventForm)
+      ]
+
+  eval :: Query ~> H.ParentDSL State Query CQ CS Void Aff
+  eval = case _ of
+
+    -- We only care about queries raised out of the components, but no messages
+    -- because we'll use `submitReply` later.
+    HandleEventForm (F.Emit q) a -> eval q *> pure a
+    HandleEventForm _ a -> pure a
+
+    HandleMemberForm _ (F.Emit q) a -> eval q *> pure a
+    HandleMemberForm _ _ a -> pure a
+
+    SubmitAll a -> do
+      st <- H.get
+
+      -- First, we'll submit the member forms to set the top-level form
+      memberForms <- for st.formIds \id -> H.query unit $ F.send id F.submitReply
+      let members = (map <<< map) F.unwrapOutputFields $ traverse join memberForms
+
+      -- Now, we'll use their outputs as the input to our top-level form component
+      _ <- H.query unit $ F.set_ (SProxy :: SProxy "members") members
+
+      -- and submit that form, accepting its output
+      res <- H.query unit F.submitReply
+
+      -- now we can review the results of submitting the form
+      case join res of
+        Nothing -> H.liftEffect $ Console.log "Forms are not valid"
+        Just r -> H.liftEffect do
+          Console.log "Valid!"
+          Console.logShow $ F.unwrapOutputFields r
+
+      pure a
+
+    AddMemberForm a -> do
+      H.modify_ \st -> st { nextId = st.nextId + 1, formIds = st.formIds `snoc` st.nextId }
+      pure a
+
+    RemoveMemberForm i a -> do
+      H.modify_ \st -> st { formIds = filter (_ /= i) st.formIds }
+      pure a
+
+----------
+-- Formless (Event Form)
+
+type Event = Record (EventRow F.OutputType)
+
+newtype EventForm r f = EventForm (r (EventRow f))
+derive instance newtypeEventForm :: Newtype (EventForm r f) _
+
+type EventRow f =
+  ( name :: f V.FieldError String String
+  , location :: f V.FieldError String String
+  , members :: f V.FieldError (Maybe (Array MemberInfo)) (Array MemberInfo)
+  )
+
+eventFormValidation :: EventForm Record (F.Validation EventForm Aff)
+eventFormValidation = EventForm
+  { name: V.minLength 3
+  , location: V.minLength 3
+  , members: V.exists
+  }
+
+renderEventForm :: State -> F.State EventForm Aff -> F.HTML Query EventCQ EventCS EventForm Aff
+renderEventForm st fs =
+  HH.div_
+    ( [ HH.div
+        [ HP.class_ $ HH.ClassName "field is-grouped" ]
+        [ HH.div
+          [ HP.class_ $ HH.ClassName "control" ]
+          [ UI.button
+            [ HE.onClick $ HE.input_ $ F.raise $ H.action AddMemberForm ]
+            [ HH.text "Add Member Form" ]
+          ]
+        , HH.div
+          [ HP.class_ $ HH.ClassName "control" ]
+          [ UI.buttonPrimary
+            [ HE.onClick $ HE.input_ $ F.raise $ H.action SubmitAll ]
+            [ HH.text "Submit" ]
+          ]
+        ]
+      , UI.input
+         { label: "Event Name"
+         , help: UI.resultToHelp "Provide an event name" $ F.getResult _name fs.form
+         , placeholder: "My Event"
+         }
+         [ HP.value $ F.getInput _name fs.form
+         , HE.onValueInput $ HE.input $ F.setValidate _name
+         ]
+      , UI.input
+         { label: "Event Location"
+         , help: UI.resultToHelp "Provide an event location" $ F.getResult _location fs.form
+         , placeholder: "Los Angeles, CA"
+         }
+         [ HP.value $ F.getInput _location fs.form
+         , HE.onValueInput $ HE.input $ F.setValidate _location
+         ]
+      ]
+      <> map mkMemberForm st.formIds
+    )
+  where
+    mkMemberForm :: Int -> F.HTML Query EventCQ EventCS EventForm Aff
+    mkMemberForm i =
+      HH.slot i F.component
+        { initialInputs: F.wrapInputFields { name: "", email: "", notes: "" }
+        , validators: memberFormValidation
+        , render: renderMemberForm i
+        }
+        (HE.input $ F.raise <<< H.action <<< HandleMemberForm i)
+
+    _name = SProxy :: SProxy "name"
+    _location = SProxy :: SProxy "location"
+
+
+
+----------
+-- Formless (Member Form)
+
+type MemberInfo = Record (MemberRow F.OutputType)
+
+newtype MemberForm r f = MemberForm (r (MemberRow f))
+derive instance newtypeMemberForm :: Newtype (MemberForm r f) _
+
+type MemberRow f =
+  ( name :: f V.FieldError String String
+  , email :: f V.FieldError String V.Email
+  , notes :: f Void String String
+  )
+
+memberFormValidation :: MemberForm Record (F.Validation MemberForm Aff)
+memberFormValidation = MemberForm
+  { name: V.minLength 5
+  , email: V.emailFormat >>> V.emailIsUsed
+  , notes: F.hoistFn_ identity
+  }
+
+renderMemberForm :: Int -> F.State MemberForm Aff -> F.HTML Query (Const Void) Void MemberForm Aff
+renderMemberForm i fs =
+ UI.formContent_
+ [ HH.div
+   [ HP.class_ $ HH.ClassName "field" ]
+   [ UI.buttonPrimary
+     [ HE.onClick $ HE.input_ $ F.raise $ H.action $ RemoveMemberForm i ]
+     [ HH.text "Remove Me" ]
+   ]
+ , UI.input
+     { label: "Member Name"
+     , help: UI.resultToHelp "Provide the registrant's name" $ F.getResult _name fs.form
+     , placeholder: "Dale Cooper"
+     }
+     [ HP.value $ F.getInput _name fs.form
+     , HE.onValueInput $ HE.input $ F.setValidate _name
+     ]
+ , UI.input
+     { label: "Member Email"
+     , help: UI.resultToHelp "Provide the registrant's email address" $ F.getResult _email fs.form
+     , placeholder: "dalecooper@fbi.gov"
+     }
+     [ HP.value $ F.getInput _email fs.form
+     , HE.onValueInput $ HE.input $ F.setValidate _email
+     ]
+ , UI.input
+     { label: "Additional Notes"
+     , help: Right "Provide any additional notes you'd like."
+     , placeholder: "Fond of Tibetan traditions"
+     }
+     [ HP.value $ F.getInput _notes fs.form
+     , HE.onValueInput $ HE.input $ F.set _notes
+     ]
+   ]
+  where
+    _name = SProxy :: SProxy "name"
+    _email = SProxy :: SProxy "email"
+    _notes = SProxy :: SProxy "notes"

src/Formless.purs

@@ -26,4 +26,4 @@ import Formless.Transform.Row (class MakeInputFieldsFromRow, class MakeSProxies,
 import Formless.Types.Component (Component, DSL, HTML, HTML', Input, Input', InternalState(..), Message(..), Message', PublicState, Query(..), Query', State, StateRow, StateStore, ValidStatus(..))
 import Formless.Types.Form (ErrorType, FormField(..), FormFieldRow, FormProxy(..), InputField(..), InputFunction(..), InputType, OutputField(..), OutputType, U(..))
 import Formless.Validation (EmptyValidators(..), Validation(..), hoistFn, hoistFnE, hoistFnE_, hoistFnME, hoistFnME_, hoistFn_, noValidation, runValidation)
-import Formless.Query (andThen, andThen_, getState, initialize, initialize_, modify, modifyAll, modifyAll_, modifyValidate, modifyValidate_, modify_, reset, resetAll, resetAll_, reset_, send, send', set, setAll, setAll_, setValidate, setValidate_, set_, submit, submitReply, submit_, validate, validateAll, validateAll_, validate_)
+import Formless.Query (andThen, andThen_, getState, initialize, initialize_, modify, modifyAll, modifyAll_, modifyValidate, modifyValidateAll, modifyValidateAll_, modifyValidate_, modify_, raise, raise_, reset, resetAll, resetAll_, reset_, send, send', set, setAll, setAll_, setValidate, setValidateAll, setValidateAll_, setValidate_, set_, submit, submitReply, submit_, validate, validateAll, validateAll_, validate_)