Finish payment add modal

2 files changed, 76 insertions, 47 deletions

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)
diff --git a/client/src/Component/Select.hs b/client/src/Component/Select.hs
index 43a8a6e..01ed37a 100644
--- a/client/src/Component/Select.hs
+++ b/client/src/Component/Select.hs
@@ -4,14 +4,17 @@ module Component.Select
   , select
   ) where
 
-import           Data.Map   (Map)
-import qualified Data.Map   as M
-import           Data.Text  (Text)
-import qualified Data.Text  as T
-import           Reflex.Dom (Dynamic, Event, MonadWidget, Reflex)
-import qualified Reflex.Dom as R
+import           Data.Map        (Map)
+import qualified Data.Map        as M
+import qualified Data.Maybe      as Maybe
+import           Data.Text       (Text)
+import qualified Data.Text       as T
+import           Data.Validation (Validation (Failure, Success))
+import           Reflex.Dom      (Dynamic, Event, MonadWidget, Reflex)
+import qualified Reflex.Dom      as R
 
-import qualified Common.Msg as Msg
+import qualified Common.Msg      as Msg
+import qualified Util.Validation as ValidationUtil
 
 data (Reflex t) => SelectIn t a b c = SelectIn
   { _selectIn_label        :: Text
@@ -24,25 +27,33 @@ data (Reflex t) => SelectIn t a b c = SelectIn
   }
 
 data SelectOut t a = SelectOut
-  { _selectOut_value :: Dynamic t a
+  { _selectOut_value :: Dynamic t (Validation Text a)
   }
 
 select :: forall t m a b c. (Ord a, MonadWidget t m) => SelectIn t a b c -> m (SelectOut t a)
 select selectIn = do
   rec
-    let containerAttr = R.ffor hasError (\e ->
+    let containerAttr = R.ffor showedError (\e ->
           M.singleton "class" $ T.intercalate " "
             [ "selectInput"
-            , if e then "error" else ""
+            , if Maybe.isJust e then "error" else ""
             ])
 
-    hasError <- R.holdDyn False $ R.attachWith
-      (\v clearError -> not clearError && not (_selectIn_isValid selectIn v))
-      (R.current value)
-      (R.leftmost
-        [ const False <$> _selectIn_validate selectIn
-        , const True <$> _selectIn_reset selectIn
-        ])
+        validatedValue =
+          R.ffor value (\v ->
+            if _selectIn_isValid selectIn v then
+              Success v
+            else
+              Failure (Msg.get Msg.Form_NonEmpty))
+
+        maybeError =
+          fmap ValidationUtil.maybeError validatedValue
+
+    showedError <- R.holdDyn Nothing $ R.leftmost
+      [ const Nothing <$> _selectIn_reset selectIn
+      , R.updated maybeError
+      , R.attachWith const (R.current maybeError) (_selectIn_validate selectIn)
+      ]
 
     value <- R.elDynAttr "div" containerAttr $ do
       R.el "label" $ R.text (_selectIn_label selectIn)
@@ -60,16 +71,11 @@ select selectIn = do
           (_selectIn_values selectIn)
           (R.def { R._dropdownConfig_setValue = setValue })
 
-      errorMessage <- R.holdDyn "" $ R.attachWith
-        (\v _ -> if (_selectIn_isValid selectIn) v then "" else "ERROR!")
-        (R.current value)
-        (_selectIn_validate selectIn)
-
       R.divClass "errorMessage" . R.dynText $
-        R.ffor hasError (\e -> if e then Msg.get Msg.Form_NonEmpty else "")
+        R.ffor showedError (Maybe.fromMaybe "")
 
       return value
 
   return SelectOut
-    { _selectOut_value = value
+    { _selectOut_value = validatedValue
     }