diff options
Diffstat (limited to 'src/client/Model')
-rw-r--r-- | src/client/Model/Config.elm | 18 | ||||
-rw-r--r-- | src/client/Model/Date.elm | 15 | ||||
-rw-r--r-- | src/client/Model/Income.elm | 76 | ||||
-rw-r--r-- | src/client/Model/Payer.elm | 132 | ||||
-rw-r--r-- | src/client/Model/Payment.elm | 44 | ||||
-rw-r--r-- | src/client/Model/Translations.elm | 69 | ||||
-rw-r--r-- | src/client/Model/User.elm | 44 | ||||
-rw-r--r-- | src/client/Model/View.elm | 12 | ||||
-rw-r--r-- | src/client/Model/View/LoggedIn/Account.elm | 67 | ||||
-rw-r--r-- | src/client/Model/View/LoggedIn/Add.elm | 43 | ||||
-rw-r--r-- | src/client/Model/View/LoggedIn/Edition.elm | 7 | ||||
-rw-r--r-- | src/client/Model/View/LoggedIn/Monthly.elm | 17 | ||||
-rw-r--r-- | src/client/Model/View/LoggedInView.elm | 35 | ||||
-rw-r--r-- | src/client/Model/View/SignInView.elm | 15 |
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 - } |