From a7db22556b91bc7c499e010b4c051f4442ad8ce2 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 29 Dec 2015 22:38:42 +0100 Subject: Using persona to validate emails --- src/client/elm/Model/Config.elm | 18 ++++ src/client/elm/Model/Date.elm | 15 +++ src/client/elm/Model/Income.elm | 76 ++++++++++++++ src/client/elm/Model/Payer.elm | 132 +++++++++++++++++++++++++ src/client/elm/Model/Payment.elm | 44 +++++++++ src/client/elm/Model/Translations.elm | 69 +++++++++++++ src/client/elm/Model/User.elm | 44 +++++++++ src/client/elm/Model/View.elm | 12 +++ src/client/elm/Model/View/LoggedIn/Account.elm | 67 +++++++++++++ src/client/elm/Model/View/LoggedIn/Add.elm | 43 ++++++++ src/client/elm/Model/View/LoggedIn/Edition.elm | 7 ++ src/client/elm/Model/View/LoggedIn/Monthly.elm | 17 ++++ src/client/elm/Model/View/LoggedInView.elm | 35 +++++++ src/client/elm/Model/View/SignInView.elm | 15 +++ 14 files changed, 594 insertions(+) create mode 100644 src/client/elm/Model/Config.elm create mode 100644 src/client/elm/Model/Date.elm create mode 100644 src/client/elm/Model/Income.elm create mode 100644 src/client/elm/Model/Payer.elm create mode 100644 src/client/elm/Model/Payment.elm create mode 100644 src/client/elm/Model/Translations.elm create mode 100644 src/client/elm/Model/User.elm create mode 100644 src/client/elm/Model/View.elm create mode 100644 src/client/elm/Model/View/LoggedIn/Account.elm create mode 100644 src/client/elm/Model/View/LoggedIn/Add.elm create mode 100644 src/client/elm/Model/View/LoggedIn/Edition.elm create mode 100644 src/client/elm/Model/View/LoggedIn/Monthly.elm create mode 100644 src/client/elm/Model/View/LoggedInView.elm create mode 100644 src/client/elm/Model/View/SignInView.elm (limited to 'src/client/elm/Model') diff --git a/src/client/elm/Model/Config.elm b/src/client/elm/Model/Config.elm new file mode 100644 index 0000000..e47b032 --- /dev/null +++ b/src/client/elm/Model/Config.elm @@ -0,0 +1,18 @@ +module Model.Config + ( Config + , configDecoder + ) where + +import Json.Decode exposing (..) + +type alias Config = + { currency : String + } + +configDecoder : Decoder Config +configDecoder = object1 Config ("currency" := string) + +defaultConfig : Config +defaultConfig = + { currency = "€" + } diff --git a/src/client/elm/Model/Date.elm b/src/client/elm/Model/Date.elm new file mode 100644 index 0000000..1c56de4 --- /dev/null +++ b/src/client/elm/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/elm/Model/Income.elm b/src/client/elm/Model/Income.elm new file mode 100644 index 0000000..97a5652 --- /dev/null +++ b/src/client/elm/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 (List Income) -> Maybe Time +incomeDefinedForAll usersIncomes = + let firstIncomes = map (head << sortBy .creation) 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/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm new file mode 100644 index 0000000..9fd1bb5 --- /dev/null +++ b/src/client/elm/Model/Payer.elm @@ -0,0 +1,132 @@ +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 = + payersIncomeDefinedForAll 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 exceedingPayersOnPreIncome = + payers + |> mapValues .preIncomePaymentSum + |> Dict.toList + |> exceedingPayersFromAmounts + in case payersIncomeDefinedForAll payers 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 + +payersIncomeDefinedForAll : Payers -> Maybe Time +payersIncomeDefinedForAll payers = + incomeDefinedForAll (List.map (.incomes << snd) << Dict.toList <| payers) + +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/Model/Payment.elm b/src/client/elm/Model/Payment.elm new file mode 100644 index 0000000..c4a8963 --- /dev/null +++ b/src/client/elm/Model/Payment.elm @@ -0,0 +1,44 @@ +module Model.Payment + ( perPage + , Payments + , Payment + , PaymentId + , paymentsDecoder + , paymentIdDecoder + ) where + +import Date exposing (..) +import Json.Decode as Json exposing ((:=)) + +import Model.User exposing (UserId, userIdDecoder) +import Model.Date exposing (dateDecoder) + +perPage : Int +perPage = 8 + +type alias Payments = List Payment + +type alias Payment = + { id : PaymentId + , creation : Date + , name : String + , cost : Int + , userId : UserId + } + +type alias PaymentId = Int + +paymentsDecoder : Json.Decoder Payments +paymentsDecoder = Json.list paymentDecoder + +paymentDecoder : Json.Decoder Payment +paymentDecoder = + Json.object5 Payment + ("id" := paymentIdDecoder) + ("creation" := dateDecoder) + ("name" := Json.string) + ("cost" := Json.int) + ("userId" := userIdDecoder) + +paymentIdDecoder : Json.Decoder PaymentId +paymentIdDecoder = Json.int diff --git a/src/client/elm/Model/Translations.elm b/src/client/elm/Model/Translations.elm new file mode 100644 index 0000000..bec8c9b --- /dev/null +++ b/src/client/elm/Model/Translations.elm @@ -0,0 +1,69 @@ +module Model.Translations + ( translationsDecoder + , Translations + , Translation + , getMessage + , getParamMessage + ) where + +import Maybe exposing (withDefault) +import Json.Decode as Json exposing ((:=)) +import String + +type alias Translations = List Translation + +translationsDecoder : Json.Decoder Translations +translationsDecoder = Json.list translationDecoder + +type alias Translation = + { key : String + , message : List MessagePart + } + +getTranslation : String -> Translations -> Maybe (List MessagePart) +getTranslation key translations = + translations + |> List.filter (\translation -> translation.key == key) + |> List.head + |> Maybe.map .message + +translationDecoder : Json.Decoder Translation +translationDecoder = + Json.object2 Translation + ("key" := Json.string) + ("message" := Json.list partDecoder) + +type MessagePart = + Order Int + | Str String + +partDecoder : Json.Decoder MessagePart +partDecoder = + ("tag" := Json.string) `Json.andThen` partDecoderWithTag + +partDecoderWithTag : String -> Json.Decoder MessagePart +partDecoderWithTag tag = + case tag of + "Order" -> Json.object1 Order ("contents" := Json.int) + "Str" -> Json.object1 Str ("contents" := Json.string) + +----- + +getMessage : String -> Translations -> String +getMessage = getParamMessage [] + +getParamMessage : List String -> String -> Translations -> String +getParamMessage values key translations = + getTranslation key translations + |> Maybe.map (\parts -> String.concat (List.map (replacePart values) parts)) + |> withDefault key + +replacePart : List String -> MessagePart -> String +replacePart values part = + case part of + Str str -> str + Order n -> + values + |> List.drop (n - 1) + |> List.head + |> withDefault ("{" ++ (toString n) ++ "}") diff --git a/src/client/elm/Model/User.elm b/src/client/elm/Model/User.elm new file mode 100644 index 0000000..1412913 --- /dev/null +++ b/src/client/elm/Model/User.elm @@ -0,0 +1,44 @@ +module Model.User + ( Users + , usersDecoder + , User + , userDecoder + , UserId + , userIdDecoder + , getUserName + ) where + +import Json.Decode as Json exposing ((:=)) +import Dict exposing (Dict) + +type alias Users = Dict UserId User + +type alias UserId = Int + +type alias User = + { name : String + , email : String + } + +usersDecoder : Json.Decoder Users +usersDecoder = Json.map Dict.fromList (Json.list userWithIdDecoder) + +userWithIdDecoder : Json.Decoder (UserId, User) +userWithIdDecoder = + Json.object2 (,) + ("id" := userIdDecoder) + userDecoder + +userDecoder : Json.Decoder User +userDecoder = + Json.object2 User + ("name" := Json.string) + ("email" := Json.string) + +userIdDecoder : Json.Decoder UserId +userIdDecoder = Json.int + +getUserName : Users -> UserId -> Maybe String +getUserName users userId = + Dict.get userId users + |> Maybe.map .name diff --git a/src/client/elm/Model/View.elm b/src/client/elm/Model/View.elm new file mode 100644 index 0000000..90c0e53 --- /dev/null +++ b/src/client/elm/Model/View.elm @@ -0,0 +1,12 @@ +module Model.View + ( View(..) + ) where + +import Model.Payment exposing (Payments) +import Model.View.SignInView exposing (..) +import Model.View.LoggedInView exposing (..) + +type View = + LoadingView + | SignInView SignInView + | LoggedInView LoggedInView diff --git a/src/client/elm/Model/View/LoggedIn/Account.elm b/src/client/elm/Model/View/LoggedIn/Account.elm new file mode 100644 index 0000000..2bb3ae7 --- /dev/null +++ b/src/client/elm/Model/View/LoggedIn/Account.elm @@ -0,0 +1,67 @@ +module Model.View.LoggedIn.Account + ( 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.Payer exposing (..) +import Model.User exposing (UserId) + +type alias Account = + { 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 + } + +initIncomeEdition : Int -> IncomeEdition +initIncomeEdition income = + { income = toString income + , error = Nothing + } + +validateIncome : String -> Translations -> Result String Int +validateIncome amount translations = + amount + |> validateNonEmpty (getMessage "IncomeRequired" translations) + |> flip Result.andThen (validateNumber (getMessage "IncomeMustBePositiveNumber" translations) (\number -> number > 0)) diff --git a/src/client/elm/Model/View/LoggedIn/Add.elm b/src/client/elm/Model/View/LoggedIn/Add.elm new file mode 100644 index 0000000..5598084 --- /dev/null +++ b/src/client/elm/Model/View/LoggedIn/Add.elm @@ -0,0 +1,43 @@ +module Model.View.LoggedIn.Add + ( AddPayment + , Frequency(..) + , initAddPayment + , validateName + , validateCost + ) where + +import Result as Result exposing (Result(..)) + +import Utils.Validation exposing (..) + +import Model.Translations exposing (..) + +type alias AddPayment = + { name : String + , nameError : Maybe String + , cost : String + , costError : Maybe String + , frequency : Frequency + } + +initAddPayment : Frequency -> AddPayment +initAddPayment frequency = + { name = "" + , nameError = Nothing + , cost = "" + , costError = Nothing + , frequency = frequency + } + +validateName : String -> Translations -> Result String String +validateName name translations = + name + |> validateNonEmpty (getMessage "CategoryRequired" translations) + +validateCost : String -> Translations -> Result String Int +validateCost cost translations = + cost + |> validateNonEmpty (getMessage "CostRequired" translations) + |> flip Result.andThen (validateNumber (getMessage "CostMustBeNonNullNumber" translations) ((/=) 0)) + +type Frequency = Punctual | Monthly diff --git a/src/client/elm/Model/View/LoggedIn/Edition.elm b/src/client/elm/Model/View/LoggedIn/Edition.elm new file mode 100644 index 0000000..da6d7b0 --- /dev/null +++ b/src/client/elm/Model/View/LoggedIn/Edition.elm @@ -0,0 +1,7 @@ +module Model.View.LoggedIn.Edition + ( Edition + ) where + +import Model.Payment exposing (PaymentId) + +type alias Edition = PaymentId diff --git a/src/client/elm/Model/View/LoggedIn/Monthly.elm b/src/client/elm/Model/View/LoggedIn/Monthly.elm new file mode 100644 index 0000000..3c6f66a --- /dev/null +++ b/src/client/elm/Model/View/LoggedIn/Monthly.elm @@ -0,0 +1,17 @@ +module Model.View.LoggedIn.Monthly + ( Monthly + , initMonthly + ) where + +import Model.Payment exposing (Payments) + +type alias Monthly = + { payments : Payments + , visibleDetail : Bool + } + +initMonthly : Payments -> Monthly +initMonthly payments = + { payments = payments + , visibleDetail = False + } diff --git a/src/client/elm/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm new file mode 100644 index 0000000..122c4be --- /dev/null +++ b/src/client/elm/Model/View/LoggedInView.elm @@ -0,0 +1,35 @@ +module Model.View.LoggedInView + ( LoggedInView + , initLoggedInView + ) where + +import Model.User exposing (Users, UserId) +import Model.Payment exposing (Payments) +import Model.Payer exposing (Payers) +import Model.View.LoggedIn.Add exposing (..) +import Model.View.LoggedIn.Edition exposing (..) +import Model.View.LoggedIn.Monthly exposing (..) +import Model.View.LoggedIn.Account exposing (..) + +type alias LoggedInView = + { users : Users + , add : AddPayment + , monthly : Monthly + , account : Account + , payments : Payments + , paymentsCount : Int + , paymentEdition : Maybe Edition + , currentPage : Int + } + +initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> LoggedInView +initLoggedInView users me monthlyPayments payments paymentsCount payers = + { users = users + , add = initAddPayment Punctual + , monthly = initMonthly monthlyPayments + , account = initAccount me payers + , payments = payments + , paymentsCount = paymentsCount + , paymentEdition = Nothing + , currentPage = 1 + } diff --git a/src/client/elm/Model/View/SignInView.elm b/src/client/elm/Model/View/SignInView.elm new file mode 100644 index 0000000..0fbce39 --- /dev/null +++ b/src/client/elm/Model/View/SignInView.elm @@ -0,0 +1,15 @@ +module Model.View.SignInView + ( SignInView + , initSignInView + ) where + +type alias SignInView = + { login : String + , result : Maybe (Result String String) + } + +initSignInView : SignInView +initSignInView = + { login = "" + , result = Nothing + } -- cgit v1.2.3