aboutsummaryrefslogtreecommitdiff
path: root/server/src/View/Mail/WeeklyReport.hs
blob: 7e88d984adcf262bb65a8177e6cd5d482f03e3d6 (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
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           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.body = body conf users payments incomes start end
    }

body :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Text
body conf users payments incomes start end =
  T.intercalate "\n" $
    [ exceedingPayers conf end users incomes (filter (null . _payment_deletedAt) payments)
    , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
    ]
      where
        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ payments
        incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes

exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
exceedingPayers conf time users incomes payments =
  T.intercalate "\n" . map formatPayer $ payers
  where
    payers = CM.getExceedingPayers time users incomes payments
    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
    ]