diff options
Diffstat (limited to 'src/server/View/Mail')
| -rw-r--r-- | src/server/View/Mail/SignIn.hs | 16 | ||||
| -rw-r--r-- | src/server/View/Mail/WeeklyReport.hs | 124 |
2 files changed, 128 insertions, 12 deletions
diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs index f776ddd..8eaa077 100644 --- a/src/server/View/Mail/SignIn.hs +++ b/src/server/View/Mail/SignIn.hs @@ -1,12 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} module View.Mail.SignIn - ( getMail + ( mail ) where import Data.Text (Text) -import qualified Data.Text.Lazy as LT -import Data.Text.Lazy.Builder (toLazyText, fromText) import Model.Database (User(..)) import qualified Model.Mail as M @@ -16,17 +14,11 @@ import Model.Message import Conf (Conf) import qualified Conf as Conf -getMail :: Conf -> User -> Text -> [Text] -> M.Mail -getMail conf user url to = +mail :: Conf -> User -> Text -> [Text] -> M.Mail +mail conf user url to = M.Mail { M.from = Conf.noReplyMail conf , M.to = to , M.subject = (getMessage SignInMailTitle) - , M.plainBody = plainBody user url + , M.plainBody = getParamMessage [userName user, url] SignInMail } - -plainBody :: User -> Text -> LT.Text -plainBody user url = strictToLazy (getParamMessage [userName user, url] SignInMail) - -strictToLazy :: Text -> LT.Text -strictToLazy = toLazyText . fromText diff --git a/src/server/View/Mail/WeeklyReport.hs b/src/server/View/Mail/WeeklyReport.hs new file mode 100644 index 0000000..b333891 --- /dev/null +++ b/src/server/View/Mail/WeeklyReport.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE OverloadedStrings #-} + +module View.Mail.WeeklyReport + ( mail + ) where + +import Data.Monoid ((<>)) +import Data.Maybe (catMaybes, fromMaybe) +import Data.Map (Map) +import qualified Data.Map as M +import Data.Text (Text) +import qualified Data.Text as T +import Data.Time.Clock (UTCTime) +import Data.Time.Calendar (Day, toGregorian) +import Data.List (sortOn) + +import Resource (Status(..), groupByStatus) + +import Database.Persist (Entity, entityVal) + +import Model.Database (Payment, Income, User, UserId) +import qualified Model.Database as D +import Model.Mail (Mail(Mail)) +import qualified Model.Mail as M +import Model.Message (getMessage, getParamMessage, plural) +import qualified Model.Message.Key as K +import Model.User (findUser) + +import Conf (Conf) +import qualified Conf as Conf + +import qualified View.Format as Format + +import Utils.Time (monthToKey) + +mail :: Conf -> [Entity User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail +mail conf users payments incomes start end = + Mail + { M.from = Conf.noReplyMail conf + , M.to = map (D.userEmail . entityVal) 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 -> [Entity User] -> Map Status [Payment] -> Map Status [Income] -> Text +body conf users paymentsByStatus incomesByStatus = + T.intercalate "\n\n" . catMaybes $ + [ paymentSection Created conf users <$> M.lookup Created paymentsByStatus + , paymentSection Edited conf users <$> M.lookup Edited paymentsByStatus + , paymentSection Deleted conf users <$> M.lookup Deleted paymentsByStatus + , incomeSection Created conf users <$> M.lookup Created incomesByStatus + , incomeSection Edited conf users <$> M.lookup Edited incomesByStatus + , incomeSection Deleted conf users <$> M.lookup Deleted incomesByStatus + ] + +paymentSection :: Status -> Conf -> [Entity User] -> [Payment] -> Text +paymentSection status conf users payments = + section + (plural (length payments) singleKey pluralKey) + (map (payedFor status conf users) . sortOn D.paymentDate $ 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 -> [Entity User] -> Payment -> Text +payedFor status conf users payment = + getParamMessage + [ formatUserName (D.paymentUserId payment) users + , Format.price conf . D.paymentCost $ payment + , D.paymentName payment + , formatDay $ D.paymentDate payment + ] + ( case status of + Created -> K.PayedFor + Edited -> K.PayedFor + Deleted -> K.DidNotPayFor + ) + +incomeSection :: Status -> Conf -> [Entity User] -> [Income] -> Text +incomeSection status conf users incomes = + section + (plural (length incomes) singleKey pluralKey) + (map (isPayedFrom status conf users) . sortOn D.incomeDate $ 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 -> [Entity User] -> Income -> Text +isPayedFrom status conf users income = + getParamMessage + [ formatUserName (D.incomeUserId income) users + , Format.price conf . D.incomeAmount $ income + , formatDay $ D.incomeDate income + ] + ( case status of + Created -> K.IsPayedFrom + Edited -> K.IsPayedFrom + Deleted -> K.IsNotPayedFrom + ) + +formatUserName :: UserId -> [Entity User] -> Text +formatUserName userId = fromMaybe "−" . fmap D.userName . 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" + , T.unlines . map (" - " <>) $ items + ] |