Implementing client side validation

3 files changed, 87 insertions, 0 deletions

diff --git a/common/src/Common/Validation/Atomic.hs b/common/src/Common/Validation/Atomic.hs
new file mode 100644
index 0000000..3516668
--- /dev/null
+++ b/common/src/Common/Validation/Atomic.hs
@@ -0,0 +1,47 @@
+module Common.Validation.Atomic
+  ( nonEmpty
+  , minLength
+  , number
+  , nonNullNumber
+  , day
+  ) where
+
+import           Data.Text          (Text)
+import qualified Data.Text          as T
+import           Data.Time.Calendar (Day)
+import           Data.Validation    (Validation)
+import qualified Data.Validation    as V
+import qualified Text.Read          as T
+
+import qualified Common.Msg         as Msg
+import qualified Common.Util.Time   as Time
+
+minLength :: Int -> Text -> Validation Text Text
+minLength l =
+  V.validate
+    (Msg.get (Msg.Form_MinChars l))
+    (\t -> if T.length t >= l then Just t else Nothing)
+
+nonEmpty :: Text -> Validation Text Text
+nonEmpty =
+  V.validate
+    (Msg.get Msg.Form_NonEmpty)
+    (\t -> if (not . T.null $ t) then Just t else Nothing)
+
+number :: Text -> Validation Text Int
+number input =
+  case (T.readMaybe . T.unpack $ input) of
+    Just n -> V.Success n
+    _      -> V.Failure (Msg.get Msg.Form_InvalidInt)
+
+nonNullNumber :: Int -> Validation Text Int
+nonNullNumber =
+  V.validate
+    (Msg.get Msg.Form_NonNullNumber)
+    (\n -> if n /= 0 then Just n else Nothing)
+
+day :: Text ->  Validation Text Day
+day str =
+  case Time.parseDay str of
+    Just d  -> V.Success d
+    Nothing -> V.Failure $ Msg.get Msg.Form_InvalidDate
diff --git a/common/src/Common/Validation/Payment.hs b/common/src/Common/Validation/Payment.hs
new file mode 100644
index 0000000..b6c1d30
--- /dev/null
+++ b/common/src/Common/Validation/Payment.hs
@@ -0,0 +1,21 @@
+module Common.Validation.Payment
+  ( name
+  , cost
+  , date
+  ) where
+
+import           Data.Text                (Text)
+import           Data.Time.Calendar       (Day)
+import           Data.Validation          (Validation)
+import qualified Data.Validation          as Validation
+
+import qualified Common.Validation.Atomic as Atomic
+
+name :: Text -> Validation Text Text
+name = Atomic.nonEmpty
+
+cost :: Text -> Validation Text Int
+cost input = Validation.bindValidation (Atomic.number input) Atomic.nonNullNumber
+
+date :: Text -> Validation Text Day
+date = Atomic.day
diff --git a/common/src/Common/Validation/SignIn.hs b/common/src/Common/Validation/SignIn.hs
new file mode 100644
index 0000000..18ceb44
--- /dev/null
+++ b/common/src/Common/Validation/SignIn.hs
@@ -0,0 +1,19 @@
+module Common.Validation.SignIn
+  ( signIn
+  , email
+  ) where
+
+import           Data.Text                (Text)
+import           Data.Validation          (Validation)
+
+import           Common.Model.Email       (Email (..))
+import           Common.Model.SignInForm  (SignInForm (..))
+import qualified Common.Validation.Atomic as Atomic
+import qualified Data.Validation          as Validation
+
+signIn :: SignInForm -> Maybe Email
+signIn (SignInForm str) =
+  Validation.validation (const Nothing) Just . email $ str
+
+email :: Text -> Validation Text Email
+email = fmap Email . Atomic.minLength 5