aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Model')
-rw-r--r--src/server/Model/Database.hs1
-rw-r--r--src/server/Model/Income.hs36
-rw-r--r--src/server/Model/Message/Key.hs13
-rw-r--r--src/server/Model/Message/Translations.hs49
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