module Model.Payer ( Payers , Payer , ExceedingPayer , payersDecoder , updatePayers , getOrderedExceedingPayers ) where import Json.Decode as Json exposing (..) import Dict exposing (..) import List import Maybe import Time exposing (Time) import Model.User exposing (UserId, userIdDecoder) import Model.Income exposing (..) import Utils.Dict exposing (mapValues) import Utils.Maybe exposing (isJust) type alias Payers = Dict UserId Payer type alias Payer = { preIncomePaymentSum : Int , postIncomePaymentSum : Int , 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 = payers |> mapValues .preIncomePaymentSum |> Dict.toList |> exceedingPayersFromAmounts in case payersIncomeDefinedForAll payers of Just since -> let postPaymentPayers = payers |> mapValues (getPostPaymentPayer currentTime since) mbMaxRatio = postPaymentPayers |> Dict.toList |> List.map (.ratio << snd) |> List.maximum in case mbMaxRatio of Just maxRatio -> postPaymentPayers |> mapValues (getFinalDiff maxRatio) |> Dict.toList |> exceedingPayersFromAmounts Nothing -> exceedingPayersOnPreIncome Nothing -> exceedingPayersOnPreIncome payersIncomeDefinedForAll : Payers -> Maybe Time payersIncomeDefinedForAll payers = incomeDefinedForAll (List.map (.incomes << snd) << Dict.toList <| payers) exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer exceedingPayersFromAmounts userAmounts = let mbMinAmount = List.minimum << List.map snd <| userAmounts in case mbMinAmount of Nothing -> [] Just minAmount -> userAmounts |> List.map (\userAmount -> { userId = fst userAmount , amount = snd userAmount - minAmount } ) |> List.filter (\payer -> payer.amount > 0) type alias PostPaymentPayer = { preIncomePaymentSum : Int , cumulativeIncome : Int , ratio : Float } getPostPaymentPayer : Time -> Time -> Payer -> PostPaymentPayer getPostPaymentPayer currentTime since payer = let cumulativeIncome = cumulativeIncomesSince currentTime since payer.incomes in { preIncomePaymentSum = payer.preIncomePaymentSum , cumulativeIncome = cumulativeIncome , ratio = toFloat payer.postIncomePaymentSum / toFloat cumulativeIncome } getFinalDiff : Float -> PostPaymentPayer -> Int getFinalDiff maxRatio payer = let postIncomeDiff = -1 * (maxRatio - payer.ratio) * toFloat payer.cumulativeIncome |> truncate in postIncomeDiff + payer.preIncomePaymentSum