From a4acc2e84158fa822f88a1d0bdddb470708b5809 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 3 Jan 2018 17:31:20 +0100
Subject: 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
---
 server/src/View/Mail/SignIn.hs       |  2 +-
 server/src/View/Mail/WeeklyReport.hs | 32 ++++++++++++++++++++++++++------
 server/src/View/Page.hs              |  6 +++---
 3 files changed, 30 insertions(+), 10 deletions(-)

(limited to 'server/src/View')

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
-- 
cgit v1.2.3