From fa47ac6e6316d47534d7b61dfa32365164f36207 Mon Sep 17 00:00:00 2001 From: "Thomas R. Honeyman" Date: Fri, 19 Oct 2018 19:45:15 -0700 Subject: [PATCH 1/5] Add ability to set or modify input values, instead of only set. Restructure modules to more accurately reflect names and uses of functions and for clarity. --- src/Formless.purs | 518 +------------------ src/{ => Formless}/Class/Initial.purs | 0 src/Formless/Component.purs | 233 +++++++++ src/Formless/Query.purs | 181 +++++++ src/{Spec => Formless}/Retrieve.purs | 146 ++++-- src/{ => Formless}/Transform/Internal.purs | 16 +- src/{ => Formless}/Transform/Record.purs | 2 +- src/{ => Formless}/Transform/Row.purs | 2 +- src/Formless/Types/Component.purs | 128 +++++ src/Formless/Types/Form.purs | 57 ++ src/{Validation => Formless}/Validation.purs | 103 ++-- src/Spec/Spec.purs | 121 ----- 12 files changed, 789 insertions(+), 718 deletions(-) rename src/{ => Formless}/Class/Initial.purs (100%) create mode 100644 src/Formless/Component.purs create mode 100644 src/Formless/Query.purs rename src/{Spec => Formless}/Retrieve.purs (56%) rename src/{ => Formless}/Transform/Internal.purs (96%) rename src/{ => Formless}/Transform/Record.purs (95%) rename src/{ => Formless}/Transform/Row.purs (98%) create mode 100644 src/Formless/Types/Component.purs create mode 100644 src/Formless/Types/Form.purs rename src/{Validation => Formless}/Validation.purs (91%) delete mode 100644 src/Spec/Spec.purs diff --git a/src/Formless.purs b/src/Formless.purs index 292f187..c6ae8af 100644 --- a/src/Formless.purs +++ b/src/Formless.purs @@ -1,505 +1,29 @@ --- | Formless is a renderless component to help you build forms in Halogen. --- | It expects that you have already written a form spec and validation and --- | you simply need a component to run it on your behalf. - +-- | Formless is a renderless component to help you build forms +-- | in Halogen. This module re-exports all public functions and +-- | types from the library, and can be used as the single import +-- | for most use cases. +-- | +-- | ```purescript +-- | import Formless as F +-- | ``` module Formless - ( Query(..) - , Query'(..) - , StateStore(..) - , Component(..) - , HTML(..) - , HTML'(..) - , DSL(..) - , State(..) - , PublicState(..) - , Input(..) - , Input'(..) - , Message(..) - , Message'(..) - , StateRow(..) - , InternalState(..) - , ValidStatus(..) - , component - , module Formless.Spec - , module Formless.Spec.Retrieve - , module Formless.Class.Initial - , module Formless.Validation + ( module Formless.Class.Initial + , module Formless.Component + , module Formless.Retrieve , module Formless.Transform.Record , module Formless.Transform.Row - , send - , send' - , modify - , modify_ - , modifyValidate - , modifyValidate_ - , validate - , validate_ - , reset - , reset_ - ) - where - -import Prelude + , module Formless.Types.Component + , module Formless.Types.Form + , module Formless.Validation + , module Formless.Query + ) where -import Control.Comonad (extract) -import Control.Comonad.Store (Store, store) -import Control.Monad.Free (liftF) -import Data.Const (Const) -import Data.Coyoneda (liftCoyoneda) -import Data.Eq (class EqRecord) -import Data.Generic.Rep (class Generic) -import Data.Generic.Rep.Show (genericShow) -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype, over, unwrap, wrap) -import Data.Symbol (class IsSymbol, SProxy(..)) -import Data.Traversable (traverse_) -import Data.Variant (Variant, inj) import Formless.Class.Initial (class Initial, initial) -import Formless.Spec (ErrorType, FormField(..), FormFieldLens, FormFieldRow, FormProxy(..), InputField(..), InputType, OutputField(..), OutputType, U(..), _Error, _Field, _Input, _Output, _Result, _Touched, _input, _result, _touched) -import Formless.Spec.Retrieve (FormFieldGet, GetAll, GetError(..), GetInputField(..), GetOutput(..), GetResultField(..), GetTouchedField(..), getError, getErrorAll, getField, getInput, getInputAll, getOutput, getOutputAll, getResult, getResultAll, getTouched, getTouchedAll) -import Formless.Transform.Internal as Internal +import Formless.Component (component) +import Formless.Retrieve (FormFieldGet, FormFieldLens, GetAll, GetError(..), GetInputField(..), GetOutput(..), GetResultField(..), GetTouchedField(..), _Error, _Field, _Input, _Output, _Result, _Touched, getError, getErrorAll, getField, getInput, getInputAll, getOutput, getOutputAll, getResult, getResultAll, getTouched, getTouchedAll) import Formless.Transform.Record (UnwrapField(..), WrapField(..), unwrapOutputFields, unwrapRecord, wrapInputFields, wrapRecord) import Formless.Transform.Row (class MakeInputFieldsFromRow, class MakeSProxies, SProxies, makeSProxiesBuilder, mkInputFields, mkInputFieldsFromRowBuilder, mkSProxies) +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 Halogen as H -import Halogen.Component.ChildPath (ChildPath, injQuery, injSlot) -import Halogen.HTML as HH -import Halogen.HTML.Events as HE -import Prim.Row as Row -import Prim.RowList as RL -import Record as Record -import Renderless.State (getState, modifyState, modifyState_, modifyStore_) -import Unsafe.Coerce (unsafeCoerce) - -data Query pq cq cs form m a - = Modify (form Variant InputField) a - | Validate (form Variant U) a - | ModifyValidate (form Variant InputField) a - | Reset (form Variant InputField) a - | ResetAll a - | ValidateAll a - | Submit a - | SubmitReply (Maybe (form Record OutputField) -> a) - | GetState (PublicState form -> a) - | Send cs (cq a) - | SyncFormData a - | Raise (pq Unit) a - | ReplaceInputs (form Record InputField) a - | Receive (Input pq cq cs form m) a - | AndThen (Query pq cq cs form m Unit) (Query pq cq cs form m Unit) a - --- | The overall component state type, which contains the local state type --- | and also the render function -type StateStore pq cq cs form m = - Store (State form m) (HTML pq cq cs form m) - --- | The component type -type Component pq cq cs form m - = H.Component - HH.HTML - (Query pq cq cs form m) - (Input pq cq cs form m) - (Message pq form) - m - --- | The component's HTML type, the result of the render function. -type HTML pq cq cs form m - = H.ParentHTML (Query pq cq cs form m) cq cs m - --- | The component's DSL type, the result of the eval function. -type DSL pq cq cs form m - = H.ParentDSL - (StateStore pq cq cs form m) - (Query pq cq cs form m) - cq - cs - (Message pq form) - m - --- | The component local state -type State form m = Record (StateRow form (internal :: InternalState form m)) - --- | The component's public state -type PublicState form = Record (StateRow form ()) - --- | The component's public state -type StateRow form r = - ( validity :: ValidStatus - , dirty :: Boolean - , submitting :: Boolean - , errors :: Int - , submitAttempts :: Int - , form :: form Record FormField - | r - ) - --- | A newtype to make easier type errors for end users to --- | read by hiding internal fields -newtype InternalState form m = InternalState - { initialInputs :: form Record InputField - , validators :: form Record (Validation form m) - , allTouched :: Boolean - } -derive instance newtypeInternalState :: Newtype (InternalState form m) _ - --- | A type to represent validation status -data ValidStatus - = Invalid - | Incomplete - | Valid -derive instance genericValidStatus :: Generic ValidStatus _ -derive instance eqValidStatus :: Eq ValidStatus -derive instance ordValidStatus :: Ord ValidStatus -instance showValidStatus :: Show ValidStatus where - show = genericShow - --- | The component's input type -type Input pq cq cs form m = - { initialInputs :: form Record InputField - , validators :: form Record (Validation form m) - , render :: State form m -> HTML pq cq cs form m - } - --- | The component tries to require as few messages to be handled as possible. You --- | can always use the *Reply variants of queries to perform actions and receive --- | a result out the other end. -data Message pq form - = Submitted (form Record OutputField) - | Changed (PublicState form) - | Emit (pq Unit) - --- | Simple types - --- | A simple query type when you have no child slots in use -type Query' form m = Query (Const Void) (Const Void) Void form m - --- | A simple HTML type when the component does not need embedding -type HTML' form m = H.ParentHTML (Query' form m) (Const Void) Void m - --- | A simple Message type when the component does not need embedding -type Message' form = Message (Const Void) form - --- | A simple Input type when the component does not need embedding -type Input' form m = Input (Const Void) (Const Void) Void form m - --- | The component itself -component - :: ∀ pq cq cs form m is ixs ivs fs fxs us vs os - . Ord cs - => Monad m - => RL.RowToList is ixs - => RL.RowToList fs fxs - => EqRecord ixs is - => Internal.InputFieldsToFormFields ixs is fs - => Internal.FormFieldsToInputFields fxs fs is - => Internal.CountErrors fxs fs - => Internal.AllTouched fxs fs - => Internal.SetFormFieldsTouched fxs fs fs - => Internal.ReplaceFormFieldInputs is fxs fs fs - => Internal.ApplyValidation vs fxs fs fs m - => Internal.FormFieldToMaybeOutput fxs fs os - => Newtype (form Record InputField) { | is } - => Newtype (form Variant InputField) (Variant ivs) - => Newtype (form Record FormField) { | fs } - => Newtype (form Record OutputField) { | os } - => Newtype (form Record (Validation form m)) { | vs } - => Newtype (form Variant U) (Variant us) - => Component pq cq cs form m -component = - H.parentComponent - { initialState - , render: extract - , eval - , receiver: HE.input Receive - } - where - - initialState :: Input pq cq cs form m -> StateStore pq cq cs form m - initialState { initialInputs, validators, render } = store render $ - { validity: Incomplete - , dirty: false - , errors: 0 - , submitAttempts: 0 - , submitting: false - , form: Internal.inputFieldsToFormFields initialInputs - , internal: InternalState { allTouched: false, initialInputs, validators } - } - - eval :: Query pq cq cs form m ~> DSL pq cq cs form m - eval = case _ of - Modify variant a -> do - modifyState_ \st -> st { form = Internal.unsafeSetInputVariant variant st.form } - eval $ SyncFormData a - - Validate variant a -> do - st <- getState - form <- H.lift - $ Internal.unsafeRunValidationVariant variant (unwrap st.internal).validators st.form - modifyState_ _ { form = form } - eval $ SyncFormData a - - ModifyValidate variant a -> do - void $ eval $ Modify variant a - void $ eval $ Validate (unsafeCoerce variant :: form Variant U) a - eval $ SyncFormData a - - Reset variant a -> do - modifyState_ \st -> st - { form = Internal.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form - , internal = over InternalState (_ { allTouched = false }) st.internal - } - eval $ SyncFormData a - - ValidateAll a -> do - st <- getState - form <- H.lift $ Internal.applyValidation (unwrap st.internal).validators st.form - modifyState_ _ { form = form } - eval $ SyncFormData a - - -- A query to sync the overall state of the form after an individual field change - -- or overall validation. - SyncFormData a -> do - modifyState_ \st -> st - { errors = Internal.countErrors st.form - -- Dirty state is computed by checking equality of original input fields - -- vs. current ones. This relies on input fields passed by the user having - -- equality defined. - , dirty = not $ (==) - (unwrap (Internal.formFieldsToInputFields st.form)) - (unwrap (unwrap st.internal).initialInputs) - } - - st <- getState - -- Need to verify the validity status of the form. - new <- case (unwrap st.internal).allTouched of - true -> modifyState _ - { validity = if not (st.errors == 0) then Invalid else Valid } - - -- If not all fields are touched, then we need to quickly sync the form state - -- to verify this is actually the case. - _ -> case Internal.allTouched st.form of - - -- The sync revealed all fields really have been touched - true -> modifyState _ - { validity = if not (st.errors == 0) then Invalid else Valid - , internal = over InternalState (_ { allTouched = true }) st.internal - } - - -- The sync revealed that not all fields have been touched - _ -> modifyState _ - { validity = Incomplete } - - H.raise $ Changed $ getPublicState new - pure a - - -- Submit, also raising a message to the user - Submit a -> do - mbForm <- runSubmit - traverse_ (H.raise <<< Submitted) mbForm - pure a - - -- Submit, not raising a message - SubmitReply reply -> do - mbForm <- runSubmit - pure $ reply mbForm - - -- | Should completely reset the form to its initial state - ResetAll a -> do - new <- modifyState \st -> st - { validity = Incomplete - , errors = 0 - , submitAttempts = 0 - , form = Internal.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form - , internal = over InternalState (_ { allTouched = false }) st.internal - } - H.raise $ Changed $ getPublicState new - pure a - - GetState reply -> do - st <- getState - pure $ reply $ getPublicState st - - Send cs cq -> H.HalogenM $ liftF $ H.ChildQuery cs $ liftCoyoneda cq - - Raise query a -> do - H.raise (Emit query) - pure a - - ReplaceInputs formInputs a -> do - st <- getState - new <- modifyState _ - { validity = Incomplete - , dirty = false - , errors = 0 - , submitAttempts = 0 - , submitting = false - , form = Internal.replaceFormFieldInputs formInputs st.form - , internal = over - InternalState - (_ { allTouched = false, initialInputs = formInputs }) - st.internal - } - H.raise $ Changed $ getPublicState new - pure a - - Receive { render, validators } a -> do - let applyOver = over InternalState (_ { validators = validators }) - modifyStore_ render (\st -> st { internal = applyOver st.internal }) - pure a - - AndThen q1 q2 a -> do - _ <- eval q1 - _ <- eval q2 - pure a - - -- Remove internal fields and return the public state - getPublicState :: State form m -> PublicState form - getPublicState = Record.delete (SProxy :: SProxy "internal") - - -- Run submission without raising messages or replies - runSubmit :: DSL pq cq cs form m (Maybe (form Record OutputField)) - runSubmit = do - init <- modifyState \st -> st - { submitAttempts = st.submitAttempts + 1 - , submitting = true - } - - -- For performance purposes, avoid running this if possible - let internal = unwrap init.internal - when (not internal.allTouched) do - modifyState_ _ - { form = Internal.setFormFieldsTouched init.form - , internal = over InternalState (_ { allTouched = true }) init.internal - } - - -- Necessary to validate after fields are touched, but before parsing - _ <- eval $ ValidateAll unit - - -- For performance purposes, only attempt to submit if the form is valid - validated <- getState - modifyState_ \st -> st { submitting = false } - pure $ - if validated.validity == Valid - then Internal.formFieldsToMaybeOutputFields validated.form - else Nothing - - ------ --- Querying - --- | For use when you need to query a component through Formless -send :: ∀ pq cs cq form m a - . cs - -> cq a - -> Query pq cq cs form m a -send p q = Send p q - --- | When you are using several different types of child components in Formless --- | the component needs a child path to be able to pick the right slot to send --- | a query to. -send' :: ∀ pq cq' cs' cs cq form m a - . ChildPath cq cq' cs cs' - -> cs - -> cq a - -> Query pq cq' cs' form m a -send' path p q = Send (injSlot path p) (injQuery path q) - ------ --- Queries - --- | A helper to create the correct `Modify` query for Formless given a label and --- | an input value -modify - :: ∀ pq cq cs form inputs m sym t0 e i o a - . IsSymbol sym - => Newtype (form Variant InputField) (Variant inputs) - => Row.Cons sym (InputField e i o) t0 inputs - => SProxy sym - -> i - -> a - -> Query pq cq cs form m a -modify sym i = Modify (wrap (inj sym (wrap i))) - --- | A helper to create the correct `Modify` query for Formless given a label and --- | an input value, as an action -modify_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant InputField) (Variant inputs) - => Row.Cons sym (InputField e i o) t0 inputs - => SProxy sym - -> i - -> Query pq cq cs form m Unit -modify_ sym i = Modify (wrap (inj sym (wrap i))) unit - --- | A helper to create the correct `ModifyValidate` query for Formless given a --- | label and an input value -modifyValidate - :: ∀ pq cq cs form inputs m sym t0 e i o a - . IsSymbol sym - => Newtype (form Variant InputField) (Variant inputs) - => Row.Cons sym (InputField e i o) t0 inputs - => SProxy sym - -> i - -> a - -> Query pq cq cs form m a -modifyValidate sym i = ModifyValidate (wrap (inj sym (wrap i))) - --- | A helper to create the correct `ModifyValidate` query for Formless given a --- | label and an input value, as an action -modifyValidate_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant InputField) (Variant inputs) - => Row.Cons sym (InputField e i o) t0 inputs - => SProxy sym - -> i - -> Query pq cq cs form m Unit -modifyValidate_ sym i = ModifyValidate (wrap (inj sym (wrap i))) unit - --- | A helper to create the correct `Reset` query for Formless given a label -reset - :: ∀ pq cq cs form inputs m sym a t0 e i o - . IsSymbol sym - => Initial i - => Newtype (form Variant InputField) (Variant inputs) - => Row.Cons sym (InputField e i o) t0 inputs - => SProxy sym - -> a - -> Query pq cq cs form m a -reset sym = Reset (wrap (inj sym (wrap initial))) - --- | A helper to create the correct `Reset` query for Formless given a label, --- | as an action. -reset_ - :: ∀ pq cq cs form inputs m sym t0 e i o - . IsSymbol sym - => Initial i - => Newtype (form Variant InputField) (Variant inputs) - => Row.Cons sym (InputField e i o) t0 inputs - => SProxy sym - -> Query pq cq cs form m Unit -reset_ sym = Reset (wrap (inj sym (wrap initial))) unit - --- | A helper to create the correct `Validate` query for Formless, given --- | a label -validate - :: ∀ pq cq cs form us m sym a t0 e i o - . IsSymbol sym - => Newtype (form Variant U) (Variant us) - => Row.Cons sym (U e i o) t0 us - => SProxy sym - -> a - -> Query pq cq cs form m a -validate sym = Validate (wrap (inj sym U)) - --- | A helper to create the correct `Validate` query for Formless given --- | a label, as an action -validate_ - :: ∀ pq cq cs form us m sym t0 e i o - . IsSymbol sym - => Newtype (form Variant U) (Variant us) - => Row.Cons sym (U e i o) t0 us - => SProxy sym - -> Query pq cq cs form m Unit -validate_ sym = Validate (wrap (inj sym U)) unit +import Formless.Query (modify, modifyValidate, modifyValidate_, modify_, reset, reset_, send, send', set, setValidate, setValidate_, set_, validate, validate_) diff --git a/src/Class/Initial.purs b/src/Formless/Class/Initial.purs similarity index 100% rename from src/Class/Initial.purs rename to src/Formless/Class/Initial.purs diff --git a/src/Formless/Component.purs b/src/Formless/Component.purs new file mode 100644 index 0000000..fcb9006 --- /dev/null +++ b/src/Formless/Component.purs @@ -0,0 +1,233 @@ +module Formless.Component where + +import Prelude + +import Control.Comonad (extract) +import Control.Comonad.Store (store) +import Control.Monad.Free (liftF) +import Data.Coyoneda (liftCoyoneda) +import Data.Eq (class EqRecord) +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype, over, unwrap) +import Data.Symbol (SProxy(..)) +import Data.Traversable (traverse_) +import Data.Variant (Variant) +import Formless.Types.Form (FormField, InputField, InputFunction, OutputField, U) +import Formless.Transform.Internal as Internal +import Formless.Types.Component (Component, DSL, Input, InternalState(..), Message(..), PublicState, Query(..), State, StateStore, ValidStatus(..)) +import Formless.Validation (Validation) +import Halogen as H +import Halogen.HTML.Events as HE +import Prim.RowList as RL +import Record as Record +import Renderless.State (getState, modifyState, modifyState_, modifyStore_) +import Unsafe.Coerce (unsafeCoerce) + +-- | The Formless component +component + :: ∀ pq cq cs form m is ixs ivs fs fxs us vs os ivfs + . Ord cs + => Monad m + => RL.RowToList is ixs + => RL.RowToList fs fxs + => EqRecord ixs is + => Internal.InputFieldsToFormFields ixs is fs + => Internal.FormFieldsToInputFields fxs fs is + => Internal.CountErrors fxs fs + => Internal.AllTouched fxs fs + => Internal.SetFormFieldsTouched fxs fs fs + => Internal.ReplaceFormFieldInputs is fxs fs fs + => Internal.ApplyValidation vs fxs fs fs m + => Internal.FormFieldToMaybeOutput fxs fs os + => Newtype (form Record InputField) { | is } + => Newtype (form Record FormField) { | fs } + => Newtype (form Record OutputField) { | os } + => Newtype (form Record (Validation form m)) { | vs } + => Newtype (form Variant InputField) (Variant ivs) + => Newtype (form Variant InputFunction) (Variant ivfs) + => Newtype (form Variant U) (Variant us) + => Component pq cq cs form m +component = + H.parentComponent + { initialState + , render: extract + , eval + , receiver: HE.input Receive + } + where + + initialState :: Input pq cq cs form m -> StateStore pq cq cs form m + initialState { initialInputs, validators, render } = store render $ + { validity: Incomplete + , dirty: false + , errors: 0 + , submitAttempts: 0 + , submitting: false + , form: Internal.inputFieldsToFormFields initialInputs + , internal: InternalState { allTouched: false, initialInputs, validators } + } + + eval :: Query pq cq cs form m ~> DSL pq cq cs form m + eval = case _ of + ModifyInput variant a -> do + modifyState_ \st -> st { form = Internal.unsafeModifyInputVariant variant st.form } + eval $ SyncFormData a + + ValidateInput variant a -> do + st <- getState + form <- H.lift + $ Internal.unsafeRunValidationVariant variant (unwrap st.internal).validators st.form + modifyState_ _ { form = form } + eval $ SyncFormData a + + -- Provided as a separate query to minimize state updates / re-renders + ModifyValidateInput variant a -> do + st <- getState + let form = Internal.unsafeModifyInputVariant variant st.form + form' <- do + let v :: form Variant U + v = unsafeCoerce variant + vs = (unwrap st.internal).validators + H.lift $ Internal.unsafeRunValidationVariant v vs form + modifyState_ _ { form = form' } + eval $ SyncFormData a + + ResetInput variant a -> do + modifyState_ \st -> st + { form = Internal.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form + , internal = over InternalState (_ { allTouched = false }) st.internal + } + eval $ SyncFormData a + + ValidateAll a -> do + st <- getState + form <- H.lift $ Internal.applyValidation (unwrap st.internal).validators st.form + modifyState_ _ { form = form } + eval $ SyncFormData a + + -- A query to sync the overall state of the form after an individual field change + -- or overall validation. + SyncFormData a -> do + st <- getState + + let errors = Internal.countErrors st.form + dirty = not $ eq + (unwrap (Internal.formFieldsToInputFields st.form)) + (unwrap (unwrap st.internal).initialInputs) + + -- Need to verify the validity status of the form. + newState <- case (unwrap st.internal).allTouched of + true -> modifyState _ + { validity = if not (st.errors == 0) then Invalid else Valid + , errors = errors + , dirty = dirty + } + + -- If not all fields are touched, then we need to quickly sync the form state + -- to verify this is actually the case. + _ -> case Internal.allTouched st.form of + + -- The sync revealed all fields really have been touched + true -> modifyState _ + { validity = if not (st.errors == 0) then Invalid else Valid + , internal = over InternalState (_ { allTouched = true }) st.internal + , errors = errors + , dirty = dirty + } + + -- The sync revealed that not all fields have been touched + _ -> modifyState _ { validity = Incomplete, errors = errors, dirty = dirty } + + H.raise $ Changed $ getPublicState newState + pure a + + -- Submit, also raising a message to the user + Submit a -> do + mbForm <- runSubmit + traverse_ (H.raise <<< Submitted) mbForm + pure a + + -- Submit, not raising a message + SubmitReply reply -> do + mbForm <- runSubmit + pure $ reply mbForm + + -- | Should completely reset the form to its initial state + ResetAll a -> do + new <- modifyState \st -> st + { validity = Incomplete + , errors = 0 + , submitAttempts = 0 + , form = Internal.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form + , internal = over InternalState (_ { allTouched = false }) st.internal + } + H.raise $ Changed $ getPublicState new + pure a + + GetState reply -> do + st <- getState + pure $ reply $ getPublicState st + + Send cs cq -> H.HalogenM $ liftF $ H.ChildQuery cs $ liftCoyoneda cq + + Raise query a -> do + H.raise (Emit query) + pure a + + ReplaceInputs formInputs a -> do + st <- getState + new <- modifyState _ + { validity = Incomplete + , dirty = false + , errors = 0 + , submitAttempts = 0 + , submitting = false + , form = Internal.replaceFormFieldInputs formInputs st.form + , internal = over + InternalState + (_ { allTouched = false, initialInputs = formInputs }) + st.internal + } + H.raise $ Changed $ getPublicState new + pure a + + Receive { render, validators } a -> do + let applyOver = over InternalState (_ { validators = validators }) + modifyStore_ render (\st -> st { internal = applyOver st.internal }) + pure a + + AndThen q1 q2 a -> do + void (eval q1) + void (eval q2) + pure a + + -- Remove internal fields and return the public state + getPublicState :: State form m -> PublicState form + getPublicState = Record.delete (SProxy :: SProxy "internal") + + -- Run submission without raising messages or replies + runSubmit :: DSL pq cq cs form m (Maybe (form Record OutputField)) + runSubmit = do + init <- modifyState \st -> st + { submitAttempts = st.submitAttempts + 1 + , submitting = true + } + + -- For performance purposes, avoid running this if possible + let internal = unwrap init.internal + when (not internal.allTouched) do + modifyState_ _ + { form = Internal.setFormFieldsTouched init.form + , internal = over InternalState (_ { allTouched = true }) init.internal + } + + -- Necessary to validate after fields are touched, but before parsing + _ <- eval $ ValidateAll unit + + -- For performance purposes, only attempt to submit if the form is valid + validated <- getState + modifyState_ \st -> st { submitting = false } + pure $ + if validated.validity == Valid + then Internal.formFieldsToMaybeOutputFields validated.form + else Nothing diff --git a/src/Formless/Query.purs b/src/Formless/Query.purs new file mode 100644 index 0000000..042eebd --- /dev/null +++ b/src/Formless/Query.purs @@ -0,0 +1,181 @@ +-- | This module exports helpers for working with Formless queries. +-- | Since many queries are used as actions and may involve injecting +-- | variants, these helpers are provided to remove any associated +-- | boilerplate. Prefer these over using data constructors from the +-- | Formless query algebra. +module Formless.Query where + +import Prelude + +import Data.Newtype (class Newtype, wrap) +import Data.Symbol (class IsSymbol, SProxy) +import Data.Variant (Variant, inj) +import Formless.Class.Initial (class Initial, initial) +import Formless.Types.Form (InputField, InputFunction, U(..)) +import Formless.Types.Component (Query(..)) +import Halogen.Component.ChildPath (ChildPath, injQuery, injSlot) +import Prim.Row as Row + +-- | For use when you need to query a component through Formless +send :: ∀ pq cs cq form m a + . cs + -> cq a + -> Query pq cq cs form m a +send p q = Send p q + +-- | When you are using several different types of child components in Formless +-- | the component needs a child path to be able to pick the right slot to send +-- | a query to. +send' :: ∀ pq cq' cs' cs cq form m a + . ChildPath cq cq' cs cs' + -> cs + -> cq a + -> Query pq cq' cs' form m a +send' path p q = Send (injSlot path p) (injQuery path q) + +-- | Set the input value of a form field at the specified label +set + :: ∀ pq cq cs form inputs m sym t0 e i o a + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) t0 inputs + => SProxy sym + -> i + -> a + -> Query pq cq cs form m a +set sym i = ModifyInput (wrap (inj sym (wrap (const i)))) + +-- | Set the input value of a form field at the specified label, as an action. +set_ + :: ∀ pq cq cs form inputs m sym t0 e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) t0 inputs + => SProxy sym + -> i + -> Query pq cq cs form m Unit +set_ sym i = ModifyInput (wrap (inj sym (wrap (const i)))) unit + +-- | Set the input value of a form field at the specified label, also triggering +-- | validation to run on the field. +setValidate + :: ∀ pq cq cs form inputs m sym t0 e i o a + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) t0 inputs + => SProxy sym + -> i + -> a + -> Query pq cq cs form m a +setValidate sym i = ModifyValidateInput (wrap (inj sym (wrap (const i)))) + +-- | Set the input value of a form field at the specified label, also triggering +-- | validation to run on the field, as an action. +setValidate_ + :: ∀ pq cq cs form inputs m sym t0 e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) t0 inputs + => SProxy sym + -> i + -> Query pq cq cs form m Unit +setValidate_ sym i = ModifyValidateInput (wrap (inj sym (wrap (const i)))) unit + +-- | ModifyInput the input value of a form field at the specified label with the +-- | provided function. +modify + :: ∀ pq cq cs form inputs m sym t0 e i o a + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) t0 inputs + => SProxy sym + -> (i -> i) + -> a + -> Query pq cq cs form m a +modify sym f = ModifyInput (wrap (inj sym (wrap f))) + +-- | ModifyInput the input value of a form field at the specified label, as an action, +-- | with the provided function. +modify_ + :: ∀ pq cq cs form inputs m sym t0 e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) t0 inputs + => SProxy sym + -> (i -> i) + -> Query pq cq cs form m Unit +modify_ sym f = ModifyInput (wrap (inj sym (wrap f))) unit + +-- | ModifyInput the input value of a form field at the specified label, also triggering +-- | validation to run on the field, with the provided function. +modifyValidate + :: ∀ pq cq cs form inputs m sym t0 e i o a + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) t0 inputs + => SProxy sym + -> (i -> i) + -> a + -> Query pq cq cs form m a +modifyValidate sym f = ModifyValidateInput (wrap (inj sym (wrap f))) + +-- | ModifyInput the input value of a form field at the specified label, also triggering +-- | validation to run on the field, as an action, with the provided function. +modifyValidate_ + :: ∀ pq cq cs form inputs m sym t0 e i o + . IsSymbol sym + => Newtype (form Variant InputFunction) (Variant inputs) + => Row.Cons sym (InputFunction e i o) t0 inputs + => SProxy sym + -> (i -> i) + -> Query pq cq cs form m Unit +modifyValidate_ sym f = ModifyValidateInput (wrap (inj sym (wrap f))) unit + +-- | Reset the value of the specified form field to its default value +-- | according to the `Initial` type class. +reset + :: ∀ pq cq cs form inputs m sym a t0 e i o + . IsSymbol sym + => Initial i + => Newtype (form Variant InputField) (Variant inputs) + => Row.Cons sym (InputField e i o) t0 inputs + => SProxy sym + -> a + -> Query pq cq cs form m a +reset sym = ResetInput (wrap (inj sym (wrap initial))) + +-- | Reset the value of the specified form field to its default value +-- | according to the `Initial` type class, as an action. +reset_ + :: ∀ pq cq cs form inputs m sym t0 e i o + . IsSymbol sym + => Initial i + => Newtype (form Variant InputField) (Variant inputs) + => Row.Cons sym (InputField e i o) t0 inputs + => SProxy sym + -> Query pq cq cs form m Unit +reset_ sym = ResetInput (wrap (inj sym (wrap initial))) unit + +-- | A helper to create the correct `Validate` query for Formless, given +-- | a label +validate + :: ∀ pq cq cs form us m sym a t0 e i o + . IsSymbol sym + => Newtype (form Variant U) (Variant us) + => Row.Cons sym (U e i o) t0 us + => SProxy sym + -> a + -> Query pq cq cs form m a +validate sym = ValidateInput (wrap (inj sym U)) + +-- | A helper to create the correct `Validate` query for Formless given +-- | a label, as an action +validate_ + :: ∀ pq cq cs form us m sym t0 e i o + . IsSymbol sym + => Newtype (form Variant U) (Variant us) + => Row.Cons sym (U e i o) t0 us + => SProxy sym + -> Query pq cq cs form m Unit +validate_ sym = ValidateInput (wrap (inj sym U)) unit + diff --git a/src/Spec/Retrieve.purs b/src/Formless/Retrieve.purs similarity index 56% rename from src/Spec/Retrieve.purs rename to src/Formless/Retrieve.purs index 04abe1b..66cfa10 100644 --- a/src/Spec/Retrieve.purs +++ b/src/Formless/Retrieve.purs @@ -1,32 +1,25 @@ -- | A module with functions for retriving particular fields from a form -module Formless.Spec.Retrieve where +module Formless.Retrieve where import Prelude import Data.Either (Either, either, hush) -import Data.Lens (preview, view) +import Data.Lens (Lens', preview, view) +import Data.Lens.Iso.Newtype (_Newtype) +import Data.Lens.Prism.Either (_Left, _Right) +import Data.Lens.Prism.Maybe (_Just) +import Data.Lens.Record (prop) +import Data.Lens.Traversal (Traversal') import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, unwrap) -import Data.Symbol (class IsSymbol, SProxy) -import Formless.Spec (FormField(..), FormFieldRow, _Error, _Field, _Input, _Output, _Result, _Touched) +import Data.Symbol (class IsSymbol, SProxy(..)) +import Formless.Types.Form (FormField(..), FormFieldRow) import Heterogeneous.Mapping (class HMap, class Mapping, hmap) import Prim.Row as Row ---------- -- Fields --- | A type representing a function to produce a value from a record of --- | form fields given a particular symbol. The result of `view` from --- | Data.Lens applied with a particular lens to the form. -type FormFieldGet e i o x = - ∀ sym form fields t0 - . IsSymbol sym - => Newtype (form Record FormField) (Record fields) - => Row.Cons sym (FormField e i o) t0 fields - => SProxy sym - -> form Record FormField - -> x - -- | Given a form, get the field at the specified symbol getField :: ∀ e i o. FormFieldGet e i o (Record (FormFieldRow e i o)) getField sym = view (_Field sym) @@ -51,10 +44,94 @@ getError sym = preview (_Error sym) getOutput :: ∀ e i o. FormFieldGet e i o (Maybe o) getOutput sym = preview (_Output sym) - ---------- -- Summary functions +-- | Get the form as a record where all fields are only the input value +getInputAll :: GetAll GetInputField +getInputAll = hmap GetInputField <<< unwrap + +-- | Get the form as a record where all fields are only the touched value +getTouchedAll :: GetAll GetTouchedField +getTouchedAll = hmap GetTouchedField <<< unwrap + +-- | Get the form as a record where all fields are only the result value +getResultAll :: GetAll GetResultField +getResultAll = hmap GetResultField <<< unwrap + +-- | Get the form as a record where all fields are only the error value +getErrorAll :: GetAll GetError +getErrorAll = hmap GetError <<< unwrap + +-- | Get the form as a record where all fields are only the output value +getOutputAll :: GetAll GetOutput +getOutputAll = hmap GetOutput <<< unwrap + +---------- +-- Lenses + +-- | A lens to operate on the field at a given symbol in your form +_Field :: ∀ e i o. FormFieldLens e i o (Record (FormFieldRow e i o)) +_Field sym = _Newtype <<< prop sym <<< _Newtype + +-- | A lens to operate on the input at a given symbol in your form +_Input :: ∀ e i o. FormFieldLens e i o i +_Input sym = _Field sym <<< prop (SProxy :: SProxy "input") + +-- | A lens to operate on the 'touched' field at a given symbol in your form +_Touched :: ∀ e i o. FormFieldLens e i o Boolean +_Touched sym = _Field sym <<< prop (SProxy :: SProxy "touched") + +-- | A lens to operate on the 'result' field at a given symbol in your form +_Result :: ∀ e i o. FormFieldLens e i o (Maybe (Either e o)) +_Result sym = _Field sym <<< prop (SProxy :: SProxy "result") + +-- | A traversal to operate on the possible error inside the 'result' field at +-- | a given symbol in your form +_Error + :: ∀ sym form fields t0 e i o + . IsSymbol sym + => Newtype (form Record FormField) (Record fields) + => Row.Cons sym (FormField e i o) t0 fields + => SProxy sym + -> Traversal' (form Record FormField) e +_Error sym = _Result sym <<< _Just <<< _Left + +-- | A traversal to operate on the possible output inside the 'result' field at +-- | a given symbol in your form +_Output + :: ∀ sym form fields t0 e i o + . IsSymbol sym + => Newtype (form Record FormField) (Record fields) + => Row.Cons sym (FormField e i o) t0 fields + => SProxy sym + -> Traversal' (form Record FormField) o +_Output sym = _Result sym <<< _Just <<< _Right + +---------- +-- Types + +-- | A type representing a function to produce a value from a record of +-- | form fields given a particular symbol. The result of `view` from +-- | Data.Lens applied with a particular lens to the form. +type FormFieldGet e i o x = + ∀ sym form fields t0 + . IsSymbol sym + => Newtype (form Record FormField) (Record fields) + => Row.Cons sym (FormField e i o) t0 fields + => SProxy sym + -> form Record FormField + -> x + +-- | A type representing a lens onto part of a form field +type FormFieldLens e i o x = + ∀ sym form fields t0 + . IsSymbol sym + => Newtype (form Record FormField) (Record fields) + => Row.Cons sym (FormField e i o) t0 fields + => SProxy sym + -> Lens' (form Record FormField) x + -- | A type representing retrieving all of a particular field with the field's -- | constructor name. For internal use. type GetAll f = @@ -64,52 +141,37 @@ type GetAll f = => form Record FormField -> r1 - +-- | Data constructor for the getInputField function data GetInputField = GetInputField +-- | Heterogeneous type class for the getInputField function instance getInputField :: Mapping GetInputField (FormField e i o) i where mapping GetInputField (FormField { input }) = input --- | Get the form as a record where all fields are only the input value -getInputAll :: GetAll GetInputField -getInputAll = hmap GetInputField <<< unwrap - - +-- | Data constructor for the getTouchedField function data GetTouchedField = GetTouchedField +-- | Heterogeneous type class for the getTouchedField function instance getTouchedField :: Mapping GetTouchedField (FormField e i o) Boolean where mapping GetTouchedField (FormField { touched }) = touched --- | Get the form as a record where all fields are only the touched value -getTouchedAll :: GetAll GetTouchedField -getTouchedAll = hmap GetTouchedField <<< unwrap - - +-- | Data constructor for the getResultField function data GetResultField = GetResultField +-- | Heterogeneous type class for the getResultField function instance getResultField :: Mapping GetResultField (FormField e i o) (Maybe (Either e o)) where mapping GetResultField (FormField { result }) = result --- | Get the form as a record where all fields are only the result value -getResultAll :: GetAll GetResultField -getResultAll = hmap GetResultField <<< unwrap - - +-- | Data constructor for the getError function data GetError = GetError +-- | Heterogeneous type class for the getError function instance getErrorResult' :: Mapping GetError (FormField e i o) (Maybe e) where mapping GetError (FormField { result }) = join $ either Just (const Nothing) <$> result --- | Get the form as a record where all fields are only the error value -getErrorAll :: GetAll GetError -getErrorAll = hmap GetError <<< unwrap - - +-- | Data constructor for the getOutput function data GetOutput = GetOutput +-- | Heterogeneous type class for the getOutput function instance getOutput' :: Mapping GetOutput (FormField e i o) (Maybe o) where mapping GetOutput (FormField { result }) = join $ hush <$> result - --- | Get the form as a record where all fields are only the output value -getOutputAll :: GetAll GetOutput -getOutputAll = hmap GetOutput <<< unwrap diff --git a/src/Transform/Internal.purs b/src/Formless/Transform/Internal.purs similarity index 96% rename from src/Transform/Internal.purs rename to src/Formless/Transform/Internal.purs index 628cf03..7fc85ed 100644 --- a/src/Transform/Internal.purs +++ b/src/Formless/Transform/Internal.purs @@ -9,7 +9,7 @@ import Data.Symbol (class IsSymbol, SProxy(..)) import Data.Tuple (Tuple(..), fst, snd) import Data.Variant (Variant) import Data.Variant.Internal (VariantRep(..)) -import Formless.Spec (FormField(..), InputField(..), OutputField(..), U, FormFieldRow) +import Formless.Types.Form (FormField(..), FormFieldRow, InputField(..), InputFunction, OutputField(..), U) import Formless.Validation (Validation, runValidation) import Prim.Row as Row import Prim.RowList as RL @@ -137,24 +137,24 @@ applyValidation vs fs = map wrap $ fromScratch <$> builder ---------- -- Don't Tell Your Boss --- | Given a variant of InputField and a record with the same labels but +-- | Given a variant of InputFunction and a record with the same labels but -- | FormField values, replace the input of the form field. -unsafeSetInputVariant +unsafeModifyInputVariant :: ∀ form x y - . Newtype (form Variant InputField) (Variant x) + . Newtype (form Variant InputFunction) (Variant x) => Newtype (form Record FormField) { | y } - => form Variant InputField + => form Variant InputFunction -> form Record FormField -> form Record FormField -unsafeSetInputVariant var rec = wrap $ unsafeSet (fst rep) val (unwrap rec) +unsafeModifyInputVariant var rec = wrap $ unsafeSet (fst rep) val (unwrap rec) where - rep :: ∀ e i o. Tuple String (InputField e i o) + rep :: ∀ e i o. Tuple String (InputFunction e i o) rep = case unsafeCoerce (unwrap var) of VariantRep x -> Tuple x.type x.value val :: ∀ e i o. FormField e i o val = case unsafeGet (fst rep) (unwrap rec) of - FormField x -> FormField $ x { input = unwrap (snd rep) } + FormField x -> FormField $ x { input = unwrap (snd rep) $ x.input } unsafeRunValidationVariant :: ∀ form x y z m diff --git a/src/Transform/Record.purs b/src/Formless/Transform/Record.purs similarity index 95% rename from src/Transform/Record.purs rename to src/Formless/Transform/Record.purs index f865bcf..9047c65 100644 --- a/src/Transform/Record.purs +++ b/src/Formless/Transform/Record.purs @@ -3,7 +3,7 @@ module Formless.Transform.Record where import Prelude import Data.Newtype (class Newtype, unwrap, wrap) -import Formless.Spec (InputField, OutputField) +import Formless.Types.Form (InputField, OutputField) import Heterogeneous.Mapping as HM -- | Unwrap every newtype in a record filled with newtypes diff --git a/src/Transform/Row.purs b/src/Formless/Transform/Row.purs similarity index 98% rename from src/Transform/Row.purs rename to src/Formless/Transform/Row.purs index 92815f2..fa2f905 100644 --- a/src/Transform/Row.purs +++ b/src/Formless/Transform/Row.purs @@ -5,7 +5,7 @@ import Prelude import Data.Newtype (class Newtype, wrap) import Data.Symbol (class IsSymbol, SProxy(..)) import Formless.Class.Initial (class Initial, initial) -import Formless.Spec (FormProxy, InputField(..)) +import Formless.Types.Form (FormProxy, InputField(..)) import Formless.Transform.Internal (class Row1Cons, FromScratch, fromScratch) import Prim.Row as Row import Prim.RowList as RL diff --git a/src/Formless/Types/Component.purs b/src/Formless/Types/Component.purs new file mode 100644 index 0000000..7e2bdf5 --- /dev/null +++ b/src/Formless/Types/Component.purs @@ -0,0 +1,128 @@ +module Formless.Types.Component where + +import Prelude + +import Control.Comonad.Store (Store) +import Data.Const (Const) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Maybe (Maybe) +import Data.Newtype (class Newtype) +import Data.Variant (Variant) +import Formless.Types.Form (FormField, InputField, InputFunction, OutputField, U) +import Formless.Validation (Validation) +import Halogen as H +import Halogen.HTML as HH + +-- | The component query type. See Formless.Query for helpers related +-- | to constructing and using these queries. +data Query pq cq cs form m a + = ModifyInput (form Variant InputFunction) a + | ValidateInput (form Variant U) a + | ModifyValidateInput (form Variant InputFunction) a + | ResetInput (form Variant InputField) a + | ResetAll a + | ValidateAll a + | Submit a + | SubmitReply (Maybe (form Record OutputField) -> a) + | GetState (PublicState form -> a) + | Send cs (cq a) + | SyncFormData a + | Raise (pq Unit) a + | ReplaceInputs (form Record InputField) a + | Receive (Input pq cq cs form m) a + | AndThen (Query pq cq cs form m Unit) (Query pq cq cs form m Unit) a + +-- | The overall component state type, which contains the local state type +-- | and also the render function +type StateStore pq cq cs form m = + Store (State form m) (HTML pq cq cs form m) + +-- | The component type +type Component pq cq cs form m + = H.Component + HH.HTML + (Query pq cq cs form m) + (Input pq cq cs form m) + (Message pq form) + m + +-- | The component's HTML type, the result of the render function. +type HTML pq cq cs form m + = H.ParentHTML (Query pq cq cs form m) cq cs m + +-- | The component's DSL type, the result of the eval function. +type DSL pq cq cs form m + = H.ParentDSL + (StateStore pq cq cs form m) + (Query pq cq cs form m) + cq + cs + (Message pq form) + m + +-- | The component local state +type State form m = Record (StateRow form (internal :: InternalState form m)) + +-- | The component's public state +type PublicState form = Record (StateRow form ()) + +-- | The component's public state +type StateRow form r = + ( validity :: ValidStatus + , dirty :: Boolean + , submitting :: Boolean + , errors :: Int + , submitAttempts :: Int + , form :: form Record FormField + | r + ) + +-- | A newtype to make easier type errors for end users to +-- | read by hiding internal fields +newtype InternalState form m = InternalState + { initialInputs :: form Record InputField + , validators :: form Record (Validation form m) + , allTouched :: Boolean + } +derive instance newtypeInternalState :: Newtype (InternalState form m) _ + +-- | A type to represent validation status +data ValidStatus + = Invalid + | Incomplete + | Valid +derive instance genericValidStatus :: Generic ValidStatus _ +derive instance eqValidStatus :: Eq ValidStatus +derive instance ordValidStatus :: Ord ValidStatus +instance showValidStatus :: Show ValidStatus where + show = genericShow + +-- | The component's input type +type Input pq cq cs form m = + { initialInputs :: form Record InputField + , validators :: form Record (Validation form m) + , render :: State form m -> HTML pq cq cs form m + } + +-- | The component tries to require as few messages to be handled as possible. You +-- | can always use the *Reply variants of queries to perform actions and receive +-- | a result out the other end. +data Message pq form + = Submitted (form Record OutputField) + | Changed (PublicState form) + | Emit (pq Unit) + +-- | Simple types + +-- | A simple query type when you have no child slots in use +type Query' form m = Query (Const Void) (Const Void) Void form m + +-- | A simple HTML type when the component does not need embedding +type HTML' form m = H.ParentHTML (Query' form m) (Const Void) Void m + +-- | A simple Message type when the component does not need embedding +type Message' form = Message (Const Void) form + +-- | A simple Input type when the component does not need embedding +type Input' form m = Input (Const Void) (Const Void) Void form m diff --git a/src/Formless/Types/Form.purs b/src/Formless/Types/Form.purs new file mode 100644 index 0000000..2556311 --- /dev/null +++ b/src/Formless/Types/Form.purs @@ -0,0 +1,57 @@ +module Formless.Types.Form where + +import Prelude + +import Data.Either (Either) +import Data.Maybe (Maybe) +import Data.Newtype (class Newtype) + +-- | Create a proxy for your form type, for use with functions that generate records from +-- | form proxies. +data FormProxy (form :: (# Type -> Type) -> (Type -> Type -> Type -> Type) -> Type) = FormProxy + +-- | A wrapper to represent only the input type. Requires that `eq` is defined for the input +-- | type in order to track dirty states. +newtype InputField error input output = InputField input +derive instance newtypeInputField :: Newtype (InputField e i o) _ +derive newtype instance eqInputField :: Eq i => Eq (InputField e i o) + +-- | A wrapper to represent only the output type. Used to represent +-- | form results at the end of validation. +newtype OutputField error input output = OutputField output +derive instance newtypeOutputField :: Newtype (OutputField e i o) _ +derive newtype instance eqOutputField :: Eq o => Eq (OutputField e i o) + +-- | Represents a unit value with the correct number of arguments; largely for internal use. +data U e i o = U + +-- | Represents modifications to input fields +newtype InputFunction error input output = InputFunction (input -> input) +derive instance newtypeInputFunction :: Newtype (InputFunction e i o) _ + +-- | The type that we need to record state across the form +newtype FormField e i o = FormField (Record (FormFieldRow e i o)) +derive instance newtypeFormField :: Newtype (FormField e i o) _ +derive newtype instance eqFormField :: (Eq e, Eq i, Eq o) => Eq (FormField e i o) + +-- | The row used for the FormField newtype and in lens type signatures +type FormFieldRow error input output = + ( input :: input + , touched :: Boolean + , result :: Maybe (Either error output) + ) + +---------- +-- Helpers + +-- | A type synonym that lets you pick out just the error type from +-- | your form row. +type ErrorType error input output = error + +-- | A type synonym that lets you pick out just the input type from +-- | your form row. +type InputType error input output = input + +-- | A type synonym that lets you pick out just the output type from +-- | your form row. +type OutputType error input output = output diff --git a/src/Validation/Validation.purs b/src/Formless/Validation.purs similarity index 91% rename from src/Validation/Validation.purs rename to src/Formless/Validation.purs index 2b861f9..0a70414 100644 --- a/src/Validation/Validation.purs +++ b/src/Formless/Validation.purs @@ -5,19 +5,61 @@ import Prelude import Control.Alt (class Alt, (<|>)) import Data.Either (Either(..), either) import Data.Newtype (class Newtype, unwrap, wrap) -import Formless.Spec (FormField, InputField) +import Formless.Types.Form (FormField, InputField) import Heterogeneous.Mapping (class MapRecordWithIndex, class Mapping, ConstMapping, hmap) import Prim.RowList (class RowToList) ---------- --- Helpers +-- Core type --- A way to create a record of hoistFn_ identity for a data type when no validation is needed. -data EmptyValidators = EmptyValidators +-- | A wrapper to represent the validation function on a form field, which can itself take +-- | the form state as its first argument. Inspired in some parts by the Validation type +-- | from purescript-polyform by @paluh. +newtype Validation form m error input output = Validation (form Record FormField -> input -> m (Either error output)) +derive instance newtypeValidation :: Newtype (Validation form m e i o) _ +derive instance functorValidation :: Functor m => Functor (Validation form m e i) + +instance applyValidation :: Monad m => Apply (Validation form m e i) where + apply vf va = Validation \form i -> do + vf' <- unwrap vf form i + va' <- unwrap va form i + pure $ vf' <*> va' + +instance applicativeValidation :: Monad m => Applicative (Validation form m e i) where + pure = Validation <<< const <<< const <<< pure <<< pure + +instance altValidation :: Monad m => Alt (Validation form m e i) where + alt v0 v1 = Validation \form i -> do + v0' <- unwrap v0 form i + v1' <- unwrap v1 form i + pure $ v0' <|> v1' + +instance semigroupValidation :: Semigroup (m (Either e o)) => Semigroup (Validation form m e i o) where + append (Validation v0) (Validation v1) = Validation \form i -> v0 form i <> v1 form i + +instance monoidValidation + :: (Applicative m, Monoid (m (Either e o)), Semigroup (m (Either e o))) + => Monoid (Validation form m e i o) where + mempty = Validation <<< const <<< pure $ mempty + +instance semigroupoidValidation :: Monad m => Semigroupoid (Validation form m e) where + compose v1 v0 = Validation \form i -> do + eo <- unwrap v0 form i + either (pure <<< Left) (unwrap v1 form) eo + +instance categoryValidation :: Monad m => Category (Validation form m e) where + identity = Validation $ \_ -> pure <<< pure -instance emptyValidators :: Monad m => Mapping EmptyValidators a (Validation form m e i i) where - mapping EmptyValidators = const (hoistFn_ identity) +---------- +-- Helpers + +-- | A more verbose but clearer function for running a validation function on its inputs +runValidation :: ∀ form m e i o. Monad m => Validation form m e i o -> form Record FormField -> i -> m (Either e o) +runValidation = unwrap + +-- | A function to create a record of validators that simply pass through all inputs +-- | for when no validation is needed. Provide this as your `validators` function. noValidation :: ∀ form fields m vs xs . Monad m @@ -29,10 +71,6 @@ noValidation -> form Record (Validation form m) noValidation = wrap <<< hmap EmptyValidators <<< unwrap --- | A more verbose but clearer function for running a validation function on its inputs -runValidation :: ∀ form m e i o. Monad m => Validation form m e i o -> form Record FormField -> i -> m (Either e o) -runValidation = unwrap - -- | Turn a function from (form Record FormField -> i -> o) into a proper Validation hoistFn :: ∀ form m e i o. Monad m => (form Record FormField -> i -> o) -> Validation form m e i o hoistFn f = Validation $ \form -> pure <<< pure <<< f form @@ -57,44 +95,13 @@ hoistFnME = Validation hoistFnME_ :: ∀ form m e i o. Monad m => (i -> m (Either e o)) -> Validation form m e i o hoistFnME_ = Validation <<< const ----------- --- Core type - --- | A wrapper to represent the validation function on a form field, which can itself take --- | the form state as its first argument. Inspired in some parts by the Validation type --- | from purescript-polyform by @paluh. -newtype Validation form m error input output = Validation (form Record FormField -> input -> m (Either error output)) -derive instance newtypeValidation :: Newtype (Validation form m e i o) _ -derive instance functorValidation :: Functor m => Functor (Validation form m e i) - -instance applyValidation :: Monad m => Apply (Validation form m e i) where - apply vf va = Validation \form i -> do - vf' <- unwrap vf form i - va' <- unwrap va form i - pure $ vf' <*> va' - -instance applicativeValidation :: Monad m => Applicative (Validation form m e i) where - pure = Validation <<< const <<< const <<< pure <<< pure -instance altValidation :: Monad m => Alt (Validation form m e i) where - alt v0 v1 = Validation \form i -> do - v0' <- unwrap v0 form i - v1' <- unwrap v1 form i - pure $ v0' <|> v1' - -instance semigroupValidation :: Semigroup (m (Either e o)) => Semigroup (Validation form m e i o) where - append (Validation v0) (Validation v1) = Validation \form i -> v0 form i <> v1 form i - -instance monoidValidation - :: (Applicative m, Monoid (m (Either e o)), Semigroup (m (Either e o))) - => Monoid (Validation form m e i o) where - mempty = Validation <<< const <<< pure $ mempty - -instance semigroupoidValidation :: Monad m => Semigroupoid (Validation form m e) where - compose v1 v0 = Validation \form i -> do - eo <- unwrap v0 form i - either (pure <<< Left) (unwrap v1 form) eo +---------- +-- Helper Types -instance categoryValidation :: Monad m => Category (Validation form m e) where - identity = Validation $ \_ -> pure <<< pure +-- | The data type used for the noValidation function's heterogenous instance +data EmptyValidators = EmptyValidators +-- | The heterogeneous instance the noValidation function +instance emptyValidators :: Monad m => Mapping EmptyValidators a (Validation form m e i i) where + mapping EmptyValidators = const (hoistFn_ identity) diff --git a/src/Spec/Spec.purs b/src/Spec/Spec.purs deleted file mode 100644 index 9847df9..0000000 --- a/src/Spec/Spec.purs +++ /dev/null @@ -1,121 +0,0 @@ -module Formless.Spec where - -import Prelude - -import Data.Either (Either) -import Data.Lens (Lens') -import Data.Lens.Iso.Newtype (_Newtype) -import Data.Lens.Prism.Either (_Left, _Right) -import Data.Lens.Prism.Maybe (_Just) -import Data.Lens.Record (prop) -import Data.Lens.Traversal (Traversal') -import Data.Maybe (Maybe) -import Data.Newtype (class Newtype) -import Data.Symbol (class IsSymbol, SProxy(..)) -import Prim.Row as Row - --- | Create a proxy for your form type, for use with functions that generate records from --- | form proxies. -data FormProxy (form :: (# Type -> Type) -> (Type -> Type -> Type -> Type) -> Type) = FormProxy - --- | A wrapper to represent only the input type. Requires that `eq` is defined for the input --- | type in order to track dirty states. -newtype InputField error input output = InputField input -derive instance newtypeInputField :: Newtype (InputField e i o) _ -derive newtype instance eqInputField :: Eq i => Eq (InputField e i o) - --- | A wrapper to represent only the output type. Used to represent --- | form results at the end of validation. -newtype OutputField error input output = OutputField output -derive instance newtypeOutputField :: Newtype (OutputField e i o) _ -derive newtype instance eqOutputField :: Eq o => Eq (OutputField e i o) - --- | Represents a unit value with the correct number of arguments; largely for internal use. -data U e i o = U - --- | The type that we need to record state across the form -newtype FormField e i o = FormField (Record (FormFieldRow e i o)) -derive instance newtypeFormField :: Newtype (FormField e i o) _ -derive newtype instance eqFormField :: (Eq e, Eq i, Eq o) => Eq (FormField e i o) - --- | The row used for the FormField newtype and in lens type signatures -type FormFieldRow error input output = - ( input :: input - , touched :: Boolean - , result :: Maybe (Either error output) - ) - --- | Proxy for the 'input' field of a form field -_input = SProxy :: SProxy "input" - --- | Proxy for the 'touched' field of a form field -_touched = SProxy :: SProxy "touched" - --- | Proxy for the 'result' field of a form field -_result = SProxy :: SProxy "result" - - ----------- --- Helpers - --- | A type synonym that lets you pick out just the error type from --- | your form row. -type ErrorType error input output = error - --- | A type synonym that lets you pick out just the input type from --- | your form row. -type InputType error input output = input - --- | A type synonym that lets you pick out just the output type from --- | your form row. -type OutputType error input output = output - ----------- --- Lenses - -type FormFieldLens e i o x = - ∀ sym form fields t0 - . IsSymbol sym - => Newtype (form Record FormField) (Record fields) - => Row.Cons sym (FormField e i o) t0 fields - => SProxy sym - -> Lens' (form Record FormField) x - --- | A lens to operate on the field at a given symbol in your form -_Field :: ∀ e i o. FormFieldLens e i o (Record (FormFieldRow e i o)) -_Field sym = _Newtype <<< prop sym <<< _Newtype - --- | A lens to operate on the input at a given symbol in your form -_Input :: ∀ e i o. FormFieldLens e i o i -_Input sym = _Field sym <<< prop _input - --- | A lens to operate on the 'touched' field at a given symbol in your form -_Touched :: ∀ e i o. FormFieldLens e i o Boolean -_Touched sym = _Field sym <<< prop _touched - --- | A lens to operate on the 'result' field at a given symbol in your form -_Result :: ∀ e i o. FormFieldLens e i o (Maybe (Either e o)) -_Result sym = _Field sym <<< prop _result - --- | A traversal to operate on the possible error inside the 'result' field at --- | a given symbol in your form -_Error - :: ∀ sym form fields t0 e i o - . IsSymbol sym - => Newtype (form Record FormField) (Record fields) - => Row.Cons sym (FormField e i o) t0 fields - => SProxy sym - -> Traversal' (form Record FormField) e -_Error sym = _Result sym <<< _Just <<< _Left - --- | A traversal to operate on the possible output inside the 'result' field at --- | a given symbol in your form -_Output - :: ∀ sym form fields t0 e i o - . IsSymbol sym - => Newtype (form Record FormField) (Record fields) - => Row.Cons sym (FormField e i o) t0 fields - => SProxy sym - -> Traversal' (form Record FormField) o -_Output sym = _Result sym <<< _Just <<< _Right - From 742a9381bef2b4745def457dd4f84dca2223cecd Mon Sep 17 00:00:00 2001 From: "Thomas R. Honeyman" Date: Fri, 19 Oct 2018 20:03:45 -0700 Subject: [PATCH 2/5] Update examples --- example/App/UI/Element.purs | 6 +++--- example/basic/Component.purs | 4 ++-- example/external-components/Component.purs | 6 +++--- example/real-world/Component.purs | 14 +++++++------- example/real-world/Render/GroupForm.purs | 4 ++-- example/real-world/Render/OptionsForm.purs | 8 ++++---- 6 files changed, 21 insertions(+), 21 deletions(-) diff --git a/example/App/UI/Element.purs b/example/App/UI/Element.purs index 02300cc..172c02a 100644 --- a/example/App/UI/Element.purs +++ b/example/App/UI/Element.purs @@ -160,9 +160,9 @@ formlessField . IsSymbol sym => ToText e => Newtype (form Record F.FormField) (Record fields) - => Newtype (form Variant F.InputField) (Variant inputs) + => Newtype (form Variant F.InputFunction) (Variant inputs) => Cons sym (F.FormField e String o) t0 fields - => Cons sym (F.InputField e String o) t1 inputs + => Cons sym (F.InputFunction e String o) t1 inputs => ( FieldConfig' -> Array ( HH.IProp ( value :: String, onBlur :: FocusEvent, onInput :: Event | r) @@ -183,5 +183,5 @@ formlessField fieldType config state = fieldType (Builder.build config' config) props = [ HP.value (F.getInput config.sym state.form) - , HE.onValueInput $ HE.input $ F.modifyValidate config.sym + , HE.onValueInput $ HE.input $ F.setValidate config.sym ] diff --git a/example/basic/Component.purs b/example/basic/Component.purs index 34d6778..5924fe6 100644 --- a/example/basic/Component.purs +++ b/example/basic/Component.purs @@ -81,7 +81,7 @@ renderFormless state = , placeholder: "Dale" } [ HP.value $ F.getInput _name state.form - , HE.onValueInput $ HE.input $ F.modifyValidate _name + , HE.onValueInput $ HE.input $ F.setValidate _name ] , UI.textarea { label: "Message" @@ -89,7 +89,7 @@ renderFormless state = , placeholder: "We prefer nice messages, but have at it." } [ HP.value $ F.getInput _text state.form - , HE.onValueInput $ HE.input $ F.modify _text + , HE.onValueInput $ HE.input $ F.set _text ] , UI.buttonPrimary [ HE.onClick $ HE.input_ F.Submit ] diff --git a/example/external-components/Component.purs b/example/external-components/Component.purs index 93184b2..9c391ba 100644 --- a/example/external-components/Component.purs +++ b/example/external-components/Component.purs @@ -69,13 +69,13 @@ component = Typeahead slot (TA.SelectionsChanged new) a -> case slot of Email -> a <$ do - H.query unit $ F.modifyValidate_ prx.email new + H.query unit $ F.setValidate_ prx.email new Whiskey -> a <$ do - _ <- H.query unit $ F.modifyValidate_ prx.whiskey new + _ <- H.query unit $ F.setValidate_ prx.whiskey new -- We'll clear the email field when a new whiskey is selected _ <- H.query unit $ F.reset_ prx.email H.query unit $ F.send Email (H.action TA.Clear) Language -> a <$ do - H.query unit $ F.modifyValidate_ prx.language new + H.query unit $ F.setValidate_ prx.language new diff --git a/example/real-world/Component.purs b/example/real-world/Component.purs index 930f4f1..0387213 100644 --- a/example/real-world/Component.purs +++ b/example/real-world/Component.purs @@ -156,22 +156,22 @@ component = pure a TASingle (TA.SelectionsChanged new) a -> a <$ do - H.query' CP.cp1 unit $ F.modifyValidate_ G.prx.whiskey new + H.query' CP.cp1 unit $ F.setValidate_ G.prx.whiskey new TAMulti slot (TA.SelectionsChanged new) a -> a <$ case slot of Applications -> - H.query' CP.cp1 unit $ F.modifyValidate_ G.prx.applications new + H.query' CP.cp1 unit $ F.setValidate_ G.prx.applications new Pixels -> - H.query' CP.cp1 unit $ F.modifyValidate_ G.prx.pixels new + H.query' CP.cp1 unit $ F.setValidate_ G.prx.pixels new AdminDropdown m a -> a <$ do _ <- H.query' CP.cp1 unit $ F.reset_ G.prx.secretKey1 _ <- H.query' CP.cp1 unit $ F.reset_ G.prx.secretKey2 case m of DD.Selected x -> do - H.query' CP.cp1 unit $ F.modifyValidate_ G.prx.admin (Just x) + H.query' CP.cp1 unit $ F.setValidate_ G.prx.admin (Just x) DD.Cleared -> do - H.query' CP.cp1 unit $ F.modifyValidate_ G.prx.admin Nothing + H.query' CP.cp1 unit $ F.setValidate_ G.prx.admin Nothing ----- -- Options Form @@ -200,6 +200,6 @@ component = MetricDropdown m a -> a <$ case m of DD.Selected x -> do - H.query' CP.cp2 unit $ F.modifyValidate_ O.prx.metric (Just x) + H.query' CP.cp2 unit $ F.setValidate_ O.prx.metric (Just x) DD.Cleared -> do - H.query' CP.cp2 unit $ F.modifyValidate_ O.prx.metric Nothing + H.query' CP.cp2 unit $ F.setValidate_ O.prx.metric Nothing diff --git a/example/real-world/Render/GroupForm.purs b/example/real-world/Render/GroupForm.purs index 965391e..5af6cc7 100644 --- a/example/real-world/Render/GroupForm.purs +++ b/example/real-world/Render/GroupForm.purs @@ -59,7 +59,7 @@ renderSecretKey1 st = } [ HP.value $ F.getInput prx.secretKey1 st.form , HE.onValueInput $ HE.input \str -> F.AndThen - (F.modifyValidate_ prx.secretKey1 str) + (F.setValidate_ prx.secretKey1 str) (F.validate_ prx.secretKey2) ] @@ -74,7 +74,7 @@ renderSecretKey2 st = } [ HP.value $ F.getInput prx.secretKey2 st.form , HE.onValueInput $ HE.input \str -> F.AndThen - (F.modifyValidate_ prx.secretKey2 str) + (F.setValidate_ prx.secretKey2 str) (F.validate_ prx.secretKey1) ] diff --git a/example/real-world/Render/OptionsForm.purs b/example/real-world/Render/OptionsForm.purs index 5964d0d..09cb2dc 100644 --- a/example/real-world/Render/OptionsForm.purs +++ b/example/real-world/Render/OptionsForm.purs @@ -72,7 +72,7 @@ renderEnabled state = [ css "checkbox" , HP.type_ InputCheckbox , HP.checked $ F.getInput prx.enable state.form - , HE.onChange $ HE.input_ $ F.modify prx.enable (not $ F.getInput prx.enable state.form) + , HE.onChange $ HE.input_ $ F.modify prx.enable not ] , HH.text " Enable extra options" ] @@ -149,7 +149,7 @@ renderSpeed state = , css "radio" , HP.type_ InputRadio , HP.checked $ speed.input == Low - , HE.onClick $ HE.input_ $ F.modify prx.speed Low + , HE.onClick $ HE.input_ $ F.set prx.speed Low ] , HH.text $ " " <> show Low ] @@ -160,7 +160,7 @@ renderSpeed state = , css "radio" , HP.type_ InputRadio , HP.checked $ speed.input == Medium - , HE.onClick $ HE.input_ $ F.modify prx.speed Medium + , HE.onClick $ HE.input_ $ F.set prx.speed Medium ] , HH.text $ " " <> show Medium ] @@ -171,7 +171,7 @@ renderSpeed state = , css "radio" , HP.type_ InputRadio , HP.checked $ speed.input == Fast - , HE.onClick $ HE.input_ $ F.modify prx.speed Fast + , HE.onClick $ HE.input_ $ F.set prx.speed Fast ] , HH.text $ " " <> show Fast ] From 0089c54870a5d609b4159e42f3d1f83b6d14dfd5 Mon Sep 17 00:00:00 2001 From: "Thomas R. Honeyman" Date: Fri, 19 Oct 2018 20:12:18 -0700 Subject: [PATCH 3/5] Update tests --- test/Main.purs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test/Main.purs b/test/Main.purs index 31fee42..40f8201 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -9,8 +9,8 @@ import Data.Symbol (SProxy(..)) import Data.Variant (Variant, inj) import Effect (Effect) import Effect.Aff (Aff) -import Formless.Spec (FormField(..), InputField(..), U(..)) -import Formless.Transform.Internal (unsafeRunValidationVariant, unsafeSetInputVariant) +import Formless.Transform.Internal (unsafeRunValidationVariant, unsafeModifyInputVariant) +import Formless.Types.Form (FormField(..), InputFunction(..), U(..)) import Formless.Validation (Validation, hoistFn_) import Test.Unit (suite, test) import Test.Unit.Assert (equal') @@ -20,7 +20,7 @@ main :: Effect Unit main = runTest do suite "variant manipulation" do test "can set input variant" do - let res = unsafeSetInputVariant testInputV testFormR + let res = unsafeModifyInputVariant testInputV testFormR equal' "Setting inputs not equal" res testFormInputRes test "can run validation" do @@ -41,8 +41,8 @@ testFormR = Form { foo: FormField { input: "goodbye", touched: true, result: Not ----- -- Set Inputs -testInputV :: Form Variant InputField -testInputV = Form $ inj (SProxy :: SProxy "foo") (InputField "hello") +testInputV :: Form Variant InputFunction +testInputV = Form $ inj (SProxy :: SProxy "foo") (InputFunction \x -> x <> "hello") testFormInputRes :: Form Record FormField testFormInputRes = Form From 3152dbd99046fe200e42c5a00f3cc6c020409e5f Mon Sep 17 00:00:00 2001 From: "Thomas R. Honeyman" Date: Fri, 19 Oct 2018 20:18:40 -0700 Subject: [PATCH 4/5] oops --- test/Main.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Main.purs b/test/Main.purs index 40f8201..1e68f4b 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -42,11 +42,11 @@ testFormR = Form { foo: FormField { input: "goodbye", touched: true, result: Not -- Set Inputs testInputV :: Form Variant InputFunction -testInputV = Form $ inj (SProxy :: SProxy "foo") (InputFunction \x -> x <> "hello") +testInputV = Form $ inj (SProxy :: SProxy "foo") (InputFunction \x -> "hello " <> x) testFormInputRes :: Form Record FormField testFormInputRes = Form - { foo: FormField { input: "hello", touched: true, result: Nothing } } + { foo: FormField { input: "hello goodbye", touched: true, result: Nothing } } ----- -- Validation From 0fbdfe8c748f47b6712c87926d0b33beca91c5e6 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Sat, 20 Oct 2018 11:43:54 -0700 Subject: [PATCH 5/5] Add support for setting / modifying all fields of a form at once (#35) * Added helper queries for all public queries. Added SetAll and ModifyAll functions. Broke something... * Fix instances * Update examples. Rename replaceInputs to initialize to better reflect its purpose and function. * Fix formatting * Add wrapInputFunctions helper function. Add documentation to wrap* and unwrap* helpers. --- example/basic/Component.purs | 2 +- example/external-components/Component.purs | 2 +- example/external-components/RenderForm.purs | 2 +- example/real-world/Component.purs | 8 +- src/Formless.purs | 4 +- src/Formless/Component.purs | 32 +++- src/Formless/Query.purs | 198 +++++++++++++++++--- src/Formless/Transform/Internal.purs | 77 ++++++-- src/Formless/Transform/Record.purs | 19 +- src/Formless/Types/Component.purs | 12 +- 10 files changed, 283 insertions(+), 73 deletions(-) diff --git a/example/basic/Component.purs b/example/basic/Component.purs index 5924fe6..91bf24b 100644 --- a/example/basic/Component.purs +++ b/example/basic/Component.purs @@ -92,7 +92,7 @@ renderFormless state = , HE.onValueInput $ HE.input $ F.set _text ] , UI.buttonPrimary - [ HE.onClick $ HE.input_ F.Submit ] + [ HE.onClick $ HE.input_ F.submit ] [ HH.text "Submit" ] ] where diff --git a/example/external-components/Component.purs b/example/external-components/Component.purs index 9c391ba..9c65376 100644 --- a/example/external-components/Component.purs +++ b/example/external-components/Component.purs @@ -65,7 +65,7 @@ component = _ <- H.query unit $ F.send Email (H.action TA.Clear) _ <- H.query unit $ F.send Whiskey (H.action TA.Clear) _ <- H.query unit $ F.send Language (H.action TA.Clear) - H.query unit $ H.action F.ResetAll + H.query unit F.resetAll_ Typeahead slot (TA.SelectionsChanged new) a -> case slot of Email -> a <$ do diff --git a/example/external-components/RenderForm.purs b/example/external-components/RenderForm.purs index 29f5a26..a3f6652 100644 --- a/example/external-components/RenderForm.purs +++ b/example/external-components/RenderForm.purs @@ -36,7 +36,7 @@ formless state = [ UI.buttonPrimary [ if state.submitting || state.validity /= F.Valid then HP.disabled true - else HE.onClick $ HE.input_ F.Submit + else HE.onClick $ HE.input_ F.submit ] [ HH.text "Submit" ] , UI.button diff --git a/example/real-world/Component.purs b/example/real-world/Component.purs index 0387213..1c6ec4e 100644 --- a/example/real-world/Component.purs +++ b/example/real-world/Component.purs @@ -121,8 +121,8 @@ component = _ <- H.query' CP.cp1 unit $ F.send' CP.cp3 unit (H.action DD.Clear) -- If there is only one child type, use Send _ <- H.query' CP.cp2 unit $ F.send unit (H.action DD.Clear) - _ <- H.query' CP.cp1 unit $ H.action F.ResetAll - _ <- H.query' CP.cp2 unit $ H.action F.ResetAll + _ <- H.query' CP.cp1 unit F.resetAll_ + _ <- H.query' CP.cp2 unit F.resetAll_ pure a -- On submit, we need to make sure both forms are run. We @@ -193,9 +193,9 @@ component = case st'.optionsEnabled of true -> do let spec' = O.OptionsForm $ _ { enable = F.InputField true } $ unwrap optionsFormInputs - void $ H.query' CP.cp2 unit $ H.action $ F.ReplaceInputs spec' + void $ H.query' CP.cp2 unit $ F.initialize_ spec' _ -> do - void $ H.query' CP.cp2 unit $ H.action $ F.ReplaceInputs defaultInputs + void $ H.query' CP.cp2 unit $ F.initialize_ defaultInputs pure a MetricDropdown m a -> a <$ case m of diff --git a/src/Formless.purs b/src/Formless.purs index c6ae8af..ce63f23 100644 --- a/src/Formless.purs +++ b/src/Formless.purs @@ -21,9 +21,9 @@ module Formless import Formless.Class.Initial (class Initial, initial) import Formless.Component (component) import Formless.Retrieve (FormFieldGet, FormFieldLens, GetAll, GetError(..), GetInputField(..), GetOutput(..), GetResultField(..), GetTouchedField(..), _Error, _Field, _Input, _Output, _Result, _Touched, getError, getErrorAll, getField, getInput, getInputAll, getOutput, getOutputAll, getResult, getResultAll, getTouched, getTouchedAll) -import Formless.Transform.Record (UnwrapField(..), WrapField(..), unwrapOutputFields, unwrapRecord, wrapInputFields, wrapRecord) +import Formless.Transform.Record (UnwrapField(..), WrapField(..), unwrapOutputFields, unwrapRecord, wrapInputFields, wrapInputFunctions, wrapRecord) import Formless.Transform.Row (class MakeInputFieldsFromRow, class MakeSProxies, SProxies, makeSProxiesBuilder, mkInputFields, mkInputFieldsFromRowBuilder, mkSProxies) 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 (modify, modifyValidate, modifyValidate_, modify_, reset, reset_, send, send', set, setValidate, setValidate_, set_, validate, validate_) +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_) diff --git a/src/Formless/Component.purs b/src/Formless/Component.purs index fcb9006..9c4c93b 100644 --- a/src/Formless/Component.purs +++ b/src/Formless/Component.purs @@ -25,7 +25,7 @@ import Unsafe.Coerce (unsafeCoerce) -- | The Formless component component - :: ∀ pq cq cs form m is ixs ivs fs fxs us vs os ivfs + :: ∀ pq cq cs form m is ixs ivs fs fxs us vs os ifs ivfs . Ord cs => Monad m => RL.RowToList is ixs @@ -37,9 +37,11 @@ component => Internal.AllTouched fxs fs => Internal.SetFormFieldsTouched fxs fs fs => Internal.ReplaceFormFieldInputs is fxs fs fs - => Internal.ApplyValidation vs fxs fs fs m + => Internal.ModifyAll ifs fxs fs fs + => Internal.ValidateAll vs fxs fs fs m => Internal.FormFieldToMaybeOutput fxs fs os => Newtype (form Record InputField) { | is } + => Newtype (form Record InputFunction) { | ifs } => Newtype (form Record FormField) { | fs } => Newtype (form Record OutputField) { | os } => Newtype (form Record (Validation form m)) { | vs } @@ -69,11 +71,11 @@ component = eval :: Query pq cq cs form m ~> DSL pq cq cs form m eval = case _ of - ModifyInput variant a -> do + Modify variant a -> do modifyState_ \st -> st { form = Internal.unsafeModifyInputVariant variant st.form } eval $ SyncFormData a - ValidateInput variant a -> do + Validate variant a -> do st <- getState form <- H.lift $ Internal.unsafeRunValidationVariant variant (unwrap st.internal).validators st.form @@ -81,7 +83,7 @@ component = eval $ SyncFormData a -- Provided as a separate query to minimize state updates / re-renders - ModifyValidateInput variant a -> do + ModifyValidate variant a -> do st <- getState let form = Internal.unsafeModifyInputVariant variant st.form form' <- do @@ -92,16 +94,28 @@ component = modifyState_ _ { form = form' } eval $ SyncFormData a - ResetInput variant a -> do + Reset variant a -> do modifyState_ \st -> st { form = Internal.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form , internal = over InternalState (_ { allTouched = false }) st.internal } eval $ SyncFormData a + SetAll formInputs a -> do + new <- modifyState \st -> st + { form = Internal.replaceFormFieldInputs formInputs st.form } + H.raise $ Changed $ getPublicState new + eval $ SyncFormData a + + ModifyAll formInputs a -> do + new <- modifyState \st -> st + { form = Internal.modifyAll formInputs st.form } + H.raise $ Changed $ getPublicState new + eval $ SyncFormData a + ValidateAll a -> do st <- getState - form <- H.lift $ Internal.applyValidation (unwrap st.internal).validators st.form + form <- H.lift $ Internal.validateAll (unwrap st.internal).validators st.form modifyState_ _ { form = form } eval $ SyncFormData a @@ -156,8 +170,10 @@ component = ResetAll a -> do new <- modifyState \st -> st { validity = Incomplete + , dirty = false , errors = 0 , submitAttempts = 0 + , submitting = false , form = Internal.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form , internal = over InternalState (_ { allTouched = false }) st.internal } @@ -174,7 +190,7 @@ component = H.raise (Emit query) pure a - ReplaceInputs formInputs a -> do + Initialize formInputs a -> do st <- getState new <- modifyState _ { validity = Incomplete diff --git a/src/Formless/Query.purs b/src/Formless/Query.purs index 042eebd..c4e80bf 100644 --- a/src/Formless/Query.purs +++ b/src/Formless/Query.purs @@ -7,25 +7,28 @@ module Formless.Query where import Prelude +import Data.Maybe (Maybe) import Data.Newtype (class Newtype, wrap) import Data.Symbol (class IsSymbol, SProxy) import Data.Variant (Variant, inj) import Formless.Class.Initial (class Initial, initial) -import Formless.Types.Form (InputField, InputFunction, U(..)) -import Formless.Types.Component (Query(..)) +import Formless.Types.Component (Query(..), PublicState) +import Formless.Types.Form (InputField, InputFunction, OutputField, U(..)) +import Halogen (request) as H import Halogen.Component.ChildPath (ChildPath, injQuery, injSlot) import Prim.Row as Row --- | For use when you need to query a component through Formless +-- | Send a query transparently through Formless, when you only have one kind of child +-- | component. Use when you would use `Halogen.query`. send :: ∀ pq cs cq form m a . cs -> cq a -> Query pq cq cs form m a send p q = Send p q --- | When you are using several different types of child components in Formless --- | the component needs a child path to be able to pick the right slot to send --- | a query to. +-- | Send a query transparently through Formless, when you are using several +-- | different types of child components and the component needs a child path +-- | to dispatch the query to. Use when you would use `Halogen.query'`. send' :: ∀ pq cq' cs' cs cq form m a . ChildPath cq cq' cs cs' -> cs @@ -43,9 +46,10 @@ set -> i -> a -> Query pq cq cs form m a -set sym i = ModifyInput (wrap (inj sym (wrap (const i)))) +set sym i = Modify (wrap (inj sym (wrap (const i)))) --- | Set the input value of a form field at the specified label, as an action. +-- | `set` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. set_ :: ∀ pq cq cs form inputs m sym t0 e i o . IsSymbol sym @@ -54,7 +58,7 @@ set_ => SProxy sym -> i -> Query pq cq cs form m Unit -set_ sym i = ModifyInput (wrap (inj sym (wrap (const i)))) unit +set_ sym i = Modify (wrap (inj sym (wrap (const i)))) unit -- | Set the input value of a form field at the specified label, also triggering -- | validation to run on the field. @@ -67,10 +71,10 @@ setValidate -> i -> a -> Query pq cq cs form m a -setValidate sym i = ModifyValidateInput (wrap (inj sym (wrap (const i)))) +setValidate sym i = ModifyValidate (wrap (inj sym (wrap (const i)))) --- | Set the input value of a form field at the specified label, also triggering --- | validation to run on the field, as an action. +-- | `setValidate` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. setValidate_ :: ∀ pq cq cs form inputs m sym t0 e i o . IsSymbol sym @@ -79,9 +83,9 @@ setValidate_ => SProxy sym -> i -> Query pq cq cs form m Unit -setValidate_ sym i = ModifyValidateInput (wrap (inj sym (wrap (const i)))) unit +setValidate_ sym i = ModifyValidate (wrap (inj sym (wrap (const i)))) unit --- | ModifyInput the input value of a form field at the specified label with the +-- | Modify the input value of a form field at the specified label with the -- | provided function. modify :: ∀ pq cq cs form inputs m sym t0 e i o a @@ -92,10 +96,10 @@ modify -> (i -> i) -> a -> Query pq cq cs form m a -modify sym f = ModifyInput (wrap (inj sym (wrap f))) +modify sym f = Modify (wrap (inj sym (wrap f))) --- | ModifyInput the input value of a form field at the specified label, as an action, --- | with the provided function. +-- | `modify` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. modify_ :: ∀ pq cq cs form inputs m sym t0 e i o . IsSymbol sym @@ -104,9 +108,9 @@ modify_ => SProxy sym -> (i -> i) -> Query pq cq cs form m Unit -modify_ sym f = ModifyInput (wrap (inj sym (wrap f))) unit +modify_ sym f = Modify (wrap (inj sym (wrap f))) unit --- | ModifyInput the input value of a form field at the specified label, also triggering +-- | Modify the input value of a form field at the specified label, also triggering -- | validation to run on the field, with the provided function. modifyValidate :: ∀ pq cq cs form inputs m sym t0 e i o a @@ -117,10 +121,10 @@ modifyValidate -> (i -> i) -> a -> Query pq cq cs form m a -modifyValidate sym f = ModifyValidateInput (wrap (inj sym (wrap f))) +modifyValidate sym f = ModifyValidate (wrap (inj sym (wrap f))) --- | ModifyInput the input value of a form field at the specified label, also triggering --- | validation to run on the field, as an action, with the provided function. +-- | `modifyValidate` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. modifyValidate_ :: ∀ pq cq cs form inputs m sym t0 e i o . IsSymbol sym @@ -129,7 +133,7 @@ modifyValidate_ => SProxy sym -> (i -> i) -> Query pq cq cs form m Unit -modifyValidate_ sym f = ModifyValidateInput (wrap (inj sym (wrap f))) unit +modifyValidate_ sym f = ModifyValidate (wrap (inj sym (wrap f))) unit -- | Reset the value of the specified form field to its default value -- | according to the `Initial` type class. @@ -142,10 +146,10 @@ reset => SProxy sym -> a -> Query pq cq cs form m a -reset sym = ResetInput (wrap (inj sym (wrap initial))) +reset sym = Reset (wrap (inj sym (wrap initial))) --- | Reset the value of the specified form field to its default value --- | according to the `Initial` type class, as an action. +-- | `reset` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. reset_ :: ∀ pq cq cs form inputs m sym t0 e i o . IsSymbol sym @@ -154,7 +158,7 @@ reset_ => Row.Cons sym (InputField e i o) t0 inputs => SProxy sym -> Query pq cq cs form m Unit -reset_ sym = ResetInput (wrap (inj sym (wrap initial))) unit +reset_ sym = Reset (wrap (inj sym (wrap initial))) unit -- | A helper to create the correct `Validate` query for Formless, given -- | a label @@ -166,10 +170,10 @@ validate => SProxy sym -> a -> Query pq cq cs form m a -validate sym = ValidateInput (wrap (inj sym U)) +validate sym = Validate (wrap (inj sym U)) --- | A helper to create the correct `Validate` query for Formless given --- | a label, as an action +-- | `validate` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. validate_ :: ∀ pq cq cs form us m sym t0 e i o . IsSymbol sym @@ -177,5 +181,137 @@ validate_ => Row.Cons sym (U e i o) t0 us => SProxy sym -> Query pq cq cs form m Unit -validate_ sym = ValidateInput (wrap (inj sym U)) unit +validate_ sym = Validate (wrap (inj sym U)) unit + +-- | Provide a record of input fields to overwrite all current +-- | inputs. Unlike `replaceInputs`, this does not otherwise reset +-- | the form as if it were new. Similar to calling `set` on every +-- | field in the form. +setAll + :: ∀ pq cq cs form m a + . form Record InputField + -> a + -> Query pq cq cs form m a +setAll = SetAll + +-- | `setAll` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +setAll_ + :: ∀ pq cq cs form m + . form Record InputField + -> Query pq cq cs form m Unit +setAll_ = flip SetAll unit + +-- | Provide a record of input functions to modify all current +-- | inputs. Similar to calling `modify` on every field in the form. +modifyAll + :: ∀ pq cq cs form m a + . form Record InputFunction + -> a + -> Query pq cq cs form m a +modifyAll = ModifyAll + +-- | `modifyAll` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +modifyAll_ + :: ∀ pq cq cs form m + . form Record InputFunction + -> Query pq cq cs form m Unit +modifyAll_ = flip ModifyAll unit + +-- | Reset all fields to their initial values, and reset the form +-- | to its initial pristine state, no touched fields. +resetAll + :: ∀ pq cq cs form m a + . a + -> Query pq cq cs form m a +resetAll = ResetAll + +-- | `resetAll` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +resetAll_ + :: ∀ pq cq cs form m + . Query pq cq cs form m Unit +resetAll_ = ResetAll unit + +-- | Validate all fields in the form, collecting errors +validateAll + :: ∀ pq cq cs form m a + . a + -> Query pq cq cs form m a +validateAll = ValidateAll + +-- | `validateAll` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +validateAll_ + :: ∀ pq cq cs form m + . Query pq cq cs form m Unit +validateAll_ = ValidateAll unit +-- | Submit the form, which will trigger a `Submitted` result if the +-- | form validates successfully. +submit + :: ∀ pq cq cs form m a + . a + -> Query pq cq cs form m a +submit = Submit + +-- | `submit` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +submit_ + :: ∀ pq cq cs form m + . Query pq cq cs form m Unit +submit_ = Submit unit + +-- | Imperatively submit the form and collect the result of submission, without +-- | triggering a `Submitted` message. Useful when you need to submit multiple +-- | forms together without listening to submission events. +submitReply + :: ∀ pq cq cs form m + . Query pq cq cs form m (Maybe (form Record OutputField)) +submitReply = H.request SubmitReply + +-- | Imperatively receive the current state of the form. +getState + :: ∀ pq cq cs form m + . Query pq cq cs form m (PublicState form) +getState = H.request GetState + +-- | Replace all form inputs with a new set of inputs, and re-initialize +-- | the form to a new state. Useful to set a new "initial state" for a form, +-- | especially when filling a form with data loaded asynchronously. +initialize + :: ∀ pq cq cs form m a + . form Record InputField + -> a + -> Query pq cq cs form m a +initialize = Initialize + +-- | `initialize` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +initialize_ + :: ∀ pq cq cs form m + . form Record InputField + -> Query pq cq cs form m Unit +initialize_ = flip Initialize unit + +-- | Perform two Formless actions in sequence. Can be chained arbitrarily. +-- | Useful when a field needs to modify itself on change and also trigger +-- | validation on one or more other fields, or when a modification on one +-- | field should also modify another field. +andThen + :: ∀ pq cq cs form m a + . Query pq cq cs form m Unit + -> Query pq cq cs form m Unit + -> a + -> Query pq cq cs form m a +andThen = AndThen + +-- | `andThen` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +andThen_ + :: ∀ pq cq cs form m + . Query pq cq cs form m Unit + -> Query pq cq cs form m Unit + -> Query pq cq cs form m Unit +andThen_ a b = AndThen a b unit diff --git a/src/Formless/Transform/Internal.purs b/src/Formless/Transform/Internal.purs index 7fc85ed..0c2da69 100644 --- a/src/Formless/Transform/Internal.purs +++ b/src/Formless/Transform/Internal.purs @@ -119,19 +119,31 @@ replaceFormFieldInputs replaceFormFieldInputs is fs = wrap $ fromScratch builder where builder = replaceFormFieldInputsBuilder (unwrap is) (RLProxy :: RLProxy fxs) (unwrap fs) -applyValidation +modifyAll + :: ∀ fxs form fs ifs + . RL.RowToList fs fxs + => ModifyAll ifs fxs fs fs + => Newtype (form Record InputFunction) { | ifs } + => Newtype (form Record FormField) { | fs } + => form Record InputFunction + -> form Record FormField + -> form Record FormField +modifyAll ifs fs = wrap $ fromScratch builder + where builder = modifyAllBuilder (unwrap ifs) (RLProxy :: RLProxy fxs) (unwrap fs) + +validateAll :: ∀ vs fxs form fs m . RL.RowToList fs fxs => Monad m - => ApplyValidation vs fxs fs fs m + => ValidateAll vs fxs fs fs m => Newtype (form Record (Validation form m)) { | vs } => Newtype (form Record FormField) { | fs } => form Record (Validation form m) -> form Record FormField -> m (form Record FormField) -applyValidation vs fs = map wrap $ fromScratch <$> builder +validateAll vs fs = map wrap $ fromScratch <$> builder where - builder = applyValidationBuilder (unwrap vs) (RLProxy :: RLProxy fxs) (unwrap fs) + builder = validateAllBuilder (unwrap vs) (RLProxy :: RLProxy fxs) (unwrap fs) ---------- @@ -342,11 +354,11 @@ instance consAllTouched -- Apply form field validation -- | A class that applies the current state to the unwrapped version of every validator -class ApplyValidation (vs :: # Type) (xs :: RL.RowList) (row :: # Type) (to :: # Type) m | xs -> to where - applyValidationBuilder :: Record vs -> RLProxy xs -> Record row -> m (FromScratch to) +class ValidateAll (vs :: # Type) (xs :: RL.RowList) (row :: # Type) (to :: # Type) m | xs -> to where + validateAllBuilder :: Record vs -> RLProxy xs -> Record row -> m (FromScratch to) -instance applyToValidationNil :: Monad m => ApplyValidation vs RL.Nil row () m where - applyValidationBuilder _ _ _ = pure identity +instance applyToValidationNil :: Monad m => ValidateAll vs RL.Nil row () m where + validateAllBuilder _ _ _ = pure identity instance applyToValidationCons :: ( IsSymbol name @@ -355,21 +367,49 @@ instance applyToValidationCons , Newtype (form Record FormField) { | row } , Row.Cons name (Validation form m e i o) t1 vs , Row1Cons name (FormField e i o) from to - , ApplyValidation vs tail row from m + , ValidateAll vs tail row from m ) - => ApplyValidation vs (RL.Cons name (FormField e i o) tail) row to m where - applyValidationBuilder vs _ r = + => ValidateAll vs (RL.Cons name (FormField e i o) tail) row to m where + validateAllBuilder vs _ r = fn <$> val <*> rest where _name = SProxy :: SProxy name fn val' rest' = Builder.insert _name val' <<< rest' - rest = applyValidationBuilder vs (RLProxy :: RLProxy tail) r + rest = validateAllBuilder vs (RLProxy :: RLProxy tail) r val = do let validator = unwrap $ Record.get _name vs formField = unwrap $ Record.get _name r res <- validator (wrap r) formField.input pure $ wrap $ formField { result = Just res } + +-------- +-- Apply modifications across a record + +class ModifyAll (ifs :: # Type) (xs :: RL.RowList) (fs :: # Type) (to :: # Type) | xs -> to where + modifyAllBuilder :: Record ifs -> RLProxy xs -> Record fs -> FromScratch to + +instance modifyAllNil :: ModifyAll ifs RL.Nil fs () where + modifyAllBuilder _ _ _ = identity + +instance modifyAllCons + :: ( IsSymbol name + , Newtype (InputFunction e i o) (i -> i) + , Newtype (FormField e i o) { | (FormFieldRow e i o) } + , Row.Cons name (InputFunction e i o) trash0 ifs + , Row.Cons name (FormField e i o) trash1 row + , Row1Cons name (FormField e i o) from to + , ModifyAll ifs tail row from + ) + => ModifyAll ifs (RL.Cons name (FormField e i o) tail) row to where + modifyAllBuilder ifs _ r = first <<< rest + where + _name = SProxy :: SProxy name + f = unwrap $ Record.get _name ifs + field = Record.get _name r + rest = modifyAllBuilder ifs (RLProxy :: RLProxy tail) r + first = Builder.insert _name (over FormField (\x -> x { input = f x.input }) field) + ---------- -- Replace all form field inputs @@ -389,14 +429,13 @@ instance replaceFormFieldInputsTouchedCons , ReplaceFormFieldInputs is tail row from ) => ReplaceFormFieldInputs is (RL.Cons name (FormField e i o) tail) row to where - replaceFormFieldInputsBuilder ir _ fr = - first <<< rest - where + replaceFormFieldInputsBuilder ir _ fr = first <<< rest + where _name = SProxy :: SProxy name - - i :: InputField e i o i = Record.get _name ir - f = unwrap $ Record.get _name fr - first = Builder.insert _name (FormField $ f { input = unwrap i, touched = false, result = Nothing }) rest = replaceFormFieldInputsBuilder ir (RLProxy :: RLProxy tail) fr + first = + Builder.insert + _name + (FormField $ f { input = unwrap i, touched = false, result = Nothing }) diff --git a/src/Formless/Transform/Record.purs b/src/Formless/Transform/Record.purs index 9047c65..a7569a0 100644 --- a/src/Formless/Transform/Record.purs +++ b/src/Formless/Transform/Record.purs @@ -3,7 +3,7 @@ module Formless.Transform.Record where import Prelude import Data.Newtype (class Newtype, unwrap, wrap) -import Formless.Types.Form (InputField, OutputField) +import Formless.Types.Form (InputField, InputFunction, OutputField) import Heterogeneous.Mapping as HM -- | Unwrap every newtype in a record filled with newtypes @@ -24,6 +24,9 @@ instance wrapField :: (Newtype wrapper x) => HM.Mapping WrapField x wrapper wher wrapRecord :: ∀ r0 r1. HM.HMap WrapField r0 r1 => r0 -> r1 wrapRecord = HM.hmap WrapField +-- | Provided your form type containing a record of only valid outputs +-- | from the result of validation, unwraps the form and every value +-- | in the record to provide a record of only the output values. unwrapOutputFields :: ∀ form os os' . Newtype (form Record OutputField) { | os } @@ -32,6 +35,9 @@ unwrapOutputFields -> { | os' } unwrapOutputFields = unwrapRecord <<< unwrap +-- | Provided a record, where each field in the record contains +-- | a value of type `input`, wraps each value in the InputField +-- | type for compatibility with Formless wrapInputFields :: ∀ form is is' . Newtype (form Record InputField) { | is' } @@ -40,3 +46,14 @@ wrapInputFields -> form Record InputField wrapInputFields = wrap <<< wrapRecord +-- | Provided a record, where each field in the record contains +-- | a function from `input -> input`, wraps each function in +-- | the InputField type for compatibility with Formless +wrapInputFunctions + :: ∀ form ifs ifs' + . Newtype (form Record InputFunction) { | ifs' } + => HM.HMap WrapField { | ifs } { | ifs' } + => { | ifs } + -> form Record InputFunction +wrapInputFunctions = wrap <<< wrapRecord + diff --git a/src/Formless/Types/Component.purs b/src/Formless/Types/Component.purs index 7e2bdf5..784c90b 100644 --- a/src/Formless/Types/Component.purs +++ b/src/Formless/Types/Component.purs @@ -17,10 +17,12 @@ import Halogen.HTML as HH -- | The component query type. See Formless.Query for helpers related -- | to constructing and using these queries. data Query pq cq cs form m a - = ModifyInput (form Variant InputFunction) a - | ValidateInput (form Variant U) a - | ModifyValidateInput (form Variant InputFunction) a - | ResetInput (form Variant InputField) a + = Modify (form Variant InputFunction) a + | Validate (form Variant U) a + | ModifyValidate (form Variant InputFunction) a + | Reset (form Variant InputField) a + | SetAll (form Record InputField) a + | ModifyAll (form Record InputFunction) a | ResetAll a | ValidateAll a | Submit a @@ -29,7 +31,7 @@ data Query pq cq cs form m a | Send cs (cq a) | SyncFormData a | Raise (pq Unit) a - | ReplaceInputs (form Record InputField) a + | Initialize (form Record InputField) a | Receive (Input pq cq cs form m) a | AndThen (Query pq cq cs form m Unit) (Query pq cq cs form m Unit) a