From 284214d3af39143fdbeca57ffa4864389e7d517a Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 14 Oct 2019 09:10:33 +0200
Subject: Show cumulative incomes per user in income page

---
 ISSUES.md                        |  1 -
 client/client.cabal              |  1 +
 client/src/Util/Date.hs          | 12 +++++++
 client/src/View/Income/Income.hs | 71 ++++++++++++++++++++++++++++++----------
 common/src/Common/Model/Payer.hs |  6 ++--
 5 files changed, 71 insertions(+), 20 deletions(-)
 create mode 100644 client/src/Util/Date.hs

diff --git a/ISSUES.md b/ISSUES.md
index fbbcc87..6863b00 100644
--- a/ISSUES.md
+++ b/ISSUES.md
@@ -1,6 +1,5 @@
 ## Income view
 
-- Show the income header
 - Add an income
 - Clone an income
 - Edit an income
diff --git a/client/client.cabal b/client/client.cabal
index f8fe1e1..eeeb8be 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -55,6 +55,7 @@ Executable client
     Icon
     Util.Ajax
     Util.Css
+    Util.Date
     Util.Either
     Util.List
     Util.Reflex
diff --git a/client/src/Util/Date.hs b/client/src/Util/Date.hs
new file mode 100644
index 0000000..8fad881
--- /dev/null
+++ b/client/src/Util/Date.hs
@@ -0,0 +1,12 @@
+module Util.Date
+  ( utcToLocalDay
+  ) where
+
+import           Data.Time.Calendar  (Day)
+import           Data.Time.Clock     (UTCTime)
+import qualified Data.Time.LocalTime as LocalTime
+
+utcToLocalDay :: UTCTime -> IO Day
+utcToLocalDay time = do
+  timezone <- LocalTime.getCurrentTimeZone
+  return . LocalTime.localDay $ LocalTime.utcToLocalTime timezone time
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index 5e9ce1d..d0c0a45 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -3,19 +3,22 @@ module View.Income.Income
   , IncomeIn(..)
   ) where
 
-import qualified Data.List          as L
-import qualified Data.Maybe         as Maybe
-import           Data.Text          (Text)
-import qualified Data.Text          as T
-import           Reflex.Dom         (MonadWidget)
-import qualified Reflex.Dom         as R
-
-import           Common.Model       (Income (..), Init (..), User (..))
-import qualified Common.Model       as CM
-import qualified Common.Msg         as Msg
-import qualified Common.View.Format as Format
-import           Component          (TableIn (..))
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.List              as L
+import qualified Data.Maybe             as Maybe
+import           Data.Text              (Text)
+import qualified Data.Text              as T
+import qualified Data.Time.Clock        as Clock
+import           Reflex.Dom             (MonadWidget)
+import qualified Reflex.Dom             as R
+
+import           Common.Model           (Income (..), Init (..), User (..))
+import qualified Common.Model           as CM
+import qualified Common.Msg             as Msg
+import qualified Common.View.Format     as Format
+import           Component              (TableIn (..))
 import qualified Component
+import qualified Util.Date              as DateUtil
 
 data IncomeIn = IncomeIn
   { _incomeIn_init :: Init
@@ -25,11 +28,7 @@ view :: forall t m. MonadWidget t m => IncomeIn -> m ()
 view incomeIn =
   R.elClass "main" "income" $ do
 
-    R.divClass "withMargin" $
-      R.divClass "titleButton" $
-        R.el "h1" $
-          R.text $
-            Msg.get Msg.Income_MonthlyNet
+    header (_incomeIn_init incomeIn)
 
     Component.table $ TableIn
       { _tableIn_headerLabel = headerLabel
@@ -42,8 +41,46 @@ view incomeIn =
         $ incomeIn
       , _tableIn_cell = cell (_incomeIn_init incomeIn)
       }
+
     return ()
 
+header :: forall t m. MonadWidget t m => Init -> m ()
+header init =
+  R.divClass "withMargin" $ do
+
+    currentTime <- liftIO Clock.getCurrentTime
+
+    Maybe.fromMaybe R.blank $
+      flip fmap useIncomesFrom $ \since ->
+        R.el "div" $ do
+
+          R.el "h1" $ do
+            day <- liftIO $ DateUtil.utcToLocalDay since
+            R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay day))
+
+          R.el "ul" $
+            flip mapM_ (_init_users init) $ \user ->
+              R.el "li" $
+                R.text $ do
+                  let incomes = filter ((==) (_user_id user) . _income_userId) (_init_incomes init)
+                  T.intercalate " "
+                    [ _user_name user
+                    , "−"
+                    , Format.price (_init_currency init) $
+                      CM.cumulativeIncomesSince currentTime since incomes
+                    ]
+
+    R.divClass "titleButton" $
+      R.el "h1" $
+        R.text $
+          Msg.get Msg.Income_MonthlyNet
+
+  where
+    useIncomesFrom = CM.useIncomesFrom
+      (map _user_id $_init_users init)
+      (_init_incomes init)
+      (_init_payments init)
+
 data Header
   = UserHeader
   | AmountHeader
diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs
index d09dbf6..40228d5 100644
--- a/common/src/Common/Model/Payer.hs
+++ b/common/src/Common/Model/Payer.hs
@@ -1,6 +1,8 @@
 module Common.Model.Payer
-  ( getExceedingPayers
-  , ExceedingPayer(..)
+  ( ExceedingPayer(..)
+  , getExceedingPayers
+  , useIncomesFrom
+  , cumulativeIncomesSince
   ) where
 
 import qualified Data.List            as List
-- 
cgit v1.2.3