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/Select.hs | 54 +++++++++++++++++++++++-------------------
 1 file changed, 30 insertions(+), 24 deletions(-)

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

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
     }
-- 
cgit v1.2.3