aboutsummaryrefslogtreecommitdiff
path: root/server/src/View/Mail/WeeklyReport.hs
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/View/Mail/WeeklyReport.hs')
-rw-r--r--server/src/View/Mail/WeeklyReport.hs22
1 files changed, 12 insertions, 10 deletions
diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 7e88d98..1f637bc 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -9,6 +9,7 @@ import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
+import Data.Time.Calendar (Day)
import Data.Time.Clock (UTCTime)
import Common.Model (ExceedingPayer (..), Income (..),
@@ -23,10 +24,11 @@ import Model.IncomeResource (IncomeResource (..))
import Model.Mail (Mail (Mail))
import qualified Model.Mail as M
import Model.PaymentResource (PaymentResource (..))
+import qualified Payer as Payer
import Resource (Status (..), groupByStatus, statuses)
-mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
-mail conf users payments incomes start end =
+mail :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Mail
+mail conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
Mail
{ M.from = Conf.noReplyMail conf
, M.to = map _user_email users
@@ -35,24 +37,24 @@ mail conf users payments incomes start end =
, " − "
, Msg.get Msg.WeeklyReport_Title
]
- , M.body = body conf users payments incomes start end
+ , M.body = body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end
}
-body :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Text
-body conf users payments incomes start end =
+body :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Text
+body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
T.intercalate "\n" $
- [ exceedingPayers conf end users incomes (filter (null . _payment_deletedAt) payments)
+ [ exceedingPayers conf end users incomes preIncomeRepartition postIncomeRepartition firstPayment
, operations conf users paymentsGroupedByStatus incomesGroupedByStatus
]
where
- paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ payments
+ paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes
-exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
-exceedingPayers conf time users incomes payments =
+exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> Text
+exceedingPayers conf time users incomes preIncomeRepartition postIncomeRepartition firstPayment =
T.intercalate "\n" . map formatPayer $ payers
where
- payers = CM.getExceedingPayers time users incomes payments
+ payers = Payer.getExceedingPayers time users incomes preIncomeRepartition postIncomeRepartition firstPayment
formatPayer p = T.concat
[ " * "
, fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users