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 +- src/client/elm/Model/Payer.elm | 122 ------------------------------- src/client/elm/View/Date.elm | 59 --------------- src/client/elm/View/Expand.elm | 25 ------- src/client/elm/View/Price.elm | 38 ---------- 12 files changed, 253 insertions(+), 252 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 delete mode 100644 src/client/elm/Model/Payer.elm delete mode 100644 src/client/elm/View/Date.elm delete mode 100644 src/client/elm/View/Expand.elm delete mode 100644 src/client/elm/View/Price.elm 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 = diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm deleted file mode 100644 index 9ae1dfa..0000000 --- a/src/client/elm/Model/Payer.elm +++ /dev/null @@ -1,122 +0,0 @@ -module 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/View/Date.elm b/src/client/elm/View/Date.elm deleted file mode 100644 index 81c5112..0000000 --- a/src/client/elm/View/Date.elm +++ /dev/null @@ -1,59 +0,0 @@ -module 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/View/Expand.elm b/src/client/elm/View/Expand.elm deleted file mode 100644 index 53b4fe5..0000000 --- a/src/client/elm/View/Expand.elm +++ /dev/null @@ -1,25 +0,0 @@ -module 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/View/Price.elm b/src/client/elm/View/Price.elm deleted file mode 100644 index be665a8..0000000 --- a/src/client/elm/View/Price.elm +++ /dev/null @@ -1,38 +0,0 @@ -module 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) -- cgit v1.2.3