From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 8 Nov 2017 23:47:26 +0100
Subject: Use a better project structure

---
 server/src/View/Mail/SignIn.hs       |  24 +++++++++
 server/src/View/Mail/WeeklyReport.hs | 102 +++++++++++++++++++++++++++++++++++
 2 files changed, 126 insertions(+)
 create mode 100644 server/src/View/Mail/SignIn.hs
 create mode 100644 server/src/View/Mail/WeeklyReport.hs

(limited to 'server/src/View/Mail')

diff --git a/server/src/View/Mail/SignIn.hs b/server/src/View/Mail/SignIn.hs
new file mode 100644
index 0000000..1daca1e
--- /dev/null
+++ b/server/src/View/Mail/SignIn.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module View.Mail.SignIn
+  ( mail
+  ) where
+
+import Data.Text (Text)
+
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model (User(..))
+
+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)
+    }
diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
new file mode 100644
index 0000000..b5f2b67
--- /dev/null
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -0,0 +1,102 @@
+{-# 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.Clock (UTCTime)
+import qualified Data.Map as M
+import qualified Data.Text as T
+
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import Common.Model (Payment(..), User(..), UserId, Income(..))
+import qualified Common.Model as CM
+import qualified Common.View.Format as Format
+
+import Model.Mail (Mail(Mail))
+import Model.Payment ()
+import qualified Model.Income ()
+import qualified Model.Mail as M
+import Resource (Status(..), groupByStatus, statuses)
+import Conf (Conf)
+import qualified Conf as Conf
+
+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
+        [ Message.get Key.App_Title
+        , " − "
+        , Message.get Key.WeeklyReport_Title
+        ]
+    , 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
+      Message.get Key.WeeklyReport_Empty
+    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 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
+        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)
+  where name = formatUserName (_payment_user payment) users
+        amount = Format.price (Conf.currency conf) . _payment_cost $ payment
+        for = _payment_name payment
+        at = Format.longDay $ _payment_date payment
+
+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
+        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)
+  where name = formatUserName (_income_userId income) users
+        amount = Format.price (Conf.currency conf) . _income_amount $ income
+        for = Format.longDay $ _income_date income
+
+formatUserName :: UserId -> [User] -> Text
+formatUserName userId = fromMaybe "−" . fmap _user_name . CM.findUser userId
+
+section :: Text -> [Text] -> Text
+section title items =
+  T.concat
+    [ title
+    , "\n\n"
+    , T.unlines . map ("  - " <>) $ items
+    ]
-- 
cgit v1.2.3


From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 13 Nov 2017 23:56:40 +0100
Subject: Setup stylish-haskell

---
 server/src/View/Mail/SignIn.hs       | 12 +++++------
 server/src/View/Mail/WeeklyReport.hs | 41 ++++++++++++++++++------------------
 2 files changed, 27 insertions(+), 26 deletions(-)

(limited to 'server/src/View/Mail')

diff --git a/server/src/View/Mail/SignIn.hs b/server/src/View/Mail/SignIn.hs
index 1daca1e..d542fd8 100644
--- a/server/src/View/Mail/SignIn.hs
+++ b/server/src/View/Mail/SignIn.hs
@@ -4,15 +4,15 @@ module View.Mail.SignIn
   ( mail
   ) where
 
-import Data.Text (Text)
+import           Data.Text          (Text)
 
-import qualified Common.Message as Message
+import qualified Common.Message     as Message
 import qualified Common.Message.Key as Key
-import Common.Model (User(..))
+import           Common.Model       (User (..))
 
-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 =
diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index b5f2b67..c0e89d5 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -4,28 +4,29 @@ 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.Clock (UTCTime)
-import qualified Data.Map as M
-import qualified Data.Text as T
+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 qualified Common.Message as Message
+import qualified Common.Message     as Message
 import qualified Common.Message.Key as Key
-import Common.Model (Payment(..), User(..), UserId, Income(..))
-import qualified Common.Model as CM
+import           Common.Model       (Income (..), Payment (..), User (..),
+                                     UserId)
+import qualified Common.Model       as CM
 import qualified Common.View.Format as Format
 
-import Model.Mail (Mail(Mail))
-import Model.Payment ()
-import qualified Model.Income ()
-import qualified Model.Mail as M
-import Resource (Status(..), groupByStatus, statuses)
-import Conf (Conf)
-import qualified Conf as Conf
+import           Conf               (Conf)
+import qualified Conf               as Conf
+import qualified Model.Income       ()
+import           Model.Mail         (Mail (Mail))
+import qualified Model.Mail         as M
+import           Model.Payment      ()
+import           Resource           (Status (..), groupByStatus, statuses)
 
 mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
 mail conf users payments incomes start end =
@@ -65,7 +66,7 @@ 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)
+    _       -> Message.get (Key.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
@@ -85,7 +86,7 @@ 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)
+    _       -> Message.get (Key.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
-- 
cgit v1.2.3


From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 19 Nov 2017 00:20:25 +0100
Subject: Show payment count and partition

- Also fixes exceedingPayer in back by using only punctual payments
---
 server/src/View/Mail/SignIn.hs       | 19 ++++++++-----------
 server/src/View/Mail/WeeklyReport.hs | 35 ++++++++++++++++-------------------
 2 files changed, 24 insertions(+), 30 deletions(-)

(limited to 'server/src/View/Mail')

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


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 ++++++++++++++++++++++++++------
 2 files changed, 27 insertions(+), 7 deletions(-)

(limited to 'server/src/View/Mail')

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


From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 28 Jan 2018 12:13:09 +0100
Subject: WIP

---
 server/src/View/Mail/WeeklyReport.hs | 55 +++++++++++++++++++-----------------
 1 file changed, 29 insertions(+), 26 deletions(-)

(limited to 'server/src/View/Mail')

diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 5418880..7e88d98 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -2,28 +2,28 @@ module View.Mail.WeeklyReport
   ( mail
   ) where
 
-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.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           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
+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
 
-import           Conf               (Conf)
-import qualified Conf               as Conf
-import qualified Model.Income       ()
-import           Model.Mail         (Mail (Mail))
-import qualified Model.Mail         as M
-import           Model.Payment      ()
-import           Resource           (Status (..), groupByStatus, statuses)
+import           Conf                  (Conf)
+import qualified Conf                  as Conf
+import           Model.IncomeResource  (IncomeResource (..))
+import           Model.Mail            (Mail (Mail))
+import qualified Model.Mail            as M
+import           Model.PaymentResource (PaymentResource (..))
+import           Resource              (Status (..), groupByStatus, statuses)
 
 mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
 mail conf users payments incomes start end =
@@ -42,8 +42,11 @@ 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)
+    , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
     ]
+      where
+        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ payments
+        incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes
 
 exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
 exceedingPayers conf time users incomes payments =
@@ -58,7 +61,7 @@ exceedingPayers conf time users incomes payments =
       , "\n"
       ]
 
-operations :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
+operations :: Conf -> [User] -> Map Status [PaymentResource] -> Map Status [IncomeResource] -> Text
 operations conf users paymentsByStatus incomesByStatus =
   if M.null paymentsByStatus && M.null incomesByStatus
     then
@@ -69,7 +72,7 @@ operations conf users paymentsByStatus incomesByStatus =
         , map (\s -> incomeSection s conf users <$> M.lookup s incomesByStatus) statuses
         ]
 
-paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text
+paymentSection :: Status -> Conf -> [User] -> [PaymentResource] -> Text
 paymentSection status conf users payments =
   section sectionTitle sectionItems
   where count = length payments
@@ -77,7 +80,7 @@ paymentSection status conf users payments =
           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
+        sectionItems = map (payedFor status conf users) . sortOn _payment_date . map (\(PaymentResource p) -> p) $ payments
 
 payedFor :: Status -> Conf -> [User] -> Payment -> Text
 payedFor status conf users payment =
@@ -89,7 +92,7 @@ payedFor status conf users payment =
         for = _payment_name payment
         at = Format.longDay $ _payment_date payment
 
-incomeSection :: Status -> Conf -> [User] -> [Income] -> Text
+incomeSection :: Status -> Conf -> [User] -> [IncomeResource] -> Text
 incomeSection status conf users incomes =
   section sectionTitle sectionItems
   where count = length incomes
@@ -97,7 +100,7 @@ incomeSection status conf users incomes =
           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
+        sectionItems = map (isPayedFrom status conf users) . sortOn _income_date . map (\(IncomeResource i) -> i) $ incomes
 
 isPayedFrom :: Status -> Conf -> [User] -> Income -> Text
 isPayedFrom status conf users income =
-- 
cgit v1.2.3


From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 17 Nov 2019 18:08:28 +0100
Subject: Optimize and refactor payments

---
 server/src/View/Mail/WeeklyReport.hs | 22 ++++++++++++----------
 1 file changed, 12 insertions(+), 10 deletions(-)

(limited to 'server/src/View/Mail')

diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 7e88d98..1f637bc 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -9,6 +9,7 @@ import           Data.Maybe            (catMaybes, fromMaybe)
 import           Data.Monoid           ((<>))
 import           Data.Text             (Text)
 import qualified Data.Text             as T
+import           Data.Time.Calendar    (Day)
 import           Data.Time.Clock       (UTCTime)
 
 import           Common.Model          (ExceedingPayer (..), Income (..),
@@ -23,10 +24,11 @@ import           Model.IncomeResource  (IncomeResource (..))
 import           Model.Mail            (Mail (Mail))
 import qualified Model.Mail            as M
 import           Model.PaymentResource (PaymentResource (..))
+import qualified Payer                 as Payer
 import           Resource              (Status (..), groupByStatus, statuses)
 
-mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
-mail conf users payments incomes start end =
+mail :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Mail
+mail conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
   Mail
     { M.from = Conf.noReplyMail conf
     , M.to = map _user_email users
@@ -35,24 +37,24 @@ mail conf users payments incomes start end =
         , " − "
         , Msg.get Msg.WeeklyReport_Title
         ]
-    , M.body = body conf users payments incomes start end
+    , M.body = body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end
     }
 
-body :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Text
-body conf users payments incomes start end =
+body :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Text
+body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
   T.intercalate "\n" $
-    [ exceedingPayers conf end users incomes (filter (null . _payment_deletedAt) payments)
+    [ exceedingPayers conf end users incomes preIncomeRepartition postIncomeRepartition firstPayment
     , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
     ]
       where
-        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ payments
+        paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
         incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes
 
-exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> [Payment] -> Text
-exceedingPayers conf time users incomes payments =
+exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> Text
+exceedingPayers conf time users incomes preIncomeRepartition postIncomeRepartition firstPayment =
   T.intercalate "\n" . map formatPayer $ payers
   where
-    payers = CM.getExceedingPayers time users incomes payments
+    payers = Payer.getExceedingPayers time users incomes preIncomeRepartition postIncomeRepartition firstPayment
     formatPayer p = T.concat
       [ "  * "
       , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users
-- 
cgit v1.2.3


From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 24 Nov 2019 16:19:53 +0100
Subject: Compute cumulative income with a DB query

---
 server/src/View/Mail/WeeklyReport.hs | 21 ++++++++++-----------
 1 file changed, 10 insertions(+), 11 deletions(-)

(limited to 'server/src/View/Mail')

diff --git a/server/src/View/Mail/WeeklyReport.hs b/server/src/View/Mail/WeeklyReport.hs
index 1f637bc..3fe224f 100644
--- a/server/src/View/Mail/WeeklyReport.hs
+++ b/server/src/View/Mail/WeeklyReport.hs
@@ -9,7 +9,6 @@ import           Data.Maybe            (catMaybes, fromMaybe)
 import           Data.Monoid           ((<>))
 import           Data.Text             (Text)
 import qualified Data.Text             as T
-import           Data.Time.Calendar    (Day)
 import           Data.Time.Clock       (UTCTime)
 
 import           Common.Model          (ExceedingPayer (..), Income (..),
@@ -27,8 +26,8 @@ import           Model.PaymentResource (PaymentResource (..))
 import qualified Payer                 as Payer
 import           Resource              (Status (..), groupByStatus, statuses)
 
-mail :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Mail
-mail conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
+mail :: Conf -> [User] -> [Income] -> [Payment] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> UTCTime -> UTCTime -> Mail
+mail conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end =
   Mail
     { M.from = Conf.noReplyMail conf
     , M.to = map _user_email users
@@ -37,24 +36,24 @@ mail conf users weekPayments preIncomeRepartition postIncomeRepartition firstPay
         , " − "
         , Msg.get Msg.WeeklyReport_Title
         ]
-    , M.body = body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end
+    , M.body = body conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end
     }
 
-body :: Conf -> [User] -> [Payment] -> Map UserId Int -> Map UserId Int -> Maybe Day -> [Income] -> UTCTime -> UTCTime -> Text
-body conf users weekPayments preIncomeRepartition postIncomeRepartition firstPayment incomes start end =
+body :: Conf -> [User] -> [Income] -> [Payment] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> UTCTime -> UTCTime -> Text
+body conf users weekIncomes weekPayments cumulativeIncome preIncomeRepartition postIncomeRepartition start end =
   T.intercalate "\n" $
-    [ exceedingPayers conf end users incomes preIncomeRepartition postIncomeRepartition firstPayment
+    [ exceedingPayers conf users cumulativeIncome preIncomeRepartition postIncomeRepartition
     , operations conf users paymentsGroupedByStatus incomesGroupedByStatus
     ]
       where
         paymentsGroupedByStatus = groupByStatus start end . map PaymentResource $ weekPayments
-        incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ incomes
+        incomesGroupedByStatus = groupByStatus start end . map IncomeResource $ weekIncomes
 
-exceedingPayers :: Conf -> UTCTime -> [User] -> [Income] -> Map UserId Int -> Map UserId Int -> Maybe Day -> Text
-exceedingPayers conf time users incomes preIncomeRepartition postIncomeRepartition firstPayment =
+exceedingPayers :: Conf -> [User] -> Map UserId Int -> Map UserId Int -> Map UserId Int -> Text
+exceedingPayers conf users cumulativeIncome preIncomeRepartition postIncomeRepartition =
   T.intercalate "\n" . map formatPayer $ payers
   where
-    payers = Payer.getExceedingPayers time users incomes preIncomeRepartition postIncomeRepartition firstPayment
+    payers = Payer.getExceedingPayers users cumulativeIncome preIncomeRepartition postIncomeRepartition
     formatPayer p = T.concat
       [ "  * "
       , fromMaybe "" $ _user_name <$> CM.findUser (_exceedingPayer_userId p) users
-- 
cgit v1.2.3


From af8353c6164aaaaa836bfed181f883ac86bb76a5 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 19 Jan 2020 14:03:31 +0100
Subject: Sign in with email and password

---
 server/src/View/Mail/SignIn.hs | 21 ---------------------
 1 file changed, 21 deletions(-)
 delete mode 100644 server/src/View/Mail/SignIn.hs

(limited to 'server/src/View/Mail')

diff --git a/server/src/View/Mail/SignIn.hs b/server/src/View/Mail/SignIn.hs
deleted file mode 100644
index 3c5469f..0000000
--- a/server/src/View/Mail/SignIn.hs
+++ /dev/null
@@ -1,21 +0,0 @@
-module View.Mail.SignIn
-  ( mail
-  ) where
-
-import           Data.Text    (Text)
-
-import           Common.Model (User (..))
-import qualified Common.Msg   as Msg
-
-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 = Msg.get Msg.SignIn_MailTitle
-    , M.body = Msg.get (Msg.SignIn_MailBody (_user_name user) url)
-    }
-- 
cgit v1.2.3