aboutsummaryrefslogtreecommitdiff
path: root/src/client/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/Model')
-rw-r--r--src/client/Model/Config.elm18
-rw-r--r--src/client/Model/Date.elm15
-rw-r--r--src/client/Model/Income.elm76
-rw-r--r--src/client/Model/Payer.elm132
-rw-r--r--src/client/Model/Payment.elm44
-rw-r--r--src/client/Model/Translations.elm69
-rw-r--r--src/client/Model/User.elm44
-rw-r--r--src/client/Model/View.elm12
-rw-r--r--src/client/Model/View/LoggedIn/Account.elm67
-rw-r--r--src/client/Model/View/LoggedIn/Add.elm43
-rw-r--r--src/client/Model/View/LoggedIn/Edition.elm7
-rw-r--r--src/client/Model/View/LoggedIn/Monthly.elm17
-rw-r--r--src/client/Model/View/LoggedInView.elm35
-rw-r--r--src/client/Model/View/SignInView.elm15
14 files changed, 0 insertions, 594 deletions
diff --git a/src/client/Model/Config.elm b/src/client/Model/Config.elm
deleted file mode 100644
index e47b032..0000000
--- a/src/client/Model/Config.elm
+++ /dev/null
@@ -1,18 +0,0 @@
-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/Model/Date.elm b/src/client/Model/Date.elm
deleted file mode 100644
index 1c56de4..0000000
--- a/src/client/Model/Date.elm
+++ /dev/null
@@ -1,15 +0,0 @@
-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/Model/Income.elm b/src/client/Model/Income.elm
deleted file mode 100644
index 97a5652..0000000
--- a/src/client/Model/Income.elm
+++ /dev/null
@@ -1,76 +0,0 @@
-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/Model/Payer.elm b/src/client/Model/Payer.elm
deleted file mode 100644
index 9fd1bb5..0000000
--- a/src/client/Model/Payer.elm
+++ /dev/null
@@ -1,132 +0,0 @@
-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/Model/Payment.elm b/src/client/Model/Payment.elm
deleted file mode 100644
index c4a8963..0000000
--- a/src/client/Model/Payment.elm
+++ /dev/null
@@ -1,44 +0,0 @@
-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/Model/Translations.elm b/src/client/Model/Translations.elm
deleted file mode 100644
index bec8c9b..0000000
--- a/src/client/Model/Translations.elm
+++ /dev/null
@@ -1,69 +0,0 @@
-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/Model/User.elm b/src/client/Model/User.elm
deleted file mode 100644
index 1412913..0000000
--- a/src/client/Model/User.elm
+++ /dev/null
@@ -1,44 +0,0 @@
-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/Model/View.elm b/src/client/Model/View.elm
deleted file mode 100644
index 90c0e53..0000000
--- a/src/client/Model/View.elm
+++ /dev/null
@@ -1,12 +0,0 @@
-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/Model/View/LoggedIn/Account.elm b/src/client/Model/View/LoggedIn/Account.elm
deleted file mode 100644
index 2bb3ae7..0000000
--- a/src/client/Model/View/LoggedIn/Account.elm
+++ /dev/null
@@ -1,67 +0,0 @@
-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/Model/View/LoggedIn/Add.elm b/src/client/Model/View/LoggedIn/Add.elm
deleted file mode 100644
index 5598084..0000000
--- a/src/client/Model/View/LoggedIn/Add.elm
+++ /dev/null
@@ -1,43 +0,0 @@
-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/Model/View/LoggedIn/Edition.elm b/src/client/Model/View/LoggedIn/Edition.elm
deleted file mode 100644
index da6d7b0..0000000
--- a/src/client/Model/View/LoggedIn/Edition.elm
+++ /dev/null
@@ -1,7 +0,0 @@
-module Model.View.LoggedIn.Edition
- ( Edition
- ) where
-
-import Model.Payment exposing (PaymentId)
-
-type alias Edition = PaymentId
diff --git a/src/client/Model/View/LoggedIn/Monthly.elm b/src/client/Model/View/LoggedIn/Monthly.elm
deleted file mode 100644
index 3c6f66a..0000000
--- a/src/client/Model/View/LoggedIn/Monthly.elm
+++ /dev/null
@@ -1,17 +0,0 @@
-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/Model/View/LoggedInView.elm b/src/client/Model/View/LoggedInView.elm
deleted file mode 100644
index 122c4be..0000000
--- a/src/client/Model/View/LoggedInView.elm
+++ /dev/null
@@ -1,35 +0,0 @@
-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/Model/View/SignInView.elm b/src/client/Model/View/SignInView.elm
deleted file mode 100644
index 0fbce39..0000000
--- a/src/client/Model/View/SignInView.elm
+++ /dev/null
@@ -1,15 +0,0 @@
-module Model.View.SignInView
- ( SignInView
- , initSignInView
- ) where
-
-type alias SignInView =
- { login : String
- , result : Maybe (Result String String)
- }
-
-initSignInView : SignInView
-initSignInView =
- { login = ""
- , result = Nothing
- }
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-19 22:26:19 +0000