Adding paging (need some fixes)

7 files changed, 69 insertions, 14 deletions

diff --git a/src/client/Main.elm b/src/client/Main.elm
index 6ca2743..685d3b2 100644
--- a/src/client/Main.elm
+++ b/src/client/Main.elm
@@ -12,7 +12,7 @@ import Time exposing (..)
 import Json.Decode as Json exposing ((:=))
 
 import Model exposing (Model, initialModel)
-import Model.Payment exposing (Payments, paymentsDecoder)
+import Model.Payment exposing (Payments, paymentsDecoder, perPage)
 import Model.Payers exposing (Payers, payersDecoder)
 import Model.Message exposing (messageDecoder)
 import Model.Translations exposing (..)
@@ -64,7 +64,7 @@ getUserName : Task Http.Error String
 getUserName = Http.get messageDecoder "/userName"
 
 getPayments : Task Http.Error Payments
-getPayments = Http.get paymentsDecoder "/payments"
+getPayments = Http.get paymentsDecoder ("/payments?page=1&perPage=" ++ toString perPage)
 
 getPaymentsCount : Task Http.Error Int
 getPaymentsCount = Http.get ("number" := Json.int) "/payments/count"
diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm
index e773be3..02dcf7e 100644
--- a/src/client/Model/Payment.elm
+++ b/src/client/Model/Payment.elm
@@ -1,5 +1,6 @@
 module Model.Payment
-  ( Payments
+  ( perPage
+  , Payments
   , Payment
   , PaymentId
   , PaymentWithId
@@ -12,6 +13,9 @@ import Date exposing (..)
 import Json.Decode as Json exposing ((:=))
 import Dict exposing (..)
 
+perPage : Int
+perPage = 10
+
 type alias Payments = Dict PaymentId Payment
 
 type alias PaymentWithId = (PaymentId, Payment)
diff --git a/src/client/Model/View/PaymentView.elm b/src/client/Model/View/PaymentView.elm
index 117be59..bf5804f 100644
--- a/src/client/Model/View/PaymentView.elm
+++ b/src/client/Model/View/PaymentView.elm
@@ -15,6 +15,7 @@ type alias PaymentView =
   , paymentsCount : Int
   , payers : Payers
   , edition : Maybe Edition
+  , currentPage : Int
   }
 
 initPaymentView : String -> Payments -> Int -> Payers -> PaymentView
@@ -25,4 +26,5 @@ initPaymentView userName payments paymentsCount payers =
   , paymentsCount = paymentsCount
   , payers = payers
   , edition = Nothing
+  , currentPage = 1
   }
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index 9bf2008..9359160 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -11,7 +11,7 @@ import Json.Decode exposing (..)
 import Date
 
 import Model.Message exposing (messageDecoder)
-import Model.Payment exposing (PaymentId)
+import Model.Payment exposing (PaymentId, perPage, paymentsDecoder)
 
 import Update as U
 import Update.SignIn exposing (..)
@@ -22,6 +22,7 @@ type Communication =
   | SignIn String
   | AddPayment String Int
   | DeletePayment PaymentId
+  | UpdatePage Int
   | SignOut
 
 serverCommunications : Signal.Mailbox Communication
@@ -42,17 +43,19 @@ getRequest communication =
     NoCommunication ->
       Nothing
     SignIn login ->
-      Just (simplePost ("/signIn?login=" ++ login))
+      Just (simple "post" ("/signIn?login=" ++ login))
     AddPayment name cost ->
-      Just (simplePost ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost)))
+      Just (simple "post" ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost)))
     DeletePayment paymentId ->
-      Just (simplePost ("payment/delete?id=" ++ paymentId))
+      Just (simple "post" ("payment/delete?id=" ++ paymentId))
+    UpdatePage page ->
+      Just (simple "get" ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage))
     SignOut ->
-      Just (simplePost  "/signOut")
+      Just (simple "post"  "/signOut")
 
-simplePost : String -> Http.Request
-simplePost url =
-  { verb = "post"
+simple : String -> String -> Http.Request
+simple method url =
+  { verb = method
   , headers = []
   , url = url
   , body = Http.empty
@@ -70,14 +73,21 @@ communicationToAction communication response =
         AddPayment name cost ->
           decodeResponse
             response
+            messageDecoder
             (\id -> U.UpdatePayment (UP.AddPayment id name cost))
         DeletePayment id ->
           U.UpdatePayment (UP.Remove id)
+        UpdatePage page ->
+          decodeResponse
+            response
+            paymentsDecoder
+            (\payments -> U.UpdatePayment (UP.UpdatePage page payments))
         SignOut ->
           U.GoSignInView
     else
       decodeResponse
         response
+        messageDecoder
         (\error ->
           case communication of
             SignIn _ ->
@@ -86,11 +96,11 @@ communicationToAction communication response =
               U.NoOp
         )
 
-decodeResponse : Http.Response -> (String -> U.Action) -> U.Action
-decodeResponse response responseToAction =
+decodeResponse : Http.Response -> Decoder a -> (a -> U.Action) -> U.Action
+decodeResponse response decoder responseToAction =
   case response.value of
     Http.Text text ->
-      case decodeString messageDecoder text of
+      case decodeString decoder text of
         Ok x ->
           responseToAction x
         Err _ ->
diff --git a/src/client/Update/Payment.elm b/src/client/Update/Payment.elm
index 53dc08a..798cdb4 100644
--- a/src/client/Update/Payment.elm
+++ b/src/client/Update/Payment.elm
@@ -20,6 +20,7 @@ type PaymentAction =
   | AddPayment PaymentId String Int
   | ToggleEdit PaymentId
   | Remove PaymentId
+  | UpdatePage Int Payments
 
 updatePayment : Model -> PaymentAction -> PaymentView -> PaymentView
 updatePayment model action paymentView =
@@ -51,3 +52,8 @@ updatePayment model action paymentView =
           }
         Nothing ->
           paymentView
+    UpdatePage page payments ->
+      { paymentView
+      | currentPage <- page
+      , payments <- payments
+      }
diff --git a/src/client/View/Payments.elm b/src/client/View/Payments.elm
index c38cc18..3c9c09d 100644
--- a/src/client/View/Payments.elm
+++ b/src/client/View/Payments.elm
@@ -12,6 +12,7 @@ import Model.View.PaymentView exposing (PaymentView)
 import View.Payments.ExceedingPayer exposing (exceedingPayers)
 import View.Payments.Add exposing (addPayment)
 import View.Payments.Table exposing (paymentsTable)
+import View.Payments.Paging exposing (paymentsPaging)
 
 renderPayments : Model -> PaymentView -> Html
 renderPayments model paymentView =
@@ -20,4 +21,5 @@ renderPayments model paymentView =
     [ exceedingPayers model paymentView
     , addPayment model paymentView.add
     , paymentsTable model paymentView
+    , paymentsPaging paymentView
     ]
diff --git a/src/client/View/Payments/Paging.elm b/src/client/View/Payments/Paging.elm
new file mode 100644
index 0000000..7be4c7b
--- /dev/null
+++ b/src/client/View/Payments/Paging.elm
@@ -0,0 +1,31 @@
+module View.Payments.Paging
+  ( paymentsPaging
+  ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Model.View.PaymentView exposing (..)
+import Model.Payment exposing (perPage)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.Payment exposing (..)
+
+paymentsPaging : PaymentView -> Html
+paymentsPaging paymentView =
+  let maxPage = ceiling (toFloat paymentView.paymentsCount / toFloat perPage)
+      pages = [1..maxPage]
+  in  ul
+        [ class "pages" ]
+        ( pages
+            |> List.map (\page ->
+                 li
+                   [ class ("page" ++ (if page == paymentView.currentPage then " current" else ""))
+                   , onClick serverCommunications.address (SC.UpdatePage page)
+                   ]
+                   [ text (toString page) ]
+               )
+        )