From 6b466f616035c2fc03359d182c074f096d6b7f17 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 29 Aug 2015 13:30:09 +0200 Subject: Showing exceeding payers --- src/client/Main.elm | 6 ++- src/client/Model/Payers.elm | 57 +++++++++++++++++++++++++++++ src/client/Model/View/PaymentView.elm | 7 +++- src/client/Update.elm | 7 ++-- src/client/Update/Payment.elm | 12 +++++- src/client/View/Payments.elm | 4 +- src/client/View/Payments/ExceedingPayer.elm | 24 ++++++++++++ 7 files changed, 109 insertions(+), 8 deletions(-) create mode 100644 src/client/Model/Payers.elm create mode 100644 src/client/View/Payments/ExceedingPayer.elm (limited to 'src/client') 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)) ] + ] -- cgit v1.2.3