aboutsummaryrefslogtreecommitdiff
path: root/server/src/View/Mail/WeeklyReport.hs
blob: 1f637bc783b756a26e0df841a2b293e84b3225b9 (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
125
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.Calendar    (Day)
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] -> [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
    , M.subject = T.concat
        [ Msg.get Msg.App_Title
        , " − "
        , Msg.get Msg.WeeklyReport_Title
        ]
    , M.body = body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment 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 preIncomeRepartition postIncomeRepartition firstPayment
    , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
    ]
      where
        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
        incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes

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 = Payer.getExceedingPayers time users incomes preIncomeRepartition postIncomeRepartition firstPayment
    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
    ]