aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/client/Model/Payment.elm4
-rw-r--r--src/client/ServerCommunication.elm62
-rw-r--r--src/client/Update/Payment.elm39
-rw-r--r--src/client/View/Payments.elm2
-rw-r--r--src/client/View/Payments/Add.elm91
-rw-r--r--src/client/View/Payments/Table.elm2
-rw-r--r--src/server/Controller/Payment.hs4
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 ()
generated by cgit v1.2.3 (git 2.25.1) at 2025-10-31 14:28:38 +0000