From 869bab77e93e2a6c776a4b1fc35ef0fd5df22f5f Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 27 Mar 2016 17:36:33 +0200 Subject: Compute payers client side rather than server side --- src/client/elm/Model/Action/AccountAction.elm | 4 +- src/client/elm/Model/Income.elm | 65 ++++++++++++++------- src/client/elm/Model/Init.elm | 4 +- src/client/elm/Model/Payer.elm | 78 +++++++++++--------------- src/client/elm/Model/Payment.elm | 8 +++ src/client/elm/Model/User.elm | 6 +- src/client/elm/Model/View/LoggedIn/Account.elm | 31 ++++------ src/client/elm/Model/View/LoggedInView.elm | 2 +- src/client/elm/Server.elm | 8 +-- src/client/elm/Update/LoggedIn.elm | 36 ++++++------ src/client/elm/Update/LoggedIn/Account.elm | 23 +------- src/client/elm/View/LoggedIn/Account.elm | 2 +- 12 files changed, 131 insertions(+), 136 deletions(-) (limited to 'src/client') diff --git a/src/client/elm/Model/Action/AccountAction.elm b/src/client/elm/Model/Action/AccountAction.elm index 520f3ab..3e156a5 100644 --- a/src/client/elm/Model/Action/AccountAction.elm +++ b/src/client/elm/Model/Action/AccountAction.elm @@ -5,13 +5,13 @@ module Model.Action.AccountAction import Time exposing (Time) import Model.User exposing (UserId) +import Model.Income exposing (IncomeId) type AccountAction = NoOp | ToggleDetail - | UpdatePayer UserId Time Int | ToggleIncomeEdition | UpdateIncomeEdition String | UpdateEditionError String | UpdateIncome Time Int - | ValidateUpdateIncome Time Int + | ValidateUpdateIncome IncomeId Time Int diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm index 97a5652..f364a8b 100644 --- a/src/client/elm/Model/Income.elm +++ b/src/client/elm/Model/Income.elm @@ -1,6 +1,9 @@ module Model.Income - ( Income - , incomeDecoder + ( Incomes + , Income + , IncomeId + , incomesDecoder + , incomeIdDecoder , incomeDefinedForAll , cumulativeIncomesSince ) where @@ -8,26 +11,46 @@ module Model.Income import Json.Decode as Json exposing ((:=)) import Time exposing (Time, hour) import List exposing (..) +import Dict exposing (Dict) import Model.Date exposing (timeDecoder) -import Model.User exposing (UserId) +import Model.User exposing (UserId, userIdDecoder) import Utils.Maybe exposing (isJust, catMaybes, maybeToList) +type alias Incomes = Dict IncomeId Income + +type alias IncomeId = Int + type alias Income = - { creation : Time + { userId : UserId + , creation : Time , amount : Int } +incomesDecoder : Json.Decoder Incomes +incomesDecoder = Json.map Dict.fromList (Json.list incomeWithIdDecoder) + +incomeWithIdDecoder : Json.Decoder (IncomeId, Income) +incomeWithIdDecoder = + Json.object2 (,) + ("id" := incomeIdDecoder) + incomeDecoder + +incomeIdDecoder : Json.Decoder IncomeId +incomeIdDecoder = Json.int + incomeDecoder : Json.Decoder Income incomeDecoder = - Json.object2 Income + Json.object3 Income + ("userId" := userIdDecoder) ("creation" := timeDecoder) ("amount" := Json.int) -incomeDefinedForAll : List (List Income) -> Maybe Time -incomeDefinedForAll usersIncomes = - let firstIncomes = map (head << sortBy .creation) usersIncomes +incomeDefinedForAll : List UserId -> Incomes -> Maybe Time +incomeDefinedForAll userIds incomes = + let userIncomes = List.map (\userId -> List.filter ((==) userId << .userId) << Dict.values <| incomes) userIds + firstIncomes = map (head << sortBy .creation) userIncomes in if all isJust firstIncomes then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes else Nothing @@ -38,37 +61,39 @@ cumulativeIncomesSince currentTime since incomes = getOrderedIncomesSince : Time -> List Income -> List Income getOrderedIncomesSince time incomes = - let mbStarterIncome = getIncomesAt time incomes + let mbStarterIncome = getIncomeAt time incomes orderedIncomesSince = filter (\income -> income.creation >= time) incomes in (maybeToList mbStarterIncome) ++ orderedIncomesSince -getIncomesAt : Time -> List Income -> Maybe Income -getIncomesAt time incomes = +getIncomeAt : Time -> List Income -> Maybe Income +getIncomeAt time incomes = case incomes of [x] -> if x.creation < time - then Just { creation = time, amount = x.amount } + then Just { userId = x.userId, creation = time, amount = x.amount } else Nothing x1 :: x2 :: xs -> if x1.creation < time && x2.creation > time - then Just { creation = time, amount = x2.amount } - else getIncomesAt time (x2 :: xs) + then Just { userId = x2.userId, creation = time, amount = x2.amount } + else getIncomeAt time (x2 :: xs) [] -> Nothing cumulativeIncome : Time -> List Income -> Int cumulativeIncome currentTime incomes = - getIncomesWithDuration (incomes ++ [{ creation = currentTime, amount = 0 }]) + getIncomesWithDuration currentTime (List.sortBy .creation incomes) |> map durationIncome |> sum -getIncomesWithDuration : List Income -> List (Float, Int) -getIncomesWithDuration incomes = +getIncomesWithDuration : Time -> List Income -> List (Float, Int) +getIncomesWithDuration currentTime incomes = case incomes of - (income1 :: income2 :: xs) -> - (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration (income2 :: xs)) - _ -> + [] -> [] + [income] -> + [(currentTime - income.creation, income.amount)] + (income1 :: income2 :: xs) -> + (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs)) durationIncome : (Float, Int) -> Int durationIncome (duration, income) = diff --git a/src/client/elm/Model/Init.elm b/src/client/elm/Model/Init.elm index 490321b..d9dbc36 100644 --- a/src/client/elm/Model/Init.elm +++ b/src/client/elm/Model/Init.elm @@ -3,7 +3,7 @@ module Model.Init ) where import Model.Payment exposing (Payments) -import Model.Payer exposing (Payers) +import Model.Income exposing (Incomes) import Model.User exposing (Users, UserId) type alias Init = @@ -12,5 +12,5 @@ type alias Init = , payments : Payments , monthlyPayments : Payments , paymentsCount : Int - , payers : Payers + , incomes : Incomes } diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm index f39a612..9ae1dfa 100644 --- a/src/client/elm/Model/Payer.elm +++ b/src/client/elm/Model/Payer.elm @@ -2,8 +2,6 @@ module Model.Payer ( Payers , Payer , ExceedingPayer - , payersDecoder - , updatePayers , getOrderedExceedingPayers ) where @@ -12,8 +10,10 @@ import Dict exposing (..) import List import Maybe import Time exposing (Time) +import Date -import Model.User exposing (UserId, userIdDecoder) +import Model.Payment exposing (Payments, totalPayments) +import Model.User exposing (Users, UserId, userIdDecoder) import Model.Income exposing (..) import Utils.Dict exposing (mapValues) @@ -27,54 +27,22 @@ type alias Payer = , incomes : List Income } -payersDecoder : Decoder Payers -payersDecoder = Json.map Dict.fromList (list payerDecoder) - -payerDecoder : Decoder (UserId, Payer) -payerDecoder = - object2 (,) - ("userId" := userIdDecoder) - (object3 Payer - ("preIncomePaymentSum" := int) - ("postIncomePaymentSum" := int) - ("incomes" := list incomeDecoder)) - -updatePayers : Payers -> UserId -> Time -> Int -> Payers -updatePayers payers userId creation amountDiff = - payers - |> Dict.update userId (\mbPayer -> - case mbPayer of - Just payer -> - let postIncome = - payersIncomeDefinedForAll payers - |> Maybe.map (\date -> creation > date) - |> Maybe.withDefault False - in if postIncome - then - Just { payer | postIncomePaymentSum = payer.postIncomePaymentSum + amountDiff } - else - Just { payer | preIncomePaymentSum = payer.preIncomePaymentSum + amountDiff } - Nothing -> - Nothing - ) - type alias ExceedingPayer = { userId : UserId , amount : Int } -getOrderedExceedingPayers : Time -> Payers -> List ExceedingPayer -getOrderedExceedingPayers currentTime payers = - let exceedingPayersOnPreIncome = +getOrderedExceedingPayers : Time -> Users -> Incomes -> Payments -> List ExceedingPayer +getOrderedExceedingPayers currentTime users incomes payments = + let payers = getPayers currentTime users incomes payments + exceedingPayersOnPreIncome = payers |> mapValues .preIncomePaymentSum |> Dict.toList |> exceedingPayersFromAmounts - in case payersIncomeDefinedForAll payers of + in case incomeDefinedForAll (Dict.keys users) incomes of Just since -> - let postPaymentPayers = - payers - |> mapValues (getPostPaymentPayer currentTime since) + let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers mbMaxRatio = postPaymentPayers |> Dict.toList @@ -91,9 +59,31 @@ getOrderedExceedingPayers currentTime payers = Nothing -> exceedingPayersOnPreIncome -payersIncomeDefinedForAll : Payers -> Maybe Time -payersIncomeDefinedForAll payers = - incomeDefinedForAll (List.map (.incomes << snd) << Dict.toList <| payers) +getPayers : Time -> Users -> Incomes -> Payments -> Payers +getPayers currentTime users incomes payments = + let incomesDefined = incomeDefinedForAll (Dict.keys users) incomes + in Dict.keys users + |> List.map (\userId -> + ( userId + , { preIncomePaymentSum = + totalPayments + (\p -> (Date.toTime p.creation) < (Maybe.withDefault currentTime incomesDefined)) + userId + payments + , postIncomePaymentSum = + totalPayments + (\p -> + case incomesDefined of + Nothing -> False + Just t -> (Date.toTime p.creation) >= t + ) + userId + payments + , incomes = List.filter ((==) userId << .userId) (Dict.values incomes) + } + ) + ) + |> Dict.fromList exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer exceedingPayersFromAmounts userAmounts = diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm index 31aba1d..80579e2 100644 --- a/src/client/elm/Model/Payment.elm +++ b/src/client/elm/Model/Payment.elm @@ -7,6 +7,7 @@ module Model.Payment , paymentIdDecoder , deletePayment , PaymentFrequency(..) + , totalPayments ) where import Date exposing (..) @@ -49,3 +50,10 @@ paymentIdDecoder = Json.int deletePayment : PaymentId -> Payments -> Payments deletePayment paymentId = List.filter (((/=) paymentId) << .id) + +totalPayments : (Payment -> Bool) -> UserId -> Payments -> Int +totalPayments paymentFilter userId payments = + payments + |> List.filter (\payment -> paymentFilter payment && payment.userId == userId) + |> List.map .cost + |> List.sum diff --git a/src/client/elm/Model/User.elm b/src/client/elm/Model/User.elm index 1412913..aac5dd5 100644 --- a/src/client/elm/Model/User.elm +++ b/src/client/elm/Model/User.elm @@ -29,15 +29,15 @@ userWithIdDecoder = ("id" := userIdDecoder) userDecoder +userIdDecoder : Json.Decoder UserId +userIdDecoder = Json.int + userDecoder : Json.Decoder User userDecoder = Json.object2 User ("name" := Json.string) ("email" := Json.string) -userIdDecoder : Json.Decoder UserId -userIdDecoder = Json.int - getUserName : Users -> UserId -> Maybe String getUserName users userId = Dict.get userId users diff --git a/src/client/elm/Model/View/LoggedIn/Account.elm b/src/client/elm/Model/View/LoggedIn/Account.elm index d03d84f..ec75397 100644 --- a/src/client/elm/Model/View/LoggedIn/Account.elm +++ b/src/client/elm/Model/View/LoggedIn/Account.elm @@ -14,40 +14,33 @@ import String import Utils.Dict exposing (mapValues) import Model.Translations exposing (..) -import Model.Payer exposing (..) +import Model.Income exposing (..) import Model.User exposing (UserId) type alias Account = { me : UserId - , payers : Payers + , incomes : Incomes , visibleDetail : Bool , incomeEdition : Maybe IncomeEdition } -initAccount : UserId -> Payers -> Account -initAccount me payers = +initAccount : UserId -> Incomes -> Account +initAccount me incomes = { me = me - , payers = - payers - |> mapValues - (\payer -> - { payer | incomes = List.sortBy .creation payer.incomes } - ) + , incomes = incomes , visibleDetail = False , incomeEdition = Nothing } getCurrentIncome : Account -> Maybe Int getCurrentIncome account = - case Dict.get account.me account.payers of - Just payer -> - payer.incomes - |> List.sortBy .creation - |> List.reverse - |> List.head - |> Maybe.map .amount - Nothing -> - Nothing + account.incomes + |> Dict.filter (\_ income -> income.userId == account.me) + |> Dict.values + |> List.sortBy .creation + |> List.reverse + |> List.head + |> Maybe.map .amount type alias IncomeEdition = { income : String diff --git a/src/client/elm/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm index 2df3525..e33c58b 100644 --- a/src/client/elm/Model/View/LoggedInView.elm +++ b/src/client/elm/Model/View/LoggedInView.elm @@ -28,7 +28,7 @@ initLoggedInView init = { users = init.users , add = initAddPayment Punctual , monthly = initMonthly init.monthlyPayments - , account = initAccount init.me init.payers + , account = initAccount init.me init.incomes , payments = init.payments , paymentsCount = init.paymentsCount , paymentEdition = Nothing diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm index c1fb445..314ca01 100644 --- a/src/client/elm/Server.elm +++ b/src/client/elm/Server.elm @@ -17,7 +17,7 @@ import Time exposing (Time) import Utils.Http exposing (..) import Model.Payment exposing (..) -import Model.Payer exposing (Payers, payersDecoder) +import Model.Income exposing (incomesDecoder, incomeIdDecoder, IncomeId) import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) import Model.Init exposing (Init) @@ -28,7 +28,7 @@ init = `Task.andMap` (Http.get paymentsDecoder "/payments") `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments") `Task.andMap` (Http.get ("number" := Json.int) "/payments/count") - `Task.andMap` (Http.get payersDecoder "/payers") + `Task.andMap` (Http.get incomesDecoder "/incomes") signIn : String -> Task Http.Error () signIn email = @@ -45,10 +45,10 @@ deletePayment payment frequency = post ("payment/delete?id=" ++ (toString payment.id)) |> Task.map (always ()) -setIncome : Time -> Int -> Task Http.Error () +setIncome : Time -> Int -> Task Http.Error IncomeId setIncome currentTime amount = post ("/income?amount=" ++ (toString amount)) - |> Task.map (always ()) + |> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder) signOut : Task Http.Error () signOut = diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm index dfc2a1b..300c63a 100644 --- a/src/client/elm/Update/LoggedIn.elm +++ b/src/client/elm/Update/LoggedIn.elm @@ -71,17 +71,15 @@ updateLoggedIn model action loggedInView = newAdd = initAddPayment frequency in case frequency of Punctual -> - let (newAccount, accountEffects) = - updateAccount (Account.UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account - in ( { loggedInView - | currentPage = 1 - , add = newAdd - , account = newAccount - , payments = newPayment :: loggedInView.payments - , paymentsCount = loggedInView.paymentsCount + 1 - } - , Effects.map UpdateAccount accountEffects - ) + ( { loggedInView + | currentPage = 1 + , add = newAdd + , account = loggedInView.account + , payments = newPayment :: loggedInView.payments + , paymentsCount = loggedInView.paymentsCount + 1 + } + , Effects.none + ) Monthly -> ( { loggedInView | add = newAdd @@ -112,15 +110,13 @@ updateLoggedIn model action loggedInView = , Effects.none ) Punctual -> - let (newAccount, accountEffects) = - updateAccount (Account.UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account - in ( { loggedInView - | account = newAccount - , payments = deletePayment payment.id loggedInView.payments - , paymentsCount = loggedInView.paymentsCount - 1 - } - , Effects.map UpdateAccount accountEffects - ) + ( { loggedInView + | account = loggedInView.account + , payments = deletePayment payment.id loggedInView.payments + , paymentsCount = loggedInView.paymentsCount - 1 + } + , Effects.none + ) UpdatePage page -> ( { loggedInView | currentPage = page } diff --git a/src/client/elm/Update/LoggedIn/Account.elm b/src/client/elm/Update/LoggedIn/Account.elm index 1773b9a..233efa9 100644 --- a/src/client/elm/Update/LoggedIn/Account.elm +++ b/src/client/elm/Update/LoggedIn/Account.elm @@ -10,7 +10,6 @@ import Effects exposing (Effects) import Server -import Model.Payer exposing (updatePayers) import Model.Action.AccountAction exposing (..) import Model.View.LoggedIn.Account exposing (..) @@ -28,11 +27,6 @@ updateAccount action account = , Effects.none ) - UpdatePayer userId creation amountDiff -> - ( { account | payers = updatePayers account.payers userId creation amountDiff } - , Effects.none - ) - ToggleIncomeEdition -> ( { account | incomeEdition = if isJust account.incomeEdition @@ -67,25 +61,14 @@ updateAccount action account = UpdateIncome currentTime amount -> ( account , Server.setIncome currentTime amount - |> Task.map (always (ValidateUpdateIncome currentTime amount)) + |> Task.map (\incomeId -> (ValidateUpdateIncome incomeId currentTime amount)) |> flip Task.onError (always <| Task.succeed NoOp) |> Effects.task ) - ValidateUpdateIncome currentTime amount -> + ValidateUpdateIncome incomeId currentTime amount -> ( { account - | payers = - account.payers - |> Dict.update account.me (\mbPayer -> - case mbPayer of - Just payer -> - Just - { payer - | incomes = payer.incomes ++ [{ creation = currentTime, amount = amount }] - } - Nothing -> - Nothing - ) + | incomes = Dict.insert incomeId { userId = account.me, creation = currentTime, amount = amount } account.incomes , incomeEdition = Nothing } , Effects.none diff --git a/src/client/elm/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm index d8884f1..5bbf73e 100644 --- a/src/client/elm/View/LoggedIn/Account.elm +++ b/src/client/elm/View/LoggedIn/Account.elm @@ -48,7 +48,7 @@ exceedingPayers address model loggedInView = [ class "header" , onClick address (UpdateLoggedIn << UpdateAccount <| ToggleDetail) ] - ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.account.payers)) + ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.users loggedInView.account.incomes loggedInView.payments)) ++ [ expand ExpandDown loggedInView.account.visibleDetail ] ) -- cgit v1.2.3