aboutsummaryrefslogtreecommitdiff
path: root/common/src
diff options
context:
space:
mode:
Diffstat (limited to 'common/src')
-rw-r--r--common/src/Common/Message/Key.hs1
-rw-r--r--common/src/Common/Message/Translation.hs9
-rw-r--r--common/src/Common/Model.hs3
-rw-r--r--common/src/Common/Model/Email.hs12
-rw-r--r--common/src/Common/Model/SignInForm.hs (renamed from common/src/Common/Model/SignIn.hs)10
-rw-r--r--common/src/Common/Util/Validation.hs13
-rw-r--r--common/src/Common/Validation/Atomic.hs47
-rw-r--r--common/src/Common/Validation/Payment.hs21
-rw-r--r--common/src/Common/Validation/SignIn.hs19
9 files changed, 127 insertions, 8 deletions
diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs
index 6e5f246..4acba93 100644
--- a/common/src/Common/Message/Key.hs
+++ b/common/src/Common/Message/Key.hs
@@ -39,6 +39,7 @@ data Key =
| Form_AlreadyExists
| Form_NonEmpty
+ | Form_MinChars Int
| Form_NonNullNumber
| Form_GreaterIntThan Int
| Form_InvalidCategory
diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs
index 70eb978..e95fa74 100644
--- a/common/src/Common/Message/Translation.hs
+++ b/common/src/Common/Message/Translation.hs
@@ -162,6 +162,11 @@ m l Form_NonEmpty =
English -> "Required field"
French -> "Champ requis"
+m l (Form_MinChars number) =
+ case l of
+ English -> T.concat [ "This field must contains at least ", T.pack . show $ number, " characters" ]
+ French -> T.concat [ "Ce champ doit contenir au moins ", T.pack . show $ number, " caractères" ]
+
m l Form_NonNullNumber =
case l of
English -> "Number must not be null"
@@ -184,8 +189,8 @@ m l Form_InvalidColor =
m l Form_InvalidDate =
case l of
- English -> "day/month/year required"
- French -> "jour/mois/année requis"
+ English -> "DD/MM/YYYY required"
+ French -> "JJ/MM/AAAA requis"
m l Form_InvalidInt =
case l of
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index cb38b2f..b0e0491 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -8,6 +8,7 @@ import Common.Model.Currency as X
import Common.Model.EditCategory as X
import Common.Model.EditIncome as X
import Common.Model.EditPayment as X
+import Common.Model.Email as X
import Common.Model.Frequency as X
import Common.Model.Income as X
import Common.Model.Init as X
@@ -15,5 +16,5 @@ import Common.Model.InitResult as X
import Common.Model.Payer as X
import Common.Model.Payment as X
import Common.Model.PaymentCategory as X
-import Common.Model.SignIn as X
+import Common.Model.SignInForm as X
import Common.Model.User as X
diff --git a/common/src/Common/Model/Email.hs b/common/src/Common/Model/Email.hs
new file mode 100644
index 0000000..e938f83
--- /dev/null
+++ b/common/src/Common/Model/Email.hs
@@ -0,0 +1,12 @@
+module Common.Model.Email
+ ( Email(..)
+ ) where
+
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+
+newtype Email = Email Text deriving (Show, Generic)
+
+instance FromJSON Email
+instance ToJSON Email
diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignInForm.hs
index bfd7fbc..2b8c955 100644
--- a/common/src/Common/Model/SignIn.hs
+++ b/common/src/Common/Model/SignInForm.hs
@@ -1,14 +1,14 @@
-module Common.Model.SignIn
- ( SignIn(..)
+module Common.Model.SignInForm
+ ( SignInForm(..)
) where
import Data.Aeson (FromJSON, ToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
-data SignIn = SignIn
+data SignInForm = SignInForm
{ _signIn_email :: Text
} deriving (Show, Generic)
-instance FromJSON SignIn
-instance ToJSON SignIn
+instance FromJSON SignInForm
+instance ToJSON SignInForm
diff --git a/common/src/Common/Util/Validation.hs b/common/src/Common/Util/Validation.hs
new file mode 100644
index 0000000..f195d95
--- /dev/null
+++ b/common/src/Common/Util/Validation.hs
@@ -0,0 +1,13 @@
+module Common.Util.Validation
+ ( isSuccess
+ , isFailure
+ ) where
+
+import Data.Validation (Validation (Failure, Success))
+
+isSuccess :: forall a b. Validation a b -> Bool
+isSuccess (Failure _) = False
+isSuccess (Success _) = True
+
+isFailure :: forall a b. Validation a b -> Bool
+isFailure = not . isSuccess
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 03:23:35 +0000