Skip to content

Commit

Permalink
Makes sure that the last captured input is used to run validations in…
Browse files Browse the repository at this point in the history
…stead 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.
  • Loading branch information
skress authored and thomashoneyman committed Jan 27, 2020
1 parent f7ad5ce commit b42d54e
Show file tree
Hide file tree
Showing 4 changed files with 27 additions and 16 deletions.
13 changes: 8 additions & 5 deletions src/Formless/Component.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 ->
Expand Down
21 changes: 14 additions & 7 deletions src/Formless/Internal/Debounce.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand All @@ -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
Expand Down
7 changes: 3 additions & 4 deletions src/Formless/Internal/Transform.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 2 additions & 0 deletions src/Formless/Types/Component.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit b42d54e

Please sign in to comment.