diff options
author | Joris | 2017-11-19 00:20:25 +0100 |
---|---|---|
committer | Joris | 2017-11-19 00:20:25 +0100 |
commit | 7194cddb28656c721342c2ef604f9f9fb0692960 (patch) | |
tree | 5b8c8562c9a1680aa315b4b7e10a3a7c22900863 /server/src | |
parent | 42e94a45e26f40edc3ad71b1e77a4bf47c13fd3d (diff) |
Show payment count and partition
- Also fixes exceedingPayer in back by using only punctual payments
Diffstat (limited to 'server/src')
43 files changed, 53 insertions, 133 deletions
diff --git a/server/src/Conf.hs b/server/src/Conf.hs index 299f071..2422a93 100644 --- a/server/src/Conf.hs +++ b/server/src/Conf.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Conf ( get , Conf(..) diff --git a/server/src/Controller/Category.hs b/server/src/Controller/Category.hs index a646496..5565b43 100644 --- a/server/src/Controller/Category.hs +++ b/server/src/Controller/Category.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Controller.Category ( create , edit @@ -11,10 +9,9 @@ import qualified Data.Text.Lazy as TL import Network.HTTP.Types.Status (badRequest400, ok200) import Web.Scotty hiding (delete) -import qualified Common.Message as Message -import qualified Common.Message.Key as Key import Common.Model (CategoryId, CreateCategory (..), EditCategory (..)) +import qualified Common.Msg as Msg import Json (jsonId) import qualified Model.Category as Category @@ -50,5 +47,5 @@ delete categoryId = status ok200 else do status badRequest400 - text . TL.fromStrict $ Message.get Key.Category_NotDeleted + text . TL.fromStrict $ Msg.get Msg.Category_NotDeleted ) diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs index c42f6a7..19f0cfc 100644 --- a/server/src/Controller/Income.hs +++ b/server/src/Controller/Income.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Controller.Income ( create , editOwn @@ -11,10 +9,9 @@ import qualified Data.Text.Lazy as TL import Network.HTTP.Types.Status (badRequest400, ok200) import Web.Scotty -import qualified Common.Message as Message -import qualified Common.Message.Key as Key import Common.Model (CreateIncome (..), EditIncome (..), IncomeId, User (..)) +import qualified Common.Msg as Msg import Json (jsonId) import qualified Model.Income as Income @@ -45,5 +42,5 @@ deleteOwn incomeId = status ok200 else do status badRequest400 - text . TL.fromStrict $ Message.get Key.Income_NotDeleted + text . TL.fromStrict $ Msg.get Msg.Income_NotDeleted ) diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs index bf4859d..f05ce6f 100644 --- a/server/src/Controller/Index.hs +++ b/server/src/Controller/Index.hs @@ -10,10 +10,9 @@ import Network.HTTP.Types.Status (ok200) import Prelude hiding (error) import Web.Scotty hiding (get) -import qualified Common.Message as Message -import Common.Message.Key (Key) -import qualified Common.Message.Key as Key import Common.Model (InitResult (..), User (..)) +import Common.Msg (Key) +import qualified Common.Msg as Msg import Conf (Conf (..)) import qualified LoginSession @@ -31,7 +30,7 @@ get conf mbToken = do userOrError <- validateSignIn conf token case userOrError of Left errorKey -> - return . InitEmpty . Left . Message.get $ errorKey + return . InitEmpty . Left . Msg.get $ errorKey Right user -> liftIO . Query.run . fmap InitSuccess $ getInit user conf Nothing -> do @@ -54,23 +53,23 @@ validateSignIn conf textToken = do now <- liftIO getCurrentTime case mbSignIn of Nothing -> - return . Left $ Key.SignIn_LinkInvalid + return . Left $ Msg.SignIn_LinkInvalid Just signIn -> if SignIn.isUsed signIn then - return . Left $ Key.SignIn_LinkUsed + return . Left $ Msg.SignIn_LinkUsed else let diffTime = now `diffUTCTime` (SignIn.creation signIn) in if diffTime > signInExpiration conf then - return . Left $ Key.SignIn_LinkExpired + return . Left $ Msg.SignIn_LinkExpired else do LoginSession.put conf (SignIn.token signIn) mbUser <- liftIO . Query.run $ do SignIn.signInTokenToUsed . SignIn.id $ signIn User.get . SignIn.email $ signIn return $ case mbUser of - Nothing -> Left Key.Secure_Unauthorized + Nothing -> Left Msg.Secure_Unauthorized Just user -> Right user getLoggedUser :: ActionM (Maybe User) diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs index e4104eb..c6c874a 100644 --- a/server/src/Controller/Payment.hs +++ b/server/src/Controller/Payment.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Controller.Payment ( list , create diff --git a/server/src/Controller/SignIn.hs b/server/src/Controller/SignIn.hs index 5552781..cf92c9f 100644 --- a/server/src/Controller/SignIn.hs +++ b/server/src/Controller/SignIn.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Controller.SignIn ( signIn ) where @@ -11,9 +9,8 @@ import qualified Data.Text.Lazy as TL import Network.HTTP.Types.Status (badRequest400, ok200) import Web.Scotty -import qualified Common.Message as Message -import qualified Common.Message.Key as Key import Common.Model (SignIn (..)) +import qualified Common.Msg as Msg import Conf (Conf) import qualified Conf @@ -40,8 +37,8 @@ signIn conf (SignIn email) = ] maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [email] case maybeSentMail of - Right _ -> textKey ok200 Key.SignIn_EmailSent - Left _ -> textKey badRequest400 Key.SignIn_EmailSendFail - Nothing -> textKey badRequest400 Key.Secure_Unauthorized - else textKey badRequest400 Key.SignIn_EmailInvalid - where textKey st key = status st >> (text . TL.fromStrict $ Message.get key) + Right _ -> textKey ok200 Msg.SignIn_EmailSent + Left _ -> textKey badRequest400 Msg.SignIn_EmailSendFail + Nothing -> textKey badRequest400 Msg.Secure_Unauthorized + else textKey badRequest400 Msg.SignIn_EmailInvalid + where textKey st key = status st >> (text . TL.fromStrict $ Msg.get key) diff --git a/server/src/Cookie.hs b/server/src/Cookie.hs index 511dd42..f79a1fa 100644 --- a/server/src/Cookie.hs +++ b/server/src/Cookie.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Cookie ( makeSimpleCookie , setCookie diff --git a/server/src/Design/Dialog.hs b/server/src/Design/Dialog.hs index 6759606..034a8b1 100644 --- a/server/src/Design/Dialog.hs +++ b/server/src/Design/Dialog.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.Dialog ( design ) where diff --git a/server/src/Design/Errors.hs b/server/src/Design/Errors.hs index 2c6c16b..9f435eb 100644 --- a/server/src/Design/Errors.hs +++ b/server/src/Design/Errors.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.Errors ( design ) where diff --git a/server/src/Design/Form.hs b/server/src/Design/Form.hs index a4a1de0..be0e74f 100644 --- a/server/src/Design/Form.hs +++ b/server/src/Design/Form.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.Form ( design ) where diff --git a/server/src/Design/Global.hs b/server/src/Design/Global.hs index 1fe6a80..34d772e 100644 --- a/server/src/Design/Global.hs +++ b/server/src/Design/Global.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.Global ( globalDesign ) where diff --git a/server/src/Design/Helper.hs b/server/src/Design/Helper.hs index 0913511..9bf7878 100644 --- a/server/src/Design/Helper.hs +++ b/server/src/Design/Helper.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.Helper ( clearFix , button diff --git a/server/src/Design/Tooltip.hs b/server/src/Design/Tooltip.hs index 57aec33..eef804e 100644 --- a/server/src/Design/Tooltip.hs +++ b/server/src/Design/Tooltip.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.Tooltip ( design ) where diff --git a/server/src/Design/View/Header.hs b/server/src/Design/View/Header.hs index d05f748..792d482 100644 --- a/server/src/Design/View/Header.hs +++ b/server/src/Design/View/Header.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.View.Header ( design ) where diff --git a/server/src/Design/View/Payment.hs b/server/src/Design/View/Payment.hs index 62f7061..0d59fa0 100644 --- a/server/src/Design/View/Payment.hs +++ b/server/src/Design/View/Payment.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.View.Payment ( design ) where diff --git a/server/src/Design/View/Payment/Header.hs b/server/src/Design/View/Payment/Header.hs index d87e95b..36bc8d9 100644 --- a/server/src/Design/View/Payment/Header.hs +++ b/server/src/Design/View/Payment/Header.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.View.Payment.Header ( design ) where diff --git a/server/src/Design/View/Payment/Pages.hs b/server/src/Design/View/Payment/Pages.hs index f6660a1..2028c1b 100644 --- a/server/src/Design/View/Payment/Pages.hs +++ b/server/src/Design/View/Payment/Pages.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.View.Payment.Pages ( design ) where diff --git a/server/src/Design/View/Payment/Table.hs b/server/src/Design/View/Payment/Table.hs index 243d7f4..26dc9ed 100644 --- a/server/src/Design/View/Payment/Table.hs +++ b/server/src/Design/View/Payment/Table.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.View.Payment.Table ( design ) where diff --git a/server/src/Design/View/SignIn.hs b/server/src/Design/View/SignIn.hs index 2b1252f..4d4be7b 100644 --- a/server/src/Design/View/SignIn.hs +++ b/server/src/Design/View/SignIn.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.View.SignIn ( design ) where diff --git a/server/src/Design/View/Stat.hs b/server/src/Design/View/Stat.hs index b10dd7b..4d7021e 100644 --- a/server/src/Design/View/Stat.hs +++ b/server/src/Design/View/Stat.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.View.Stat ( design ) where diff --git a/server/src/Design/View/Table.hs b/server/src/Design/View/Table.hs index fd55656..cd406fc 100644 --- a/server/src/Design/View/Table.hs +++ b/server/src/Design/View/Table.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.View.Table ( design ) where diff --git a/server/src/Design/Views.hs b/server/src/Design/Views.hs index 1157b68..a73a1fa 100644 --- a/server/src/Design/Views.hs +++ b/server/src/Design/Views.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Design.Views ( design ) where diff --git a/server/src/Job/Daemon.hs b/server/src/Job/Daemon.hs index 26977d1..d8cd522 100644 --- a/server/src/Job/Daemon.hs +++ b/server/src/Job/Daemon.hs @@ -14,7 +14,7 @@ import Job.Model (actualizeLastCheck, actualizeLastExecution, import Job.MonthlyPayment (monthlyPayment) import Job.WeeklyReport (weeklyReport) import qualified Model.Query as Query -import Utils.Time (belongToCurrentMonth, belongToCurrentWeek) +import Util.Time (belongToCurrentMonth, belongToCurrentWeek) runDaemons :: Conf -> IO () runDaemons conf = do diff --git a/server/src/Job/Model.hs b/server/src/Job/Model.hs index b90dca0..a5fa62b 100644 --- a/server/src/Job/Model.hs +++ b/server/src/Job/Model.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Job.Model ( Job(..) , getLastExecution diff --git a/server/src/Job/MonthlyPayment.hs b/server/src/Job/MonthlyPayment.hs index 8cb1c27..ca7e007 100644 --- a/server/src/Job/MonthlyPayment.hs +++ b/server/src/Job/MonthlyPayment.hs @@ -8,7 +8,7 @@ import Common.Model (Frequency (..), Payment (..)) import qualified Model.Payment as Payment import qualified Model.Query as Query -import Utils.Time (timeToDay) +import Util.Time (timeToDay) monthlyPayment :: Maybe UTCTime -> IO UTCTime monthlyPayment _ = do diff --git a/server/src/Json.hs b/server/src/Json.hs index eb5c572..6d40305 100644 --- a/server/src/Json.hs +++ b/server/src/Json.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE OverloadedStrings #-} - module Json ( jsonObject , jsonId diff --git a/server/src/LoginSession.hs b/server/src/LoginSession.hs index beca697..86f1329 100644 --- a/server/src/LoginSession.hs +++ b/server/src/LoginSession.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module LoginSession ( put , get diff --git a/server/src/Main.hs b/server/src/Main.hs index 5ac68db..d7b9b93 100644 --- a/server/src/Main.hs +++ b/server/src/Main.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - import Control.Applicative (liftA3) import Control.Monad.IO.Class (liftIO) @@ -9,6 +7,8 @@ import qualified Network.Wai.Middleware.Gzip as W import Network.Wai.Middleware.Static import Web.Scotty +import Common.Model (Frequency (..), Payment (..)) + import qualified Conf import qualified Controller.Category as Category import qualified Controller.Income as Income @@ -35,7 +35,8 @@ main = do time <- liftIO Time.getCurrentTime (users, incomes, payments) <- liftIO . Query.run $ liftA3 (,,) UserM.list IncomeM.list PaymentM.list - let exceedingPayers = getOrderedExceedingPayers time users incomes payments + let punctualPayments = filter ((==) Punctual . _payment_frequency) payments + exceedingPayers = getOrderedExceedingPayers time users incomes punctualPayments text . LT.pack . show $ exceedingPayers get "/" $ do diff --git a/server/src/MimeMail.hs b/server/src/MimeMail.hs index 7fe98ed..c994905 100644 --- a/server/src/MimeMail.hs +++ b/server/src/MimeMail.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module MimeMail ( -- * Datatypes Boundary (..) diff --git a/server/src/Model/Category.hs b/server/src/Model/Category.hs index b972ebd..ee406bc 100644 --- a/server/src/Model/Category.hs +++ b/server/src/Model/Category.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.Category diff --git a/server/src/Model/Frequency.hs b/server/src/Model/Frequency.hs index 41a325d..c29cf37 100644 --- a/server/src/Model/Frequency.hs +++ b/server/src/Model/Frequency.hs @@ -1,6 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.Frequency () where diff --git a/server/src/Model/Income.hs b/server/src/Model/Income.hs index a69112a..a6174bc 100644 --- a/server/src/Model/Income.hs +++ b/server/src/Model/Income.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.Income diff --git a/server/src/Model/Init.hs b/server/src/Model/Init.hs index c030c58..be44c72 100644 --- a/server/src/Model/Init.hs +++ b/server/src/Model/Init.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Model.Init ( getInit ) where diff --git a/server/src/Model/Payment.hs b/server/src/Model/Payment.hs index c1b109f..33551e5 100644 --- a/server/src/Model/Payment.hs +++ b/server/src/Model/Payment.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.Payment diff --git a/server/src/Model/PaymentCategory.hs b/server/src/Model/PaymentCategory.hs index 6d02136..c60c1a2 100644 --- a/server/src/Model/PaymentCategory.hs +++ b/server/src/Model/PaymentCategory.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.PaymentCategory diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs index 6f38fe7..0cc4a03 100644 --- a/server/src/Model/SignIn.hs +++ b/server/src/Model/SignIn.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Model.SignIn ( SignIn(..) , createSignInToken diff --git a/server/src/Model/User.hs b/server/src/Model/User.hs index f17f545..8dc1fc8 100644 --- a/server/src/Model/User.hs +++ b/server/src/Model/User.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Model.User diff --git a/server/src/Secure.hs b/server/src/Secure.hs index 88bdcda..6e5b998 100644 --- a/server/src/Secure.hs +++ b/server/src/Secure.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module Secure ( loggedAction , getUserFromToken @@ -11,9 +9,8 @@ import Data.Text.Lazy (fromStrict) import Network.HTTP.Types.Status (forbidden403) import Web.Scotty -import qualified Common.Message as Message -import qualified Common.Message.Key as Key import Common.Model (User) +import qualified Common.Msg as Msg import qualified LoginSession import Model.Query (Query) @@ -32,10 +29,10 @@ loggedAction action = do action user Nothing -> do status forbidden403 - html . fromStrict . Message.get $ Key.Secure_Unauthorized + html . fromStrict . Msg.get $ Msg.Secure_Unauthorized Nothing -> do status forbidden403 - html . fromStrict . Message.get $ Key.Secure_Forbidden + html . fromStrict . Msg.get $ Msg.Secure_Forbidden getUserFromToken :: Text -> Query (Maybe User) getUserFromToken token = do diff --git a/server/src/SendMail.hs b/server/src/SendMail.hs index 959f21d..d00912f 100644 --- a/server/src/SendMail.hs +++ b/server/src/SendMail.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module SendMail ( sendMail ) where diff --git a/server/src/Utils/Time.hs b/server/src/Util/Time.hs index e1a94d3..3e0856d 100644 --- a/server/src/Utils/Time.hs +++ b/server/src/Util/Time.hs @@ -1,4 +1,4 @@ -module Utils.Time +module Util.Time ( belongToCurrentMonth , belongToCurrentWeek , timeToDay diff --git a/server/src/View/Mail/SignIn.hs b/server/src/View/Mail/SignIn.hs index d542fd8..22c3cb0 100644 --- a/server/src/View/Mail/SignIn.hs +++ b/server/src/View/Mail/SignIn.hs @@ -1,24 +1,21 @@ -{-# LANGUAGE OverloadedStrings #-} - module View.Mail.SignIn ( mail ) where -import Data.Text (Text) +import Data.Text (Text) -import qualified Common.Message as Message -import qualified Common.Message.Key as Key -import Common.Model (User (..)) +import Common.Model (User (..)) +import qualified Common.Msg as Msg -import Conf (Conf) -import qualified Conf as Conf -import qualified Model.Mail as M +import Conf (Conf) +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 = Message.get Key.SignIn_MailTitle - , M.plainBody = Message.get (Key.SignIn_MailBody (_user_name user) url) + , M.subject = Msg.get Msg.SignIn_MailTitle + , M.plainBody = Msg.get (Msg.SignIn_MailBody (_user_name user) url) } diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs index c0e89d5..4ad8b77 100644 --- a/server/src/View/Mail/WeeklyReport.hs +++ b/server/src/View/Mail/WeeklyReport.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module View.Mail.WeeklyReport ( mail ) where @@ -13,11 +11,10 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Time.Clock (UTCTime) -import qualified Common.Message as Message -import qualified Common.Message.Key as Key import Common.Model (Income (..), Payment (..), User (..), UserId) import qualified Common.Model as CM +import qualified Common.Msg as Msg import qualified Common.View.Format as Format import Conf (Conf) @@ -34,9 +31,9 @@ mail conf users payments incomes start end = { M.from = Conf.noReplyMail conf , M.to = map _user_email users , M.subject = T.concat - [ Message.get Key.App_Title + [ Msg.get Msg.App_Title , " − " - , Message.get Key.WeeklyReport_Title + , Msg.get Msg.WeeklyReport_Title ] , M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes) } @@ -45,7 +42,7 @@ body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text body conf users paymentsByStatus incomesByStatus = if M.null paymentsByStatus && M.null incomesByStatus then - Message.get Key.WeeklyReport_Empty + Msg.get Msg.WeeklyReport_Empty else T.intercalate "\n" . catMaybes . concat $ [ map (\s -> paymentSection s conf users <$> M.lookup s paymentsByStatus) statuses @@ -56,17 +53,17 @@ paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text paymentSection status conf users payments = 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 + sectionTitle = Msg.get $ case status of + Created -> if count > 1 then Msg.WeeklyReport_PaymentsCreated count else Msg.WeeklyReport_PaymentCreated count + Edited -> if count > 1 then Msg.WeeklyReport_PaymentsEdited count else Msg.WeeklyReport_PaymentEdited count + Deleted -> if count > 1 then Msg.WeeklyReport_PaymentsDeleted count else Msg.WeeklyReport_PaymentDeleted count sectionItems = map (payedFor status conf users) . sortOn _payment_date $ payments payedFor :: Status -> Conf -> [User] -> Payment -> Text payedFor status conf users payment = case status of - Deleted -> Message.get (Key.WeeklyReport_PayedForNot name amount for at) - _ -> Message.get (Key.WeeklyReport_PayedFor name amount for at) + Deleted -> Msg.get (Msg.WeeklyReport_PayedForNot name amount for at) + _ -> Msg.get (Msg.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 @@ -76,17 +73,17 @@ incomeSection :: Status -> Conf -> [User] -> [Income] -> Text incomeSection status conf users incomes = 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 + sectionTitle = Msg.get $ case status of + Created -> if count > 1 then Msg.WeeklyReport_IncomesCreated count else Msg.WeeklyReport_IncomeCreated count + Edited -> if count > 1 then Msg.WeeklyReport_IncomesEdited count else Msg.WeeklyReport_IncomeEdited count + Deleted -> if count > 1 then Msg.WeeklyReport_IncomesDeleted count else Msg.WeeklyReport_IncomeDeleted count sectionItems = map (isPayedFrom status conf users) . sortOn _income_date $ incomes isPayedFrom :: Status -> Conf -> [User] -> Income -> Text isPayedFrom status conf users income = case status of - Deleted -> Message.get (Key.WeeklyReport_PayedFromNot name amount for) - _ -> Message.get (Key.WeeklyReport_PayedFrom name amount for) + Deleted -> Msg.get (Msg.WeeklyReport_PayedFromNot name amount for) + _ -> Msg.get (Msg.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 diff --git a/server/src/View/Page.hs b/server/src/View/Page.hs index ff7bdc7..27b4f26 100644 --- a/server/src/View/Page.hs +++ b/server/src/View/Page.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} - module View.Page ( page ) where @@ -16,9 +14,8 @@ import qualified Text.Blaze.Html5 as H import Text.Blaze.Html5.Attributes import qualified Text.Blaze.Html5.Attributes as A -import qualified Common.Message as Message -import qualified Common.Message.Key as Key import Common.Model (InitResult) +import qualified Common.Msg as Msg import Design.Global (globalDesign) @@ -28,7 +25,7 @@ page initResult = H.head $ do meta ! charset "UTF-8" meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0" - H.title (toHtml $ Message.get Key.App_Title) + H.title (toHtml $ Msg.get Msg.App_Title) script ! src "javascript/main.js" $ "" jsonScript "init" initResult link ! rel "stylesheet" ! type_ "text/css" ! href "css/reset.css" |