From b0d80a5458d7ba4546e5f01f5b6398ea6d23f981 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 27 Mar 2016 21:59:46 +0200 Subject: Move view and models files --- src/client/elm/LoggedIn/Account/View.elm | 6 +- src/client/elm/LoggedIn/Model.elm | 3 +- src/client/elm/LoggedIn/Model/Payer.elm | 122 +++++++++++++++++++++++++++++++ src/client/elm/LoggedIn/Monthly/View.elm | 4 +- src/client/elm/LoggedIn/View/Date.elm | 59 +++++++++++++++ src/client/elm/LoggedIn/View/Expand.elm | 25 +++++++ src/client/elm/LoggedIn/View/Price.elm | 38 ++++++++++ src/client/elm/LoggedIn/View/Table.elm | 4 +- 8 files changed, 253 insertions(+), 8 deletions(-) create mode 100644 src/client/elm/LoggedIn/Model/Payer.elm create mode 100644 src/client/elm/LoggedIn/View/Date.elm create mode 100644 src/client/elm/LoggedIn/View/Expand.elm create mode 100644 src/client/elm/LoggedIn/View/Price.elm (limited to 'src/client/elm/LoggedIn') 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 = -- cgit v1.2.3