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

---
 .stylish-haskell.yaml            |  1 +
 ISSUES.md                        | 64 ---------------------------------------
 README.md                        |  4 ---
 client/src/Component/Pages.hs    | 22 +++++---------
 client/src/Component/Table.hs    | 62 +++++++++++++++++++-------------------
 client/src/Loadable.hs           | 17 +++--------
 client/src/Util/Reflex.hs        |  1 -
 client/src/View/Income/Income.hs | 65 +++++++++++++++++++---------------------
 client/src/View/Income/Table.hs  |  4 +--
 9 files changed, 77 insertions(+), 163 deletions(-)
 delete mode 100644 ISSUES.md

diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml
index 034ace0..82305b9 100644
--- a/.stylish-haskell.yaml
+++ b/.stylish-haskell.yaml
@@ -31,3 +31,4 @@ language_extensions:
   - MultiParamTypeClasses
   - OverloadedStrings
   - RecursiveDo
+  - ScopedTypeVariables
diff --git a/ISSUES.md b/ISSUES.md
deleted file mode 100644
index 4cfc960..0000000
--- a/ISSUES.md
+++ /dev/null
@@ -1,64 +0,0 @@
-#  MVP
-
-## Income
-
-- Implement server side paging
-
-## Payment
-
-- Use income table factorizations
-- Implement server side paging
-
-## Category view
-
-- Show the category table
-- Add a category
-- Clone a category
-- Edit a category
-- Remove a category
-
-## Bugs
-
-- After modal close, it is still on the DOM, preventing any click
-
-# Next
-
-## Bugs
-
-- Fix page flickering on loading
-
-## Additional features
-
-- Remove unused payment category after payment edit on frontend
-- Auto focus on first input when payment modal is open
-- Add icon tooltip
-- HTTP error message
-- Use only one loader
-- Login with email and password
-- Search payments by:
-    - category,
-    - date.
-- Show statistics.
-- Pages: 1 … 3 4 5 … 10
-
-## Code
-
-- Do something with ModalForm and ConfirmDialog
-- remove client warning messages
-- Use BEM style
-- Move the CSS out from the index page
-- Test exceedingPayers
-- try DuplicateRecordFields (https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields)
-- ajax query parameters
-
-## DB
-
-- Add DB indexes
-
-## Tooling
-
-- deploy command
-- migration diff (use flyway?).
-- use ghcid
-- set up fast deploy
-- pin nixpkgs
diff --git a/README.md b/README.md
index 7f8d8f3..c83a18b 100644
--- a/README.md
+++ b/README.md
@@ -55,7 +55,3 @@ See [application.conf](application.conf).
 
 - [reflex](https://hackage.haskell.org/package/reflex-0.6.2.4/docs/doc-index-All.html)
 - [reflex-dom](https://hackage.haskell.org/package/reflex-dom-core-0.5/docs/doc-index-All.html)
-
-## Issues
-
-See [ISSUES.md](ISSUES.md).
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
 
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index 7103abd..3b9ec24 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -4,8 +4,9 @@ module Component.Table
   , Out(..)
   ) where
 
+import qualified Data.Map as M
 import           Data.Text        (Text)
-import           Reflex.Dom       (Dynamic, Event, MonadWidget)
+import           Reflex.Dom       (Event, MonadWidget)
 import qualified Reflex.Dom       as R
 
 import qualified Component.Button as Button
@@ -15,7 +16,7 @@ import qualified View.Icon        as Icon
 
 data In m t h r a = In
   { _in_headerLabel :: h -> Text
-  , _in_rows        :: Dynamic t [r]
+  , _in_rows        :: [r]
   , _in_cell        :: h -> r -> Text
   , _in_cloneModal  :: r -> Modal.Content t m a
   , _in_editModal   :: r -> Modal.Content t m a
@@ -44,61 +45,60 @@ view input =
           R.divClass "cell" $ R.blank
           R.divClass "cell" $ R.blank
 
-        R.simpleList (_in_rows input) $ \r ->
+        flip mapM (_in_rows input) $ \row ->
           R.divClass "row" $ do
-            flip mapM_ [minBound..] $ \h ->
+            flip mapM_ [minBound..] $ \header ->
               R.divClass "cell" $
-                R.dynText $
-                  R.ffor r (_in_cell input h)
+                R.text $
+                  _in_cell input header row
 
-            clone <-
+            cloneButton <-
               R.divClass "cell button" $
                 Button._out_clic <$> (Button.view $
                   Button.defaultIn Icon.clone)
 
-            cloned <-
+            clone <-
               Modal.view $ Modal.In
-                { Modal._in_show    = clone
-                , Modal._in_content = \curtainClick ->
-                  (R.dyn . R.ffor r $ \r2 -> _in_cloneModal input r2 curtainClick)
-                    >>= ReflexUtil.flattenTuple
+                { Modal._in_show    = cloneButton
+                , Modal._in_content = _in_cloneModal input row
                 }
 
-            let isOwner = R.ffor r (_in_isOwner input)
+            let isOwner = _in_isOwner input row
 
-            edit <-
+            let visibleIf cond =
+                  R.elAttr
+                    "div"
+                    (if cond then M.empty else M.singleton "style" "display:none")
+
+            editButton <-
               R.divClass "cell button" $
-                ReflexUtil.divVisibleIf isOwner $
+                visibleIf isOwner $
                   Button._out_clic <$> (Button.view $
                     Button.defaultIn Icon.edit)
 
-            edited <-
+            edit <-
               Modal.view $ Modal.In
-                { Modal._in_show    = edit
-                , Modal._in_content = \curtainClick ->
-                  (R.dyn . R.ffor r $ \r2 -> _in_editModal input r2 curtainClick)
-                    >>= ReflexUtil.flattenTuple
+                { Modal._in_show    = editButton
+                , Modal._in_content = _in_editModal input row
                 }
 
-            delete <-
+            deleteButton <-
               R.divClass "cell button" $
-                ReflexUtil.divVisibleIf isOwner $
+                visibleIf isOwner $
                   Button._out_clic <$> (Button.view $
                     Button.defaultIn Icon.delete)
 
-            deleted <-
+            delete <-
               Modal.view $ Modal.In
-                { Modal._in_show    = delete
-                , Modal._in_content = \curtainClick ->
-                  (R.dyn . R.ffor r $ \r2 -> _in_deleteModal input r2 curtainClick)
-                    >>= ReflexUtil.flattenTuple
+                { Modal._in_show    = deleteButton
+                , Modal._in_content = _in_deleteModal input row
                 }
 
-            return (cloned, edited, deleted)
+            return (clone, edit, delete)
 
-    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
+    let add = R.leftmost . map (\(a, _, _) -> a) $ result
+        edit = R.leftmost . map (\(_, a, _) -> a) $ result
+        delete = R.leftmost . map (\(_, _, a) -> a) $ result
 
     return $ Out
       { _out_add = add
diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index a5c1d41..f57b99c 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -45,16 +45,7 @@ fromEvent =
     )
     Loading
 
-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)
+view :: forall t m a b. MonadWidget t m => (a -> m b) -> Loadable a -> m (Maybe b)
+view _ (Loading)  = (R.divClass "pageSpinner" $ R.divClass "spinner" $ R.blank) >> return Nothing
+view _ (Error e)  = R.text e >> return Nothing
+view f (Loaded x) = Just <$> f x
diff --git a/client/src/Util/Reflex.hs b/client/src/Util/Reflex.hs
index 9f51c5c..aa5cebb 100644
--- a/client/src/Util/Reflex.hs
+++ b/client/src/Util/Reflex.hs
@@ -45,7 +45,6 @@ flatten e = do
   dyn <- R.holdDyn R.never e
   return $ R.switchDyn dyn
 
-
 flattenTuple
   :: forall t m a b. MonadWidget t m
   => Event t (Event t a, Event t b)
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index c48f325..fedf3d8 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -1,10 +1,14 @@
+{-# LANGUAGE ExplicitForAll #-}
+
 module View.Income.Income
   ( init
   , view
   , In(..)
   ) where
 
+import qualified Data.Text as T
 import           Data.Aeson          (FromJSON)
+import qualified Data.Maybe          as Maybe
 import           Prelude             hiding (init)
 import           Reflex.Dom          (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom          as R
@@ -41,45 +45,38 @@ init = do
 
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
-  -- 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)
-    --   }
-
   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
+      { Reducer._in_newPage      = newPage
+      , Reducer._in_currentPage  = currentPage
+      , Reducer._in_addIncome    = addIncome
+      , Reducer._in_editIncome   = editIncome
+      , Reducer._in_deleteIncome = deleteIncome
       }
 
-    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
-          _         -> []
-      }
+    let eventFromResult :: forall a. ((Table.Out t, Pages.Out t) -> Event t a) -> m (Event t a)
+        eventFromResult op = ReflexUtil.flatten . fmap (Maybe.fromMaybe R.never . fmap op) $ result
 
-    pages <- Pages.view $ Pages.In
-      { Pages._in_total = R.ffor incomes $ \case
-          Loaded (IncomesAndCount _ n) -> n
-          _         -> 0
-      , Pages._in_perPage = Reducer.perPage
-      }
+    newPage <- eventFromResult $ Pages._out_newPage . snd
+    currentPage <- R.holdDyn 1 newPage
+    addIncome <- eventFromResult $ Table._out_add . fst
+    editIncome <- eventFromResult $ Table._out_edit . fst
+    deleteIncome <- eventFromResult $ Table._out_delete . fst
+
+    result <- R.dyn . R.ffor ((,) <$> incomes <*> currentPage) $ \(is, p) ->
+      flip Loadable.view is $ \(IncomesAndCount incomes count) -> do
+        table <- Table.view $ Table.In
+          { Table._in_currentUser = _in_currentUser input
+          , Table._in_currency = _in_currency input
+          , Table._in_incomes = incomes
+          }
+
+        pages <- Pages.view $ Pages.In
+          { Pages._in_total = R.constDyn count
+          , Pages._in_perPage = Reducer.perPage
+          , Pages._in_page = p
+          }
 
-  -- -- 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 (table, pages)
 
   return ()
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index 6d69c19..9b2129f 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -26,7 +26,7 @@ import qualified View.Income.Form        as Form
 data In t = In
   { _in_currentUser :: UserId
   , _in_currency    :: Currency
-  , _in_incomes     :: Dynamic t [Income]
+  , _in_incomes     :: [Income]
   }
 
 data Out t = Out
@@ -40,7 +40,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_rows = reverse . L.sortOn _income_date $ _in_incomes input
     , Table._in_cell = cell [] (_in_currency input)
     , Table._in_cloneModal = \income ->
       Form.view $ Form.In
-- 
cgit v1.2.3