Paging model works with both payments addition and deletion

7 files changed, 112 insertions, 92 deletions

diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm
index 02dcf7e..88063b4 100644
--- a/src/client/Model/Payment.elm
+++ b/src/client/Model/Payment.elm
@@ -5,7 +5,6 @@ module Model.Payment
   , PaymentId
   , PaymentWithId
   , paymentsDecoder
-  , addPayment
   , removePayment
   ) where
 
@@ -50,8 +49,5 @@ paymentIdDecoder = Json.string
 dateDecoder : Json.Decoder Date
 dateDecoder = Json.customDecoder Json.string Date.fromString
 
-addPayment : Payments -> (PaymentId, Payment) -> Payments
-addPayment payments (paymentId, payment) = Dict.insert paymentId payment payments
-
 removePayment : Payments -> PaymentId -> Payments
 removePayment payments paymentId = Dict.remove paymentId payments
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index 9359160..719a563 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -20,8 +20,8 @@ import Update.Payment as UP
 type Communication =
   NoCommunication
   | SignIn String
-  | AddPayment String Int
-  | DeletePayment PaymentId
+  | AddPayment String String Int
+  | DeletePayment PaymentId String Int Int
   | UpdatePage Int
   | SignOut
 
@@ -34,8 +34,7 @@ sendRequest communication =
     Nothing ->
       Task.succeed U.NoOp
     Just request ->
-      Http.send Http.defaultSettings request
-        |> Task.map (communicationToAction communication)
+      (Http.send Http.defaultSettings request) `Task.andThen` (serverResult communication)
 
 getRequest : Communication -> Maybe Http.Request
 getRequest communication =
@@ -44,15 +43,19 @@ getRequest communication =
       Nothing
     SignIn login ->
       Just (simple "post" ("/signIn?login=" ++ login))
-    AddPayment name cost ->
-      Just (simple "post" ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost)))
-    DeletePayment paymentId ->
+    AddPayment userName paymentName cost ->
+      Just (simple "post" ("/payment/add?name=" ++ paymentName ++ "&cost=" ++ (toString cost)))
+    DeletePayment paymentId _ _ _ ->
       Just (simple "post" ("payment/delete?id=" ++ paymentId))
     UpdatePage page ->
-      Just (simple "get" ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage))
+      Just (updatePageRequest page)
     SignOut ->
       Just (simple "post"  "/signOut")
 
+updatePageRequest : Int -> Http.Request
+updatePageRequest page =
+  simple "get" ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage)
+
 simple : String -> String -> Http.Request
 simple method url =
   { verb = method
@@ -61,29 +64,47 @@ simple method url =
   , body = Http.empty
   }
 
-communicationToAction : Communication -> Http.Response -> U.Action
-communicationToAction communication response =
+serverResult : Communication -> Http.Response -> Task Http.RawError U.Action
+serverResult communication response =
   if response.status == 200
     then
       case communication of
         NoCommunication ->
-          U.NoOp
+          Task.succeed U.NoOp
         SignIn login ->
-          U.UpdateSignIn (ValidLogin login)
-        AddPayment name cost ->
-          decodeResponse
-            response
-            messageDecoder
-            (\id -> U.UpdatePayment (UP.AddPayment id name cost))
-        DeletePayment id ->
-          U.UpdatePayment (UP.Remove id)
+          Task.succeed (U.UpdateSignIn (ValidLogin login))
+        AddPayment userName paymentName cost ->
+          Http.send Http.defaultSettings (updatePageRequest 1)
+            |> Task.map (\response ->
+                 if response.status == 200
+                   then
+                     decodeResponse
+                       response
+                       paymentsDecoder
+                       (\payments -> U.UpdatePayment (UP.AddPayment userName cost payments))
+                   else
+                     U.NoOp
+               )
+        DeletePayment id userName cost currentPage ->
+          Http.send Http.defaultSettings (updatePageRequest currentPage)
+            |> Task.map (\response ->
+                 if response.status == 200
+                   then
+                     decodeResponse
+                       response
+                       paymentsDecoder
+                       (\payments -> U.UpdatePayment (UP.Remove userName cost payments))
+                   else
+                     U.NoOp
+               )
         UpdatePage page ->
           decodeResponse
             response
             paymentsDecoder
             (\payments -> U.UpdatePayment (UP.UpdatePage page payments))
+          |> Task.succeed
         SignOut ->
-          U.GoSignInView
+          Task.succeed (U.GoSignInView)
     else
       decodeResponse
         response
@@ -95,6 +116,7 @@ communicationToAction communication response =
             _ ->
               U.NoOp
         )
+      |> Task.succeed
 
 decodeResponse : Http.Response -> Decoder a -> (a -> U.Action) -> U.Action
 decodeResponse response decoder responseToAction =
diff --git a/src/client/Update/Payment.elm b/src/client/Update/Payment.elm
index 798cdb4..b9b60dd 100644
--- a/src/client/Update/Payment.elm
+++ b/src/client/Update/Payment.elm
@@ -17,9 +17,9 @@ import Update.Payment.Add exposing (..)
 type PaymentAction =
   UpdateAdd AddPaymentAction
   | UpdatePayments Payments
-  | AddPayment PaymentId String Int
+  | AddPayment String Int Payments
   | ToggleEdit PaymentId
-  | Remove PaymentId
+  | Remove String Int Payments
   | UpdatePage Int Payments
 
 updatePayment : Model -> PaymentAction -> PaymentView -> PaymentView
@@ -29,29 +29,22 @@ updatePayment model action paymentView =
       { paymentView | add <- updateAddPayment addPaymentAction paymentView.add }
     UpdatePayments payments ->
       { paymentView | payments <- payments }
-    AddPayment id name cost ->
-      let payment =
-            { creation = Date.fromTime model.currentTime
-            , name = name
-            , cost = cost
-            , userName = paymentView.userName
-            }
-      in  { paymentView
-          | payments <- addPayment paymentView.payments (id, payment)
-          , add <- initAddPayment
-          , payers <- updatePayers paymentView.payers payment.userName payment.cost
-          }
+    AddPayment userName cost payments ->
+      { paymentView
+      | payments <- payments
+      , currentPage <- 1
+      , add <- initAddPayment
+      , payers <- updatePayers paymentView.payers userName cost
+      , paymentsCount <- paymentView.paymentsCount + 1
+      }
     ToggleEdit id ->
       { paymentView | edition <- if paymentView.edition == Just id then Nothing else Just id }
-    Remove id ->
-      case Dict.get id paymentView.payments of
-        Just payment ->
-          { paymentView
-          | payments <- removePayment paymentView.payments id
-          , payers <- updatePayers paymentView.payers payment.userName -payment.cost
-          }
-        Nothing ->
-          paymentView
+    Remove userName cost payments ->
+      { paymentView
+      | payments <- payments
+      , payers <- updatePayers paymentView.payers userName -cost
+      , paymentsCount <- paymentView.paymentsCount - 1
+      }
     UpdatePage page payments ->
       { paymentView
       | currentPage <- page
diff --git a/src/client/View/Payments.elm b/src/client/View/Payments.elm
index 3c9c09d..256e686 100644
--- a/src/client/View/Payments.elm
+++ b/src/client/View/Payments.elm
@@ -19,7 +19,7 @@ renderPayments model paymentView =
   div
     [ class "payments" ]
     [ exceedingPayers model paymentView
-    , addPayment model paymentView.add
+    , addPayment model paymentView
     , paymentsTable model paymentView
     , paymentsPaging paymentView
     ]
diff --git a/src/client/View/Payments/Add.elm b/src/client/View/Payments/Add.elm
index 941f6b8..115fed2 100644
--- a/src/client/View/Payments/Add.elm
+++ b/src/client/View/Payments/Add.elm
@@ -17,6 +17,7 @@ import Update.Payment.Add exposing (..)
 import Model exposing (Model)
 import Model.View.Payment.Add exposing (..)
 import Model.Translations exposing (getMessage)
+import Model.View.PaymentView exposing (PaymentView)
 
 import View.Events exposing (onSubmitPrevDefault)
 import View.Icon exposing (renderIcon)
@@ -24,53 +25,61 @@ import View.Icon exposing (renderIcon)
 import Utils.Maybe exposing (isJust)
 import Utils.Either exposing (toMaybeError)
 
-addPayment : Model -> AddPayment -> Html
-addPayment model addPayment =
+addPayment : Model -> PaymentView -> Html
+addPayment model paymentView =
   H.form
     [ class "add"
-    , case (validateName addPayment.name model.translations, validateCost addPayment.cost model.translations) of
+    , case (validateName paymentView.add.name model.translations, validateCost paymentView.add.cost model.translations) of
         (Ok name, Ok cost) ->
-          onSubmitPrevDefault serverCommunications.address (SC.AddPayment name cost)
+          onSubmitPrevDefault serverCommunications.address (SC.AddPayment paymentView.userName name cost)
         (resName, resCost) ->
           onSubmitPrevDefault actions.address (UpdatePayment <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
     ]
-    [ div
-        [ class ("name " ++ (if isJust addPayment.nameError then "error" else "")) ]
-        [ input
-            [ id "nameInput"
-            , value addPayment.name
-            , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateAdd << UpdateName)
-            , maxlength 20
-            ]
-            []
-        , label
-            [ for "nameInput" ]
-            [ renderIcon "shopping-cart" ]
-        , case addPayment.nameError of
-            Just error ->
-              div [ class "errorMessage" ] [ text error ]
-            Nothing ->
-              text ""
+    [ addPaymentName paymentView.add
+    , addPaymentCost model paymentView.add
+    , button
+        [ type' "submit" ]
+        [ text (getMessage "Add" model.translations)]
+    ]
+
+addPaymentName : AddPayment -> Html
+addPaymentName addPayment =
+  div
+    [ class ("name " ++ (if isJust addPayment.nameError then "error" else "")) ]
+    [ input
+        [ id "nameInput"
+        , value addPayment.name
+        , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateAdd << UpdateName)
+        , maxlength 20
         ]
-    , div
-        [ class ("cost " ++ (if isJust addPayment.costError then "error" else "")) ]
-        [ input
-            [ id "costInput"
-            , value addPayment.cost
-            , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateAdd << UpdateCost)
-            , maxlength 7
-            ]
-            []
-        , label
-            [ for "costInput" ]
-            [ text (getMessage "MoneySymbol" model.translations) ]
-        , case addPayment.costError of
-            Just error ->
-              div [ class "errorMessage" ] [ text error ]
-            Nothing ->
-              text ""
+        []
+    , label
+        [ for "nameInput" ]
+        [ renderIcon "shopping-cart" ]
+    , case addPayment.nameError of
+        Just error ->
+          div [ class "errorMessage" ] [ text error ]
+        Nothing ->
+          text ""
+    ]
+
+addPaymentCost : Model -> AddPayment -> Html
+addPaymentCost model addPayment =
+  div
+    [ class ("cost " ++ (if isJust addPayment.costError then "error" else "")) ]
+    [ input
+        [ id "costInput"
+        , value addPayment.cost
+        , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateAdd << UpdateCost)
+        , maxlength 7
         ]
-      , button
-          [ type' "submit" ]
-          [ text (getMessage "Add" model.translations)]
+        []
+    , label
+        [ for "costInput" ]
+        [ text (getMessage "MoneySymbol" model.translations) ]
+    , case addPayment.costError of
+        Just error ->
+          div [ class "errorMessage" ] [ text error ]
+        Nothing ->
+          text ""
     ]
diff --git a/src/client/View/Payments/Table.elm b/src/client/View/Payments/Table.elm
index 12b1a46..06bec17 100644
--- a/src/client/View/Payments/Table.elm
+++ b/src/client/View/Payments/Table.elm
@@ -69,7 +69,7 @@ paymentLine model paymentView (id, payment) =
         then
           div
             [ class "cell remove"
-            , onClick serverCommunications.address (SC.DeletePayment id)
+            , onClick serverCommunications.address (SC.DeletePayment id payment.userName payment.cost paymentView.currentPage)
             ]
             [ renderIcon "times" ]
         else
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 271d970..b3fe07a 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -35,8 +35,8 @@ getPaymentsAction page perPage =
 createPaymentAction :: Text -> Int -> ActionM ()
 createPaymentAction name cost =
   Secure.loggedAction (\user -> do
-    paymentKey <- liftIO . runDb $ createPayment (entityKey user) name cost
-    json . Message . paymentKeyToText $ paymentKey
+    _ <- liftIO . runDb $ createPayment (entityKey user) name cost
+    ok200
   )
 
 deletePaymentAction :: Text -> ActionM ()