aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Model')
-rw-r--r--src/server/Model/Database.hs17
-rw-r--r--src/server/Model/Income.hs12
-rw-r--r--src/server/Model/Job.hs33
-rw-r--r--src/server/Model/JobKind.hs13
-rw-r--r--src/server/Model/Mail.hs3
-rw-r--r--src/server/Model/Message.hs5
-rw-r--r--src/server/Model/Message/Key.hs22
-rw-r--r--src/server/Model/Message/Translations.hs147
-rw-r--r--src/server/Model/Payment.hs11
-rw-r--r--src/server/Model/User.hs5
10 files changed, 180 insertions, 88 deletions
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 6a2fefe..7f8326e 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -22,8 +22,11 @@ import Data.Int (Int64)
import Database.Persist.Sqlite
import Database.Persist.TH
+import Resource (Resource, createdAt, editedAt, deletedAt)
+
import Model.Frequency
-import Model.JobKind
+
+import Job.Kind
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
User
@@ -51,7 +54,7 @@ SignIn
UniqSignInToken token
deriving Show
Job
- kind JobKind
+ kind Kind
lastExecution UTCTime Maybe
lastCheck UTCTime Maybe
UniqJobName kind
@@ -66,6 +69,16 @@ Income
deriving Show
|]
+instance Resource Payment where
+ createdAt = paymentCreatedAt
+ editedAt = paymentEditedAt
+ deletedAt = paymentDeletedAt
+
+instance Resource Income where
+ createdAt = incomeCreatedAt
+ editedAt = incomeEditedAt
+ deletedAt = incomeDeletedAt
+
type Persist a = SqlPersistT (ResourceT (NoLoggingT IO)) a
runDb :: Persist a -> IO a
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index f389661..b7dd11c 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -4,9 +4,10 @@ module Model.Income
, create
, editOwn
, deleteOwn
+ , modifiedDuring
) where
-import Data.Time.Clock (getCurrentTime)
+import Data.Time.Clock (UTCTime, getCurrentTime)
import Data.Time.Calendar (Day)
import Control.Monad.IO.Class (liftIO)
@@ -62,3 +63,12 @@ deleteOwn user incomeId = do
return False
Nothing ->
return False
+
+modifiedDuring :: UTCTime -> UTCTime -> Persist [Income]
+modifiedDuring start end =
+ map entityVal <$> selectList
+ ( [IncomeCreatedAt >=. start, IncomeCreatedAt <. end]
+ ||. [IncomeEditedAt >=. Just start, IncomeEditedAt <. Just end]
+ ||. [IncomeDeletedAt >=. Just start, IncomeDeletedAt <. Just end]
+ )
+ []
diff --git a/src/server/Model/Job.hs b/src/server/Model/Job.hs
deleted file mode 100644
index 5b0d89d..0000000
--- a/src/server/Model/Job.hs
+++ /dev/null
@@ -1,33 +0,0 @@
-module Model.Job
- ( getLastExecution
- , actualizeLastExecution
- , actualizeLastCheck
- ) where
-
-import Control.Monad.IO.Class (liftIO)
-
-import Data.Time.Clock (UTCTime, getCurrentTime)
-import Data.Maybe (isJust)
-
-import Database.Persist
-
-import Model.Database
-import Model.JobKind
-
-getLastExecution :: JobKind -> Persist (Maybe UTCTime)
-getLastExecution kind = do
- mbJob <- fmap entityVal <$> selectFirst [JobKind ==. kind] []
- return (mbJob >>= jobLastExecution)
-
-actualizeLastExecution :: JobKind -> Persist ()
-actualizeLastExecution kind = do
- now <- liftIO getCurrentTime
- jobKindDefined <- isJust <$> selectFirst [JobKind ==. kind] []
- if jobKindDefined
- then updateWhere [JobKind ==. kind] [JobLastExecution =. Just now]
- else insert (Job kind (Just now) (Just now)) >> return ()
-
-actualizeLastCheck :: JobKind -> Persist ()
-actualizeLastCheck kind = do
- now <- liftIO getCurrentTime
- updateWhere [JobKind ==. kind] [JobLastCheck =. Just now]
diff --git a/src/server/Model/JobKind.hs b/src/server/Model/JobKind.hs
deleted file mode 100644
index bbe1d45..0000000
--- a/src/server/Model/JobKind.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-
-module Model.JobKind
- ( JobKind(..)
- ) where
-
-import Database.Persist.TH
-
-data JobKind =
- MonthlyPaymentJob
- deriving (Eq, Show, Read)
-
-derivePersistField "JobKind"
diff --git a/src/server/Model/Mail.hs b/src/server/Model/Mail.hs
index 7c1a6ed..9a4db73 100644
--- a/src/server/Model/Mail.hs
+++ b/src/server/Model/Mail.hs
@@ -3,11 +3,10 @@ module Model.Mail
) where
import Data.Text (Text)
-import qualified Data.Text.Lazy as LT
data Mail = Mail
{ from :: Text
, to :: [Text]
, subject :: Text
- , plainBody :: LT.Text
+ , plainBody :: Text
} deriving (Eq, Show)
diff --git a/src/server/Model/Message.hs b/src/server/Model/Message.hs
index 0e83e5b..026967f 100644
--- a/src/server/Model/Message.hs
+++ b/src/server/Model/Message.hs
@@ -2,6 +2,7 @@ module Model.Message
( getMessage
, getParamMessage
, getTranslations
+ , plural
) where
import Data.Text (Text)
@@ -28,3 +29,7 @@ getTranslation translationKey =
Translation
(T.pack . show $ translationKey)
(getParts $ getNonFormattedMessage lang translationKey)
+
+plural :: Int -> Key -> Key -> Text
+plural count singularKey pluralKey =
+ getParamMessage [T.pack . show $ count] (if count <= 1 then singularKey else pluralKey)
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 8deca69..e64cfb5 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -77,7 +77,6 @@ data Key =
| PaymentName
| PaymentCost
- | PaymentDate
| PaymentPunctual
| PaymentMonthly
@@ -101,7 +100,6 @@ data Key =
| CloneIncome
| EditIncome
| IncomeNotDeleted
- | IncomeDate
| IncomeAmount
| ConfirmIncomeDelete
| Add
@@ -130,6 +128,26 @@ data Key =
| Confirm
| Undo
+ -- Weekly report
+
+ | WeeklyReport
+ | PaymentCreated
+ | PaymentsCreated
+ | PaymentEdited
+ | PaymentsEdited
+ | PaymentDeleted
+ | PaymentsDeleted
+ | IncomeCreated
+ | IncomesCreated
+ | IncomeEdited
+ | IncomesEdited
+ | IncomeDeleted
+ | IncomesDeleted
+ | PayedFor
+ | DidNotPayFor
+ | IsPayedFrom
+ | IsNotPayedFrom
+
-- Http error
| Timeout
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 994a56c..cf11a5e 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -118,63 +118,63 @@ m l SignInEmailSent =
m l January =
case l of
- English -> "January"
- French -> "Janvier"
+ English -> "january"
+ French -> "janvier"
m l February =
case l of
- English -> "February"
- French -> "Février"
+ English -> "february"
+ French -> "février"
m l March =
case l of
- English -> "March"
- French -> "Mars"
+ English -> "march"
+ French -> "mars"
m l April =
case l of
- English -> "April"
- French -> "Avril"
+ English -> "april"
+ French -> "avril"
m l May =
case l of
- English -> "May"
- French -> "Mai"
+ English -> "may"
+ French -> "mai"
m l June =
case l of
- English -> "June"
- French -> "Juin"
+ English -> "june"
+ French -> "juin"
m l July =
case l of
- English -> "July"
- French -> "Juillet"
+ English -> "july"
+ French -> "juillet"
m l August =
case l of
- English -> "August"
- French -> "Août"
+ English -> "august"
+ French -> "août"
m l September =
case l of
- English -> "September"
- French -> "Septembre"
+ English -> "september"
+ French -> "septembre"
m l October =
case l of
- English -> "October"
- French -> "Octobre"
+ English -> "october"
+ French -> "octobre"
m l November =
case l of
- English -> "November"
- French -> "Novembre"
+ English -> "november"
+ French -> "novembre"
m l December =
case l of
- English -> "December"
- French -> "Décembre"
+ English -> "december"
+ French -> "décembre"
m l ShortDate =
case l of
@@ -322,11 +322,6 @@ m l PaymentCost =
English -> "Cost"
French -> "Coût"
-m l PaymentDate =
- case l of
- English -> "Date"
- French -> "Date"
-
m l PaymentPunctual =
case l of
English -> "Punctual"
@@ -371,7 +366,7 @@ m l Income =
m l MonthlyNetIncomes =
case l of
- English -> "Monthly incomes"
+ English -> "Net monthly incomes"
French -> "Revenus mensuels nets"
m l AddIncome =
@@ -394,11 +389,6 @@ m l IncomeNotDeleted =
English -> "The income could not have been deleted."
French -> "Le revenu n'a pas pu être supprimé."
-m l IncomeDate =
- case l of
- English -> "Date"
- French -> "Date"
-
m l IncomeAmount =
case l of
English -> "Amount"
@@ -495,6 +485,93 @@ m l Undo =
English -> "Undo"
French -> "Annuler"
+-- Weekly report
+
+m l WeeklyReport =
+ case l of
+ English -> "Weekly report"
+ French -> "Rapport hebdomadaire"
+
+m l PaymentCreated =
+ case l of
+ English -> "{1} payment created:"
+ French -> "{1} paiement créé :"
+
+m l PaymentsCreated =
+ case l of
+ English -> "{1} payments created:"
+ French -> "{1} paiements créés :"
+
+m l PaymentEdited =
+ case l of
+ English -> "{1} payment edited:"
+ French -> "{1} paiement modifié :"
+
+m l PaymentsEdited =
+ case l of
+ English -> "{1} payments edited:"
+ French -> "{1} paiements modifiés :"
+
+m l PaymentDeleted =
+ case l of
+ English -> "{1} payment deleted:"
+ French -> "{1} paiement supprimé :"
+
+m l PaymentsDeleted =
+ case l of
+ English -> "{1} payments deleted:"
+ French -> "{1} paiements supprimés :"
+
+m l IncomeCreated =
+ case l of
+ English -> "{1} income created:"
+ French -> "{1} revenu créé :"
+
+m l IncomesCreated =
+ case l of
+ English -> "{1} incomes created:"
+ French -> "{1} revenus créés :"
+
+m l IncomeEdited =
+ case l of
+ English -> "{1} income edited:"
+ French -> "{1} revenu modifié :"
+
+m l IncomesEdited =
+ case l of
+ English -> "{1} incomes edited:"
+ French -> "{1} revenus modifiés :"
+
+m l IncomeDeleted =
+ case l of
+ English -> "{1} income deleted:"
+ French -> "{1} revenu supprimé :"
+
+m l IncomesDeleted =
+ case l of
+ English -> "{1} incomes deleted:"
+ French -> "{1} revenus supprimés :"
+
+m l PayedFor =
+ case l of
+ English -> "{1} payed {2} for “{3}” at {4}"
+ French -> "{1} a payé {2} concernant « {3} » le {4}"
+
+m l DidNotPayFor =
+ case l of
+ English -> "{1} didn't pay {2} for “{3}” at {4}"
+ French -> "{1} n'a pas payé {2} concernant « {3} » le {4}"
+
+m l IsPayedFrom =
+ case l of
+ English -> "{1} is payed {2} of net monthly income from {3}"
+ French -> "{1} est payé {2} net par mois à partir du {3}"
+
+m l IsNotPayedFrom =
+ case l of
+ English -> "{1} isn't payed {2} of net monthly income from {3}"
+ French -> "{1} n'est pas payé {2} net par mois à partir du {3}"
+
-- Http error
m l Timeout =
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 0d5e188..ac6cf0a 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -6,9 +6,11 @@ module Model.Payment
, create
, editOwn
, deleteOwn
+ , modifiedDuring
) where
import Data.Text (Text)
+import Data.Time (UTCTime)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Calendar (Day)
@@ -86,3 +88,12 @@ deleteOwn userId paymentId = do
return False
Nothing ->
return False
+
+modifiedDuring :: UTCTime -> UTCTime -> Persist [Payment]
+modifiedDuring start end =
+ map entityVal <$> selectList
+ ( [PaymentFrequency ==. Punctual, PaymentCreatedAt >=. start, PaymentCreatedAt <. end]
+ ||. [PaymentFrequency ==. Punctual, PaymentEditedAt >=. Just start, PaymentEditedAt <. Just end]
+ ||. [PaymentFrequency ==. Punctual, PaymentDeletedAt >=. Just start, PaymentDeletedAt <. Just end]
+ )
+ []
diff --git a/src/server/Model/User.hs b/src/server/Model/User.hs
index 2b52d03..696ef4f 100644
--- a/src/server/Model/User.hs
+++ b/src/server/Model/User.hs
@@ -1,6 +1,7 @@
module Model.User
( getUsers
, getUser
+ , findUser
, getJsonUser
, createUser
, deleteUser
@@ -8,6 +9,7 @@ module Model.User
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime)
+import Data.List (find)
import Control.Monad.IO.Class (liftIO)
@@ -22,6 +24,9 @@ getUsers = selectList [] [Desc UserCreation]
getUser :: Text -> Persist (Maybe (Entity User))
getUser email = selectFirst [UserEmail ==. email] []
+findUser :: UserId -> [Entity User] -> Maybe User
+findUser i = fmap entityVal . find ((==) i . entityKey)
+
getJsonUser :: Entity User -> Json.User
getJsonUser userEntity =
let user = entityVal userEntity
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-06 09:49:16 +0000