aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoris2019-10-14 09:10:33 +0200
committerJoris2019-10-14 09:11:20 +0200
commit284214d3af39143fdbeca57ffa4864389e7d517a (patch)
treeb514a4a293e836dffa1572f7d16378dd0bbcdb71
parent04c59f08f100ba6a0658d1f2b357f7d8b1e14218 (diff)
Show cumulative incomes per user in income page
-rw-r--r--ISSUES.md1
-rw-r--r--client/client.cabal1
-rw-r--r--client/src/Util/Date.hs12
-rw-r--r--client/src/View/Income/Income.hs71
-rw-r--r--common/src/Common/Model/Payer.hs6
5 files changed, 71 insertions, 20 deletions
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