aboutsummaryrefslogtreecommitdiff
path: root/client/src/Util/Validation.hs
diff options
context:
space:
mode:
Diffstat (limited to 'client/src/Util/Validation.hs')
-rw-r--r--client/src/Util/Validation.hs36
1 files changed, 36 insertions, 0 deletions
diff --git a/client/src/Util/Validation.hs b/client/src/Util/Validation.hs
new file mode 100644
index 0000000..50f2468
--- /dev/null
+++ b/client/src/Util/Validation.hs
@@ -0,0 +1,36 @@
+module Util.Validation
+ ( nelError
+ , toMaybe
+ , maybeError
+ , fireValidation
+ ) 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
+
+toMaybe :: Validation a b -> Maybe b
+toMaybe (Success s) = Just s
+toMaybe (Failure _) = Nothing
+
+maybeError :: Validation a b -> Maybe a
+maybeError (Success _) = Nothing
+maybeError (Failure e) = Just e
+
+fireValidation
+ :: forall t a b c. Reflex t
+ => Dynamic t (Validation a b)
+ -> Event t c
+ -> Event t b
+fireValidation value validate =
+ R.fmapMaybe
+ (Validation.validation (const Nothing) Just)
+ (R.tag (R.current value) validate)