From 42e94a45e26f40edc3ad71b1e77a4bf47c13fd3d Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 15 Nov 2017 23:50:44 +0100
Subject: Add dynamic pages

---
 client/src/View/Payment/Pages.hs | 71 +++++++++++++++++++++++++---------------
 1 file changed, 45 insertions(+), 26 deletions(-)

(limited to 'client/src/View/Payment/Pages.hs')

diff --git a/client/src/View/Payment/Pages.hs b/client/src/View/Payment/Pages.hs
index cf3e115..f96cb8e 100644
--- a/client/src/View/Payment/Pages.hs
+++ b/client/src/View/Payment/Pages.hs
@@ -7,15 +7,17 @@ module View.Payment.Pages
   , PagesOut(..)
   ) where
 
-import qualified Data.Text    as T
-import           Reflex.Dom   (Event, Dynamic, MonadWidget)
-import qualified Reflex.Dom   as R
+import qualified Data.Text              as T
+import           Reflex.Dom             (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom             as R
 
-import           Common.Model (Payment (..))
+import           Common.Model           (Payment (..))
+
+import           Component              (ButtonIn (..), ButtonOut (..))
+import qualified Component              as Component
 
-import           Component    (ButtonIn (..), ButtonOut (..))
-import qualified Component    as Component
 import qualified Icon
+import qualified View.Payment.Constants as Constants
 
 data PagesIn = PagesIn
   { _pagesIn_payments :: [Payment]
@@ -26,26 +28,43 @@ data PagesOut t = PagesOut
   }
 
 widget :: forall t m. MonadWidget t m => PagesIn -> m (PagesOut t)
-widget _ = do
-  currentPage <- R.divClass "pages" $ do
-    a <- page 1 Icon.doubleLeftBar
-    b <- page 1 Icon.doubleLeft
-    c <- page 1 (R.text . T.pack . show $ (1 :: Integer))
-    d <- page 2 (R.text . T.pack . show $ (2 :: Integer))
-    e <- page 3 (R.text . T.pack . show $ (3 :: Integer))
-    f <- page 4 (R.text . T.pack . show $ (4 :: Integer))
-    g <- page 5 (R.text . T.pack . show $ (5 :: Integer))
-    h <- page 5 Icon.doubleRight
-    i <- page 5 Icon.doubleRightBar
-    R.holdDyn 1 $ R.leftmost [ a, b, c, d, e, f, g, h, i ]
-  return $ PagesOut
-    { _pagesOut_currentPage = currentPage
-    }
-
-page :: forall t m. MonadWidget t m => Int -> m () -> m (Event t Int)
-page n content =
-  ((fmap (const n)) . _buttonOut_clic) <$> (Component.button $ ButtonIn
-    { _buttonIn_class   = "page"
+widget pagesIn = do
+  R.divClass "pages" $ do
+    rec
+      currentPage <- R.holdDyn 1 . R.leftmost $ [ firstPageClic, previousPageClic, pageClic, nextPageClic, lastPageClic ]
+
+      firstPageClic <- pageButton (R.constDyn 0) (R.constDyn 1) Icon.doubleLeftBar
+
+      previousPageClic <- pageButton (R.constDyn 0) (fmap (\x -> max (x - 1) 1) currentPage) Icon.doubleLeft
+
+      pageClic <- pageEvent <$> (R.simpleList (fmap (range maxPage) currentPage) $ \p ->
+        pageButton currentPage p (R.dynText $ fmap (T.pack . show) p))
+
+      nextPageClic <- pageButton (R.constDyn 0) (fmap (\x -> min (x + 1) maxPage) currentPage) Icon.doubleRight
+
+      lastPageClic <- pageButton (R.constDyn 0) (R.constDyn maxPage) Icon.doubleRightBar
+
+    return $ PagesOut
+      { _pagesOut_currentPage = currentPage
+      }
+
+    where maxPage = ceiling $ (toRational . length . _pagesIn_payments $ pagesIn) / toRational Constants.paymentsPerPage
+          pageEvent = R.switchPromptlyDyn . fmap R.leftmost
+
+range :: Int -> Int -> [Int]
+range maxPage currentPage = [start..end]
+  where sidePages = 2
+        start = max 1 (currentPage - sidePages)
+        end = min maxPage (start + sidePages * 2)
+
+pageButton :: forall t m. MonadWidget t m => Dynamic t Int -> Dynamic t Int -> m () -> m (Event t Int)
+pageButton currentPage page content = do
+  clic <- _buttonOut_clic <$> (Component.button $ ButtonIn
+    { _buttonIn_class   = do
+        cp <- currentPage
+        p <- page
+        if cp == p then "page current" else "page"
     , _buttonIn_content = content
     , _buttonIn_waiting = R.never
     })
+  return . fmap fst $ R.attach (R.current page) clic
-- 
cgit v1.2.3