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/client.cabal | 1 + client/src/Component/Pages.hs | 37 ++++++++------ client/src/Component/Table.hs | 20 +------- client/src/Loadable.hs | 9 ++++ client/src/View/Income/Income.hs | 101 +++++++++++++++++++------------------- client/src/View/Income/Reducer.hs | 66 +++++++++++++++++++++++++ client/src/View/Income/Table.hs | 13 ++--- 7 files changed, 152 insertions(+), 95 deletions(-) create mode 100644 client/src/View/Income/Reducer.hs (limited to 'client') diff --git a/client/client.cabal b/client/client.cabal index 9a212e8..8648d57 100644 --- a/client/client.cabal +++ b/client/client.cabal @@ -72,6 +72,7 @@ Executable client View.Income.Form View.Income.Header View.Income.Income + View.Income.Reducer View.Income.Table View.NotFound View.Payment.Add diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs index 7284a36..a297222 100644 --- a/client/src/Component/Pages.hs +++ b/client/src/Component/Pages.hs @@ -16,38 +16,43 @@ import qualified View.Icon as Icon data In t = In { _in_total :: Dynamic t Int , _in_perPage :: Int - , _in_reset :: Event t () } data Out t = Out - { _out_currentPage :: Dynamic t Int + { _out_newPage :: Event t Int + , _out_currentPage :: Dynamic t Int } view :: forall t m. MonadWidget t m => In t -> m (Out t) view input = do - currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset + (newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage return $ Out - { _out_currentPage = currentPage + { _out_newPage = newPage + , _out_currentPage = currentPage } where total = _in_total input perPage = _in_perPage input - reset = _in_reset input -pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int) -pageButtons total perPage reset = do +pageButtons + :: forall t m. MonadWidget t m + => Dynamic t Int + -> Int + -> m (Event t Int, Dynamic t Int) +pageButtons total perPage = do R.divClass "pages" $ do rec - currentPage <- R.holdDyn 1 . R.leftmost $ - [ firstPageClic - , previousPageClic - , pageClic - , nextPageClic - , lastPageClic - , 1 <$ reset - ] + let newPage = R.leftmost + [ firstPageClic + , previousPageClic + , pageClic + , nextPageClic + , lastPageClic + ] + + currentPage <- R.holdDyn 1 newPage firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar @@ -60,7 +65,7 @@ pageButtons total perPage reset = do lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar - return currentPage + return (newPage, currentPage) where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage) pageEvent = R.switch . R.current . fmap R.leftmost diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs index a02eaa7..7103abd 100644 --- a/client/src/Component/Table.hs +++ b/client/src/Component/Table.hs @@ -10,7 +10,6 @@ import qualified Reflex.Dom as R import qualified Component.Button as Button import qualified Component.Modal as Modal -import qualified Component.Pages as Pages import qualified Util.Reflex as ReflexUtil import qualified View.Icon as Icon @@ -18,8 +17,6 @@ data In m t h r a = In { _in_headerLabel :: h -> Text , _in_rows :: Dynamic t [r] , _in_cell :: h -> r -> Text - , _in_perPage :: Int - , _in_resetPage :: Event t () , _in_cloneModal :: r -> Modal.Content t m a , _in_editModal :: r -> Modal.Content t m a , _in_deleteModal :: r -> Modal.Content t m a @@ -47,12 +44,7 @@ view input = R.divClass "cell" $ R.blank R.divClass "cell" $ R.blank - let rows = getRange - (_in_perPage input) - <$> (Pages._out_currentPage pages) - <*> (_in_rows input) - - R.simpleList rows $ \r -> + R.simpleList (_in_rows input) $ \r -> R.divClass "row" $ do flip mapM_ [minBound..] $ \h -> R.divClass "cell" $ @@ -104,12 +96,6 @@ view input = return (cloned, edited, deleted) - pages <- Pages.view $ Pages.In - { Pages._in_total = length <$> _in_rows input - , Pages._in_perPage = _in_perPage input - , Pages._in_reset = _in_resetPage input - } - let add = R.switch . R.current . fmap (R.leftmost . map (\(a, _, _) -> a)) $ result edit = R.switch . R.current . fmap (R.leftmost . map (\(_, a, _) -> a)) $ result delete = R.switch . R.current . fmap (R.leftmost . map (\(_, _, a) -> a)) $ result @@ -119,7 +105,3 @@ view input = , _out_edit = edit , _out_delete = delete } - -getRange :: forall a. Int -> Int -> [a] -> [a] -getRange perPage currentPage = - take perPage . drop ((currentPage - 1) * perPage) diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs index 8714a4d..a5c1d41 100644 --- a/client/src/Loadable.hs +++ b/client/src/Loadable.hs @@ -49,3 +49,12 @@ view :: forall t m a. MonadWidget t m => (a -> m ()) -> Loadable a -> m () view _ (Loading) = R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank view _ (Error e) = R.text e view f (Loaded x) = f x + +-- view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b) +-- view _ (Loading) = do +-- R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank +-- return Nothing +-- view _ (Error e) = do +-- R.text e +-- return Nothing +-- view f (Loaded x) = Just <$> (f x) 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