From c876fd8c2f1aac2c3fe10c2b7de734f3ef71b71f Mon Sep 17 00:00:00 2001 From: Joris Date: Fri, 4 Sep 2015 23:13:48 +0200 Subject: Paging model works with both payments addition and deletion --- src/client/Model/Payment.elm | 4 -- src/client/ServerCommunication.elm | 62 +++++++++++++++++--------- src/client/Update/Payment.elm | 39 +++++++--------- src/client/View/Payments.elm | 2 +- src/client/View/Payments/Add.elm | 91 +++++++++++++++++++++----------------- src/client/View/Payments/Table.elm | 2 +- src/server/Controller/Payment.hs | 4 +- 7 files changed, 112 insertions(+), 92 deletions(-) (limited to 'src') 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 () -- cgit v1.2.3