diff --git a/example/App/UI/Element.purs b/example/App/UI/Element.purs index 172c02a..ba2fc32 100644 --- a/example/App/UI/Element.purs +++ b/example/App/UI/Element.purs @@ -5,13 +5,13 @@ import Prelude import DOM.HTML.Indexed (HTMLa, HTMLbutton, HTMLinput, HTMLtextarea) import DOM.HTML.Indexed.InputType (InputType(..)) import Data.Either (Either(..), either) -import Data.Lens (preview) -import Data.Maybe (Maybe, maybe) +import Data.Maybe (maybe) import Data.Newtype (class Newtype) import Data.Symbol (class IsSymbol, SProxy(..)) import Data.Variant (Variant) import Example.App.Validation (class ToText, toText) import Example.App.Validation as V +import Formless (FormFieldResult(..)) import Formless as F import Halogen.HTML as HH import Halogen.HTML.Events as HE @@ -112,8 +112,11 @@ field config contents = -- Formless -- Render a result as help text -resultToHelp :: ∀ t e. ToText e => String -> Maybe (Either e t) -> Either String String -resultToHelp str = maybe (Right str) Left <<< V.showError +resultToHelp :: ∀ t e. ToText e => String -> FormFieldResult e t -> Either String String +resultToHelp str = case _ of + NotValidated -> Right str + Validating -> Right "validating..." + other -> maybe (Right str) Left $ V.showError other -- Provide your own label, error or help text, and placeholder type FieldConfig' = @@ -179,7 +182,7 @@ formlessField fieldType config state = fieldType (Builder.build config' config) Builder.delete (SProxy :: SProxy "sym") <<< Builder.modify (SProxy :: SProxy "help") (const help') - help' = maybe (Right config.help) (Left <<< toText) (preview (F._Error config.sym) state.form) + help' = maybe (Right config.help) (Left <<< toText) (F.getError config.sym state.form) props = [ HP.value (F.getInput config.sym state.form) diff --git a/example/App/Validation.purs b/example/App/Validation.purs index 4a4b2c0..8ecfcec 100644 --- a/example/App/Validation.purs +++ b/example/App/Validation.purs @@ -2,17 +2,19 @@ module Example.App.Validation where import Prelude -import Data.Either (Either(..), either) +import Data.Either (Either(..)) import Data.Foldable (length) as Foldable import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Show (genericShow) import Data.Int (fromString) as Int -import Data.Maybe (Maybe(..), maybe) +import Data.Lens (preview) +import Data.Maybe (Maybe, maybe) import Data.Newtype (class Newtype) import Data.String (contains, length, null) import Data.String.Pattern (Pattern(..)) -import Effect.Class (class MonadEffect, liftEffect) -import Effect.Random (random) +import Effect.Aff (Milliseconds(..), delay) +import Effect.Aff.Class (class MonadAff, liftAff) +import Formless (FormFieldResult, _Error) import Formless.Validation (Validation(..), hoistFnE_) data FieldError @@ -23,6 +25,7 @@ data FieldError | TooLong Int | InvalidInt String | NotEqual String String + | NotEnoughMoney derive instance genericFieldError :: Generic FieldError _ instance showFieldError :: Show FieldError where @@ -36,6 +39,7 @@ instance toTextFieldError :: ToText FieldError where toText (TooLong n) = "You must enter less than " <> show n <> " characters." toText (InvalidInt str) = "Could not parse \"" <> str <> "\" to a valid integer." toText (NotEqual str0 str1) = "This field contains \"" <> str1 <> "\" but must be equal to \"" <> str0 <> "\" to validate." + toText (NotEnoughMoney) = "You don't have that much money." -- | Some useful types we'll parse to newtype Name = Name String @@ -48,8 +52,8 @@ derive newtype instance eqEmail :: Eq Email derive newtype instance showEmail :: Show Email -- | Unpacks errors to render as a string -showError :: ∀ e o. ToText e => Maybe (Either e o) -> Maybe String -showError = (=<<) (either (pure <<< toText) (const Nothing)) +showError :: ∀ e o. ToText e => FormFieldResult e o -> Maybe String +showError = map toText <<< preview _Error class ToText item where toText :: item -> String @@ -67,14 +71,6 @@ emailFormat = hoistFnE_ $ \str -> then pure $ Email str else Left InvalidEmail -emailIsUsed :: ∀ form m. MonadEffect m => Validation form m FieldError Email Email -emailIsUsed = Validation \_ e@(Email e') -> do - -- Perhaps we hit the server to if the email is in use - _ <- liftEffect random - pure $ if (contains (Pattern "t") e') - then pure e - else Left EmailInUse - minLength :: ∀ form m. Monad m => Int -> Validation form m FieldError String String minLength n = hoistFnE_ $ \str -> let n' = length str @@ -104,3 +100,23 @@ nonEmptyStr = hoistFnE_ $ \str -> if null str then Left EmptyField else Right str + +-------------------- +-- Formless Async Validation +-------------------- + +emailIsUsed :: ∀ form m. MonadAff m => Validation form m FieldError Email Email +emailIsUsed = Validation \_ e@(Email e') -> do + -- Perhaps we hit the server to if the email is in use + _ <- liftAff $ delay $ Milliseconds 1000.0 + pure $ if (contains (Pattern "t") e') + then pure e + else Left EmailInUse + +enoughMoney :: ∀ form m. MonadAff m => Validation form m FieldError Int Int +enoughMoney = Validation \_ i -> do + -- Let's check if we have enough money... + _ <- liftAff $ delay $ Milliseconds 5000.0 + pure $ if (i > 1000) + then pure i + else Left NotEnoughMoney \ No newline at end of file diff --git a/example/Main.purs b/example/Main.purs index bea2fc2..5993148 100644 --- a/example/Main.purs +++ b/example/Main.purs @@ -7,6 +7,7 @@ import Data.Tuple (Tuple(..)) import Effect (Effect) import Effect.Aff (Aff) import Example.Basic.Component as Basic +import Example.Async.Component as Async import Example.Nested.Component as Nested import Example.ExternalComponents.Component as ExternalComponents import Example.App.Home as Home @@ -21,6 +22,7 @@ stories = Object.fromFoldable [ Tuple "" $ proxy Home.component , Tuple "basic" $ proxy Basic.component , Tuple "external-components" $ proxy ExternalComponents.component + , Tuple "async" $ proxy Async.component , Tuple "nested" $ proxy Nested.component , Tuple "real-world" $ proxy RealWorld.component ] diff --git a/example/async/Component.purs b/example/async/Component.purs new file mode 100644 index 0000000..3fb051e --- /dev/null +++ b/example/async/Component.purs @@ -0,0 +1,117 @@ +module Example.Async.Component where + +import Prelude + +import Data.Maybe (Maybe(..)) +import Data.Newtype (class Newtype) +import Effect.Aff (Aff, Milliseconds(..)) +import Effect.Aff.Class (class MonadAff) +import Effect.Console (logShow) +import Example.App.UI.Element as UI +import Example.App.Validation as V +import Formless as F +import Halogen as H +import Halogen.HTML as HH +import Halogen.HTML.Events as HE +import Halogen.HTML.Properties as HP + +data Query a = Formless (F.Message' Form) a + +type ChildQuery = F.Query' Form Aff +type ChildSlot = Unit + +component :: H.Component HH.HTML Query Unit Void Aff +component = H.parentComponent + { initialState: const unit + , render + , eval + , receiver: const Nothing + } + where + + render :: Unit -> H.ParentHTML Query ChildQuery ChildSlot Aff + render _ = + UI.section_ + [ UI.h1_ [ HH.text "Formless" ] + , UI.h2_ [ HH.text "A form with debounced async fields." ] + , UI.p_ $ + "If you have fields with expensive validation, you can debounce modifications to the field " + <> "with the async versions of setValidate and modifyValidate query functions. The result " + <> "type of the form field lets you know whether the field has not been validated, is " + <> "currently validating, or has produced an error or result." + , HH.br_ + , HH.slot unit F.component { initialInputs, validators, render: renderForm } (HE.input Formless) + ] + + eval :: Query ~> H.ParentDSL Unit Query ChildQuery ChildSlot Void Aff + eval (Formless (F.Submitted formOutputs) a) = a <$ do + let result = F.unwrapOutputFields formOutputs + H.liftEffect $ logShow result + + -- In this example we can ignore other outputs, but see the other examples for more + -- in-depth usage. + eval (Formless _ a) = pure a + +---------- +-- FORM SPEC +----------- + +newtype Form r f = Form (r (FormRow f)) +derive instance newtypeForm :: Newtype (Form r f) _ + +type FormRow f = + ( name :: f V.FieldError String String + , email :: f V.FieldError String V.Email + , balance :: f V.FieldError String Int + ) + +-- | You'll usually want symbol proxies for convenience +prx :: F.SProxies Form +prx = F.mkSProxies $ F.FormProxy :: F.FormProxy Form + +-- | You can generate your initial inputs +initialInputs :: Form Record F.InputField +initialInputs = F.mkInputFields $ F.FormProxy :: F.FormProxy Form + +validators :: ∀ m. MonadAff m => Form Record (F.Validation Form m) +validators = Form + { name: V.minLength 5 + , email: V.emailFormat >>> V.emailIsUsed + , balance: V.strIsInt >>> V.enoughMoney + } + +---------- +-- RENDER +---------- + +renderForm :: F.State Form Aff -> F.HTML' Form Aff +renderForm { form } = + UI.formContent_ + [ UI.input + { label: "Name" + , help: UI.resultToHelp "Write your name" $ F.getResult prx.name form + , placeholder: "Frank Ocean" + } + [ HP.value $ F.getInput prx.name form + , HE.onValueInput $ HE.input $ F.setValidate prx.name + ] + , UI.input + { label: "Email" + , help: UI.resultToHelp "Provide your email address" $ F.getResult prx.email form + , placeholder: "john@hamm.com" + } + [ HP.value $ F.getInput prx.email form + , HE.onValueInput $ HE.input $ F.asyncSetValidate (Milliseconds 300.0) prx.email + ] + , UI.input + { label: "Donation" + , help: UI.resultToHelp "How many dollas do you want to spend?" $ F.getResult prx.balance form + , placeholder: "1000" + } + [ HP.value $ F.getInput prx.balance form + , HE.onValueInput $ HE.input $ F.asyncSetValidate (Milliseconds 500.0) prx.balance + ] + , UI.buttonPrimary + [ HE.onClick $ HE.input_ F.submit ] + [ HH.text "Submit" ] + ] \ No newline at end of file diff --git a/example/external-components/Spec.purs b/example/external-components/Spec.purs index d31bf30..aaf0a2c 100644 --- a/example/external-components/Spec.purs +++ b/example/external-components/Spec.purs @@ -4,7 +4,6 @@ import Prelude import Data.Maybe (Maybe) import Data.Newtype (class Newtype) -import Effect.Class (class MonadEffect) import Example.App.Validation as V import Formless as F @@ -30,12 +29,11 @@ prx = F.mkSProxies $ F.FormProxy :: F.FormProxy UserForm initialInputs :: UserForm Record F.InputField initialInputs = F.mkInputFields $ F.FormProxy :: F.FormProxy UserForm -validators :: ∀ m. MonadEffect m => UserForm Record (F.Validation UserForm m) +validators :: ∀ m. Monad m => UserForm Record (F.Validation UserForm m) validators = UserForm { name: V.minLength 7 - -- Unpacks the Maybe value, then checks the email format, then verifies it is not in use - -- monadically. - , email: V.exists >>> V.emailFormat >>> V.emailIsUsed + -- Unpacks the Maybe value, then checks the email format + , email: V.exists >>> V.emailFormat , whiskey: V.exists , language: V.exists } diff --git a/example/real-world/Component.purs b/example/real-world/Component.purs index 1c6ec4e..0807b05 100644 --- a/example/real-world/Component.purs +++ b/example/real-world/Component.purs @@ -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 $ F.initialize_ spec' + void $ H.query' CP.cp2 unit $ F.loadForm_ spec' _ -> do - void $ H.query' CP.cp2 unit $ F.initialize_ defaultInputs + void $ H.query' CP.cp2 unit $ F.loadForm_ defaultInputs pure a MetricDropdown m a -> a <$ case m of diff --git a/readme.md b/readme.md index 3a0f098..06b8a50 100644 --- a/readme.md +++ b/readme.md @@ -45,9 +45,15 @@ This is the data type we'll use throughout our application, but our form will ha Formless requires a specific shape from your `Form` data type. You are expected to write a newtype that takes two arguments, `r` and `f` below, and a row containing the fields in your form. +
+ Expand to read about these two type arguments The first argument has the kind `(# Type -> Type)` and turns a row of types into a concrete type. For example, you can fill in `Record` to get a record; `Record (name :: String)` is the same as `{ name :: String }`. However, Formless will often fill in `Variant` internally. This lets the library access the entire form at once (`Record`) or a single field (`Variant`) to perform various operations. The important thing is that you make sure this variable is left free in your `Form` newtype. -The second argument has the kind `(Type -> Type -> Type -> Type)` and will be filled in with one of many types Formless uses internally to manage your form. You should use this type on every field in your form and provide it with its three type arguments: +The second argument has the kind `(Type -> Type -> Type -> Type)` and will be filled in with one of many types Formless uses internally to manage your form. It expects an error type, an input type, and an output type for the field in question. + +
+ +Every field should use the second argument, `f`, and provide it with three type arguments: - an `error` type, which represents possible validation errors for the field - an `input` type, which represents the value the user will provide when interacting with the field @@ -65,7 +71,7 @@ newtype Form r f = Form (r derive instance newtypeForm :: Newtype (Form r f) _ ``` -You don't need to manage or worry about these two arguments much; they're mostly filled in by Formless on your behalf. Your biggest focus will be on defining the fields in your form with their input, error, and output types. +Formless will use this type to perform all kinds of transformations and track data about your form over time. You simply need to decide what fields will exist and what their error, input, and output types are.
Expand to read a longer explanation of this form type @@ -78,14 +84,14 @@ This can be a scary type to look at, but it's not so bad once you provide concre -- we need to provide as our `Form` newtype's second argument. type OutputType e i o = o --- Let's fill in each occurrence of `f` with `OutputType` +-- Let's fill in each occurrence of `f` with `OutputType` myForm :: Form Record OutputType myForm = Form { name :: OutputType Error String String , email1 :: OutputType Error String Email , email2 :: OutputType Error String Email } - + -- This isn't much less confusing, so let's take things a step further. What if we act as the -- compiler does and erase the type synonym? After all, OutputType is equivalent to only the -- third type argument from each field. @@ -95,13 +101,14 @@ myForm2 = Form , email1 :: Email , email2 :: Email } - + -- `myForm` and `myForm2` are exactly equivalent! Accepting a type that itself accepts three -- arguments allows us to represent several different sorts of records and variants from the -- same underlying row and can result in quite simple data types despite the admittedly -- complicated-looking original type. ``` +
@@ -116,6 +123,7 @@ data Error | EmailIsUsed | EmailInvalid ``` +
## Component Inputs @@ -126,7 +134,6 @@ Now that we have a form type and an output type we can produce the `Input` type - `validators`: Your `Form` newtype around a record, where each field contains a validation function which will process its input value - `render`: The render function the component will use, which is the standard `State -> HTML` type in Halogen - ```purescript import Formless as F @@ -194,16 +201,26 @@ This type represents a function which takes your entire form, the input for this The `FormField` newtype represents the state of every field in the form: ```purescript -newtype FormField e i o = FormField +newtype FormField error input output = FormField { -- The value the user will input - input :: i + input :: input -- Whether the field has been modified yet (validators ignore untouched fields) , touched :: Boolean -- The result of validation, IF validation has been run on this field - , result :: Maybe (Either e o) + , result :: FormFieldResult error output } ``` +A field's result can be in one of several states, represented by the `FormFieldResult` type: + +```purescript +data FormFieldResult e o + = NotValidated + | Validating -- Useful to display a loading spinner during asynchronous / long validations + | Error e + | Success o +``` + Let's see some examples of validators written in this style: ```purescript @@ -272,12 +289,12 @@ These validators are building blocks that you can compose together to validate a validators :: Form Record (F.Validation Form Aff) validators = Form { name: isNonEmpty - , email1: isNonEmpty >>> validEmail >>> emailIsUsed - , email2: isNonEmpty >>> equalsEmail1 >>> emailIsUsed + , email1: isNonEmpty >>> validEmail >>> emailNotUsed + , email2: isNonEmpty >>> equalsEmail1 >>> emailNotUsed } ``` -Note how validators can be composed: `validEmail` takes a `String` and produces an `Email`, which is then passed to `emailIsUsed`, which takes an `Email` and produces an `Email`. You can use this to build up validators that change a field's output type over time. Composition with `>>>` will short-circuit on the first failure. +Note how validators can be composed: `validEmail` takes a `String` and produces an `Email`, which is then passed to `emailNotUsed`, which takes an `Email` and produces an `Email`. You can use this to build up validators that change a field's output type over time. Composition with `>>>` will short-circuit on the first failure. ### Render Function @@ -289,10 +306,11 @@ The main things to keep in mind when writing a render function for Formless: - You can extend Formless' functionality by embedding your own queries in the render function with `Raise` - You can mount external components inside Formless and control them from the parent with `send` and `send'` - You should use `F.set` to set a field's value, `F.modify` to modify a field with a function, `F.validate` to validate fields, and `F.setValidate` or `F.modifyValidate` to do both at the same time +- If you want to avoid running expensive or long-running validations on each key press, use the asynchronous versions (`F.asyncSetValidate`, etc.) and provide a number of milliseconds to debounce. You can use `getResult` to show a loading spinner when the result is `Validating`. - If you need to chain multiple operations, you can use `F.andThen` to provide multiple Formless queries - There are functions to get various parts of a field, given a symbol; these include `getInput`, `getResult`, `getError`, and more. -Let's write a render function using `setValidate` and `getInput`, using symbol proxies we've defined in the `where` clause: +Let's write a render function using `setValidate`, `asyncSetValidate`, and `getInput`, using symbol proxies we've defined in the `where` clause: ```purescript renderFormless :: ∀ m. F.State Form m -> F.HTML' Form m @@ -304,17 +322,19 @@ renderFormless fstate = ] , HH.input [ HP.value $ F.getInput _email1 fstate.form - , HE.onValueInput $ HE.input $ F.setValidate _email1 + -- This will help us avoid hitting the server on every single key press. + , HE.onValueInput $ HE.input $ F.asyncSetValidate debounceTime _email1 ] , HH.input [ HP.value $ F.getInput _email2 fstate.form - , HE.onValueInput $ HE.input $ F.setValidate _email2 + , HE.onValueInput $ HE.input $ F.asyncSetValidate debounceTime _email2 ] ] where _name = SProxy :: SProxy "name" _email1 SProxy :: SProxy "email1" _email2 = SProxy :: SProxy "email2" + debounceTime = Milliseconds 300.0 ``` It can be tedious to write out symbol proxies for every field you want to access in a form. You can instead generate a record of these proxies automatically using the `mkSProxies` function: @@ -330,7 +350,6 @@ x = prx.name Now, instead of writing out proxies over and over, you can just import the proxies record! - ## Mounting The Component Whew! With those three functions and the `Form` type, we've now got everything necessary to run Formless. Let's bring it all together by mounting the component and handling its `Submitted` output message: diff --git a/src/Formless.purs b/src/Formless.purs index 072bef6..009aa8b 100644 --- a/src/Formless.purs +++ b/src/Formless.purs @@ -9,6 +9,7 @@ module Formless ( module Formless.Class.Initial , module Formless.Component + , module Formless.Data.FormFieldResult , module Formless.Retrieve , module Formless.Transform.Record , module Formless.Transform.Row @@ -18,12 +19,13 @@ module Formless , module Formless.Query ) where -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, 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 (andThen, andThen_, getState, initialize, initialize_, modify, modifyAll, modifyAll_, modifyValidate, modifyValidateAll, modifyValidateAll_, modifyValidate_, modify_, raise, raise_, reset, resetAll, resetAll_, reset_, send, send', set, setAll, setAll_, setValidate, setValidateAll, setValidateAll_, setValidate_, set_, submit, submitReply, submit_, validate, validateAll, validateAll_, validate_) +import Formless.Class.Initial (class Initial, initial) +import Formless.Component (component) +import Formless.Data.FormFieldResult (FormFieldResult(..), _Error, _Success, fromEither, toMaybe) +import Formless.Retrieve (FormFieldGet, FormFieldLens, GetAll, GetError(..), GetInputField(..), GetOutput(..), GetResultField(..), GetTouchedField(..), _Field, _FieldError, _FieldInput, _FieldOutput, _FieldResult, _FieldTouched, getError, getErrorAll, getField, getInput, getInputAll, getOutput, getOutputAll, getResult, getResultAll, getTouched, getTouchedAll) +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, Debouncer, HTML, HTML', Input, Input', InternalState(..), Message(..), Message', PublicState, Query(..), Query', State, StateRow, StateStore, ValidStatus(..)) +import Formless.Types.Form (ErrorType, FormField(..), FormFieldRow, FormProxy(..), InputField(..), InputFunction(..), InputType, OutputField(..), OutputType, U(..)) +import Formless.Validation (EmptyValidators(..), Validation(..), hoistFn, hoistFnE, hoistFnE_, hoistFnME, hoistFnME_, hoistFn_, noValidation, runValidation) +import Formless.Query (andThen, andThen_, asyncModifyValidate, asyncModifyValidate_, asyncSetValidate, asyncSetValidate_, getState, loadForm, loadForm_, modify, modifyAll, modifyAll_, modifyValidate, modifyValidateAll, modifyValidateAll_, modifyValidate_, modify_, raise, raise_, reset, resetAll, resetAll_, reset_, send, send', set, setAll, setAll_, setValidate, setValidateAll, setValidateAll_, setValidate_, set_, submit, submitReply, submit_, validate, validateAll, validateAll_, validate_) diff --git a/src/Formless/Component.purs b/src/Formless/Component.purs index 9c4c93b..f0d1e5d 100644 --- a/src/Formless/Component.purs +++ b/src/Formless/Component.purs @@ -12,9 +12,13 @@ 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 Effect.Aff.Class (class MonadAff) +import Effect.Ref as Ref +import Formless.Data.FormFieldResult (FormFieldResult(..)) +import Formless.Internal.Debounce (debounceForm) +import Formless.Internal.Transform as Internal import Formless.Types.Component (Component, DSL, Input, InternalState(..), Message(..), PublicState, Query(..), State, StateStore, ValidStatus(..)) +import Formless.Types.Form (FormField, InputField, InputFunction, OutputField, U) import Formless.Validation (Validation) import Halogen as H import Halogen.HTML.Events as HE @@ -27,7 +31,7 @@ import Unsafe.Coerce (unsafeCoerce) component :: ∀ pq cq cs form m is ixs ivs fs fxs us vs os ifs ivfs . Ord cs - => Monad m + => MonadAff m => RL.RowToList is ixs => RL.RowToList fs fxs => EqRecord ixs is @@ -50,11 +54,13 @@ component => Newtype (form Variant U) (Variant us) => Component pq cq cs form m component = - H.parentComponent + H.lifecycleParentComponent { initialState , render: extract , eval , receiver: HE.input Receive + , initializer: Just $ H.action Initialize + , finalizer: Nothing } where @@ -66,13 +72,25 @@ component = , submitAttempts: 0 , submitting: false , form: Internal.inputFieldsToFormFields initialInputs - , internal: InternalState { allTouched: false, initialInputs, validators } + , internal: InternalState + { allTouched: false + , initialInputs + , validators + , debounceRef: Nothing + } } eval :: Query pq cq cs form m ~> DSL pq cq cs form m eval = case _ of + Initialize a -> do + ref <- H.liftEffect $ Ref.new Nothing + modifyState_ \st -> st + { internal = over InternalState (_ { debounceRef = Just ref }) st.internal } + pure a + Modify variant a -> do - modifyState_ \st -> st { form = Internal.unsafeModifyInputVariant variant st.form } + modifyState_ \st -> st + { form = Internal.unsafeModifyInputVariant identity variant st.form } eval $ SyncFormData a Validate variant a -> do @@ -83,17 +101,35 @@ component = eval $ SyncFormData a -- Provided as a separate query to minimize state updates / re-renders - ModifyValidate 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 - + ModifyValidate milliseconds variant a -> do + let + modifyWith + :: (forall e o. FormFieldResult e o -> FormFieldResult e o) + -> DSL pq cq cs form m (form Record FormField) + modifyWith f = do + s <- modifyState \st -> st { form = Internal.unsafeModifyInputVariant f variant st.form } + pure s.form + + validate = do + st <- getState + let vs = (unwrap st.internal).validators + form <- H.lift $ Internal.unsafeRunValidationVariant (unsafeCoerce variant) vs st.form + modifyState_ _ { form = form } + pure form + + case milliseconds of + Nothing -> do + _ <- modifyWith identity + _ <- validate + eval (SyncFormData a) + Just ms -> do + debounceForm + ms + (modifyWith identity) + (modifyWith (const Validating) *> validate) + (eval $ SyncFormData a) + pure a + Reset variant a -> do modifyState_ \st -> st { form = Internal.replaceFormFieldInputs (unwrap st.internal).initialInputs st.form @@ -190,7 +226,7 @@ component = H.raise (Emit query) pure a - Initialize formInputs a -> do + LoadForm formInputs a -> do st <- getState new <- modifyState _ { validity = Incomplete @@ -201,9 +237,14 @@ component = , form = Internal.replaceFormFieldInputs formInputs st.form , internal = over InternalState - (_ { allTouched = false, initialInputs = formInputs }) + (_ + { allTouched = false + , initialInputs = formInputs + } + ) st.internal } + H.raise $ Changed $ getPublicState new pure a diff --git a/src/Formless/Data/FormFieldResult.purs b/src/Formless/Data/FormFieldResult.purs new file mode 100644 index 0000000..4e3274d --- /dev/null +++ b/src/Formless/Data/FormFieldResult.purs @@ -0,0 +1,61 @@ +module Formless.Data.FormFieldResult where + +import Prelude + +import Data.Either (Either(..)) +import Data.Generic.Rep (class Generic) +import Data.Generic.Rep.Show (genericShow) +import Data.Lens (Prism', prism') +import Data.Maybe (Maybe(..)) + +-- | A data type which represents the possible output states of the field. Use +-- | the helpers in `Retrieve` to easily manipulate this type. +data FormFieldResult error output + = NotValidated + | Validating + | Error error + | Success output + +derive instance genericFormFieldResult :: Generic (FormFieldResult e o) _ +derive instance eqFormFieldResult :: (Eq e, Eq o) => Eq (FormFieldResult e o) +derive instance functorFormFieldResult :: Functor (FormFieldResult e) + +instance applyFormFieldResult :: Apply (FormFieldResult e) where + apply (Success f) r = map f r + apply (Error e) _ = Error e + apply Validating _ = Validating + apply NotValidated _ = NotValidated + +instance applicativeFormFieldResult :: Applicative (FormFieldResult e) where + pure = Success + +instance bindFormFieldResult :: Bind (FormFieldResult e) where + bind (Success a) f = f a + bind (Error e) _ = Error e + bind Validating _ = Validating + bind NotValidated _ = NotValidated + +instance monadFormFieldResult :: Monad (FormFieldResult e) + +instance showFormFieldResult :: (Show e, Show o) => Show (FormFieldResult e o) where + show = genericShow + +fromEither :: forall e o. Either e o -> FormFieldResult e o +fromEither = case _ of + Left e -> Error e + Right v -> Success v + +toMaybe :: forall e o. FormFieldResult e o -> Maybe o +toMaybe = case _ of + Success v -> Just v + _ -> Nothing + +_Error :: forall e o. Prism' (FormFieldResult e o) e +_Error = prism' Error case _ of + Error e -> Just e + _ -> Nothing + +_Success :: forall e o. Prism' (FormFieldResult e o) o +_Success = prism' Success case _ of + Success o -> Just o + _ -> Nothing \ No newline at end of file diff --git a/src/Formless/Internal/Debounce.purs b/src/Formless/Internal/Debounce.purs new file mode 100755 index 0000000..b114c1c --- /dev/null +++ b/src/Formless/Internal/Debounce.purs @@ -0,0 +1,60 @@ +module Formless.Internal.Debounce where + +import Prelude + +import Data.Maybe (Maybe(..)) +import Data.Newtype (unwrap) +import Data.Traversable (traverse, traverse_) +import Effect.Aff (Milliseconds, delay, error, forkAff, killFiber) +import Effect.Aff.AVar as AVar +import Effect.Aff.Class (class MonadAff) +import Effect.Ref as Ref +import Formless.Types.Component (DSL, Debouncer) +import Formless.Types.Form (FormField) +import Halogen as H +import Renderless.State (getState, modifyState_) + +-- | A helper function to debounce actions on the form and form fields. Implemented +-- | to reduce type variables necessary in the `State` type + +debounceForm + :: forall pq cq cs form m a + . MonadAff m + => Milliseconds + -> DSL pq cq cs form m (form Record FormField) + -> DSL pq cq cs form m (form Record FormField) + -> DSL pq cq cs form m a + -> DSL pq cq cs form m Unit +debounceForm ms pre post last = do + state <- getState + + let + ref = (unwrap state.internal).debounceRef + mkFiber v = H.liftAff $ forkAff do + delay ms + AVar.put unit v + + debouncer :: Maybe Debouncer <- H.liftEffect $ map join $ traverse Ref.read ref + + case debouncer of + Nothing -> do + var <- H.liftAff $ AVar.empty + fiber <- mkFiber var + + void $ H.fork do + _ <- H.liftAff (AVar.take var) + H.liftEffect $ traverse_ (Ref.write Nothing) ref + form <- post + modifyState_ _ { form = form } + last + + H.liftEffect $ traverse_ (Ref.write $ Just { var, fiber }) ref + form <- pre + modifyState_ _ { form = form } + pure unit + + Just db -> do + let var = db.var + _ <- H.liftAff $ killFiber (error "time's up!") db.fiber + fiber <- mkFiber var + H.liftEffect $ traverse_ (Ref.write $ Just { var, fiber }) ref \ No newline at end of file diff --git a/src/Formless/Transform/Internal.purs b/src/Formless/Internal/Transform.purs similarity index 94% rename from src/Formless/Transform/Internal.purs rename to src/Formless/Internal/Transform.purs index 0c2da69..9d7a374 100644 --- a/src/Formless/Transform/Internal.purs +++ b/src/Formless/Internal/Transform.purs @@ -1,8 +1,7 @@ -module Formless.Transform.Internal where +module Formless.Internal.Transform where import Prelude -import Data.Either (Either(..), hush) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, over, unwrap, wrap) import Data.Symbol (class IsSymbol, SProxy(..)) @@ -10,6 +9,7 @@ import Data.Tuple (Tuple(..), fst, snd) import Data.Variant (Variant) import Data.Variant.Internal (VariantRep(..)) import Formless.Types.Form (FormField(..), FormFieldRow, InputField(..), InputFunction, OutputField(..), U) +import Formless.Data.FormFieldResult (FormFieldResult(..), fromEither, toMaybe) import Formless.Validation (Validation, runValidation) import Prim.Row as Row import Prim.RowList as RL @@ -150,15 +150,18 @@ validateAll vs fs = map wrap $ fromScratch <$> builder -- Don't Tell Your Boss -- | Given a variant of InputFunction and a record with the same labels but --- | FormField values, replace the input of the form field. +-- | FormField values, replace the input of the form field. In addition, modify +-- | the form field result to represent whether async validation is going to +-- | occur. unsafeModifyInputVariant :: ∀ form x y . Newtype (form Variant InputFunction) (Variant x) => Newtype (form Record FormField) { | y } - => form Variant InputFunction + => (forall e o. FormFieldResult e o -> FormFieldResult e o) + -> form Variant InputFunction -> form Record FormField -> form Record FormField -unsafeModifyInputVariant var rec = wrap $ unsafeSet (fst rep) val (unwrap rec) +unsafeModifyInputVariant f var rec = wrap $ unsafeSet (fst rep) val (unwrap rec) where rep :: ∀ e i o. Tuple String (InputFunction e i o) rep = case unsafeCoerce (unwrap var) of @@ -166,7 +169,8 @@ unsafeModifyInputVariant var rec = wrap $ unsafeSet (fst rep) val (unwrap rec) val :: ∀ e i o. FormField e i o val = case unsafeGet (fst rep) (unwrap rec) of - FormField x -> FormField $ x { input = unwrap (snd rep) $ x.input } + FormField x -> FormField $ x + { input = unwrap (snd rep) $ x.input, result = f x.result } unsafeRunValidationVariant :: ∀ form x y z m @@ -188,10 +192,9 @@ unsafeRunValidationVariant var vs rec = rec2 rec2 = case unsafeGet label (unwrap rec) of FormField x -> do res <- runValidation (unsafeGet label $ unwrap vs) rec x.input - let rec' = unsafeSet label (FormField $ x { result = Just res }) (unwrap rec) + let rec' = unsafeSet label (FormField $ x { result = fromEither res }) (unwrap rec) pure (wrap rec') - ----- -- Classes (Internal) @@ -269,11 +272,7 @@ instance inputFieldsToFormFieldsCons val = transform $ Record.get _name r rest = inputFieldsToFormFieldsBuilder (RLProxy :: RLProxy tail) r first = Builder.insert _name val - transform (InputField input) = FormField - { input - , touched: false - , result: Nothing - } + transform (InputField input) = FormField { input, touched: false, result: NotValidated } ---------- -- Flip all form fields if valid @@ -300,7 +299,7 @@ instance formFieldsToMaybeOutputCons _name = SProxy :: SProxy name val :: Maybe (OutputField e i o) - val = map OutputField $ join $ map hush (unwrap $ Record.get _name r).result + val = OutputField <$> toMaybe (unwrap $ Record.get _name r).result rest :: Maybe (FromScratch from) rest = formFieldsToMaybeOutputBuilder (RLProxy :: RLProxy tail) r @@ -324,7 +323,7 @@ instance consCountErrors where countErrorsImpl _ r = do let res = case (unwrap $ Record.get (SProxy :: SProxy name) r).result of - Just (Left _) -> 1 + Error _ -> 1 _ -> 0 res + countErrorsImpl (RLProxy :: RLProxy tail) r @@ -380,7 +379,7 @@ instance applyToValidationCons 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 } + pure $ wrap $ formField { result = fromEither res } -------- @@ -438,4 +437,4 @@ instance replaceFormFieldInputsTouchedCons first = Builder.insert _name - (FormField $ f { input = unwrap i, touched = false, result = Nothing }) + (FormField $ f { input = unwrap i, touched = false, result = NotValidated }) diff --git a/src/Formless/Query.purs b/src/Formless/Query.purs index 7d92c02..ef81460 100644 --- a/src/Formless/Query.purs +++ b/src/Formless/Query.purs @@ -7,9 +7,10 @@ module Formless.Query where import Prelude -import Data.Maybe (Maybe) +import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, wrap) import Data.Symbol (class IsSymbol, SProxy) +import Data.Time.Duration (Milliseconds) import Data.Variant (Variant, inj) import Formless.Class.Initial (class Initial, initial) import Formless.Transform.Record (WrapField, wrapInputFields, wrapInputFunctions) @@ -70,20 +71,20 @@ 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 +loadForm :: ∀ pq cq cs form m a . form Record InputField -> a -> Query pq cq cs form m a -initialize = Initialize +loadForm = LoadForm -- | `initialize` as an action, so you don't need to specify a `Unit` -- | result. Use to skip a use of `Halogen.action`. -initialize_ +loadForm_ :: ∀ pq cq cs form m . form Record InputField -> Query pq cq cs form m Unit -initialize_ = flip Initialize unit +loadForm_ = flip LoadForm unit -- | Perform two Formless actions in sequence. Can be chained arbitrarily. -- | Useful when a field needs to modify itself on change and also trigger @@ -159,7 +160,7 @@ setValidate -> i -> a -> Query pq cq cs form m a -setValidate sym i = ModifyValidate (wrap (inj sym (wrap (const i)))) +setValidate sym i = ModifyValidate Nothing (wrap (inj sym (wrap (const i)))) -- | `setValidate` as an action, so you don't need to specify a `Unit` -- | result. Use to skip a use of `Halogen.action`. @@ -171,7 +172,36 @@ setValidate_ => SProxy sym -> i -> Query pq cq cs form m Unit -setValidate_ sym i = ModifyValidate (wrap (inj sym (wrap (const i)))) unit +setValidate_ sym i = ModifyValidate Nothing (wrap (inj sym (wrap (const i)))) unit + +-- | Set the input value of a form field at the specified label, while debouncing +-- | validation so that it only runs after the specified amount of time has elapsed +-- | since the last modification. Useful when you need to avoid expensive validation +-- | but do not want to wait for a blur event to validate. +asyncSetValidate + :: ∀ 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 + => Milliseconds + -> SProxy sym + -> i + -> a + -> Query pq cq cs form m a +asyncSetValidate ms sym i = ModifyValidate (Just ms) (wrap (inj sym (wrap (const i)))) + +-- | `asyncSetValidate` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +asyncSetValidate_ + :: ∀ 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 + => Milliseconds + -> SProxy sym + -> i + -> Query pq cq cs form m Unit +asyncSetValidate_ ms sym i = ModifyValidate (Just ms) (wrap (inj sym (wrap (const i)))) unit -- | Modify the input value of a form field at the specified label with the -- | provided function. @@ -209,7 +239,7 @@ modifyValidate -> (i -> i) -> a -> Query pq cq cs form m a -modifyValidate sym f = ModifyValidate (wrap (inj sym (wrap f))) +modifyValidate sym f = ModifyValidate Nothing (wrap (inj sym (wrap f))) -- | `modifyValidate` as an action, so you don't need to specify a `Unit` -- | result. Use to skip a use of `Halogen.action`. @@ -221,7 +251,36 @@ modifyValidate_ => SProxy sym -> (i -> i) -> Query pq cq cs form m Unit -modifyValidate_ sym f = ModifyValidate (wrap (inj sym (wrap f))) unit +modifyValidate_ sym f = ModifyValidate Nothing (wrap (inj sym (wrap f))) unit + +-- | Modify the input value of a form field at the specified label, while debouncing +-- | validation so that it only runs after the specified amount of time has elapsed +-- | since the last modification. Useful when you need to avoid expensive validation +-- | but do not want to wait for a blur event to validate. +asyncModifyValidate + :: ∀ 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 + => Milliseconds + -> SProxy sym + -> (i -> i) + -> a + -> Query pq cq cs form m a +asyncModifyValidate ms sym f = ModifyValidate (Just ms) (wrap (inj sym (wrap f))) + +-- | `asyncModifyValidate` as an action, so you don't need to specify a `Unit` +-- | result. Use to skip a use of `Halogen.action`. +asyncModifyValidate_ + :: ∀ 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 + => Milliseconds + -> SProxy sym + -> (i -> i) + -> Query pq cq cs form m Unit +asyncModifyValidate_ ms sym f = ModifyValidate (Just ms) (wrap (inj sym (wrap f))) unit -- | Reset the value of the specified form field to its default value -- | according to the `Initial` type class. diff --git a/src/Formless/Retrieve.purs b/src/Formless/Retrieve.purs index 66cfa10..dc598de 100644 --- a/src/Formless/Retrieve.purs +++ b/src/Formless/Retrieve.purs @@ -3,16 +3,14 @@ module Formless.Retrieve where import Prelude -import Data.Either (Either, either, hush) 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.Data.FormFieldResult (FormFieldResult(..), _Error, _Success, toMaybe) import Formless.Types.Form (FormField(..), FormFieldRow) import Heterogeneous.Mapping (class HMap, class Mapping, hmap) import Prim.Row as Row @@ -26,23 +24,23 @@ getField sym = view (_Field sym) -- | Given a form, get the input at the specified symbol getInput :: ∀ e i o. FormFieldGet e i o i -getInput sym = view (_Input sym) +getInput sym = view (_FieldInput sym) -- | Given a form, get the touched field at the specified symbol getTouched :: ∀ e i o. FormFieldGet e i o Boolean -getTouched sym = view (_Touched sym) +getTouched sym = view (_FieldTouched sym) -- | Given a form, get the result at the specified symbol -getResult :: ∀ e i o. FormFieldGet e i o (Maybe (Either e o)) -getResult sym = view (_Result sym) +getResult :: ∀ e i o. FormFieldGet e i o (FormFieldResult e o) +getResult sym = view (_FieldResult sym) -- | Given a form, get the error (if it exists) at the specified symbol getError :: ∀ e i o. FormFieldGet e i o (Maybe e) -getError sym = preview (_Error sym) +getError sym = preview (_FieldError sym) -- | Given a form, get the output (if it exists) at the specified symbol getOutput :: ∀ e i o. FormFieldGet e i o (Maybe o) -getOutput sym = preview (_Output sym) +getOutput sym = preview (_FieldOutput sym) ---------- -- Summary functions @@ -75,38 +73,38 @@ _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") +_FieldInput :: ∀ e i o. FormFieldLens e i o i +_FieldInput 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") +_FieldTouched :: ∀ e i o. FormFieldLens e i o Boolean +_FieldTouched 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") +_FieldResult :: ∀ e i o. FormFieldLens e i o (FormFieldResult e o) +_FieldResult 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 +_FieldError :: ∀ 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 +_FieldError sym = _FieldResult sym <<< _Error -- | A traversal to operate on the possible output inside the 'result' field at -- | a given symbol in your form -_Output +_FieldOutput :: ∀ 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 +_FieldOutput sym = _FieldResult sym <<< _Success ---------- -- Types @@ -159,7 +157,7 @@ instance getTouchedField :: Mapping GetTouchedField (FormField e i o) Boolean wh data GetResultField = GetResultField -- | Heterogeneous type class for the getResultField function -instance getResultField :: Mapping GetResultField (FormField e i o) (Maybe (Either e o)) where +instance getResultField :: Mapping GetResultField (FormField e i o) (FormFieldResult e o) where mapping GetResultField (FormField { result }) = result -- | Data constructor for the getError function @@ -167,11 +165,13 @@ 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 + mapping GetError (FormField { result }) = case result of + Error e -> Just e + _ -> Nothing -- | 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 + mapping GetOutput (FormField { result }) = toMaybe result diff --git a/src/Formless/Transform/Row.purs b/src/Formless/Transform/Row.purs index fa2f905..f782ff0 100644 --- a/src/Formless/Transform/Row.purs +++ b/src/Formless/Transform/Row.purs @@ -6,7 +6,7 @@ import Data.Newtype (class Newtype, wrap) import Data.Symbol (class IsSymbol, SProxy(..)) import Formless.Class.Initial (class Initial, initial) import Formless.Types.Form (FormProxy, InputField(..)) -import Formless.Transform.Internal (class Row1Cons, FromScratch, fromScratch) +import Formless.Internal.Transform (class Row1Cons, FromScratch, fromScratch) import Prim.Row as Row import Prim.RowList as RL import Record.Builder as Builder diff --git a/src/Formless/Types/Component.purs b/src/Formless/Types/Component.purs index 784c90b..b8661aa 100644 --- a/src/Formless/Types/Component.purs +++ b/src/Formless/Types/Component.purs @@ -9,6 +9,9 @@ import Data.Generic.Rep.Show (genericShow) import Data.Maybe (Maybe) import Data.Newtype (class Newtype) import Data.Variant (Variant) +import Effect.Aff (Fiber, Milliseconds) +import Effect.Aff.AVar (AVar) +import Effect.Ref (Ref) import Formless.Types.Form (FormField, InputField, InputFunction, OutputField, U) import Formless.Validation (Validation) import Halogen as H @@ -19,7 +22,7 @@ import Halogen.HTML as HH data Query pq cq cs form m a = Modify (form Variant InputFunction) a | Validate (form Variant U) a - | ModifyValidate (form Variant InputFunction) a + | ModifyValidate (Maybe Milliseconds) (form Variant InputFunction) a | Reset (form Variant InputField) a | SetAll (form Record InputField) a | ModifyAll (form Record InputFunction) a @@ -29,16 +32,16 @@ data Query pq cq cs form m a | SubmitReply (Maybe (form Record OutputField) -> a) | GetState (PublicState form -> a) | Send cs (cq a) + | LoadForm (form Record InputField) a | SyncFormData a | Raise (pq Unit) a - | Initialize (form Record InputField) a + | Initialize 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) +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 @@ -50,8 +53,7 @@ type Component pq cq cs form m 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 +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 @@ -86,17 +88,26 @@ newtype InternalState form m = InternalState { initialInputs :: form Record InputField , validators :: form Record (Validation form m) , allTouched :: Boolean + , debounceRef :: Maybe (Ref (Maybe Debouncer)) } derive instance newtypeInternalState :: Newtype (InternalState form m) _ +-- | A type to represent a running debouncer +type Debouncer = + { var :: AVar Unit + , fiber :: Fiber Unit + } + -- | 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 diff --git a/src/Formless/Types/Form.purs b/src/Formless/Types/Form.purs index 2556311..62519ae 100644 --- a/src/Formless/Types/Form.purs +++ b/src/Formless/Types/Form.purs @@ -2,9 +2,8 @@ module Formless.Types.Form where import Prelude -import Data.Either (Either) -import Data.Maybe (Maybe) import Data.Newtype (class Newtype) +import Formless.Data.FormFieldResult (FormFieldResult) -- | Create a proxy for your form type, for use with functions that generate records from -- | form proxies. @@ -32,13 +31,13 @@ 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) +derive 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) + , result :: FormFieldResult error output ) ---------- diff --git a/test/Main.purs b/test/Main.purs index 1e68f4b..1dc181d 100644 --- a/test/Main.purs +++ b/test/Main.purs @@ -2,66 +2,7 @@ module Test.Main where import Prelude -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) -import Data.Newtype (class Newtype) -import Data.Symbol (SProxy(..)) -import Data.Variant (Variant, inj) import Effect (Effect) -import Effect.Aff (Aff) -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') -import Test.Unit.Main (runTest) main :: Effect Unit -main = runTest do - suite "variant manipulation" do - test "can set input variant" do - let res = unsafeModifyInputVariant testInputV testFormR - equal' "Setting inputs not equal" res testFormInputRes - - test "can run validation" do - res <- unsafeRunValidationVariant testValidationV testValidationR testFormR - equal' "Validation not equal" res testFormValidRes - - ----------- --- Unsafe Internals - -newtype Form r f = Form (r ( foo :: f Void String String )) -derive instance newtypeForm :: Newtype (Form r f) _ -derive newtype instance eqFormField :: Eq (Form Record FormField) - -testFormR :: Form Record FormField -testFormR = Form { foo: FormField { input: "goodbye", touched: true, result: Nothing } } - ------ --- Set Inputs - -testInputV :: Form Variant InputFunction -testInputV = Form $ inj (SProxy :: SProxy "foo") (InputFunction \x -> "hello " <> x) - -testFormInputRes :: Form Record FormField -testFormInputRes = Form - { foo: FormField { input: "hello goodbye", touched: true, result: Nothing } } - ------ --- Validation - -testValidationR :: Form Record (Validation Form Aff) -testValidationR = Form { foo: hoistFn_ identity } - -testValidationV :: Form Variant U -testValidationV = Form $ inj (SProxy :: SProxy "foo") U - -testFormValidRes :: Form Record FormField -testFormValidRes = Form - { foo: FormField - { input: "goodbye" - , touched: true - , result: Just (Right "goodbye") - } - } +main = pure unit \ No newline at end of file