Separate client and server watch

1 files changed, 138 insertions, 0 deletions

diff --git a/src/client/Model/Payer.elm b/src/client/Model/Payer.elm
new file mode 100644
index 0000000..1663273
--- /dev/null
+++ b/src/client/Model/Payer.elm
@@ -0,0 +1,138 @@
+module Model.Payer exposing
+  ( Payers
+  , Payer
+  , ExceedingPayer
+  , getOrderedExceedingPayers
+  , useIncomesFrom
+  )
+
+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 << Tuple.second)
+                  |> 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 Tuple.second <| userAmounts
+  in  case mbMinAmount of
+        Nothing ->
+          []
+        Just minAmount ->
+          userAmounts
+            |> List.map (\userAmount ->
+                 { userId = Tuple.first userAmount
+                 , amount = Tuple.second 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