diff --git a/src/Formless/Component.purs b/src/Formless/Component.purs index 27b8b22..61edd78 100644 --- a/src/Formless/Component.purs +++ b/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 -> diff --git a/src/Formless/Internal/Debounce.purs b/src/Formless/Internal/Debounce.purs index f65b582..fee18f9 100755 --- a/src/Formless/Internal/Debounce.purs +++ b/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 diff --git a/src/Formless/Internal/Transform.purs b/src/Formless/Internal/Transform.purs index 93b9aeb..91cfd6c 100644 --- a/src/Formless/Internal/Transform.purs +++ b/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) diff --git a/src/Formless/Types/Component.purs b/src/Formless/Types/Component.purs index 5d679ef..6199604 100644 --- a/src/Formless/Types/Component.purs +++ b/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