Implementing client side validation

1 files changed, 37 insertions, 0 deletions

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)