Adding paging (need some fixes)

5 files changed, 36 insertions, 11 deletions

diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index dc1083e..271d970 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -25,10 +25,10 @@ import Model.Json.Number
 import Model.Message
 import Model.Message.Key (Key(PaymentNotDeleted))
 
-getPaymentsAction :: ActionM ()
-getPaymentsAction =
+getPaymentsAction :: Int -> Int -> ActionM ()
+getPaymentsAction page perPage =
   Secure.loggedAction (\_ -> do
-    payments <- liftIO $ runDb getPayments
+    payments <- liftIO $ runDb (getPayments page perPage)
     json payments
   )
 
diff --git a/src/server/Design/Color.hs b/src/server/Design/Color.hs
index c1c4057..adbe50f 100644
--- a/src/server/Design/Color.hs
+++ b/src/server/Design/Color.hs
@@ -23,8 +23,8 @@ blue = C.rgb 108 162 164
 paymentFocus :: C.Color
 paymentFocus = C.rgb 255 223 196
 
-darkgrey :: C.Color
-darkgrey = C.rgb 150 150 150
+darkGrey :: C.Color
+darkGrey = C.rgb 150 150 150
 
 grey :: C.Color
 grey = C.rgb 200 200 200
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 4933300..5efb2bf 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -78,7 +78,7 @@ global = do
           display inlineBlock
           width (px 60)
           textAlign (alignSide sideCenter)
-          backgroundColor C.darkgrey
+          backgroundColor C.darkGrey
           color C.white
           height (px inputHeight)
           lineHeight (px inputHeight)
@@ -167,6 +167,26 @@ global = do
           color C.white
           visibility hidden
 
+    ".pages" ? do
+      padding (px 30) (px 30) (px 30) (px 30)
+      clearFix
+      ".page" ? do
+        border solid (px 2) C.darkGrey
+        borderRadius (px 2) (px 2) (px 2) (px 2)
+        marginRight (px 10)
+        cursor pointer
+        let side = 50
+        width (px side)
+        height (px side)
+        lineHeight (px side)
+        textAlign (alignSide (sideCenter))
+        float floatLeft
+        fontWeight bold
+
+        ".current" & do
+          borderColor C.red
+          color C.red
+
   ".signIn" ? do
 
     form ? do
@@ -214,6 +234,6 @@ defaultInput inputHeight = do
   height (px inputHeight)
   padding (px 10) (px 10) (px 10) (px 10)
   borderRadius (px 3) (px 3) (px 3) (px 3)
-  border solid (px 1) C.darkgrey
+  border solid (px 1) C.darkGrey
   focus & borderColor C.grey
   verticalAlign middle
diff --git a/src/server/Main.hs b/src/server/Main.hs
index ce652d0..8a77598 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -42,8 +42,10 @@ main = do
         get "/userName" $
           getUserName
 
-        get "/payments" $
-          getPaymentsAction
+        get "/payments" $ do
+          page <- param "page" :: ActionM Int
+          perPage <- param "perPage" :: ActionM Int
+          getPaymentsAction page perPage
 
         post "/payment/add" $ do
           name <- param "name" :: ActionM Text
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index db1f36f..ce8c5a1 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -23,12 +23,15 @@ import Model.Database
 import qualified Model.Json.Payment as P
 import qualified Model.Json.TotalPayment as TP
 
-getPayments :: Persist [P.Payment]
-getPayments = do
+getPayments :: Int -> Int -> Persist [P.Payment]
+getPayments page perPage = do
   xs <- select $
         from $ \(payment `InnerJoin` user) -> do
           on (payment ^. PaymentUserId E.==. user ^. UserId)
           where_ (isNothing (payment ^. PaymentDeletedAt))
+          orderBy [desc (payment ^. PaymentCreation)]
+          limit . fromIntegral $ perPage
+          offset . fromIntegral $ (page - 1) * perPage
           return (payment, user)
   return (map getJsonPayment xs)