aboutsummaryrefslogtreecommitdiff
path: root/src/server/View/Mail/WeeklyReport.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/View/Mail/WeeklyReport.hs')
-rw-r--r--src/server/View/Mail/WeeklyReport.hs110
1 files changed, 43 insertions, 67 deletions
diff --git a/src/server/View/Mail/WeeklyReport.hs b/src/server/View/Mail/WeeklyReport.hs
index 1a80b95..0bafb70 100644
--- a/src/server/View/Mail/WeeklyReport.hs
+++ b/src/server/View/Mail/WeeklyReport.hs
@@ -9,38 +9,34 @@ import Data.Map (Map)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid ((<>))
import Data.Text (Text)
-import Data.Time.Calendar (Day, toGregorian)
import Data.Time.Clock (UTCTime)
import qualified Data.Map as M
import qualified Data.Text as T
-import Resource (Status(..), groupByStatus, statuses)
+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.Income (Income)
import Model.Mail (Mail(Mail))
-import Model.Message (getMessage, getParamMessage, plural)
-import Model.Payment (Payment)
-import Model.User (findUser)
-import Model.User (User, UserId)
-import qualified Model.Income as Income
+import Model.Payment ()
+import qualified Model.Income ()
import qualified Model.Mail as M
-import qualified Model.Message.Key as K
-import qualified Model.Payment as Payment
-import qualified Model.User as User
-
+import Resource (Status(..), groupByStatus, statuses)
import Conf (Conf)
import qualified Conf as Conf
-import qualified View.Format as Format
-
-import Utils.Time (monthToKey)
-
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 [getMessage K.SharedCost, " − ", getMessage K.WeeklyReport]
+ , 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)
}
@@ -48,7 +44,7 @@ body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
body conf users paymentsByStatus incomesByStatus =
if M.null paymentsByStatus && M.null incomesByStatus
then
- getMessage K.WeeklyReportEmpty
+ Message.get Key.WeeklyReport_Empty
else
T.intercalate "\n" . catMaybes . concat $
[ map (\s -> paymentSection s conf users <$> M.lookup s paymentsByStatus) statuses
@@ -57,65 +53,45 @@ body conf users paymentsByStatus incomesByStatus =
paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text
paymentSection status conf users payments =
- section
- (plural (length payments) singleKey pluralKey)
- (map (payedFor status conf users) . sortOn Payment.date $ payments)
- where (singleKey, pluralKey) =
- case status of
- Created -> (K.PaymentCreated, K.PaymentsCreated)
- Edited -> (K.PaymentEdited, K.PaymentsEdited)
- Deleted -> (K.PaymentDeleted, K.PaymentsDeleted)
+ 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 =
- getParamMessage
- [ formatUserName (Payment.userId payment) users
- , Format.price conf . Payment.cost $ payment
- , Payment.name payment
- , formatDay $ Payment.date payment
- ]
- ( case status of
- Created -> K.PayedFor
- Edited -> K.PayedFor
- Deleted -> K.DidNotPayFor
- )
+ 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
- (plural (length incomes) singleKey pluralKey)
- (map (isPayedFrom status conf users) . sortOn Income.date $ incomes)
- where (singleKey, pluralKey) =
- case status of
- Created -> (K.IncomeCreated, K.IncomesCreated)
- Edited -> (K.IncomeEdited, K.IncomesEdited)
- Deleted -> (K.IncomeDeleted, K.IncomesDeleted)
+ 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 =
- getParamMessage
- [ formatUserName (Income.userId income) users
- , Format.price conf . Income.amount $ income
- , formatDay $ Income.date income
- ]
- ( case status of
- Created -> K.IsPayedFrom
- Edited -> K.IsPayedFrom
- Deleted -> K.IsNotPayedFrom
- )
+ 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 . findUser userId
-
-formatDay :: Day -> Text
-formatDay d =
- let (year, month, day) = toGregorian d
- in getParamMessage
- [ T.pack . show $ day
- , fromMaybe "−" . fmap getMessage . monthToKey $ month
- , T.pack . show $ year
- ]
- K.LongDate
+formatUserName userId = fromMaybe "−" . fmap _user_name . User.find userId
section :: Text -> [Text] -> Text
section title items =