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
|
module View.Mail.WeeklyReport
( mail
) where
import Data.List (sortOn)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
import Common.Model (Income (..), Payment (..), User (..),
UserId)
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
import Conf (Conf)
import qualified Conf as Conf
import qualified Model.Income ()
import Model.Mail (Mail (Mail))
import qualified Model.Mail as M
import Model.Payment ()
import Resource (Status (..), groupByStatus, statuses)
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
[ Msg.get Msg.App_Title
, " − "
, Msg.get Msg.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
Msg.get Msg.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 = Msg.get $ case status of
Created -> if count > 1 then Msg.WeeklyReport_PaymentsCreated count else Msg.WeeklyReport_PaymentCreated count
Edited -> if count > 1 then Msg.WeeklyReport_PaymentsEdited count else Msg.WeeklyReport_PaymentEdited count
Deleted -> if count > 1 then Msg.WeeklyReport_PaymentsDeleted count else Msg.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 -> Msg.get (Msg.WeeklyReport_PayedForNot name amount for at)
_ -> Msg.get (Msg.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 = Msg.get $ case status of
Created -> if count > 1 then Msg.WeeklyReport_IncomesCreated count else Msg.WeeklyReport_IncomeCreated count
Edited -> if count > 1 then Msg.WeeklyReport_IncomesEdited count else Msg.WeeklyReport_IncomeEdited count
Deleted -> if count > 1 then Msg.WeeklyReport_IncomesDeleted count else Msg.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 -> Msg.get (Msg.WeeklyReport_PayedFromNot name amount for)
_ -> Msg.get (Msg.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 . CM.findUser userId
section :: Text -> [Text] -> Text
section title items =
T.concat
[ title
, "\n\n"
, T.unlines . map (" - " <>) $ items
]
|
