From b97ad942495352c3fc1e0c820cfba82a9693ac7a Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 27 Oct 2019 20:26:29 +0100 Subject: WIP Set up server side paging for incomes --- client/src/View/Income/Income.hs | 101 +++++++++++++++++++------------------- client/src/View/Income/Reducer.hs | 66 +++++++++++++++++++++++++ client/src/View/Income/Table.hs | 13 ++--- 3 files changed, 120 insertions(+), 60 deletions(-) create mode 100644 client/src/View/Income/Reducer.hs (limited to 'client/src/View') diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index 2f0b8f5..c48f325 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -4,19 +4,23 @@ module View.Income.Income , In(..) ) where -import Data.Aeson (FromJSON) -import Prelude hiding (init) -import Reflex.Dom (Dynamic, Event, MonadWidget) -import qualified Reflex.Dom as R +import Data.Aeson (FromJSON) +import Prelude hiding (init) +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R -import Common.Model (Currency, Income (..), UserId) +import Common.Model (Currency, Income (..), + IncomesAndCount (..), UserId) -import Loadable (Loadable (..)) +import qualified Component.Pages as Pages +import Loadable (Loadable (..)) import qualified Loadable -import qualified Util.Ajax as AjaxUtil -import qualified View.Income.Header as Header -import View.Income.Init (Init (..)) -import qualified View.Income.Table as Table +import qualified Util.Ajax as AjaxUtil +import qualified Util.Reflex as ReflexUtil +-- 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 data In t = In { _in_currentUser :: UserId @@ -37,50 +41,45 @@ init = do view :: forall t m. MonadWidget t m => In t -> m () view input = do - R.dyn . R.ffor (_in_init input) . Loadable.view $ \init -> + -- rec + -- incomes <- Reducer.reducer + -- { Reducer._in_newPage = ReflexUtil.flatten (Table._out_newPage <$> table) + -- , Reducer._in_currentPage = ReflexUtil.flatten (Table._out_currentPage <$> table) + -- , Reducer._in_addIncome = ReflexUtil.flatten (Table._out_add <$> table) + -- , Reducer._in_editIncome = ReflexUtil.flatten (Table._out_edit <$> table) + -- , Reducer._in_deleteIncome = ReflexUtil.flatten (Table._out_delete <$> table) + -- } - R.elClass "main" "income" $ do + rec + incomes <- Reducer.reducer $ Reducer.In + { Reducer._in_newPage = Pages._out_newPage pages + , Reducer._in_currentPage = Pages._out_currentPage pages + , Reducer._in_addIncome = Table._out_add table + , Reducer._in_editIncome = Table._out_edit table + , Reducer._in_deleteIncome = Table._out_delete table + } - rec - let addIncome = R.leftmost - [ Header._out_add header - , Table._out_add table - ] + table <- Table.view $ Table.In + { Table._in_currentUser = _in_currentUser input + , Table._in_currency = _in_currency input + , Table._in_incomes = R.ffor incomes $ \case + Loaded (IncomesAndCount xs _) -> xs + _ -> [] + } - incomes <- reduceIncomes - (_init_incomes init) - addIncome - (Table._out_edit table) - (Table._out_delete table) + pages <- Pages.view $ Pages.In + { Pages._in_total = R.ffor incomes $ \case + Loaded (IncomesAndCount _ n) -> n + _ -> 0 + , Pages._in_perPage = Reducer.perPage + } - header <- Header.view $ Header.In - { Header._in_init = init - , Header._in_currency = _in_currency input - , Header._in_incomes = incomes - } - - table <- Table.view $ Table.In - { Table._in_currentUser = _in_currentUser input - , Table._in_init = init - , Table._in_currency = _in_currency input - , Table._in_incomes = incomes - , Table._in_resetPage = () <$ addIncome - } - - return () + -- -- table :: Event t (Maybe (Table.Out t)) + -- table <- R.dyn . R.ffor incomes . Loadable.view $ \incomes -> + -- Table.view $ Table.In + -- { Table._in_currentUser = _in_currentUser input + -- , Table._in_currency = _in_currency input + -- , Table._in_incomes = incomes + -- } return () - -reduceIncomes - :: forall t m. MonadWidget t m - => [Income] - -> Event t Income -- add - -> Event t Income -- edit - -> Event t Income -- delete - -> m (Dynamic t [Income]) -reduceIncomes initIncomes add edit delete = - R.foldDyn id initIncomes $ R.leftmost - [ (:) <$> add - , R.ffor edit (\p -> (p:) . filter ((/= (_income_id p)) . _income_id)) - , R.ffor delete (\p -> filter ((/= (_income_id p)) . _income_id)) - ] diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs new file mode 100644 index 0000000..5b346cb --- /dev/null +++ b/client/src/View/Income/Reducer.hs @@ -0,0 +1,66 @@ +module View.Income.Reducer + ( perPage + , reducer + , In(..) + ) where + +import Data.Text (Text) +import qualified Data.Text as T +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R + +import Common.Model (IncomesAndCount) + +import Loadable (Loadable (..)) +import qualified Loadable as Loadable +import qualified Util.Ajax as AjaxUtil + +perPage :: Int +perPage = 7 + +data In t a b c = In + { _in_newPage :: Event t Int + , _in_currentPage :: Dynamic t Int + , _in_addIncome :: Event t a + , _in_editIncome :: Event t b + , _in_deleteIncome :: Event t c + } + +data Action + = LoadPage Int + | GetResult (Either Text IncomesAndCount) + +reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomesAndCount)) +reducer input = do + + postBuild <- R.getPostBuild + + let loadPage = + R.leftmost + [ 1 <$ postBuild + , _in_newPage input + , 1 <$ _in_addIncome input + , R.tag (R.current $ _in_currentPage input) (_in_editIncome input) + , R.tag (R.current $ _in_currentPage input) (_in_deleteIncome input) + ] + + getResult <- AjaxUtil.get $ fmap pageUrl loadPage + + R.foldDyn + (\action _ -> case action of + LoadPage _ -> Loading + GetResult (Left err) -> Error err + GetResult (Right incomes) -> Loaded incomes + ) + Loading + (R.leftmost + [ LoadPage <$> loadPage + , GetResult <$> getResult + ]) + + where + pageUrl p = + "api/v2/incomes?page=" + <> (T.pack . show $ p) + <> "&perPage=" + <> (T.pack . show $ perPage) diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs index d089d9f..6d69c19 100644 --- a/client/src/View/Income/Table.hs +++ b/client/src/View/Income/Table.hs @@ -22,14 +22,11 @@ import qualified Component.Table as Table import qualified Util.Ajax as Ajax import qualified Util.Either as EitherUtil import qualified View.Income.Form as Form -import View.Income.Init (Init (..)) data In t = In { _in_currentUser :: UserId - , _in_init :: Init , _in_currency :: Currency , _in_incomes :: Dynamic t [Income] - , _in_resetPage :: Event t () } data Out t = Out @@ -44,9 +41,7 @@ view input = do table <- Table.view $ Table.In { Table._in_headerLabel = headerLabel , Table._in_rows = R.ffor (_in_incomes input) $ reverse . L.sortOn _income_date - , Table._in_cell = cell (_in_init input) (_in_currency input) - , Table._in_perPage = 7 - , Table._in_resetPage = _in_resetPage input + , Table._in_cell = cell [] (_in_currency input) , Table._in_cloneModal = \income -> Form.view $ Form.In { Form._in_operation = Form.Clone income @@ -84,11 +79,11 @@ headerLabel UserHeader = Msg.get Msg.Income_Name headerLabel DateHeader = Msg.get Msg.Income_Date headerLabel AmountHeader = Msg.get Msg.Income_Amount -cell :: Init -> Currency -> Header -> Income -> Text -cell init currency header income = +cell :: [User] -> Currency -> Header -> Income -> Text +cell users currency header income = case header of UserHeader -> - Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) (_init_users init) + Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users DateHeader -> Format.longDay . _income_date $ income -- cgit v1.2.3