From 86a96decdb8892b10c5314eb916ef15a64204450 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 13 Nov 2016 00:49:32 +0100
Subject: Send weekly activity at start of week about previous week

---
 src/server/Model/Database.hs             |  17 +++-
 src/server/Model/Income.hs               |  12 ++-
 src/server/Model/Job.hs                  |  33 -------
 src/server/Model/JobKind.hs              |  13 ---
 src/server/Model/Mail.hs                 |   3 +-
 src/server/Model/Message.hs              |   5 ++
 src/server/Model/Message/Key.hs          |  22 ++++-
 src/server/Model/Message/Translations.hs | 147 +++++++++++++++++++++++--------
 src/server/Model/Payment.hs              |  11 +++
 src/server/Model/User.hs                 |   5 ++
 10 files changed, 180 insertions(+), 88 deletions(-)
 delete mode 100644 src/server/Model/Job.hs
 delete mode 100644 src/server/Model/JobKind.hs

(limited to 'src/server/Model')

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
-- 
cgit v1.2.3