From 227dcd4435b775d7dbc5ae5d3d81b589897253cc Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 2 Nov 2019 20:52:27 +0100 Subject: Implement incomes server side paging --- client/src/Component/Pages.hs | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) (limited to 'client/src/Component/Pages.hs') diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs index a297222..d54cd3d 100644 --- a/client/src/Component/Pages.hs +++ b/client/src/Component/Pages.hs @@ -16,32 +16,26 @@ import qualified View.Icon as Icon data In t = In { _in_total :: Dynamic t Int , _in_perPage :: Int + , _in_page :: Int } data Out t = Out { _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 - (newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage + newPage <- ReflexUtil.divVisibleIf ((> 0) <$> (_in_total input)) $ pageButtons input return $ Out { _out_newPage = newPage - , _out_currentPage = currentPage } - where - total = _in_total input - perPage = _in_perPage input - pageButtons :: forall t m. MonadWidget t m - => Dynamic t Int - -> Int - -> m (Event t Int, Dynamic t Int) -pageButtons total perPage = do + => In t + -> m (Event t Int) +pageButtons input = do R.divClass "pages" $ do rec let newPage = R.leftmost @@ -52,7 +46,7 @@ pageButtons total perPage = do , lastPageClic ] - currentPage <- R.holdDyn 1 newPage + currentPage <- R.holdDyn (_in_page input) newPage firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar @@ -65,9 +59,9 @@ pageButtons total perPage = do lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar - return (newPage, currentPage) + return newPage - where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage) + where maxPage = R.ffor (_in_total input) (\t -> ceiling $ toRational t / toRational (_in_perPage input)) pageEvent = R.switch . R.current . fmap R.leftmost noCurrentPage = R.constDyn Nothing -- cgit v1.2.3