Makes sure that the last captured input is used to run validations instead of the first input (#63)

* Makes sure that the last captured input is used to run validations instead of the first input.

* Fix bug when async validation overwrites the other form fields with an old snapshot.

unsafeRunValidationVariant in Internal.Transform now returns a function that modifies the form such that this transformation can be run against the current value of the form instead of the old one which was captured before the (possibly async) validations have been run.

Author: skress

src/Formless/Component.purs

@@ -237,9 +237,10 @@ handleAction handleAction' handleEvent action = flip match action
   , validate: \variant -> do
       st <- H.get
       let validators = (unwrap st.internal).validators
-      form <- H.lift do
+      formProcessor <- H.lift do
         IT.unsafeRunValidationVariant variant validators st.form
-      H.modify_ _ { form = form }
+      st' <- H.get
+      H.modify_ _ { form = formProcessor st'.form }
       handleAction handleAction' handleEvent sync
 
   , modifyValidate: \(Tuple milliseconds variant) -> do
@@ -255,10 +256,12 @@ handleAction handleAction' handleEvent action = flip match action
         validate = do
           st <- H.get
           let vs = (unwrap st.internal).validators
-          form <- H.lift do
+          formProcessor <- H.lift do
             IT.unsafeRunValidationVariant (unsafeCoerce variant) vs st.form
-          H.modify_ _ { form = form }
-          pure form
+          st' <- H.get
+          let newForm = formProcessor st'.form
+          H.modify_ _ { form = newForm }
+          pure newForm
 
       case milliseconds of
         Nothing ->

src/Formless/Internal/Debounce.purs

@@ -11,8 +11,9 @@ import Effect.Aff.AVar as AVar
 import Effect.Aff.Class (class MonadAff)
 import Effect.Ref (Ref)
 import Effect.Ref as Ref
-import Formless.Types.Component (HalogenM)
+import Formless.Types.Component (HalogenM, Debouncer)
 import Formless.Types.Form (FormField)
+import Halogen (ForkId)
 import Halogen as H
 
 -- | A helper function to debounce actions on the form and form fields. Implemented
@@ -42,19 +43,19 @@ debounceForm ms pre post last = do
       var <- H.liftAff $ AVar.empty
       fiber <- mkFiber var
 
-      _ <- H.fork do
-        void $ H.liftAff (AVar.take var)
-        H.liftEffect $ traverse_ (Ref.write Nothing) dbRef
-        atomic post (Just last)
+      forkId <- processAfterDelay var dbRef
 
-      H.liftEffect $ for_ dbRef $ Ref.write (Just { var, fiber })
+      H.liftEffect $ for_ dbRef $ Ref.write (Just { var, fiber, forkId })
       atomic pre Nothing
 
     Just db -> do
       let var = db.var
+          forkId' = db.forkId
       void $ killFiber' db.fiber
+      void $ H.kill forkId'
       fiber <- mkFiber var
-      H.liftEffect $ for_ dbRef $ Ref.write (Just { var, fiber })
+      forkId <- processAfterDelay var dbRef 
+      H.liftEffect $ for_ dbRef $ Ref.write (Just { var, fiber, forkId })
 
   where
   mkFiber :: AVar Unit -> HalogenM form st act ps msg m (Fiber Unit)
@@ -68,6 +69,12 @@ debounceForm ms pre post last = do
   readRef :: forall x n. MonadAff n => Maybe (Ref (Maybe x)) -> n (Maybe x)
   readRef = H.liftEffect <<< map join <<< traverse Ref.read
 
+  processAfterDelay :: AVar Unit -> (Maybe (Ref (Maybe Debouncer))) -> HalogenM form st act ps msg m ForkId
+  processAfterDelay var dbRef = H.fork do
+    void $ H.liftAff (AVar.take var)
+    H.liftEffect $ traverse_ (Ref.write Nothing) dbRef
+    atomic post (Just last)
+  
   atomic
     :: forall n
      . MonadAff n

src/Formless/Internal/Transform.purs

@@ -184,19 +184,18 @@ unsafeRunValidationVariant
   => form Variant U
   -> form Record (Validation form m)
   -> form Record FormField
-  -> m (form Record FormField)
+  -> m ((form Record FormField) -> (form Record FormField))
 unsafeRunValidationVariant var vs rec = rec2
   where
     label :: String
     label = case unsafeCoerce (unwrap var) of
       VariantRep x -> x.type
 
-    rec2 :: m (form Record FormField)
+    rec2 :: m ((form Record FormField) -> (form Record FormField))
     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 = fromEither res }) (unwrap rec)
-        pure (wrap rec')
+        pure (\newRec -> wrap $ unsafeSet label (FormField $ x { result = fromEither res }) (unwrap newRec))
 
 -----
 -- Classes (Internal)

src/Formless/Types/Component.purs

@@ -20,6 +20,7 @@ import Type.Row (type (+))
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.Query.ChildQuery (ChildQueryBox)
+import Halogen.Query.HalogenM (ForkId)
 
 -- | A type representing the various functions that can be provided to extend
 -- | the Formless component. Usually only the `render` function is required,
@@ -160,6 +161,7 @@ derive instance newtypeInternalState :: Newtype (InternalState form m) _
 type Debouncer =
   { var :: AVar Unit
   , fiber :: Fiber Unit
+  , forkId :: ForkId
   }
 
 -- | A type to represent validation status