Show the payment table with server side paging

1 files changed, 16 insertions, 3 deletions

diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index 30b63ff..01702cb 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -1,5 +1,6 @@
 module Controller.Payment
-  ( list
+  ( deprecatedList
+  , list
   , listPaymentCategories
   , create
   , edit
@@ -15,6 +16,7 @@ import           Common.Model                (Category (..),
                                               CreatePaymentForm (..),
                                               EditPaymentForm (..),
                                               Payment (..), PaymentId,
+                                              PaymentPage (..),
                                               SavedPayment (..), User (..))
 import qualified Common.Msg                  as Msg
 import qualified Controller.Helper           as ControllerHelper
@@ -27,12 +29,23 @@ import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
 import qualified Secure
 import qualified Validation.Payment          as PaymentValidation
 
-list :: ActionM ()
-list =
+deprecatedList :: ActionM ()
+deprecatedList =
   Secure.loggedAction (\_ ->
     (liftIO . Query.run $ PaymentPersistence.listActive) >>= json
   )
 
+list :: Int -> Int -> ActionM ()
+list page perPage =
+  Secure.loggedAction (\_ ->
+    (liftIO . Query.run $ do
+      count <- PaymentPersistence.count
+      payments <- PaymentPersistence.listActivePage page perPage
+      paymentCategories <- PaymentCategoryPersistence.list
+      return $ PaymentPage payments paymentCategories count
+    ) >>= json
+  )
+
 listPaymentCategories :: ActionM ()
 listPaymentCategories =
   Secure.loggedAction (\_ ->