1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
{-# LANGUAGE OverloadedStrings #-}
module View.Mail.WeeklyReport
( mail
) where
import Data.List (sortOn)
import Data.Map (Map)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Common.Message as Message
import qualified Common.Message.Key as Key
import Common.Model (Payment(..), User(..), UserId, Income(..))
import qualified Common.Model.User as User
import qualified Common.View.Format as Format
import Model.Mail (Mail(Mail))
import Model.Payment ()
import qualified Model.Income ()
import qualified Model.Mail as M
import Resource (Status(..), groupByStatus, statuses)
import Conf (Conf)
import qualified Conf as Conf
mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
mail conf users payments incomes start end =
Mail
{ M.from = Conf.noReplyMail conf
, M.to = map _user_email users
, M.subject = T.concat
[ Message.get Key.App_Title
, " − "
, Message.get Key.WeeklyReport_Title
]
, M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes)
}
body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
body conf users paymentsByStatus incomesByStatus =
if M.null paymentsByStatus && M.null incomesByStatus
then
Message.get Key.WeeklyReport_Empty
else
T.intercalate "\n" . catMaybes . concat $
[ map (\s -> paymentSection s conf users <$> M.lookup s paymentsByStatus) statuses
, map (\s -> incomeSection s conf users <$> M.lookup s incomesByStatus) statuses
]
paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text
paymentSection status conf users payments =
section sectionTitle sectionItems
where count = length payments
sectionTitle = Message.get $ case status of
Created -> if count > 1 then Key.WeeklyReport_PaymentsCreated count else Key.WeeklyReport_PaymentCreated count
Edited -> if count > 1 then Key.WeeklyReport_PaymentsEdited count else Key.WeeklyReport_PaymentEdited count
Deleted -> if count > 1 then Key.WeeklyReport_PaymentsDeleted count else Key.WeeklyReport_PaymentDeleted count
sectionItems = map (payedFor status conf users) . sortOn _payment_date $ payments
payedFor :: Status -> Conf -> [User] -> Payment -> Text
payedFor status conf users payment =
case status of
Deleted -> Message.get (Key.WeeklyReport_PayedForNot name amount for at)
_ -> Message.get (Key.WeeklyReport_PayedFor name amount for at)
where name = formatUserName (_payment_user payment) users
amount = Format.price (Conf.currency conf) . _payment_cost $ payment
for = _payment_name payment
at = Format.longDay $ _payment_date payment
incomeSection :: Status -> Conf -> [User] -> [Income] -> Text
incomeSection status conf users incomes =
section sectionTitle sectionItems
where count = length incomes
sectionTitle = Message.get $ case status of
Created -> if count > 1 then Key.WeeklyReport_IncomesCreated count else Key.WeeklyReport_IncomeCreated count
Edited -> if count > 1 then Key.WeeklyReport_IncomesEdited count else Key.WeeklyReport_IncomeEdited count
Deleted -> if count > 1 then Key.WeeklyReport_IncomesDeleted count else Key.WeeklyReport_IncomeDeleted count
sectionItems = map (isPayedFrom status conf users) . sortOn _income_date $ incomes
isPayedFrom :: Status -> Conf -> [User] -> Income -> Text
isPayedFrom status conf users income =
case status of
Deleted -> Message.get (Key.WeeklyReport_PayedFromNot name amount for)
_ -> Message.get (Key.WeeklyReport_PayedFrom name amount for)
where name = formatUserName (_income_userId income) users
amount = Format.price (Conf.currency conf) . _income_amount $ income
for = Format.longDay $ _income_date income
formatUserName :: UserId -> [User] -> Text
formatUserName userId = fromMaybe "−" . fmap _user_name . User.find userId
section :: Text -> [Text] -> Text
section title items =
T.concat
[ title
, "\n\n"
, T.unlines . map (" - " <>) $ items
]
|
