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
123
124
125
126
127
128
129
|
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 =
incomeDefinedForAll (Dict.toList << mapValues .incomes <| 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 mbIncomeDefinedForAll = incomeDefinedForAll (Dict.toList << mapValues .incomes <| payers)
exceedingPayersOnPreIncome =
payers
|> mapValues .preIncomePaymentSum
|> Dict.toList
|> exceedingPayersFromAmounts
in case mbIncomeDefinedForAll 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
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
|
