Use the search to view either punctual or monthly payments

3 files changed, 74 insertions, 75 deletions

diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index c87a2c1..8b957f1 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -47,15 +47,19 @@ data Key =
   | ShortDate
   | LongDate
 
-  -- Validation
+  -- Search
 
-  | CategoryRequired
-  | CostRequired
+  | SearchName
+  | SearchPunctual
+  | SearchMonthly
 
   -- Payments
 
+  | PaymentsAreBalanced
   | Name
   | Cost
+  | Payer
+  | Date
   | Frequency
   | InvalidFrequency
   | AddPayment
@@ -63,22 +67,22 @@ data Key =
   | Punctual
   | Monthly
 
-  | SingularMonthlyCount
-  | PluralMonthlyCount
   | PaymentsTitle
   | Payment
   | Payments
-  | SearchText
   | Worth
+  | NoPayment
+
+  | PaymentName
+  | PaymentCost
+  | PaymentPunctual
+  | PaymentMonthly
 
   -- Statistics
 
   | Statistics
-  | Balance
-  | Overall
-  | ByMonths
+  | ByMonthsAndMean
   | By
-  | Mean
 
   -- Income
 
@@ -86,8 +90,8 @@ data Key =
   | Income
   | MonthlyNetIncomes
   | IncomeNotDeleted
-  | Creation
-  | Amount
+  | IncomeCreation
+  | IncomeAmount
   | ConfirmDelete
 
   -- Form
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index f4087a4..df3f402 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -186,20 +186,30 @@ m l LongDate =
     English -> "{2} {1}, {3}"
     French  -> "{1} {2} {3}"
 
--- Validation
+-- Search
 
-m l CategoryRequired =
+m l SearchName =
   case l of
-    English -> "Type a category."
-    French  -> "Entre une catégorie."
+    English -> "Search"
+    French  -> "Recherche"
+
+m l SearchPunctual =
+  case l of
+    English -> "Punctual"
+    French  -> "Ponctuel"
 
-m l CostRequired =
+m l SearchMonthly =
   case l of
-    English -> "Type a positive cost."
-    French  -> "Entre un coût positif."
+    English -> "Monthly"
+    French  -> "Mensuel"
 
 -- Payments
 
+m l PaymentsAreBalanced =
+  case l of
+    English -> "Payments are balanced."
+    French  -> "Les paiements sont équilibrés."
+
 m l Name =
   case l of
     English -> "Name"
@@ -210,6 +220,16 @@ m l Cost =
     English -> "Cost"
     French  -> "Coût"
 
+m l Payer =
+  case l of
+    English -> "Payer"
+    French  -> "Payeur"
+
+m l Date =
+  case l of
+    English -> "Date"
+    French  -> "Date"
+
 m l Frequency =
   case l of
     English -> "Frequency"
@@ -240,16 +260,6 @@ m l Monthly =
     English -> "Monthly"
     French  -> "Mensuelle"
 
-m l SingularMonthlyCount =
-  case l of
-    English -> "{1} monthly payment of {2}"
-    French  -> "{1} paiement mensuel de {2}"
-
-m l PluralMonthlyCount =
-  case l of
-    English -> "{1} monthly payments worth {2}"
-    French  -> "{1} paiements mensuels comptabilisant {2}"
-
 m l PaymentsTitle =
   case l of
     English -> "Payments"
@@ -265,16 +275,16 @@ m l Payments =
     English -> "payments"
     French  -> "paiements"
 
-m l SearchText =
-  case l of
-    English -> "Search"
-    French  -> "Recherche"
-
 m l Worth =
   case l of
     English -> "{1} worth {2}"
     French  -> "{1} comptabilisant {2}"
 
+m l NoPayment =
+  case l of
+    English -> "No payment found from your search criteria."
+    French  -> "Aucun paiement ne correspond à vos critères de recherches."
+
 -- Statistics
 
 m l Statistics =
@@ -282,30 +292,35 @@ m l Statistics =
     English -> "Statistics"
     French  -> "Statistiques"
 
-m l Balance =
+m l ByMonthsAndMean =
+  case l of
+    English -> "By months ({1} on average)"
+    French  -> "Par mois (en moyenne {1})"
+
+m l By =
   case l of
-    English -> "Balance"
-    French  -> "Équilibre"
+    English -> "{1}: {2}"
+    French  -> "{1} : {2}"
 
-m l Overall =
+m l PaymentName =
   case l of
-    English -> "Overall"
-    French  -> "Global"
+    English -> "Name"
+    French  -> "Nom"
 
-m l ByMonths =
+m l PaymentCost =
   case l of
-    English -> "By months"
-    French  -> "Par mois"
+    English -> "Cost"
+    French  -> "Coût"
 
-m l By =
+m l PaymentPunctual =
   case l of
-    English -> "by"
-    French  -> "par"
+    English -> "Punctual"
+    French  -> "Ponctuel"
 
-m l Mean =
+m l PaymentMonthly =
   case l of
-    English -> "Mean: {1}"
-    French  -> "En moyenne : {1}"
+    English -> "Monthly"
+    French  -> "Mensuel"
 
 -- Income
 
@@ -329,12 +344,12 @@ m l IncomeNotDeleted =
     English -> "The income could not have been deleted."
     French  -> "Le revenu n'a pas pu être supprimé."
 
-m l Creation =
+m l IncomeCreation =
   case l of
     English -> "Creation"
     French  -> "Création"
 
-m l Amount =
+m l IncomeAmount =
   case l of
     English -> "Amount"
     French  -> "Montant"
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 47397ff..28f1a09 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -9,18 +9,14 @@ module Model.Payment
 
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
-import Data.Either (lefts)
 
 import Control.Monad.IO.Class (liftIO)
 
 import Database.Persist
 
-import qualified Validation
-
 import Model.Database
 import Model.Frequency
 import qualified Model.Json.Payment as P
-import qualified Model.Message.Key as K
 
 getPayments :: Persist [P.Payment]
 getPayments =
@@ -48,26 +44,10 @@ getJsonPayment paymentEntity =
         , P.frequency = paymentFrequency payment
         }
 
-createPayment :: UserId -> Text -> Text -> Frequency -> Persist (Either [(Text, K.Key)] PaymentId)
-createPayment userId name cost frequency =
-  case validatePayment name cost of
-    Left err ->
-      return . Left $ err
-    Right (validatedName, validatedCost) -> do
-      now <- liftIO getCurrentTime
-      Right <$> insert (Payment userId now validatedName validatedCost Nothing frequency)
-
-validatePayment :: Text -> Text -> Either [(Text, K.Key)] (Text, Int)
-validatePayment name cost =
-  let eitherName = Validation.nonEmpty K.CategoryRequired name
-      eitherCost = Validation.nonEmpty K.CostRequired cost >>= Validation.number K.CostRequired (/= 0)
-  in  case (eitherName, eitherCost) of
-        (Right validatedName, Right validatedCost) ->
-          Right (validatedName, validatedCost)
-        _ ->
-          let nameErrors = map (\x -> ("name", x)) $ lefts [eitherName]
-              costErrors = map (\x -> ("cost", x)) $ lefts [eitherCost]
-          in  Left (nameErrors ++ costErrors)
+createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId
+createPayment userId name cost frequency = do
+  now <- liftIO getCurrentTime
+  insert (Payment userId now name cost Nothing frequency)
 
 deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool
 deleteOwnPayment user paymentId = do