From 7c77e52faa71e43324087903c905f9d493b1dfb7 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 8 Aug 2019 21:28:22 +0200
Subject: Finish payment add modal

---
 client/src/Component/Input.hs | 69 ++++++++++++++++++++++++++++---------------
 1 file changed, 46 insertions(+), 23 deletions(-)

(limited to 'client/src/Component/Input.hs')

diff --git a/client/src/Component/Input.hs b/client/src/Component/Input.hs
index d679f9b..abdc51c 100644
--- a/client/src/Component/Input.hs
+++ b/client/src/Component/Input.hs
@@ -40,7 +40,7 @@ defaultInputIn = InputIn
 
 data InputOut t a = InputOut
   { _inputOut_raw   :: Dynamic t Text
-  , _inputOut_value :: Dynamic t (Maybe (Validation Text a))
+  , _inputOut_value :: Dynamic t (Validation Text a)
   , _inputOut_enter :: Event t ()
   }
 
@@ -64,27 +64,14 @@ input inputIn reset validate = do
 
         value =  R._textInput_value textInput
 
-        containerAttr = R.ffor validatedValue (\v ->
+        containerAttr = R.ffor inputError (\e ->
           M.singleton "class" $ T.intercalate " "
             [ "textInput"
-            , if Maybe.fromMaybe False (ValidationUtil.isFailure <$> v) then "error" else ""
+            , if Maybe.isJust e then "error" else ""
             ])
 
-    -- Clear validation errors after reset
-    delayedReset <- R.delay (0.1 :: NominalDiffTime) reset
-
-    validatedValue <- R.holdDyn Nothing $ R.attachWith
-      (\v (clearValidation, validateEmpty) ->
-        if clearValidation
-           then Nothing
-           else Just (_inputIn_validation inputIn $ (if validateEmpty then "" else v)))
-      (R.current value)
-      (R.leftmost
-        [ const (False, True) <$> resetClic
-        , (\f -> (f, False)) <$> (R.updated . R._textInput_hasFocus $ textInput)
-        , const (False, False) <$> validate
-        , const (True, False) <$> delayedReset
-        ])
+    let valueWithValidation = R.ffor value (\v -> (v, _inputIn_validation inputIn $ v))
+    inputError <- getInputError valueWithValidation validate
 
     (textInput, resetClic) <- R.elDynAttr "div" containerAttr $ do
 
@@ -108,7 +95,7 @@ input inputIn reset validate = do
             return R.never
 
       R.divClass "errorMessage" $
-        R.dynText . fmap validationError $ validatedValue
+        R.dynText . fmap (Maybe.fromMaybe "") $ inputError
 
       return (textInput, resetClic)
 
@@ -116,10 +103,46 @@ input inputIn reset validate = do
 
   return $ InputOut
     { _inputOut_raw = value
-    , _inputOut_value = validatedValue
+    , _inputOut_value = fmap snd valueWithValidation
     , _inputOut_enter = enter
     }
 
-validationError :: Maybe (Validation Text a) -> Text
-validationError (Just (Failure e)) = e
-validationError _                  = ""
+getInputError
+  :: forall t m a b c. MonadWidget t m
+  => Dynamic t (Text, Validation Text a)
+  -> Event t c
+  -> m (Dynamic t (Maybe Text))
+getInputError validatedValue validate = do
+  let errorDynamic = fmap (\(t, v) -> (t, validationError v)) validatedValue
+      errorEvent = R.updated errorDynamic
+  delayedError <- R.debounce (1 :: NominalDiffTime) errorEvent
+  fmap (fmap fst) $ R.foldDyn
+    (\event (err, hasBeenResetted) ->
+      case event of
+        ModifiedEvent t ->
+          (Nothing, T.null t)
+
+        ValidateEvent e ->
+          (e, False)
+
+        DelayEvent e ->
+          if hasBeenResetted then
+            (Nothing, False)
+          else
+            (e, False)
+    )
+    (Nothing, False)
+    (R.leftmost
+      [ fmap (\(t, _) -> ModifiedEvent t) errorEvent
+      , fmap (\(_, e) -> DelayEvent e) delayedError
+      , R.attachWith (\(_, e) _ -> ValidateEvent e) (R.current errorDynamic) validate
+      ])
+
+validationError :: (Validation Text a) -> Maybe Text
+validationError (Failure e) = Just e
+validationError _           = Nothing
+
+data InputEvent
+  = ModifiedEvent Text
+  | DelayEvent (Maybe Text)
+  | ValidateEvent (Maybe Text)
-- 
cgit v1.2.3