From 2741f47ef7b87255203bc2f7f7b2b9140c70b8f0 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 1 Nov 2018 13:14:25 +0100
Subject: Implementing client side validation

---
 client/src/Util/Validation.hs | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)
 create mode 100644 client/src/Util/Validation.hs

(limited to 'client/src/Util')

diff --git a/client/src/Util/Validation.hs b/client/src/Util/Validation.hs
new file mode 100644
index 0000000..e2a3dcb
--- /dev/null
+++ b/client/src/Util/Validation.hs
@@ -0,0 +1,37 @@
+module Util.Validation
+  ( fireValidation
+  , fireMaybe
+  , nelError
+  ) where
+
+import           Control.Monad      (join)
+import           Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NEL
+import           Data.Text          (Text)
+import           Data.Validation    (Validation (Failure, Success))
+import qualified Data.Validation    as Validation
+import           Reflex.Dom         (Dynamic, Event, Reflex)
+import qualified Reflex.Dom         as R
+
+nelError :: Validation a b -> Validation (NonEmpty a) b
+nelError = Validation.validation (Failure . NEL.fromList . (:[])) Success
+
+fireValidation
+  :: forall t a b c. Reflex t
+  => Dynamic t (Maybe (Validation a b))
+  -> Event t c
+  -> Event t b
+fireValidation value validate =
+  R.fmapMaybe
+    (join . fmap (Validation.validation (const Nothing) Just))
+    (R.tag (R.current value) validate)
+
+fireMaybe
+  :: forall t a b. Reflex t
+  => Dynamic t (Maybe a)
+  -> Event t b
+  -> Event t a
+fireMaybe value validate =
+  R.fmapMaybe
+    id
+    (R.tag (R.current value) validate)
-- 
cgit v1.2.3