From 0b40b6b5583b5c437f83e61bf8913f2b4c447b24 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 19 Oct 2019 09:36:03 +0200 Subject: Include pages into table component --- client/src/Component.hs | 1 + client/src/Component/Pages.hs | 88 ++++++++++++++++++++++++++++++++++++++++ client/src/Component/Table.hs | 53 +++++++++++++++++------- client/src/View/Income/Income.hs | 2 + 4 files changed, 129 insertions(+), 15 deletions(-) create mode 100644 client/src/Component/Pages.hs (limited to 'client/src') diff --git a/client/src/Component.hs b/client/src/Component.hs index 97c250e..4c51750 100644 --- a/client/src/Component.hs +++ b/client/src/Component.hs @@ -5,5 +5,6 @@ import Component.Form as X import Component.Input as X import Component.Link as X import Component.Modal as X +import Component.Pages as X import Component.Select as X import Component.Table as X diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs new file mode 100644 index 0000000..5611cb7 --- /dev/null +++ b/client/src/Component/Pages.hs @@ -0,0 +1,88 @@ +module Component.Pages + ( widget + , PagesIn(..) + , PagesOut(..) + ) where + +import qualified Data.Text as T +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R + +import Component.Button (ButtonIn (..), ButtonOut (..)) +import qualified Component.Button as Button + +import qualified Icon +import qualified Util.Reflex as ReflexUtil + +data PagesIn t = PagesIn + { _pagesIn_total :: Dynamic t Int + , _pagesIn_perPage :: Int + , _pagesIn_reset :: Event t () + } + +data PagesOut t = PagesOut + { _pagesOut_currentPage :: Dynamic t Int + } + +widget :: forall t m. MonadWidget t m => PagesIn t -> m (PagesOut t) +widget pagesIn = do + currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset + + return $ PagesOut + { _pagesOut_currentPage = currentPage + } + + where + total = _pagesIn_total pagesIn + perPage = _pagesIn_perPage pagesIn + reset = _pagesIn_reset pagesIn + +pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int) +pageButtons total perPage reset = do + R.divClass "pages" $ do + rec + currentPage <- R.holdDyn 1 . R.leftmost $ + [ firstPageClic + , previousPageClic + , pageClic + , nextPageClic + , lastPageClic + , 1 <$ reset + ] + + firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar + + previousPageClic <- pageButton noCurrentPage (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft + + pageClic <- pageEvent <$> (R.simpleList (range <$> currentPage <*> maxPage) $ \p -> + pageButton (Just <$> currentPage) p (R.dynText $ fmap (T.pack . show) p)) + + nextPageClic <- pageButton noCurrentPage ((\c m -> min (c + 1) m) <$> currentPage <*> maxPage) Icon.doubleRight + + lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar + + return currentPage + + where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage) + pageEvent = R.switch . R.current . fmap R.leftmost + noCurrentPage = R.constDyn Nothing + +range :: Int -> Int -> [Int] +range currentPage maxPage = [start..end] + where sidePages = 2 + start = max 1 (min (currentPage - sidePages) (maxPage - sidePages * 2)) + end = min maxPage (start + sidePages * 2) + +pageButton :: forall t m. MonadWidget t m => Dynamic t (Maybe Int) -> Dynamic t Int -> m () -> m (Event t Int) +pageButton currentPage page content = do + clic <- _buttonOut_clic <$> (Button.button $ ButtonIn + { _buttonIn_class = do + cp <- currentPage + p <- page + if cp == Just p then "page current" else "page" + , _buttonIn_content = content + , _buttonIn_waiting = R.never + , _buttonIn_tabIndex = Nothing + , _buttonIn_submit = False + }) + return . fmap fst $ R.attach (R.current page) clic diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs index a77a18d..b431c14 100644 --- a/client/src/Component/Table.hs +++ b/client/src/Component/Table.hs @@ -4,35 +4,58 @@ module Component.Table , TableOut(..) ) where -import Data.Text (Text) -import Reflex.Dom (Dynamic, MonadWidget) -import qualified Reflex.Dom as R +import Data.Text (Text) +import Reflex.Dom (Dynamic, Event, MonadWidget) +import qualified Reflex.Dom as R + +import Component.Pages (PagesIn (..), PagesOut (..)) +import qualified Component.Pages as Pages data TableIn h r t = TableIn { _tableIn_headerLabel :: h -> Text , _tableIn_rows :: Dynamic t [r] , _tableIn_cell :: h -> r -> Text + , _tableIn_perPage :: Int + , _tableIn_resetPage :: Event t () } data TableOut = TableOut {} table :: forall t m h r. (MonadWidget t m, Bounded h, Enum h) => TableIn h r t -> m (TableOut) -table tableIn = do +table tableIn = R.divClass "table" $ do + rec + R.divClass "lines" $ do + + R.divClass "header" $ + flip mapM_ [minBound..] $ \header -> + R.divClass "cell" . R.text $ + _tableIn_headerLabel tableIn header + + let rows = getRange + (_tableIn_perPage tableIn) + <$> (_pagesOut_currentPage pages) + <*> (_tableIn_rows tableIn) - R.divClass "lines" $ do - R.divClass "header" $ do - flip mapM_ [minBound..] $ \header -> - R.divClass "cell" . R.text $ - _tableIn_headerLabel tableIn header + R.simpleList rows $ \r -> + R.divClass "row" $ + flip mapM_ [minBound..] $ \h -> + R.divClass "cell name" $ + R.dynText $ + R.ffor r (_tableIn_cell tableIn h) - R.simpleList (_tableIn_rows tableIn) $ \r -> - R.divClass "row" $ - flip mapM_ [minBound..] $ \h -> - R.divClass "cell name" $ - R.dynText $ - R.ffor r (_tableIn_cell tableIn h) + pages <- Pages.widget $ PagesIn + { _pagesIn_total = length <$> (_tableIn_rows tableIn) + , _pagesIn_perPage = _tableIn_perPage tableIn + , _pagesIn_reset = _tableIn_resetPage tableIn + } + + return () return $ TableOut {} + +getRange :: forall a. Int -> Int -> [a] -> [a] +getRange perPage currentPage = + take perPage . drop ((currentPage - 1) * perPage) diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs index d0c0a45..0fdd7d3 100644 --- a/client/src/View/Income/Income.hs +++ b/client/src/View/Income/Income.hs @@ -40,6 +40,8 @@ view incomeIn = . _incomeIn_init $ incomeIn , _tableIn_cell = cell (_incomeIn_init incomeIn) + , _tableIn_perPage = 7 + , _tableIn_resetPage = R.never } return () -- cgit v1.2.3