From 0b191f5c48edffc9da3e38c284e9640fd82e7cb1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 5 Jun 2017 18:02:13 +0200 Subject: Replace persistent by sqlite-simple --- src/server/View/Mail/SignIn.hs | 11 +++---- src/server/View/Mail/WeeklyReport.hs | 62 +++++++++++++++++++----------------- 2 files changed, 37 insertions(+), 36 deletions(-) (limited to 'src/server/View') diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs index 8eaa077..c7d40d8 100644 --- a/src/server/View/Mail/SignIn.hs +++ b/src/server/View/Mail/SignIn.hs @@ -6,13 +6,12 @@ module View.Mail.SignIn import Data.Text (Text) -import Model.Database (User(..)) -import qualified Model.Mail as M -import Model.Message.Key -import Model.Message - 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 = @@ -20,5 +19,5 @@ mail conf user url to = { M.from = Conf.noReplyMail conf , M.to = to , M.subject = (getMessage SignInMailTitle) - , M.plainBody = getParamMessage [userName user, url] SignInMail + , M.plainBody = getParamMessage [name user, url] SignInMail } diff --git a/src/server/View/Mail/WeeklyReport.hs b/src/server/View/Mail/WeeklyReport.hs index e33459c..1a80b95 100644 --- a/src/server/View/Mail/WeeklyReport.hs +++ b/src/server/View/Mail/WeeklyReport.hs @@ -4,27 +4,29 @@ module View.Mail.WeeklyReport ( mail ) where -import Data.Monoid ((<>)) -import Data.Maybe (catMaybes, fromMaybe) +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 Data.Time.Calendar (Day, toGregorian) -import Data.List (sortOn) +import Data.Time.Clock (UTCTime) +import qualified Data.Map as M +import qualified Data.Text as T import Resource (Status(..), groupByStatus, statuses) -import Database.Persist (Entity, entityVal) - -import Model.Database (Payment, Income, User, UserId) -import qualified Model.Database as D +import Model.Income (Income) 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.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 @@ -33,16 +35,16 @@ import qualified View.Format as Format import Utils.Time (monthToKey) -mail :: Conf -> [Entity User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail +mail :: Conf -> [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.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 -> [Entity User] -> Map Status [Payment] -> Map Status [Income] -> Text +body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text body conf users paymentsByStatus incomesByStatus = if M.null paymentsByStatus && M.null incomesByStatus then @@ -53,24 +55,24 @@ body conf users paymentsByStatus incomesByStatus = , map (\s -> incomeSection s conf users <$> M.lookup s incomesByStatus) statuses ] -paymentSection :: Status -> Conf -> [Entity User] -> [Payment] -> Text +paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text paymentSection status conf users payments = section (plural (length payments) singleKey pluralKey) - (map (payedFor status conf users) . sortOn D.paymentDate $ payments) + (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 -> [Entity User] -> Payment -> Text +payedFor :: Status -> Conf -> [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 + [ formatUserName (Payment.userId payment) users + , Format.price conf . Payment.cost $ payment + , Payment.name payment + , formatDay $ Payment.date payment ] ( case status of Created -> K.PayedFor @@ -78,23 +80,23 @@ payedFor status conf users payment = Deleted -> K.DidNotPayFor ) -incomeSection :: Status -> Conf -> [Entity User] -> [Income] -> Text +incomeSection :: Status -> Conf -> [User] -> [Income] -> Text incomeSection status conf users incomes = section (plural (length incomes) singleKey pluralKey) - (map (isPayedFrom status conf users) . sortOn D.incomeDate $ incomes) + (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 -> [Entity User] -> Income -> Text +isPayedFrom :: Status -> Conf -> [User] -> Income -> Text isPayedFrom status conf users income = getParamMessage - [ formatUserName (D.incomeUserId income) users - , Format.price conf . D.incomeAmount $ income - , formatDay $ D.incomeDate income + [ formatUserName (Income.userId income) users + , Format.price conf . Income.amount $ income + , formatDay $ Income.date income ] ( case status of Created -> K.IsPayedFrom @@ -102,8 +104,8 @@ isPayedFrom status conf users income = Deleted -> K.IsNotPayedFrom ) -formatUserName :: UserId -> [Entity User] -> Text -formatUserName userId = fromMaybe "−" . fmap D.userName . findUser userId +formatUserName :: UserId -> [User] -> Text +formatUserName userId = fromMaybe "−" . fmap User.name . findUser userId formatDay :: Day -> Text formatDay d = -- cgit v1.2.3