1 files changed, 61 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..9c21e14
--- /dev/null
+++ b/common/src/Common/Validation/Atomic.hs
@@ -0,0 +1,61 @@
+module Common.Validation.Atomic
+  ( color
+  , day
+  , minLength
+  , nonEmpty
+  , nonNullNumber
+  , number
+  , password
+  ) where
+
+import qualified Data.Char          as Char
+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
+
+color :: Text -> Validation Text Text
+color str =
+  if T.take 1 str == "#" && T.all Char.isHexDigit (T.drop 1 str) then
+    V.Success str
+
+  else
+    V.Failure (Msg.get Msg.Form_InvalidColor)
+
+password :: Text -> Validation Text Text
+password = minLength 8