aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/LoggedIn
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm/LoggedIn')
-rw-r--r--src/client/elm/LoggedIn/Account/View.elm6
-rw-r--r--src/client/elm/LoggedIn/Model.elm3
-rw-r--r--src/client/elm/LoggedIn/Model/Payer.elm122
-rw-r--r--src/client/elm/LoggedIn/Monthly/View.elm4
-rw-r--r--src/client/elm/LoggedIn/View/Date.elm59
-rw-r--r--src/client/elm/LoggedIn/View/Expand.elm25
-rw-r--r--src/client/elm/LoggedIn/View/Price.elm38
-rw-r--r--src/client/elm/LoggedIn/View/Table.elm4
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 =
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 05:26:59 +0000