Add cumulative incomes by user

2 files changed, 148 insertions, 0 deletions

diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm
index f364a8b..ea990e2 100644
--- a/src/client/elm/Model/Income.elm
+++ b/src/client/elm/Model/Income.elm
@@ -5,6 +5,7 @@ module Model.Income
   , incomesDecoder
   , incomeIdDecoder
   , incomeDefinedForAll
+  , userCumulativeIncomeSince
   , cumulativeIncomesSince
   ) where
 
@@ -55,6 +56,13 @@ incomeDefinedForAll userIds incomes =
         then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes
         else Nothing
 
+userCumulativeIncomeSince : Time -> Time -> Incomes -> UserId -> Int
+userCumulativeIncomeSince currentTime since incomes userId =
+  incomes
+    |> Dict.values
+    |> List.filter (\income -> income.userId == userId)
+    |> cumulativeIncomesSince currentTime since
+
 cumulativeIncomesSince : Time -> Time -> (List Income) -> Int
 cumulativeIncomesSince currentTime since incomes =
   cumulativeIncome currentTime (getOrderedIncomesSince since incomes)
diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm
new file mode 100644
index 0000000..a7ce5fa
--- /dev/null
+++ b/src/client/elm/Model/Payer.elm
@@ -0,0 +1,140 @@
+module Model.Payer
+  ( Payers
+  , Payer
+  , ExceedingPayer
+  , getOrderedExceedingPayers
+  , useIncomesFrom
+  , getPostPaymentPayer
+  ) 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
+      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
+      incomesForAllTime = incomeDefinedForAll (Dict.keys users) incomes
+  in  case (firstPaymentTime, incomesForAllTime) 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)
+
+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