aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm/Model')
-rw-r--r--src/client/elm/Model/Config.elm18
-rw-r--r--src/client/elm/Model/Date.elm15
-rw-r--r--src/client/elm/Model/Income.elm76
-rw-r--r--src/client/elm/Model/Payer.elm132
-rw-r--r--src/client/elm/Model/Payment.elm44
-rw-r--r--src/client/elm/Model/Translations.elm69
-rw-r--r--src/client/elm/Model/User.elm44
-rw-r--r--src/client/elm/Model/View.elm12
-rw-r--r--src/client/elm/Model/View/LoggedIn/Account.elm67
-rw-r--r--src/client/elm/Model/View/LoggedIn/Add.elm43
-rw-r--r--src/client/elm/Model/View/LoggedIn/Edition.elm7
-rw-r--r--src/client/elm/Model/View/LoggedIn/Monthly.elm17
-rw-r--r--src/client/elm/Model/View/LoggedInView.elm35
-rw-r--r--src/client/elm/Model/View/SignInView.elm15
14 files changed, 594 insertions, 0 deletions
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
+ }