From f4f24158a46d8c0975f1b8813bbdbbeebad8c108 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 6 Nov 2019 19:44:15 +0100
Subject: Show the payment table with server side paging

---
 server/src/Controller/Payment.hs  | 19 ++++++++++++++++---
 server/src/Design/View/Header.hs  |  1 -
 server/src/Design/View/SignIn.hs  |  2 +-
 server/src/Design/View/Table.hs   | 11 +++++++++++
 server/src/Main.hs                |  9 +++++++--
 server/src/Persistence/Income.hs  |  3 ---
 server/src/Persistence/Payment.hs | 25 ++++++++++++++++++++++++-
 7 files changed, 59 insertions(+), 11 deletions(-)

(limited to 'server/src')

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 (\_ ->
diff --git a/server/src/Design/View/Header.hs b/server/src/Design/View/Header.hs
index 59e0e51..609d8fc 100644
--- a/server/src/Design/View/Header.hs
+++ b/server/src/Design/View/Header.hs
@@ -25,7 +25,6 @@ design = do
   ".title" <> ".item" ? headerPadding
 
   ".title" ? do
-    height (pct 100)
     textAlign (alignSide sideLeft)
 
     Media.mobile $ fontSize (px 22)
diff --git a/server/src/Design/View/SignIn.hs b/server/src/Design/View/SignIn.hs
index a39276e..42c9621 100644
--- a/server/src/Design/View/SignIn.hs
+++ b/server/src/Design/View/SignIn.hs
@@ -13,7 +13,7 @@ import qualified Design.Helper    as Helper
 design :: Css
 design = do
   let inputHeight = 50
-  maxWidth (px 550)
+  width (px 350)
   sym2 padding (rem 0) (rem 2)
   marginTop (px 100)
   marginLeft auto
diff --git a/server/src/Design/View/Table.hs b/server/src/Design/View/Table.hs
index 1c4e806..c77cb7c 100644
--- a/server/src/Design/View/Table.hs
+++ b/server/src/Design/View/Table.hs
@@ -67,6 +67,17 @@ design = do
 
       ".refund" & color Color.mossGreen
 
+      Media.desktop $ do
+        ".shortDate" ? display none
+        ".longDate" ? display inline
+      Media.tablet $ do
+        ".shortDate" ? display inline
+        ".longDate" ? display none
+      Media.mobile $ do
+        ".shortDate" ? display none
+        ".longDate" ? display inline
+        marginBottom (em 0.5)
+
       ".cell.button" & do
         position relative
         textAlign (alignSide sideCenter)
diff --git a/server/src/Main.hs b/server/src/Main.hs
index b2672e4..a4d8635 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -41,8 +41,13 @@ main = do
     S.get "/api/users"$
       User.list
 
-    S.get "/api/payments" $
-      Payment.list
+    S.get "/api/deprecated/payments" $
+      Payment.deprecatedList
+
+    S.get "/api/payments" $ do
+      page <- S.param "page"
+      perPage <- S.param "perPage"
+      Payment.list page perPage
 
     S.post "/api/payment" $
       S.jsonData >>= Payment.create
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index 4ae3228..cb2ef10 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -60,9 +60,6 @@ listAll =
       SQLite.query_ conn "SELECT * FROM income WHERE deleted_at IS NULL"
   )
 
--- firstIncomeByUser
--- SELECT user_id, MIN(date) FROM income WHERE deleted_at IS NULL GROUP BY user_id;
-
 create :: UserId -> Day -> Int -> Query Income
 create userId date amount =
   Query (\conn -> do
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index eb238d4..e01753f 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -1,8 +1,9 @@
 module Persistence.Payment
-  ( Payment(..)
+  ( count
   , find
   , firstPunctualDay
   , listActive
+  , listActivePage
   , listPunctual
   , listActiveMonthlyOrderedByName
   , create
@@ -54,6 +55,18 @@ instance ToRow InsertRow where
     , toField (_payment_createdAt p)
     ]
 
+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 payment WHERE deleted_at IS NULL"
+  )
+
 find :: PaymentId -> Query (Maybe Payment)
 find paymentId =
   Query (\conn -> do
@@ -83,6 +96,16 @@ listActive =
       SQLite.query_ conn "SELECT * FROM payment WHERE deleted_at IS NULL"
   )
 
+listActivePage :: Int -> Int -> Query [Payment]
+listActivePage page perPage =
+  Query (\conn ->
+    map (\(Row p) -> p) <$>
+      SQLite.query
+        conn
+        "SELECT * FROM payment WHERE deleted_at IS NULL ORDER BY date DESC LIMIT ? OFFSET ?"
+        (perPage, (page - 1) * perPage)
+  )
+
 listPunctual :: Query [Payment]
 listPunctual =
   Query (\conn -> do
-- 
cgit v1.2.3