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