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 --- ISSUES.md | 1 + client/client.cabal | 1 + client/src/Component.hs | 1 + client/src/Component/Pages.hs | 88 ++++++++++++++++++++++++++++++++++++++++ client/src/Component/Table.hs | 53 +++++++++++++++++------- client/src/View/Income/Income.hs | 2 + server/server.cabal | 1 + server/src/Design/View/Pages.hs | 55 +++++++++++++++++++++++++ server/src/Design/Views.hs | 2 + 9 files changed, 189 insertions(+), 15 deletions(-) create mode 100644 client/src/Component/Pages.hs create mode 100644 server/src/Design/View/Pages.hs diff --git a/ISSUES.md b/ISSUES.md index 6863b00..04fdf2f 100644 --- a/ISSUES.md +++ b/ISSUES.md @@ -29,6 +29,7 @@ - category, - date. - Show statistics. +- Pages: 1 … 3 4 5 … 10 # Code diff --git a/client/client.cabal b/client/client.cabal index eeeb8be..8c25da7 100644 --- a/client/client.cabal +++ b/client/client.cabal @@ -50,6 +50,7 @@ Executable client Component.Input Component.Link Component.Modal + Component.Pages Component.Table Component.Select Icon 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 () diff --git a/server/server.cabal b/server/server.cabal index 75af442..426f521 100644 --- a/server/server.cabal +++ b/server/server.cabal @@ -74,6 +74,7 @@ Executable server Design.Tooltip Design.View.Header Design.View.NotFound + Design.View.Pages Design.View.Payment Design.View.Payment.Add Design.View.Payment.Delete diff --git a/server/src/Design/View/Pages.hs b/server/src/Design/View/Pages.hs new file mode 100644 index 0000000..1482ef4 --- /dev/null +++ b/server/src/Design/View/Pages.hs @@ -0,0 +1,55 @@ +module Design.View.Pages + ( design + ) where + +import Clay + +import qualified Design.Color as Color +import qualified Design.Constants as Constants +import qualified Design.Helper as Helper +import qualified Design.Media as Media + +design :: Css +design = + ".pages" ? do + display flex + justifyContent center + + Media.desktop $ do + padding (px 40) (px 30) (px 30) (px 30) + + Media.tablet $ do + padding (px 30) (px 30) (px 30) (px 30) + + Media.mobile $ do + padding (px 20) (px 0) (px 20) (px 0) + lineHeight (px 40) + + svg ? "path" ? ("fill" -: Color.toString Color.dustyGray) + + ".page" ? do + display inlineBlock + fontWeight bold + + Media.desktop $ do + Helper.button Color.white Color.dustyGray (px 50) Constants.focusDarken + + Media.tabletDesktop $ do + border solid (px 2) Color.dustyGray + marginRight (px 10) + + Media.tablet $ do + Helper.button Color.white Color.dustyGray (px 40) Constants.focusDarken + fontSize (px 15) + + Media.mobile $ do + Helper.button Color.white Color.dustyGray (px 30) Constants.focusDarken + fontSize (px 12) + border solid (px 1) Color.dustyGray + marginRight (px 5) + + ":not(.current)" & cursor pointer + + ".current" & do + borderColor Color.chestnutRose + color Color.chestnutRose diff --git a/server/src/Design/Views.hs b/server/src/Design/Views.hs index bf39cff..73b7240 100644 --- a/server/src/Design/Views.hs +++ b/server/src/Design/Views.hs @@ -10,6 +10,7 @@ import qualified Design.Helper as Helper import qualified Design.Media as Media import qualified Design.View.Header as Header import qualified Design.View.NotFound as NotFound +import qualified Design.View.Pages as Pages import qualified Design.View.Payment as Payment import qualified Design.View.SignIn as SignIn import qualified Design.View.Stat as Stat @@ -23,6 +24,7 @@ design = do ".stat" ? Stat.design ".notfound" ? NotFound.design Table.design + Pages.design ".withMargin" ? do "margin" -: "0 2vw" -- cgit v1.2.3