aboutsummaryrefslogtreecommitdiff
path: root/src/server/View/Mail/WeeklyReport.hs
diff options
context:
space:
mode:
authorJoris2020-01-30 11:35:31 +0000
committerJoris2020-01-30 11:35:31 +0000
commit960fa7cb7ae4c57d01306f78cd349f3a8337d0ab (patch)
tree5077cc720525fb025e4dba65a9a8b631862cbcc8 /src/server/View/Mail/WeeklyReport.hs
parent14bdbc8c937f5d0b35c61350dba28cb41c3737cd (diff)
parent6a04e640955051616c3ad0874605830c448f2d75 (diff)
downloadbudget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.tar.gz
budget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.tar.bz2
budget-960fa7cb7ae4c57d01306f78cd349f3a8337d0ab.zip
Merge branch 'with-ghcjs' into 'master'
Use Haskell on the frontend See merge request guyonvarch/shared-cost!2
Diffstat (limited to 'src/server/View/Mail/WeeklyReport.hs')
-rw-r--r--src/server/View/Mail/WeeklyReport.hs126
1 files changed, 0 insertions, 126 deletions
diff --git a/src/server/View/Mail/WeeklyReport.hs b/src/server/View/Mail/WeeklyReport.hs
deleted file mode 100644
index 1a80b95..0000000
--- a/src/server/View/Mail/WeeklyReport.hs
+++ /dev/null
@@ -1,126 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module View.Mail.WeeklyReport
- ( mail
- ) where
-
-import Data.List (sortOn)
-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 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 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 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.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
- getMessage K.WeeklyReportEmpty
- 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
- (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)
-
-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
- )
-
-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)
-
-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
- )
-
-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
-
-section :: Text -> [Text] -> Text
-section title items =
- T.concat
- [ title
- , "\n\n"
- , T.unlines . map (" - " <>) $ items
- ]