Merge pull request #40 from thomashoneyman/async-validation

Support debounce for expensive validation functions on form fields

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)

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

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
   ]

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" ]
+  ]

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
   }

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