aboutsummaryrefslogtreecommitdiff
path: root/server/src/View
diff options
context:
space:
mode:
authorJoris2018-01-03 17:31:20 +0100
committerJoris2018-01-03 17:31:22 +0100
commita4acc2e84158fa822f88a1d0bdddb470708b5809 (patch)
tree3faeb0128a51b437501470bd38be62e6e871e9f3 /server/src/View
parent49426740e8e0c59040f4f3721a658f225572582b (diff)
Modify weelky report and payment search interface
- Add payment balance in weekly report - Show a message and hide pages when the search results in no results - Go to page 1 when the search is updated / erased
Diffstat (limited to 'server/src/View')
-rw-r--r--server/src/View/Mail/SignIn.hs2
-rw-r--r--server/src/View/Mail/WeeklyReport.hs32
-rw-r--r--server/src/View/Page.hs6
3 files changed, 30 insertions, 10 deletions
diff --git a/server/src/View/Mail/SignIn.hs b/server/src/View/Mail/SignIn.hs
index 22c3cb0..3c5469f 100644
--- a/server/src/View/Mail/SignIn.hs
+++ b/server/src/View/Mail/SignIn.hs
@@ -17,5 +17,5 @@ mail conf user url to =
{ M.from = Conf.noReplyMail conf
, M.to = to
, M.subject = Msg.get Msg.SignIn_MailTitle
- , M.plainBody = Msg.get (Msg.SignIn_MailBody (_user_name user) url)
+ , M.body = 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 4ad8b77..5418880 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -11,8 +11,8 @@ import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock (UTCTime)
-import Common.Model (Income (..), Payment (..), User (..),
- UserId)
+import Common.Model (ExceedingPayer (..), Income (..),
+ Payment (..), User (..), UserId)
import qualified Common.Model as CM
import qualified Common.Msg as Msg
import qualified Common.View.Format as Format
@@ -35,11 +35,31 @@ mail conf users payments incomes start end =
, " − "
, Msg.get Msg.WeeklyReport_Title
]
- , M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes)
+ , M.body = body conf users payments incomes start end
}
-body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
-body conf users paymentsByStatus incomesByStatus =
+body :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Text
+body conf users payments incomes start end =
+ T.intercalate "\n" $
+ [ exceedingPayers conf end users incomes (filter (null . _payment_deletedAt) payments)
+ , operations conf users (groupByStatus start end payments) (groupByStatus start end incomes)
+ ]
+
+exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
+exceedingPayers conf time users incomes payments =
+ T.intercalate "\n" . map formatPayer $ payers
+ where
+ payers = CM.getExceedingPayers time users incomes payments
+ formatPayer p = T.concat
+ [ " * "
+ , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users
+ , " + "
+ , Format.price (Conf.currency conf) $ _exceedingPayer_amount p
+ , "\n"
+ ]
+
+operations :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
+operations conf users paymentsByStatus incomesByStatus =
if M.null paymentsByStatus && M.null incomesByStatus
then
Msg.get Msg.WeeklyReport_Empty
@@ -96,5 +116,5 @@ section title items =
T.concat
[ title
, "\n\n"
- , T.unlines . map (" - " <>) $ items
+ , T.unlines . map (" * " <>) $ items
]
diff --git a/server/src/View/Page.hs b/server/src/View/Page.hs
index 27b4f26..97b84fa 100644
--- a/server/src/View/Page.hs
+++ b/server/src/View/Page.hs
@@ -26,10 +26,10 @@ page initResult =
meta ! charset "UTF-8"
meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0"
H.title (toHtml $ Msg.get Msg.App_Title)
- script ! src "javascript/main.js" $ ""
+ script ! src "/javascript/main.js" $ ""
jsonScript "init" initResult
- link ! rel "stylesheet" ! type_ "text/css" ! href "css/reset.css"
- link ! rel "icon" ! type_ "image/png" ! href "images/icon.png"
+ link ! rel "stylesheet" ! type_ "text/css" ! href "/css/reset.css"
+ link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png"
H.style $ toHtml globalDesign
jsonScript :: Json.ToJSON a => Text -> a -> Html