aboutsummaryrefslogtreecommitdiff
path: root/src/client
diff options
context:
space:
mode:
Diffstat (limited to 'src/client')
-rw-r--r--src/client/Main.elm6
-rw-r--r--src/client/Model/Payers.elm57
-rw-r--r--src/client/Model/View/PaymentView.elm7
-rw-r--r--src/client/Update.elm7
-rw-r--r--src/client/Update/Payment.elm12
-rw-r--r--src/client/View/Payments.elm4
-rw-r--r--src/client/View/Payments/ExceedingPayer.elm24
7 files changed, 109 insertions, 8 deletions
diff --git a/src/client/Main.elm b/src/client/Main.elm
index badb450..57e41d4 100644
--- a/src/client/Main.elm
+++ b/src/client/Main.elm
@@ -13,6 +13,7 @@ import Json.Decode as Json
import Model exposing (Model, initialModel)
import Model.Payment exposing (Payments, paymentsDecoder)
+import Model.Payers exposing (Payers, payersDecoder)
import Model.Message exposing (messageDecoder)
import Model.Translations exposing (..)
@@ -55,7 +56,7 @@ port initView =
Just msg ->
Signal.send actions.address (SignInError msg)
Nothing ->
- Task.map2 GoPaymentView getUserName getPayments
+ Task.map3 GoPaymentView getUserName getPayments getPayers
|> flip Task.andThen (Signal.send actions.address)
|> flip Task.onError (\_ -> Signal.send actions.address GoSignInView)
@@ -65,6 +66,9 @@ getUserName = Http.get messageDecoder "/userName"
getPayments : Task Http.Error Payments
getPayments = Http.get paymentsDecoder "/payments"
+getPayers : Task Http.Error Payers
+getPayers = Http.get payersDecoder "/payments/total"
+
---------------------------------------
port serverCommunicationsPort : Signal (Task Http.RawError ())
diff --git a/src/client/Model/Payers.elm b/src/client/Model/Payers.elm
new file mode 100644
index 0000000..6550eaa
--- /dev/null
+++ b/src/client/Model/Payers.elm
@@ -0,0 +1,57 @@
+module Model.Payers
+ ( Payers
+ , ExceedingPayer
+ , payersDecoder
+ , updatePayers
+ , getOrderedExceedingPayers
+ ) where
+
+import Json.Decode as Json exposing (..)
+import Dict exposing (..)
+import List
+import Maybe
+
+type alias Payers = Dict String Int
+
+payersDecoder : Decoder Payers
+payersDecoder = Json.map Dict.fromList (list payerDecoder)
+
+payerDecoder : Decoder (String, Int)
+payerDecoder =
+ object2 (,)
+ ("userName" := string)
+ ("totalPayment" := int)
+
+updatePayers : Payers -> String -> Int -> Payers
+updatePayers payers userName amountDiff =
+ Dict.update
+ userName
+ (\mbAmount ->
+ case mbAmount of
+ Just amount -> Just (amount + amountDiff)
+ Nothing -> Nothing
+ )
+ payers
+
+type alias ExceedingPayer =
+ { userName : String
+ , amount : Int
+ }
+
+getOrderedExceedingPayers : Payers -> List ExceedingPayer
+getOrderedExceedingPayers payers =
+ let orderedPayers =
+ Dict.toList payers
+ |> List.map (\(userName, amount) -> ExceedingPayer userName amount)
+ |> List.sortBy .amount
+ maybeMinAmount =
+ List.head orderedPayers
+ |> Maybe.map .amount
+ in case maybeMinAmount of
+ Just minAmount ->
+ orderedPayers
+ |> List.map (\payer -> { payer | amount <- payer.amount - minAmount })
+ |> List.filter (\payer -> payer.amount /= 0)
+ |> List.reverse
+ Nothing ->
+ []
diff --git a/src/client/Model/View/PaymentView.elm b/src/client/Model/View/PaymentView.elm
index 2f2be46..19ad355 100644
--- a/src/client/Model/View/PaymentView.elm
+++ b/src/client/Model/View/PaymentView.elm
@@ -4,6 +4,7 @@ module Model.View.PaymentView
) where
import Model.Payment exposing (Payments)
+import Model.Payers exposing (Payers)
import Model.View.Payment.Add exposing (..)
import Model.View.Payment.Edition exposing (..)
@@ -11,13 +12,15 @@ type alias PaymentView =
{ userName : String
, add : AddPayment
, payments : Payments
+ , payers : Payers
, edition : Maybe Edition
}
-initPaymentView : String -> Payments -> PaymentView
-initPaymentView userName payments =
+initPaymentView : String -> Payments -> Payers -> PaymentView
+initPaymentView userName payments payers =
{ userName = userName
, add = initAddPayment
, payments = payments
+ , payers = payers
, edition = Nothing
}
diff --git a/src/client/Update.elm b/src/client/Update.elm
index be7538a..df19775 100644
--- a/src/client/Update.elm
+++ b/src/client/Update.elm
@@ -8,6 +8,7 @@ import Time exposing (Time)
import Model exposing (Model)
import Model.Payment exposing (Payments)
+import Model.Payers exposing (Payers)
import Model.View as V
import Model.View.SignInView exposing (..)
import Model.View.PaymentView exposing (..)
@@ -21,7 +22,7 @@ type Action =
| GoSignInView
| SignInError String
| UpdateSignIn SignInAction
- | GoPaymentView String Payments
+ | GoPaymentView String Payments Payers
| UpdatePayment PaymentAction
actions : Signal.Mailbox Action
@@ -36,8 +37,8 @@ updateModel action model =
{ model | currentTime <- time }
GoSignInView ->
{ model | view <- V.SignInView initSignInView }
- GoPaymentView userName payments ->
- { model | view <- V.PaymentView (initPaymentView userName payments) }
+ GoPaymentView userName payments payers ->
+ { model | view <- V.PaymentView (initPaymentView userName payments payers) }
SignInError msg ->
let signInView = { initSignInView | result <- Just (Err msg) }
in { model | view <- V.SignInView signInView }
diff --git a/src/client/Update/Payment.elm b/src/client/Update/Payment.elm
index 67331d6..53dc08a 100644
--- a/src/client/Update/Payment.elm
+++ b/src/client/Update/Payment.elm
@@ -4,9 +4,11 @@ module Update.Payment
) where
import Date
+import Dict
import Model exposing (Model)
import Model.Payment exposing (..)
+import Model.Payers exposing (..)
import Model.View.PaymentView exposing (..)
import Model.View.Payment.Add exposing (..)
@@ -36,8 +38,16 @@ updatePayment model action paymentView =
in { paymentView
| payments <- addPayment paymentView.payments (id, payment)
, add <- initAddPayment
+ , payers <- updatePayers paymentView.payers payment.userName payment.cost
}
ToggleEdit id ->
{ paymentView | edition <- if paymentView.edition == Just id then Nothing else Just id }
Remove id ->
- { paymentView | payments <- removePayment paymentView.payments 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
diff --git a/src/client/View/Payments.elm b/src/client/View/Payments.elm
index 29ab481..03886f8 100644
--- a/src/client/View/Payments.elm
+++ b/src/client/View/Payments.elm
@@ -9,6 +9,7 @@ import Model exposing (Model)
import Model.Payment exposing (Payments)
import Model.View.PaymentView exposing (PaymentView)
+import View.Payments.ExceedingPayer exposing (exceedingPayers)
import View.Payments.Add exposing (addPayment)
import View.Payments.Table exposing (paymentsTable)
@@ -16,6 +17,7 @@ renderPayments : Model -> PaymentView -> Html
renderPayments model paymentView =
div
[ class "payments" ]
- [ addPayment model paymentView.add
+ [ exceedingPayers paymentView
+ , addPayment model paymentView.add
, paymentsTable model paymentView
]
diff --git a/src/client/View/Payments/ExceedingPayer.elm b/src/client/View/Payments/ExceedingPayer.elm
new file mode 100644
index 0000000..cea8d66
--- /dev/null
+++ b/src/client/View/Payments/ExceedingPayer.elm
@@ -0,0 +1,24 @@
+module View.Payments.ExceedingPayer
+ ( exceedingPayers
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import List
+
+import Model.Payers exposing (..)
+import Model.View.PaymentView exposing (PaymentView)
+
+exceedingPayers : PaymentView -> Html
+exceedingPayers paymentView =
+ div
+ [ class "exceedingPayers" ]
+ (List.map exceedingPayer (getOrderedExceedingPayers paymentView.payers))
+
+exceedingPayer : ExceedingPayer -> Html
+exceedingPayer payer =
+ div
+ [ class "exceedingPayer" ]
+ [ span [ class "userName" ] [ text payer.userName ]
+ , span [ class "amount" ] [ text ("+ " ++ (toString payer.amount)) ]
+ ]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 21:52:40 +0000