1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
module Model.Payer
( Payers
, Payer
, ExceedingPayer
, getOrderedExceedingPayers
) where
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 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
in case incomeDefinedForAll (Dict.keys users) incomes 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
Nothing ->
exceedingPayersOnPreIncome
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 =
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
|