Using incomes to compute a fair computation to designate the payer

8 files changed, 260 insertions, 80 deletions

diff --git a/src/client/Model/Date.elm b/src/client/Model/Date.elm
new file mode 100644
index 0000000..1c56de4
--- /dev/null
+++ b/src/client/Model/Date.elm
@@ -0,0 +1,15 @@
+module Model.Date
+  ( timeDecoder
+  , dateDecoder
+  ) where
+
+import Date as Date exposing (Date)
+import Time exposing (Time)
+
+import Json.Decode as Json exposing (..)
+
+timeDecoder : Decoder Time
+timeDecoder = Json.map Date.toTime dateDecoder
+
+dateDecoder : Decoder Date
+dateDecoder = customDecoder string Date.fromString
diff --git a/src/client/Model/Income.elm b/src/client/Model/Income.elm
new file mode 100644
index 0000000..ce30772
--- /dev/null
+++ b/src/client/Model/Income.elm
@@ -0,0 +1,76 @@
+module Model.Income
+  ( Income
+  , incomeDecoder
+  , incomeDefinedForAll
+  , cumulativeIncomesSince
+  ) where
+
+import Json.Decode as Json exposing ((:=))
+import Time exposing (Time, hour)
+import List exposing (..)
+
+import Model.Date exposing (timeDecoder)
+import Model.User exposing (UserId)
+
+import Utils.Maybe exposing (isJust, catMaybes, maybeToList)
+
+type alias Income =
+  { creation : Time
+  , amount : Int
+  }
+
+incomeDecoder : Json.Decoder Income
+incomeDecoder =
+  Json.object2 Income
+    ("creation" := timeDecoder)
+    ("amount" := Json.int)
+
+incomeDefinedForAll : List (UserId, List Income) -> Maybe Time
+incomeDefinedForAll usersIncomes =
+  let firstIncomes = map (head << sortBy .creation << snd) usersIncomes
+  in  if all isJust firstIncomes
+        then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes
+        else Nothing
+
+cumulativeIncomesSince : Time -> Time -> (List Income) -> Int
+cumulativeIncomesSince currentTime since incomes =
+  cumulativeIncome currentTime (getOrderedIncomesSince since incomes)
+
+getOrderedIncomesSince : Time -> List Income -> List Income
+getOrderedIncomesSince time incomes =
+  let mbStarterIncome = getIncomesAt time incomes
+      orderedIncomesSince = filter (\income -> income.creation >= time) incomes
+  in  (maybeToList mbStarterIncome) ++ orderedIncomesSince
+
+getIncomesAt : Time -> List Income -> Maybe Income
+getIncomesAt time incomes =
+  case incomes of
+    [x] ->
+      if x.creation < time
+        then Just { creation = time, amount = x.amount }
+        else Nothing
+    x1 :: x2 :: xs ->
+      if x1.creation < time && x2.creation > time
+        then Just { creation = time, amount = x2.amount }
+        else getIncomesAt time (x2 :: xs)
+    [] ->
+      Nothing
+
+cumulativeIncome : Time -> List Income -> Int
+cumulativeIncome currentTime incomes =
+  getIncomesWithDuration (incomes ++ [{ creation = currentTime, amount = 0 }])
+    |> map durationIncome
+    |> sum
+
+getIncomesWithDuration : List Income -> List (Float, Int)
+getIncomesWithDuration incomes =
+  case incomes of
+    (income1 :: income2 :: xs) ->
+      (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration (income2 :: xs))
+    _ ->
+      []
+
+durationIncome : (Float, Int) -> Int
+durationIncome (duration, income) =
+  duration * toFloat income / (hour * 24 * 365 / 12)
+    |> truncate
diff --git a/src/client/Model/Payer.elm b/src/client/Model/Payer.elm
new file mode 100644
index 0000000..af475bb
--- /dev/null
+++ b/src/client/Model/Payer.elm
@@ -0,0 +1,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
diff --git a/src/client/Model/Payers.elm b/src/client/Model/Payers.elm
deleted file mode 100644
index 983e7b3..0000000
--- a/src/client/Model/Payers.elm
+++ /dev/null
@@ -1,59 +0,0 @@
-module Model.Payers
-  ( Payers
-  , ExceedingPayer
-  , payersDecoder
-  , updatePayers
-  , getOrderedExceedingPayers
-  ) where
-
-import Json.Decode as Json exposing (..)
-import Dict exposing (..)
-import List
-import Maybe
-
-import Model.User exposing (UserId, userIdDecoder)
-
-type alias Payers = Dict UserId Int
-
-payersDecoder : Decoder Payers
-payersDecoder = Json.map Dict.fromList (list payerDecoder)
-
-payerDecoder : Decoder (UserId, Int)
-payerDecoder =
-  object2 (,)
-    ("userId" := userIdDecoder)
-    ("totalPayment" := int)
-
-updatePayers : Payers -> UserId -> Int -> Payers
-updatePayers payers userId amountDiff =
-  Dict.update
-    userId
-    (\mbAmount ->
-      case mbAmount of
-        Just amount -> Just (amount + amountDiff)
-        Nothing -> Nothing
-    )
-    payers
-
-type alias ExceedingPayer =
-  { userId : UserId
-  , amount : Int
-  }
-
-getOrderedExceedingPayers : Payers -> List ExceedingPayer
-getOrderedExceedingPayers payers =
-  let orderedPayers =
-        Dict.toList payers
-          |> List.map (\(userId, amount) -> ExceedingPayer userId amount)
-          |> List.sortBy .amount
-      maybeMinAmount =
-        List.head orderedPayers
-          |> Maybe.map .amount
-  in  case maybeMinAmount of
-        Just minAmount ->
-          orderedPayers
-            |> List.map (\payer -> { payer | amount <- payer.amount - minAmount })
-            |> List.filter (\payer -> payer.amount /= 0)
-            |> List.reverse
-        Nothing ->
-          []
diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm
index 1f1c4ed..c4a8963 100644
--- a/src/client/Model/Payment.elm
+++ b/src/client/Model/Payment.elm
@@ -11,6 +11,7 @@ import Date exposing (..)
 import Json.Decode as Json exposing ((:=))
 
 import Model.User exposing (UserId, userIdDecoder)
+import Model.Date exposing (dateDecoder)
 
 perPage : Int
 perPage = 8
@@ -41,6 +42,3 @@ paymentDecoder =
 
 paymentIdDecoder : Json.Decoder PaymentId
 paymentIdDecoder = Json.int
-
-dateDecoder : Json.Decoder Date
-dateDecoder = Json.customDecoder Json.string Date.fromString
diff --git a/src/client/Model/User.elm b/src/client/Model/User.elm
index b0d62a6..1412913 100644
--- a/src/client/Model/User.elm
+++ b/src/client/Model/User.elm
@@ -25,7 +25,9 @@ usersDecoder = Json.map Dict.fromList (Json.list userWithIdDecoder)
 
 userWithIdDecoder : Json.Decoder (UserId, User)
 userWithIdDecoder =
-  userDecoder `Json.andThen` (\user -> Json.map (\id -> (id, user)) ("id" := userIdDecoder))
+  Json.object2 (,)
+    ("id" := userIdDecoder)
+    userDecoder
 
 userDecoder : Json.Decoder User
 userDecoder =
diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/Model/View/LoggedIn/Account.elm
index 7f0fbe3..ab37b81 100644
--- a/src/client/Model/View/LoggedIn/Account.elm
+++ b/src/client/Model/View/LoggedIn/Account.elm
@@ -3,36 +3,57 @@ module Model.View.LoggedIn.Account
   , IncomeEdition
   , initAccount
   , initIncomeEdition
+  , getCurrentIncome
   , validateIncome
   ) where
 
 import Result as Result exposing (Result(..))
+import Dict
 
 import Utils.Validation exposing (..)
+import Utils.Dict exposing (mapValues)
 
 import Model.Translations exposing (..)
-import Model.Payers exposing (..)
+import Model.Payer exposing (..)
+import Model.User exposing (UserId)
 
 type alias Account =
-  { payers : Payers
-  , income : Maybe Int
+  { me : UserId
+  , payers : Payers
   , visibleDetail : Bool
   , incomeEdition : Maybe IncomeEdition
   }
 
+initAccount : UserId -> Payers -> Account
+initAccount me payers =
+  { me = me
+  , payers =
+      payers
+        |> mapValues
+             (\payer ->
+               { payer | incomes <- List.sortBy .creation payer.incomes }
+             )
+  , visibleDetail = False
+  , incomeEdition = Nothing
+  }
+
+getCurrentIncome : Account -> Maybe Int
+getCurrentIncome account =
+  case Dict.get account.me account.payers of
+    Just payer ->
+      payer.incomes
+        |> List.sortBy .creation
+        |> List.reverse
+        |> List.head
+        |> Maybe.map .amount
+    Nothing ->
+      Nothing
+
 type alias IncomeEdition =
   { income : String
   , error : Maybe String
   }
 
-initAccount : Payers -> Maybe Int -> Account
-initAccount payers income =
-  { payers = payers
-  , income = income
-  , visibleDetail = False
-  , incomeEdition = Nothing
-  }
-
 initIncomeEdition : Int -> IncomeEdition
 initIncomeEdition income =
   { income = toString income
diff --git a/src/client/Model/View/LoggedInView.elm b/src/client/Model/View/LoggedInView.elm
index 12a7294..122c4be 100644
--- a/src/client/Model/View/LoggedInView.elm
+++ b/src/client/Model/View/LoggedInView.elm
@@ -5,7 +5,7 @@ module Model.View.LoggedInView
 
 import Model.User exposing (Users, UserId)
 import Model.Payment exposing (Payments)
-import Model.Payers exposing (Payers)
+import Model.Payer exposing (Payers)
 import Model.View.LoggedIn.Add exposing (..)
 import Model.View.LoggedIn.Edition exposing (..)
 import Model.View.LoggedIn.Monthly exposing (..)
@@ -13,7 +13,6 @@ import Model.View.LoggedIn.Account exposing (..)
 
 type alias LoggedInView =
   { users : Users
-  , me : UserId
   , add : AddPayment
   , monthly : Monthly
   , account : Account
@@ -23,13 +22,12 @@ type alias LoggedInView =
   , currentPage : Int
   }
 
-initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> Maybe Int -> LoggedInView
-initLoggedInView users me monthlyPayments payments paymentsCount payers income =
+initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> LoggedInView
+initLoggedInView users me monthlyPayments payments paymentsCount payers =
   { users = users
-  , me = me
   , add = initAddPayment Punctual
   , monthly = initMonthly monthlyPayments
-  , account = initAccount payers income
+  , account = initAccount me payers
   , payments = payments
   , paymentsCount = paymentsCount
   , paymentEdition = Nothing