WIP Set up server side paging for incomes

14 files changed, 218 insertions, 101 deletions

diff --git a/ISSUES.md b/ISSUES.md
index da9103f..4cfc960 100644
--- a/ISSUES.md
+++ b/ISSUES.md
@@ -1,8 +1,13 @@
 #  MVP
 
+## Income
+
+- Implement server side paging
+
 ## Payment
 
 - Use income table factorizations
+- Implement server side paging
 
 ## Category view
 
@@ -12,10 +17,6 @@
 - Edit a category
 - Remove a category
 
-## Low speed
-
-- Implement server side paging
-
 ## Bugs
 
 - After modal close, it is still on the DOM, preventing any click
@@ -48,6 +49,7 @@
 - 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
 
diff --git a/client/client.cabal b/client/client.cabal
index 9a212e8..8648d57 100644
--- a/client/client.cabal
+++ b/client/client.cabal
@@ -72,6 +72,7 @@ Executable client
     View.Income.Form
     View.Income.Header
     View.Income.Income
+    View.Income.Reducer
     View.Income.Table
     View.NotFound
     View.Payment.Add
diff --git a/client/src/Component/Pages.hs b/client/src/Component/Pages.hs
index 7284a36..a297222 100644
--- a/client/src/Component/Pages.hs
+++ b/client/src/Component/Pages.hs
@@ -16,38 +16,43 @@ import qualified View.Icon        as Icon
 data In t = In
   { _in_total   :: Dynamic t Int
   , _in_perPage :: Int
-  , _in_reset   :: Event t ()
   }
 
 data Out t = Out
-  { _out_currentPage :: Dynamic t Int
+  { _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
-  currentPage <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage reset
+  (newPage, currentPage) <- ReflexUtil.divVisibleIf ((> 0) <$> total) $ pageButtons total perPage
 
   return $ Out
-    { _out_currentPage = currentPage
+    { _out_newPage = newPage
+    , _out_currentPage = currentPage
     }
 
   where
     total = _in_total input
     perPage = _in_perPage input
-    reset = _in_reset input
 
-pageButtons :: forall t m. MonadWidget t m => Dynamic t Int -> Int -> Event t () -> m (Dynamic t Int)
-pageButtons total perPage reset = do
+pageButtons
+  :: forall t m. MonadWidget t m
+  => Dynamic t Int
+  -> Int
+  -> m (Event t Int, Dynamic t Int)
+pageButtons total perPage = do
   R.divClass "pages" $ do
     rec
-      currentPage <- R.holdDyn 1 . R.leftmost $
-        [ firstPageClic
-        , previousPageClic
-        , pageClic
-        , nextPageClic
-        , lastPageClic
-        , 1 <$ reset
-        ]
+      let newPage = R.leftmost
+            [ firstPageClic
+            , previousPageClic
+            , pageClic
+            , nextPageClic
+            , lastPageClic
+            ]
+
+      currentPage <- R.holdDyn 1 newPage
 
       firstPageClic <- pageButton noCurrentPage (R.constDyn 1) Icon.doubleLeftBar
 
@@ -60,7 +65,7 @@ pageButtons total perPage reset = do
 
       lastPageClic <- pageButton noCurrentPage maxPage Icon.doubleRightBar
 
-    return currentPage
+    return (newPage, currentPage)
 
     where maxPage = R.ffor total (\t -> ceiling $ toRational t / toRational perPage)
           pageEvent = R.switch . R.current . fmap R.leftmost
diff --git a/client/src/Component/Table.hs b/client/src/Component/Table.hs
index a02eaa7..7103abd 100644
--- a/client/src/Component/Table.hs
+++ b/client/src/Component/Table.hs
@@ -10,7 +10,6 @@ import qualified Reflex.Dom       as R
 
 import qualified Component.Button as Button
 import qualified Component.Modal  as Modal
-import qualified Component.Pages  as Pages
 import qualified Util.Reflex      as ReflexUtil
 import qualified View.Icon        as Icon
 
@@ -18,8 +17,6 @@ data In m t h r a = In
   { _in_headerLabel :: h -> Text
   , _in_rows        :: Dynamic t [r]
   , _in_cell        :: h -> r -> Text
-  , _in_perPage     :: Int
-  , _in_resetPage   :: Event t ()
   , _in_cloneModal  :: r -> Modal.Content t m a
   , _in_editModal   :: r -> Modal.Content t m a
   , _in_deleteModal :: r -> Modal.Content t m a
@@ -47,12 +44,7 @@ view input =
           R.divClass "cell" $ R.blank
           R.divClass "cell" $ R.blank
 
-        let rows = getRange
-              (_in_perPage input)
-                <$> (Pages._out_currentPage pages)
-                <*> (_in_rows input)
-
-        R.simpleList rows $ \r ->
+        R.simpleList (_in_rows input) $ \r ->
           R.divClass "row" $ do
             flip mapM_ [minBound..] $ \h ->
               R.divClass "cell" $
@@ -104,12 +96,6 @@ view input =
 
             return (cloned, edited, deleted)
 
-      pages <- Pages.view $ Pages.In
-        { Pages._in_total = length <$> _in_rows input
-        , Pages._in_perPage = _in_perPage input
-        , Pages._in_reset = _in_resetPage input
-        }
-
     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
@@ -119,7 +105,3 @@ view input =
       , _out_edit = edit
       , _out_delete = delete
       }
-
-getRange :: forall a. Int -> Int -> [a] -> [a]
-getRange perPage currentPage =
-  take perPage . drop ((currentPage - 1) * perPage)
diff --git a/client/src/Loadable.hs b/client/src/Loadable.hs
index 8714a4d..a5c1d41 100644
--- a/client/src/Loadable.hs
+++ b/client/src/Loadable.hs
@@ -49,3 +49,12 @@ 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)
diff --git a/client/src/View/Income/Income.hs b/client/src/View/Income/Income.hs
index 2f0b8f5..c48f325 100644
--- a/client/src/View/Income/Income.hs
+++ b/client/src/View/Income/Income.hs
@@ -4,19 +4,23 @@ module View.Income.Income
   , In(..)
   ) where
 
-import           Data.Aeson         (FromJSON)
-import           Prelude            hiding (init)
-import           Reflex.Dom         (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom         as R
+import           Data.Aeson          (FromJSON)
+import           Prelude             hiding (init)
+import           Reflex.Dom          (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom          as R
 
-import           Common.Model       (Currency, Income (..), UserId)
+import           Common.Model        (Currency, Income (..),
+                                      IncomesAndCount (..), UserId)
 
-import           Loadable           (Loadable (..))
+import qualified Component.Pages     as Pages
+import           Loadable            (Loadable (..))
 import qualified Loadable
-import qualified Util.Ajax          as AjaxUtil
-import qualified View.Income.Header as Header
-import           View.Income.Init   (Init (..))
-import qualified View.Income.Table  as Table
+import qualified Util.Ajax           as AjaxUtil
+import qualified Util.Reflex         as ReflexUtil
+-- import qualified View.Income.Header as Header
+import           View.Income.Init    (Init (..))
+import qualified View.Income.Reducer as Reducer
+import qualified View.Income.Table   as Table
 
 data In t = In
   { _in_currentUser :: UserId
@@ -37,50 +41,45 @@ init = do
 
 view :: forall t m. MonadWidget t m => In t -> m ()
 view input = do
-  R.dyn . R.ffor (_in_init input) . Loadable.view $ \init ->
+  -- 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)
+    --   }
 
-    R.elClass "main" "income" $ do
+  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
+      }
 
-      rec
-        let addIncome = R.leftmost
-              [ Header._out_add header
-              , Table._out_add table
-              ]
+    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
+          _         -> []
+      }
 
-        incomes <- reduceIncomes
-          (_init_incomes init)
-          addIncome
-          (Table._out_edit table)
-          (Table._out_delete table)
+    pages <- Pages.view $ Pages.In
+      { Pages._in_total = R.ffor incomes $ \case
+          Loaded (IncomesAndCount _ n) -> n
+          _         -> 0
+      , Pages._in_perPage = Reducer.perPage
+      }
 
-        header <- Header.view $ Header.In
-          { Header._in_init = init
-          , Header._in_currency = _in_currency input
-          , Header._in_incomes = incomes
-          }
-
-        table <- Table.view $ Table.In
-          { Table._in_currentUser = _in_currentUser input
-          , Table._in_init = init
-          , Table._in_currency = _in_currency input
-          , Table._in_incomes = incomes
-          , Table._in_resetPage = () <$ addIncome
-          }
-
-      return ()
+  -- -- 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 ()
-
-reduceIncomes
-  :: forall t m. MonadWidget t m
-  => [Income]
-  -> Event t Income -- add
-  -> Event t Income -- edit
-  -> Event t Income -- delete
-  -> m (Dynamic t [Income])
-reduceIncomes initIncomes add edit delete =
-  R.foldDyn id initIncomes $ R.leftmost
-    [ (:) <$> add
-    , R.ffor edit (\p -> (p:) . filter ((/= (_income_id p)) . _income_id))
-    , R.ffor delete (\p -> filter ((/= (_income_id p)) . _income_id))
-    ]
diff --git a/client/src/View/Income/Reducer.hs b/client/src/View/Income/Reducer.hs
new file mode 100644
index 0000000..5b346cb
--- /dev/null
+++ b/client/src/View/Income/Reducer.hs
@@ -0,0 +1,66 @@
+module View.Income.Reducer
+  ( perPage
+  , reducer
+  , In(..)
+  ) where
+
+import           Data.Text    (Text)
+import qualified Data.Text    as T
+import           Reflex.Dom   (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom   as R
+
+import           Common.Model (IncomesAndCount)
+
+import           Loadable     (Loadable (..))
+import qualified Loadable     as Loadable
+import qualified Util.Ajax    as AjaxUtil
+
+perPage :: Int
+perPage = 7
+
+data In t a b c = In
+  { _in_newPage      :: Event t Int
+  , _in_currentPage  :: Dynamic t Int
+  , _in_addIncome    :: Event t a
+  , _in_editIncome   :: Event t b
+  , _in_deleteIncome :: Event t c
+  }
+
+data Action
+  = LoadPage Int
+  | GetResult (Either Text IncomesAndCount)
+
+reducer :: forall t m a b c. MonadWidget t m => In t a b c -> m (Dynamic t (Loadable IncomesAndCount))
+reducer input = do
+
+  postBuild <- R.getPostBuild
+
+  let loadPage =
+        R.leftmost
+          [ 1 <$ postBuild
+          , _in_newPage input
+          , 1 <$ _in_addIncome input
+          , R.tag (R.current $ _in_currentPage input) (_in_editIncome input)
+          , R.tag (R.current $ _in_currentPage input) (_in_deleteIncome input)
+          ]
+
+  getResult <- AjaxUtil.get $ fmap pageUrl loadPage
+
+  R.foldDyn
+    (\action _ -> case action of
+      LoadPage _                -> Loading
+      GetResult (Left err)      -> Error err
+      GetResult (Right incomes) -> Loaded incomes
+    )
+    Loading
+    (R.leftmost
+      [ LoadPage <$> loadPage
+      , GetResult <$> getResult
+      ])
+
+  where
+    pageUrl p =
+      "api/v2/incomes?page="
+      <> (T.pack . show $ p)
+      <> "&perPage="
+      <> (T.pack . show $ perPage)
diff --git a/client/src/View/Income/Table.hs b/client/src/View/Income/Table.hs
index d089d9f..6d69c19 100644
--- a/client/src/View/Income/Table.hs
+++ b/client/src/View/Income/Table.hs
@@ -22,14 +22,11 @@ import qualified Component.Table         as Table
 import qualified Util.Ajax               as Ajax
 import qualified Util.Either             as EitherUtil
 import qualified View.Income.Form        as Form
-import           View.Income.Init        (Init (..))
 
 data In t = In
   { _in_currentUser :: UserId
-  , _in_init        :: Init
   , _in_currency    :: Currency
   , _in_incomes     :: Dynamic t [Income]
-  , _in_resetPage   :: Event t ()
   }
 
 data Out t = Out
@@ -44,9 +41,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_cell = cell (_in_init input) (_in_currency input)
-    , Table._in_perPage = 7
-    , Table._in_resetPage = _in_resetPage input
+    , Table._in_cell = cell [] (_in_currency input)
     , Table._in_cloneModal = \income ->
       Form.view $ Form.In
         { Form._in_operation = Form.Clone income
@@ -84,11 +79,11 @@ headerLabel UserHeader   = Msg.get Msg.Income_Name
 headerLabel DateHeader   = Msg.get Msg.Income_Date
 headerLabel AmountHeader = Msg.get Msg.Income_Amount
 
-cell :: Init -> Currency -> Header -> Income -> Text
-cell init currency header income =
+cell :: [User] -> Currency -> Header -> Income -> Text
+cell users currency header income =
   case header of
     UserHeader ->
-      Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) (_init_users init)
+      Maybe.fromMaybe "" . fmap _user_name $ CM.findUser (_income_userId income) users
 
     DateHeader ->
       Format.longDay . _income_date $ income
diff --git a/common/common.cabal b/common/common.cabal
index 1a441c5..9f3f65b 100644
--- a/common/common.cabal
+++ b/common/common.cabal
@@ -60,6 +60,7 @@ Library
     Common.Model.EditPaymentForm
     Common.Model.Frequency
     Common.Model.Income
+    Common.Model.IncomesAndCount
     Common.Model.Init
     Common.Model.InitResult
     Common.Model.Payer
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index c9f500b..3a5a627 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -12,6 +12,7 @@ import           Common.Model.EditPaymentForm   as X
 import           Common.Model.Email             as X
 import           Common.Model.Frequency         as X
 import           Common.Model.Income            as X
+import           Common.Model.IncomesAndCount   as X
 import           Common.Model.Init              as X
 import           Common.Model.InitResult        as X
 import           Common.Model.Payer             as X
diff --git a/common/src/Common/Model/IncomesAndCount.hs b/common/src/Common/Model/IncomesAndCount.hs
new file mode 100644
index 0000000..4365180
--- /dev/null
+++ b/common/src/Common/Model/IncomesAndCount.hs
@@ -0,0 +1,16 @@
+module Common.Model.IncomesAndCount
+  ( IncomesAndCount(..)
+  ) where
+
+import           Data.Aeson          (FromJSON, ToJSON)
+import           GHC.Generics        (Generic)
+
+import           Common.Model.Income (Income)
+
+data IncomesAndCount = IncomesAndCount
+  { _incomesAndCount_incomes :: [Income]
+  , _incomesAndCount_count   :: Int
+  } deriving (Show, Generic)
+
+instance FromJSON IncomesAndCount
+instance ToJSON IncomesAndCount
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 236e032..3272cbf 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,5 +1,6 @@
 module Controller.Income
   ( list
+  , listv2
   , create
   , edit
   , delete
@@ -12,7 +13,7 @@ import           Web.Scotty                hiding (delete)
 
 import           Common.Model              (CreateIncomeForm (..),
                                             EditIncomeForm (..), IncomeId,
-                                            User (..))
+                                            IncomesAndCount (..), User (..))
 
 import qualified Controller.Helper         as ControllerHelper
 import           Model.CreateIncome        (CreateIncome (..))
@@ -28,6 +29,16 @@ list =
     (liftIO . Query.run $ IncomePersistence.list) >>= json
   )
 
+listv2 :: Int -> Int -> ActionM ()
+listv2 page perPage =
+  Secure.loggedAction (\_ ->
+    (liftIO . Query.run $ do
+      count <- IncomePersistence.count
+      incomes <- IncomePersistence.listv2 page perPage
+      return $ IncomesAndCount incomes count
+    ) >>= json
+  )
+
 create :: CreateIncomeForm -> ActionM ()
 create form =
   Secure.loggedAction (\user ->
diff --git a/server/src/Main.hs b/server/src/Main.hs
index 9882092..00e8d1c 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -54,6 +54,11 @@ main = do
       paymentId <- S.param "id"
       Payment.delete paymentId
 
+    S.get "/api/v2/incomes" $ do
+      page <- S.param "page"
+      perPage <- S.param "perPage"
+      Income.listv2 page perPage
+
     S.get "/api/incomes" $
       Income.list
 
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index 2b9bf0c..de55a18 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -1,5 +1,7 @@
 module Persistence.Income
-  ( list
+  ( count
+  , list
+  , listv2
   , create
   , edit
   , delete
@@ -29,6 +31,18 @@ instance FromRow Row where
     SQLite.field <*>
     SQLite.field)
 
+data Count = Count Int
+
+instance FromRow Count where
+  fromRow = Count <$> SQLite.field
+
+count :: Query Int
+count =
+  Query (\conn ->
+    (\[Count n] -> n) <$>
+      SQLite.query_ conn "SELECT COUNT(*) FROM income WHERE deleted_at IS NULL"
+  )
+
 list :: Query [Income]
 list =
   Query (\conn ->
@@ -36,6 +50,16 @@ list =
       SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
   )
 
+listv2 :: Int -> Int -> Query [Income]
+listv2 page perPage =
+  Query (\conn ->
+    map (\(Row i) -> i) <$>
+      SQLite.query
+        conn
+        "SELECT * FROM income WHERE deleted_at IS NULL ORDER BY date DESC LIMIT ? OFFSET ?"
+        (perPage, (page - 1) * perPage)
+  )
+
 create :: UserId -> Day -> Int -> Query Income
 create userId date amount =
   Query (\conn -> do