Add income list CRUD in user page

4 files changed, 45 insertions, 54 deletions

diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 58160c3..0915afe 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -57,6 +57,7 @@ Income
   userId UserId
   creation UTCTime
   amount Int
+  deletedAt UTCTime Maybe
   deriving Show
 |]
 
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index 2177617..c0cac45 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,11 +1,11 @@
 module Model.Income
   ( getJsonIncome
-  , getFirstIncome
   , getIncomes
-  , setIncome
+  , addIncome
+  , deleteOwnIncome
   ) where
 
-import Data.Time.Clock (getCurrentTime)
+import Data.Time.Clock (UTCTime, getCurrentTime)
 
 import Control.Monad.IO.Class (liftIO)
 
@@ -20,13 +20,23 @@ getJsonIncome incomeEntity =
   where income = entityVal incomeEntity
 
 getIncomes :: Persist [Entity Income]
-getIncomes = selectList [] []
-
-getFirstIncome :: UserId -> Persist (Maybe Income)
-getFirstIncome userId =
-  fmap entityVal <$> selectFirst [IncomeUserId ==. userId] [Asc IncomeCreation]
-
-setIncome :: UserId -> Int -> Persist IncomeId
-setIncome userId amount = do
-  now <- liftIO getCurrentTime
-  insert (Income userId now amount)
+getIncomes = selectList [IncomeDeletedAt ==. Nothing] []
+
+addIncome :: UserId -> UTCTime -> Int -> Persist IncomeId
+addIncome userId creation amount = do
+  insert (Income userId creation amount Nothing)
+
+deleteOwnIncome :: Entity User -> IncomeId -> Persist Bool
+deleteOwnIncome user incomeId = do
+  mbIncome <- get incomeId
+  case mbIncome of
+    Just income ->
+      if incomeUserId income == entityKey user
+        then do
+          now <- liftIO getCurrentTime
+          update incomeId [IncomeDeletedAt =. Just now]
+          return True
+        else
+          return False
+    Nothing ->
+      return False
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 8f5cf2a..9d1c053 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -51,9 +51,8 @@ data Key =
 
   | CategoryRequired
   | CostRequired
-  | IncomeRequired
-  | IncomeMustBeNonNullNumber
-  | IncomeMustBePositiveNumber
+  | DateValidationError
+  | IncomeValidationError
 
   -- Payments
 
@@ -66,12 +65,10 @@ data Key =
 
   -- Income
 
+  | AddIncome
+  | Incomes
   | Income
-  | NoIncome
-  | Edit
-  | Validate
-  | Undo
-  | NewIncome
+  | IncomeNotDeleted
 
   -- Http error
 
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index f41a417..9db4a76 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -198,17 +198,12 @@ m l CostRequired =
     English -> "Type a positive cost."
     French  -> "Entre un coût positif."
 
-m l IncomeRequired =
+m l DateValidationError =
   case l of
-    English -> "Type an income."
-    French  -> "Entre un revenu."
+    English -> "The date must be day/month/year"
+    French  -> "La date doit avoir la forme jour/mois/année"
 
-m l IncomeMustBeNonNullNumber =
-  case l of
-    English -> "The income must be a non-null integer."
-    French  -> "Le revenu doit être un entier non nul."
-
-m l IncomeMustBePositiveNumber =
+m l IncomeValidationError =
   case l of
     English -> "The income must be a positive integer."
     French  -> "Le revenu doit être un entier positif."
@@ -251,37 +246,25 @@ m l PluralMonthlyCount =
 
 -- Income
 
-m l Income =
-  T.concat
-    [ case l of
-        English -> "Monthly net income: {1}"
-        French  -> "Revenu mensuel net : {1}"
-    ]
-
-m l NoIncome =
+m l AddIncome =
   case l of
-    English -> "Income not given"
-    French  -> "Revenu non renseigné"
+    English -> "Add a monthly net income"
+    French  -> "Ajouter un revenu mensuel net"
 
-m l Edit =
+m l Incomes =
   case l of
-    English -> "Edit"
-    French  -> "Éditer"
+    English -> "Monthly net incomes"
+    French  -> "Revenus mensuels nets"
 
-m l Validate =
-  case l of
-    English -> "Validate"
-    French  -> "Valider"
-
-m l Undo =
+m l Income =
   case l of
-    English -> "Undo"
-    French  -> "Annuler"
+    English -> "Monthly net income: {1}"
+    French  -> "Revenu mensuel net : {1}"
 
-m l NewIncome =
+m l IncomeNotDeleted =
   case l of
-    English -> "New income"
-    French  -> "Nouveau revenu"
+    English -> "The income could not have been deleted."
+    French  -> "Le revenu n'a pas pu être supprimé."
 
 -- Http error