module Model.Payer exposing ( Payers , Payer , ExceedingPayer , getOrderedExceedingPayers , useIncomesFrom ) import Json.Decode as Json exposing (..) import Dict exposing (..) import List import Maybe import Time exposing (Time) import Date import Model.Payment exposing (Payments, totalPayments) import Model.User exposing (Users, 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 } type alias PostPaymentPayer = { preIncomePaymentSum : Int , cumulativeIncome : Int , ratio : Float } type alias ExceedingPayer = { userId : UserId , amount : Int } 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 mbSince = useIncomesFrom users incomes payments in case mbSince of Just since -> let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers 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 _ -> exceedingPayersOnPreIncome useIncomesFrom : Users -> Incomes -> Payments -> Maybe Time useIncomesFrom users incomes payments = let firstPaymentTime = payments |> List.map (Date.toTime << .creation) |> List.sort |> List.head mbIncomeTime = incomeDefinedForAll (Dict.keys users) incomes in case (firstPaymentTime, mbIncomeTime) of (Just paymentTime, Just incomeTime) -> Just (max paymentTime incomeTime) _ -> Nothing getPayers : Time -> Users -> Incomes -> Payments -> Payers getPayers currentTime users incomes payments = let userIds = Dict.keys users incomesDefined = incomeDefinedForAll userIds incomes in userIds |> 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 = 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) 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