Move view and models files

8 files changed, 253 insertions, 8 deletions

diff --git a/src/client/elm/LoggedIn/Account/View.elm b/src/client/elm/LoggedIn/Account/View.elm
index d074c41..5d96da6 100644
--- a/src/client/elm/LoggedIn/Account/View.elm
+++ b/src/client/elm/LoggedIn/Account/View.elm
@@ -12,18 +12,18 @@ import Html.Events exposing (..)
 
 import LoggedIn.Action as LoggedInAction
 import LoggedIn.Model as LoggedInModel
+import LoggedIn.Model.Payer exposing (..)
+import LoggedIn.View.Price exposing (price)
+import LoggedIn.View.Expand exposing (..)
 
 import LoggedIn.Account.Action as AccountAction
 import LoggedIn.Account.Model as AccountModel
 
 import Model exposing (Model)
 import Model.User exposing (getUserName)
-import Model.Payer exposing (..)
 import Model.Translations exposing (getParamMessage, getMessage)
 import Action exposing (..)
 
-import View.Expand exposing (..)
-import View.Price exposing (price)
 import View.Events exposing (onSubmitPrevDefault)
 
 import Utils.Either exposing (toMaybeError)
diff --git a/src/client/elm/LoggedIn/Model.elm b/src/client/elm/LoggedIn/Model.elm
index a268afc..4d85e68 100644
--- a/src/client/elm/LoggedIn/Model.elm
+++ b/src/client/elm/LoggedIn/Model.elm
@@ -3,9 +3,10 @@ module LoggedIn.Model
   , init
   ) where
 
+import LoggedIn.Model.Payer exposing (Payers)
+
 import Model.User exposing (Users, UserId)
 import Model.Payment exposing (PaymentId, Payments, PaymentFrequency(..))
-import Model.Payer exposing (Payers)
 import Model.Init exposing (..)
 
 import LoggedIn.Account.Model as AccountModel
diff --git a/src/client/elm/LoggedIn/Model/Payer.elm b/src/client/elm/LoggedIn/Model/Payer.elm
new file mode 100644
index 0000000..9242610
--- /dev/null
+++ b/src/client/elm/LoggedIn/Model/Payer.elm
@@ -0,0 +1,122 @@
+module LoggedIn.Model.Payer
+  ( Payers
+  , Payer
+  , ExceedingPayer
+  , getOrderedExceedingPayers
+  ) 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
+  in  case incomeDefinedForAll (Dict.keys users) incomes 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
+        Nothing ->
+          exceedingPayersOnPreIncome
+
+getPayers : Time -> Users -> Incomes -> Payments -> Payers
+getPayers currentTime users incomes payments =
+  let incomesDefined = incomeDefinedForAll (Dict.keys users) incomes
+  in  Dict.keys users
+        |> 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
diff --git a/src/client/elm/LoggedIn/Monthly/View.elm b/src/client/elm/LoggedIn/Monthly/View.elm
index 6fc90b2..f4ae2c9 100644
--- a/src/client/elm/LoggedIn/Monthly/View.elm
+++ b/src/client/elm/LoggedIn/Monthly/View.elm
@@ -11,6 +11,8 @@ import Html.Events exposing (..)
 
 import LoggedIn.Action as LoggedInAction
 import LoggedIn.Model as LoggedInModel
+import LoggedIn.View.Price exposing (price)
+import LoggedIn.View.Expand exposing (..)
 
 import LoggedIn.Monthly.Action as MonthlyAction
 import LoggedIn.Monthly.Model as MonthlyModel
@@ -21,8 +23,6 @@ import Model.Translations exposing (getMessage, getParamMessage)
 import Action exposing (..)
 
 import View.Icon exposing (renderIcon)
-import View.Expand exposing (..)
-import View.Price exposing (price)
 
 view : Address Action -> Model -> LoggedInModel.Model -> Html
 view address model loggedInModel =
diff --git a/src/client/elm/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/View/Date.elm
new file mode 100644
index 0000000..62c8be5
--- /dev/null
+++ b/src/client/elm/LoggedIn/View/Date.elm
@@ -0,0 +1,59 @@
+module LoggedIn.View.Date
+  ( renderShortDate
+  , renderLongDate
+  ) where
+
+import Date exposing (..)
+import String
+
+import Model.Translations exposing (..)
+
+renderShortDate : Date -> Translations -> String
+renderShortDate date translations =
+  let params =
+        [ String.pad 2 '0' (toString (Date.day date))
+        , String.pad 2 '0' (toString (getMonthNumber (Date.month date)))
+        , toString (Date.year date)
+        ]
+  in  getParamMessage params "ShortDate" translations
+
+renderLongDate : Date -> Translations -> String
+renderLongDate date translations =
+  let params =
+        [ toString (Date.day date)
+        , (getMessage (getMonthKey (Date.month date)) translations)
+        , toString (Date.year date)
+        ]
+  in  getParamMessage params "LongDate" translations
+
+getMonthNumber : Month -> Int
+getMonthNumber month =
+  case month of
+    Jan -> 1
+    Feb -> 2
+    Mar -> 3
+    Apr -> 4
+    May -> 5
+    Jun -> 6
+    Jul -> 7
+    Aug -> 8
+    Sep -> 9
+    Oct -> 10
+    Nov -> 11
+    Dec -> 12
+
+getMonthKey : Month -> String
+getMonthKey month =
+  case month of
+    Jan -> "January"
+    Feb -> "February"
+    Mar -> "March"
+    Apr -> "April"
+    May -> "May"
+    Jun -> "June"
+    Jul -> "July"
+    Aug -> "August"
+    Sep -> "September"
+    Oct -> "October"
+    Nov -> "November"
+    Dec -> "December"
diff --git a/src/client/elm/LoggedIn/View/Expand.elm b/src/client/elm/LoggedIn/View/Expand.elm
new file mode 100644
index 0000000..1055c1b
--- /dev/null
+++ b/src/client/elm/LoggedIn/View/Expand.elm
@@ -0,0 +1,25 @@
+module LoggedIn.View.Expand
+  ( expand
+  , ExpandType(..)
+  ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+
+import View.Icon exposing (renderIcon)
+
+type ExpandType = ExpandUp | ExpandDown
+
+expand : ExpandType -> Bool -> Html
+expand expandType isExpanded =
+  div
+    [ class "expand" ]
+    [ renderIcon (chevronIcon expandType isExpanded) ]
+
+chevronIcon : ExpandType -> Bool -> String
+chevronIcon expandType isExpanded =
+  case (expandType, isExpanded) of
+    (ExpandUp, True)    -> "chevron-down"
+    (ExpandUp, False)   -> "chevron-up"
+    (ExpandDown, True)  -> "chevron-up"
+    (ExpandDown, False) -> "chevron-down"
diff --git a/src/client/elm/LoggedIn/View/Price.elm b/src/client/elm/LoggedIn/View/Price.elm
new file mode 100644
index 0000000..e8b4c58
--- /dev/null
+++ b/src/client/elm/LoggedIn/View/Price.elm
@@ -0,0 +1,38 @@
+module LoggedIn.View.Price
+  ( price
+  ) where
+
+import String exposing (..)
+
+import Model exposing (Model)
+import Model.Translations exposing (getMessage)
+
+price : Model -> Int -> String
+price model amount =
+  (  formatInt amount
+  ++ " "
+  ++ model.conf.currency
+  )
+
+formatInt : Int -> String
+formatInt n =
+  abs n
+    |> toString
+    |> toList
+    |> List.reverse
+    |> group 3
+    |> List.intersperse [' ']
+    |> List.concat
+    |> List.reverse
+    |> fromList
+    |> append (if n < 0 then "-" else "")
+
+group : Int -> List a -> List (List a)
+group n xs =
+  if List.length xs <= n
+    then
+      [xs]
+    else
+      let take = List.take n xs
+          drop = List.drop n xs
+      in  take :: (group n drop)
diff --git a/src/client/elm/LoggedIn/View/Table.elm b/src/client/elm/LoggedIn/View/Table.elm
index 7a156af..57167be 100644
--- a/src/client/elm/LoggedIn/View/Table.elm
+++ b/src/client/elm/LoggedIn/View/Table.elm
@@ -13,6 +13,8 @@ import Html.Events exposing (..)
 
 import LoggedIn.Action as LoggedInAction
 import LoggedIn.Model as LoggedInModel
+import LoggedIn.View.Date exposing (..)
+import LoggedIn.View.Price exposing (price)
 
 import Model exposing (Model)
 import Model.User exposing (getUserName)
@@ -21,8 +23,6 @@ import Model.Translations exposing (getMessage)
 import Action exposing (..)
 
 import View.Icon exposing (renderIcon)
-import View.Date exposing (..)
-import View.Price exposing (price)
 
 paymentsTable : Address Action -> Model -> LoggedInModel.Model -> Html
 paymentsTable address model loggedInModel =