aboutsummaryrefslogtreecommitdiff
path: root/server/src/View/Mail/WeeklyReport.hs
blob: 3fe224f936c4dc11104ca3db1d30f7e98d26a7ee (plain)
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
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          (ExceedingPayer (..), 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           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] -> [Income] -> [Payment] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> UTCTime -> UTCTime -> Mail
mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition 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.body = body conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end
    }

body :: Conf -> [User] -> [Income] -> [Payment] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> UTCTime -> UTCTime -> Text
body conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end =
  T.intercalate "\n" $
    [ exceedingPayers conf users cumulativeIncome preIncomeRepartition postIncomeRepartition
    , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
    ]
      where
        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
        incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ weekIncomes

exceedingPayers :: Conf -> [User] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> Text
exceedingPayers conf users cumulativeIncome preIncomeRepartition postIncomeRepartition =
  T.intercalate "\n" . map formatPayer $ payers
  where
    payers = Payer.getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition
    formatPayer p = T.concat
      [ "  * "
      , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users
      , " + "
      , Format.price (Conf.currency conf) $ _exceedingPayer_amount p
      , "\n"
      ]

operations :: Conf -> [User] -> Map Status [PaymentResource] -> Map Status [IncomeResource] -> Text
operations 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] -> [PaymentResource] -> 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 . map (\(PaymentResource p) -> p) $ 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] -> [IncomeResource] -> 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 . map (\(IncomeResource i) -> i) $ 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
    ]