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
130
131
132
133
134
135
136
137
138
139
|
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 << .date)
|> 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.date) < (Maybe.withDefault currentTime incomesDefined))
userId
payments
, postIncomePaymentSum =
totalPayments
(\p ->
case incomesDefined of
Nothing -> False
Just t -> (Date.toTime p.date) >= 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
|
