Using persona to validate emails

1 files changed, 132 insertions, 0 deletions

diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm
new file mode 100644
index 0000000..9fd1bb5
--- /dev/null
+++ b/src/client/elm/Model/Payer.elm
@@ -0,0 +1,132 @@
+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 =
+                payersIncomeDefinedForAll 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 exceedingPayersOnPreIncome =
+        payers
+          |> mapValues .preIncomePaymentSum
+          |> Dict.toList
+          |> exceedingPayersFromAmounts
+  in  case payersIncomeDefinedForAll payers 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
+
+payersIncomeDefinedForAll : Payers -> Maybe Time
+payersIncomeDefinedForAll payers =
+  incomeDefinedForAll (List.map (.incomes << snd) << Dict.toList <| payers)
+
+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