diff options
Diffstat (limited to 'src/server/View/Mail')
| -rw-r--r-- | src/server/View/Mail/SignIn.hs | 23 | ||||
| -rw-r--r-- | src/server/View/Mail/WeeklyReport.hs | 126 | 
2 files changed, 0 insertions, 149 deletions
diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs deleted file mode 100644 index c7d40d8..0000000 --- a/src/server/View/Mail/SignIn.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module View.Mail.SignIn -  ( mail -  ) where - -import Data.Text (Text) - -import Conf (Conf) -import Model.Message -import Model.Message.Key -import Model.User (User(..)) -import qualified Conf as Conf -import qualified Model.Mail as M - -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 = getParamMessage [name user, url] SignInMail -    } 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 -    ]  | 
