From 9dbb4e6f7c2f0edc1126626e2ff498144c6b9947 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Nov 2019 11:28:42 +0100 Subject: Show income header --- client/src/View/Income/Header.hs | 35 ++++++++++++----------------------- client/src/View/Income/Income.hs | 29 ++++++++++++++++++----------- client/src/View/Income/Reducer.hs | 8 ++++---- 3 files changed, 34 insertions(+), 38 deletions(-) (limited to 'client') diff --git a/client/src/View/Income/Header.hs b/client/src/View/Income/Header.hs index 8e82525..8451ee4 100644 --- a/client/src/View/Income/Header.hs +++ b/client/src/View/Income/Header.hs @@ -5,13 +5,15 @@ module View.Income.Header ) where import Control.Monad.IO.Class (liftIO) +import qualified Data.Map as M import qualified Data.Maybe as Maybe import qualified Data.Text as T import qualified Data.Time.Clock as Clock import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Currency, Income (..), User (..)) +import Common.Model (Currency, Income (..), + IncomeHeader (..), User (..)) import qualified Common.Model as CM import qualified Common.Msg as Msg import qualified Common.View.Format as Format @@ -23,9 +25,9 @@ import qualified View.Income.Form as Form import View.Income.Init (Init (..)) data In t = In - { _in_init :: Init + { _in_users :: [User] + , _in_header :: IncomeHeader , _in_currency :: Currency - , _in_incomes :: Dynamic t [Income] } data Out t = Out @@ -38,11 +40,11 @@ view input = currentTime <- liftIO Clock.getCurrentTime - R.dyn . R.ffor useIncomesFrom $ \case - (Nothing, _) -> + case _incomeHeader_since $ _in_header input of + Nothing -> R.blank - (Just since, incomes) -> + Just since -> R.el "div" $ do R.el "h1" $ do @@ -50,15 +52,13 @@ view input = R.text $ Msg.get (Msg.Income_CumulativeSince (Format.longDay day)) R.el "ul" $ - flip mapM_ (_init_users init) $ \user -> + flip mapM_ (M.toList . _incomeHeader_byUser $ _in_header input) $ \(userId, amount) -> R.el "li" $ - R.text $ do - let userIncomes = filter ((==) (_user_id user) . _income_userId) incomes + R.text $ T.intercalate " " - [ _user_name user + [ Maybe.fromMaybe "" . fmap _user_name $ CM.findUser userId (_in_users input) , "−" - , Format.price (_in_currency input) $ - CM.cumulativeIncomesSince currentTime since userIncomes + , Format.price (_in_currency input) amount ] R.divClass "titleButton" $ do @@ -78,14 +78,3 @@ view input = return $ Out { _out_add = addIncome } - - where - init = _in_init input - - useIncomesFrom = R.ffor (_in_incomes input) $ \incomes -> - ( CM.useIncomesFrom - (map _user_id $_init_users init) - incomes - (_init_payments init) - , incomes - ) diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index d31775a..d82ab4d 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -11,15 +11,15 @@ import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (Currency, Income (..), - IncomesAndCount (..), User, UserId) +import Common.Model (Currency, Income (..), IncomePage (..), + User, UserId) import qualified Component.Pages as Pages import Loadable (Loadable (..)) import qualified Loadable import qualified Util.Ajax as AjaxUtil import qualified Util.Reflex as ReflexUtil --- import qualified View.Income.Header as Header +import qualified View.Income.Header as Header import View.Income.Init (Init (..)) import qualified View.Income.Reducer as Reducer import qualified View.Income.Table as Table @@ -36,22 +36,29 @@ view input = do incomes <- Reducer.reducer $ Reducer.In { Reducer._in_newPage = newPage , Reducer._in_currentPage = currentPage - , Reducer._in_addIncome = addIncome + , Reducer._in_addIncome = R.leftmost [headerAddIncome, tableAddIncome] , Reducer._in_editIncome = editIncome , Reducer._in_deleteIncome = deleteIncome } - let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a) + let eventFromResult :: forall a. ((Header.Out t, Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a) eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result - newPage <- eventFromResult $ Pages._out_newPage . snd + newPage <- eventFromResult $ Pages._out_newPage . (\(_, _, c) -> c) currentPage <- R.holdDyn 1 newPage - addIncome <- eventFromResult $ Table._out_add . fst - editIncome <- eventFromResult $ Table._out_edit . fst - deleteIncome <- eventFromResult $ Table._out_delete . fst + headerAddIncome <- eventFromResult $ Header._out_add . (\(a, _, _) -> a) + tableAddIncome <- eventFromResult $ Table._out_add . (\(_, b, _) -> b) + editIncome <- eventFromResult $ Table._out_edit . (\(_, b, _) -> b) + deleteIncome <- eventFromResult $ Table._out_delete . (\(_, b, _) -> b) result <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) -> - flip Loadable.view is $ \(IncomesAndCount incomes count) -> do + flip Loadable.view is $ \(IncomePage header incomes count) -> do + header <- Header.view $ Header.In + { Header._in_users = _in_users input + , Header._in_header = header + , Header._in_currency = _in_currency input + } + table <- Table.view $ Table.In { Table._in_currentUser = _in_currentUser input , Table._in_currency = _in_currency input @@ -65,6 +72,6 @@ view input = do , Pages._in_page = p } - return (table, pages) + return (header, table, pages) return () diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs index 5b346cb..092d9b3 100644 --- a/client/src/View/Income/Reducer.hs +++ b/client/src/View/Income/Reducer.hs @@ -9,7 +9,7 @@ import qualified Data.Text as T import Reflex.Dom (Dynamic, Event, MonadWidget) import qualified Reflex.Dom as R -import Common.Model (IncomesAndCount) +import Common.Model (IncomePage) import Loadable (Loadable (..)) import qualified Loadable as Loadable @@ -28,9 +28,9 @@ data In t a b c = In data Action = LoadPage Int - | GetResult (Either Text IncomesAndCount) + | GetResult (Either Text IncomePage) -reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomesAndCount)) +reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomePage)) reducer input = do postBuild <- R.getPostBuild @@ -60,7 +60,7 @@ reducer input = do where pageUrl p = - "api/v2/incomes?page=" + "api/incomes?page=" <> (T.pack . show $ p) <> "&perPage=" <> (T.pack . show $ perPage) -- cgit v1.2.3