From 1e47a7754ca38bd1a6c74765d8378caf68ce4619 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 26 Mar 2017 21:10:42 +0200 Subject: Separate client and server watch --- src/client/Model/Category.elm | 35 +++++++++ src/client/Model/Conf.elm | 13 ++++ src/client/Model/Date.elm | 15 ++++ src/client/Model/Income.elm | 102 +++++++++++++++++++++++++ src/client/Model/Init.elm | 31 ++++++++ src/client/Model/InitResult.elm | 28 +++++++ src/client/Model/Payer.elm | 138 +++++++++++++++++++++++++++++++++ src/client/Model/Payment.elm | 143 +++++++++++++++++++++++++++++++++++ src/client/Model/PaymentCategory.elm | 48 ++++++++++++ src/client/Model/Size.elm | 17 +++++ src/client/Model/Translations.elm | 68 +++++++++++++++++ src/client/Model/User.elm | 44 +++++++++++ src/client/Model/View.elm | 12 +++ 13 files changed, 694 insertions(+) create mode 100644 src/client/Model/Category.elm create mode 100644 src/client/Model/Conf.elm create mode 100644 src/client/Model/Date.elm create mode 100644 src/client/Model/Income.elm create mode 100644 src/client/Model/Init.elm create mode 100644 src/client/Model/InitResult.elm create mode 100644 src/client/Model/Payer.elm create mode 100644 src/client/Model/Payment.elm create mode 100644 src/client/Model/PaymentCategory.elm create mode 100644 src/client/Model/Size.elm create mode 100644 src/client/Model/Translations.elm create mode 100644 src/client/Model/User.elm create mode 100644 src/client/Model/View.elm (limited to 'src/client/Model') diff --git a/src/client/Model/Category.elm b/src/client/Model/Category.elm new file mode 100644 index 0000000..8b653a7 --- /dev/null +++ b/src/client/Model/Category.elm @@ -0,0 +1,35 @@ +module Model.Category exposing + ( Categories + , Category + , CategoryId + , categoriesDecoder + , categoryIdDecoder + , empty + ) + +import Json.Decode as Decode exposing (Decoder) +import Utils.Json as Json +import Dict exposing (Dict) + +type alias Categories = Dict CategoryId Category + +type alias CategoryId = Int + +type alias Category = + { name : String + , color : String + } + +categoriesDecoder : Decoder Categories +categoriesDecoder = + Json.dictDecoder (Decode.field "id" categoryIdDecoder) <| + Decode.map2 + Category + (Decode.field "name" Decode.string) + (Decode.field "color" Decode.string) + +categoryIdDecoder : Decoder CategoryId +categoryIdDecoder = Decode.int + +empty : Categories +empty = Dict.empty diff --git a/src/client/Model/Conf.elm b/src/client/Model/Conf.elm new file mode 100644 index 0000000..308fa04 --- /dev/null +++ b/src/client/Model/Conf.elm @@ -0,0 +1,13 @@ +module Model.Conf exposing + ( Conf + , confDecoder + ) + +import Json.Decode as Decode exposing (Decoder) + +type alias Conf = + { currency : String + } + +confDecoder : Decoder Conf +confDecoder = Decode.map Conf (Decode.field "currency" Decode.string) diff --git a/src/client/Model/Date.elm b/src/client/Model/Date.elm new file mode 100644 index 0000000..bfba02f --- /dev/null +++ b/src/client/Model/Date.elm @@ -0,0 +1,15 @@ +module Model.Date exposing + ( timeDecoder + , dateDecoder + ) + +import Date as Date exposing (Date) +import Json.Decode as Decode exposing (Decoder) +import Json.Decode.Extra as Decode +import Time exposing (Time) + +timeDecoder : Decoder Time +timeDecoder = Decode.map Date.toTime dateDecoder + +dateDecoder : Decoder Date +dateDecoder = Decode.string |> Decode.andThen (Date.fromString >> Decode.fromResult) diff --git a/src/client/Model/Income.elm b/src/client/Model/Income.elm new file mode 100644 index 0000000..34578c6 --- /dev/null +++ b/src/client/Model/Income.elm @@ -0,0 +1,102 @@ +module Model.Income exposing + ( Incomes + , Income + , IncomeId + , incomesDecoder + , incomeIdDecoder + , incomeDefinedForAll + , userCumulativeIncomeSince + , cumulativeIncomesSince + ) + +import Json.Decode as Decode exposing (Decoder) +import Utils.Json as Json +import Time exposing (Time, hour) +import List exposing (..) +import Dict exposing (Dict) + +import Model.Date exposing (timeDecoder) +import Model.User exposing (UserId, userIdDecoder) + +import Utils.Maybe as Maybe + +type alias Incomes = Dict IncomeId Income + +type alias IncomeId = Int + +type alias Income = + { userId : UserId + , time : Float + , amount : Int + } + +incomesDecoder : Decoder Incomes +incomesDecoder = + Json.dictDecoder (Decode.field "id" incomeIdDecoder) <| + Decode.map3 Income + (Decode.field "userId" userIdDecoder) + (Decode.field "date" timeDecoder) + (Decode.field "amount" Decode.int) + +incomeIdDecoder : Decoder IncomeId +incomeIdDecoder = Decode.int + +incomeDefinedForAll : List UserId -> Incomes -> Maybe Time +incomeDefinedForAll userIds incomes = + let userIncomes = List.map (\userId -> List.filter ((==) userId << .userId) << Dict.values <| incomes) userIds + firstIncomes = map (head << sortBy .time) userIncomes + in if all Maybe.isJust firstIncomes + then head << reverse << List.sort << map .time << Maybe.cat <| firstIncomes + else Nothing + +userCumulativeIncomeSince : Time -> Time -> Incomes -> UserId -> Int +userCumulativeIncomeSince currentTime since incomes userId = + incomes + |> Dict.values + |> List.filter (\income -> income.userId == userId) + |> cumulativeIncomesSince currentTime since + +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 = getIncomeAt time incomes + orderedIncomesSince = filter (\income -> income.time >= time) incomes + in (Maybe.toList mbStarterIncome) ++ orderedIncomesSince + +getIncomeAt : Time -> List Income -> Maybe Income +getIncomeAt time incomes = + case incomes of + [x] -> + if x.time < time + then Just { userId = x.userId, time = time, amount = x.amount } + else Nothing + x1 :: x2 :: xs -> + if x1.time < time && x2.time >= time + then Just { userId = x1.userId, time = time, amount = x1.amount } + else getIncomeAt time (x2 :: xs) + [] -> + Nothing + +cumulativeIncome : Time -> List Income -> Int +cumulativeIncome currentTime incomes = + getIncomesWithDuration currentTime (List.sortBy .time incomes) + |> map durationIncome + |> sum + +getIncomesWithDuration : Time -> List Income -> List (Float, Int) +getIncomesWithDuration currentTime incomes = + case incomes of + [] -> + [] + [income] -> + [(currentTime - income.time, income.amount)] + (income1 :: income2 :: xs) -> + (income2.time - income1.time, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs)) + +durationIncome : (Float, Int) -> Int +durationIncome (duration, income) = + duration * toFloat income / (hour * 24 * 365 / 12) + |> truncate diff --git a/src/client/Model/Init.elm b/src/client/Model/Init.elm new file mode 100644 index 0000000..db7069f --- /dev/null +++ b/src/client/Model/Init.elm @@ -0,0 +1,31 @@ +module Model.Init exposing + ( Init + , initDecoder + ) + +import Json.Decode as Decode exposing (Decoder) + +import Model.Payment exposing (Payments, paymentsDecoder) +import Model.User exposing (Users, UserId, usersDecoder, userIdDecoder) +import Model.Income exposing (Incomes, incomesDecoder) +import Model.Category exposing (Categories, categoriesDecoder) +import Model.PaymentCategory exposing (PaymentCategories, paymentCategoriesDecoder) + +type alias Init = + { users : Users + , me : UserId + , payments : Payments + , incomes : Incomes + , categories : Categories + , paymentCategories : PaymentCategories + } + +initDecoder : Decoder Init +initDecoder = + Decode.map6 Init + (Decode.field "users" usersDecoder) + (Decode.field "me" userIdDecoder) + (Decode.field "payments" paymentsDecoder) + (Decode.field "incomes" incomesDecoder) + (Decode.field "categories" categoriesDecoder) + (Decode.field "paymentCategories" paymentCategoriesDecoder) diff --git a/src/client/Model/InitResult.elm b/src/client/Model/InitResult.elm new file mode 100644 index 0000000..7ce0be2 --- /dev/null +++ b/src/client/Model/InitResult.elm @@ -0,0 +1,28 @@ +module Model.InitResult exposing + ( InitResult(..) + , initResultDecoder + ) + +import Json.Decode as Decode exposing (Decoder) + +import Model.Init exposing (Init, initDecoder) + +type InitResult = + InitEmpty + | InitSuccess Init + | InitError String + +initResultDecoder : Decoder InitResult +initResultDecoder = (Decode.field "tag" Decode.string) |> Decode.andThen initResultDecoderWithTag + +initResultDecoderWithTag : String -> Decoder InitResult +initResultDecoderWithTag tag = + case tag of + "InitEmpty" -> + Decode.succeed InitEmpty + "InitSuccess" -> + Decode.map InitSuccess (Decode.field "contents" initDecoder) + "InitError" -> + Decode.map InitError (Decode.field "contents" Decode.string) + _ -> + Decode.fail <| "got " ++ tag ++ " for InitResult" diff --git a/src/client/Model/Payer.elm b/src/client/Model/Payer.elm new file mode 100644 index 0000000..1663273 --- /dev/null +++ b/src/client/Model/Payer.elm @@ -0,0 +1,138 @@ +module Model.Payer exposing + ( Payers + , Payer + , ExceedingPayer + , getOrderedExceedingPayers + , useIncomesFrom + ) + +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 PostPaymentPayer = + { preIncomePaymentSum : Int + , cumulativeIncome : Int + , ratio : Float + } + +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 + mbSince = useIncomesFrom users incomes payments + in case mbSince of + Just since -> + let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers + mbMaxRatio = + postPaymentPayers + |> Dict.toList + |> List.map (.ratio << Tuple.second) + |> List.maximum + in case mbMaxRatio of + Just maxRatio -> + postPaymentPayers + |> mapValues (getFinalDiff maxRatio) + |> Dict.toList + |> exceedingPayersFromAmounts + Nothing -> + exceedingPayersOnPreIncome + _ -> + exceedingPayersOnPreIncome + +useIncomesFrom : Users -> Incomes -> Payments -> Maybe Time +useIncomesFrom users incomes payments = + let firstPaymentTime = + payments + |> List.map (Date.toTime << .date) + |> List.sort + |> List.head + mbIncomeTime = incomeDefinedForAll (Dict.keys users) incomes + in case (firstPaymentTime, mbIncomeTime) of + (Just paymentTime, Just incomeTime) -> + Just (max paymentTime incomeTime) + _ -> + Nothing + +getPayers : Time -> Users -> Incomes -> Payments -> Payers +getPayers currentTime users incomes payments = + let userIds = Dict.keys users + incomesDefined = incomeDefinedForAll userIds incomes + in userIds + |> List.map (\userId -> + ( userId + , { preIncomePaymentSum = + totalPayments + (\p -> (Date.toTime p.date) < (Maybe.withDefault currentTime incomesDefined)) + userId + payments + , postIncomePaymentSum = + totalPayments + (\p -> + case incomesDefined of + Nothing -> False + Just t -> (Date.toTime p.date) >= 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 Tuple.second <| userAmounts + in case mbMinAmount of + Nothing -> + [] + Just minAmount -> + userAmounts + |> List.map (\userAmount -> + { userId = Tuple.first userAmount + , amount = Tuple.second userAmount - minAmount + } + ) + |> List.filter (\payer -> payer.amount > 0) + +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 new file mode 100644 index 0000000..f61ded8 --- /dev/null +++ b/src/client/Model/Payment.elm @@ -0,0 +1,143 @@ +module Model.Payment exposing + ( perPage + , Payments + , Payment + , PaymentId + , Frequency(..) + , paymentsDecoder + , paymentIdDecoder + , find + , edit + , delete + , totalPayments + , punctual + , monthly + , groupAndSortByMonth + , search + , validateFrequency + ) + +import Date exposing (..) +import Date.Extra.Core exposing (monthToInt, intToMonth) +import Json.Decode as Decode exposing (Decoder) +import Json.Decode.Extra as Decode +import List + +import Form.Validate as Validate exposing (Validation) +import Model.Date exposing (dateDecoder) +import Model.User exposing (UserId, userIdDecoder) + +import Utils.List as List +import Utils.Search as Search + +perPage : Int +perPage = 7 + +type alias Payments = List Payment + +type alias Payment = + { id : PaymentId + , name : String + , cost : Int + , date : Date + , userId : UserId + , frequency : Frequency + } + +type alias PaymentId = Int + +type Frequency = Punctual | Monthly + +paymentsDecoder : Decoder Payments +paymentsDecoder = Decode.list paymentDecoder + +paymentDecoder : Decoder Payment +paymentDecoder = + Decode.map6 Payment + (Decode.field "id" paymentIdDecoder) + (Decode.field "name" Decode.string) + (Decode.field "cost" Decode.int) + (Decode.field "date" dateDecoder) + (Decode.field "userId" userIdDecoder) + (Decode.field "frequency" frequencyDecoder) + +paymentIdDecoder : Decoder PaymentId +paymentIdDecoder = Decode.int + +frequencyDecoder : Decoder Frequency +frequencyDecoder = + let frequencyResult input = + case input of + "Punctual" -> Ok Punctual + "Monthly" -> Ok Monthly + _ -> Err ("Could not deduce Punctual nor Monthly from " ++ input) + in Decode.string |> Decode.andThen (Decode.fromResult << frequencyResult) + +find : PaymentId -> Payments -> Maybe Payment +find paymentId payments = + payments + |> List.filter (\p -> p.id == paymentId) + |> List.head + +edit : Payment -> Payments -> Payments +edit payment payments = payment :: delete payment.id payments + +delete : PaymentId -> Payments -> Payments +delete paymentId = List.filter (((/=) paymentId) << .id) + +totalPayments : (Payment -> Bool) -> UserId -> Payments -> Int +totalPayments paymentFilter userId payments = + payments + |> List.filter (\payment -> + paymentFilter payment + && payment.userId == userId + ) + |> List.map .cost + |> List.sum + +punctual : Payments -> Payments +punctual = List.filter ((==) Punctual << .frequency) + +monthly : Payments -> Payments +monthly = List.filter ((==) Monthly << .frequency) + +groupAndSortByMonth : Payments -> List ((Month, Int), Payments) +groupAndSortByMonth payments = + payments + |> List.groupBy (\payment -> (Date.year payment.date, monthToInt << Date.month <| payment.date)) + |> List.sortBy Tuple.first + |> List.map (\((year, month), payments) -> ((intToMonth month, year), payments)) + |> List.reverse + +search : String -> Frequency -> Payments -> Payments +search name frequency payments = + payments + |> List.filter ((==) frequency << .frequency) + |> paymentSort frequency + |> List.filter (searchSuccess name) + +paymentSort : Frequency -> Payments -> Payments +paymentSort frequency = + case frequency of + Punctual -> List.reverse << List.sortBy (Date.toTime << .date) + Monthly -> List.sortBy (String.toLower << .name) + +searchSuccess : String -> Payment -> Bool +searchSuccess search { name, cost } = + let searchSuccessWord word = + ( String.contains (Search.format word) (Search.format name) + || String.contains word (toString cost) + ) + in List.all searchSuccessWord (String.words search) + +validateFrequency : Validation String Frequency +validateFrequency = + Validate.customValidation Validate.string (\str -> + if str == toString Punctual + then + Ok Punctual + else + if str == toString Monthly + then Ok Monthly + else Err (Validate.customError "InvalidFrequency") + ) diff --git a/src/client/Model/PaymentCategory.elm b/src/client/Model/PaymentCategory.elm new file mode 100644 index 0000000..87678fe --- /dev/null +++ b/src/client/Model/PaymentCategory.elm @@ -0,0 +1,48 @@ +module Model.PaymentCategory exposing + ( PaymentCategories + , paymentCategoriesDecoder + , search + , isCategoryUnused + , set + , update + ) + +import Dict exposing (Dict) +import Json.Decode as Decode exposing (Decoder) + +import Model.Category exposing (CategoryId, categoryIdDecoder) +import Utils.Json as Json +import Utils.Search as Search + +type alias PaymentCategories = List PaymentCategory + +type alias PaymentCategory = + { name : String + , category : CategoryId + } + +paymentCategoriesDecoder : Decoder PaymentCategories +paymentCategoriesDecoder = + Decode.list <| Decode.map2 PaymentCategory + (Decode.field "name" Decode.string) + (Decode.field "category" categoryIdDecoder) + +search : String -> PaymentCategories -> Maybe CategoryId +search paymentName paymentCategories = + paymentCategories + |> List.filter (\pc -> Search.format pc.name == Search.format paymentName) + |> List.head + |> Maybe.map .category + +isCategoryUnused : CategoryId -> PaymentCategories -> Bool +isCategoryUnused category paymentCategories = + paymentCategories + |> List.filter ((==) category << .category) + |> List.isEmpty + +set : String -> CategoryId -> PaymentCategories -> PaymentCategories +set name category paymentCategories = update name name category paymentCategories + +update : String -> String -> CategoryId -> PaymentCategories -> PaymentCategories +update oldName newName category paymentCategories = + { name = newName, category = category } :: List.filter (\pc -> not <| Search.format pc.name == Search.format oldName) paymentCategories diff --git a/src/client/Model/Size.elm b/src/client/Model/Size.elm new file mode 100644 index 0000000..f40fb01 --- /dev/null +++ b/src/client/Model/Size.elm @@ -0,0 +1,17 @@ +module Model.Size exposing + ( Size + , sizeDecoder + ) + +import Json.Decode as Decode exposing (Decoder) + +type alias Size = + { width: Int + , height: Int + } + +sizeDecoder : Decoder Size +sizeDecoder = + Decode.map2 Size + (Decode.field "width" Decode.int) + (Decode.field "height" Decode.int) diff --git a/src/client/Model/Translations.elm b/src/client/Model/Translations.elm new file mode 100644 index 0000000..9b314e1 --- /dev/null +++ b/src/client/Model/Translations.elm @@ -0,0 +1,68 @@ +module Model.Translations exposing + ( translationsDecoder + , Translations + , Translation + , getMessage + , getParamMessage + ) + +import Maybe exposing (withDefault) +import Json.Decode as Decode exposing (Decoder) +import String + +type alias Translations = List Translation + +translationsDecoder : Decoder Translations +translationsDecoder = Decode.list translationDecoder + +type alias Translation = + { key : String + , message : List MessagePart + } + +getTranslation : String -> Translations -> Maybe (List MessagePart) +getTranslation key translations = + translations + |> List.filter (\translation -> String.toLower translation.key == String.toLower key) + |> List.head + |> Maybe.map .message + +translationDecoder : Decoder Translation +translationDecoder = + Decode.map2 Translation + (Decode.field "key" Decode.string) + (Decode.field "message" (Decode.list partDecoder)) + +type MessagePart = + Order Int + | Str String + +partDecoder : Decoder MessagePart +partDecoder = (Decode.field "tag" Decode.string) |> Decode.andThen partDecoderWithTag + +partDecoderWithTag : String -> Decoder MessagePart +partDecoderWithTag tag = + case tag of + "Order" -> Decode.map Order (Decode.field "contents" Decode.int) + _ -> Decode.map Str (Decode.field "contents" Decode.string) + +----- + +getMessage : Translations -> String -> String +getMessage = getParamMessage [] + +getParamMessage : List String -> Translations -> String -> String +getParamMessage values translations key = + 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 new file mode 100644 index 0000000..f6e8147 --- /dev/null +++ b/src/client/Model/User.elm @@ -0,0 +1,44 @@ +module Model.User exposing + ( Users + , usersDecoder + , User + , userDecoder + , UserId + , userIdDecoder + , getUserName + ) + +import Json.Decode as Decode exposing (Decoder) +import Dict exposing (Dict) + +type alias Users = Dict UserId User + +type alias UserId = Int + +type alias User = + { name : String + , email : String + } + +usersDecoder : Decoder Users +usersDecoder = Decode.map Dict.fromList (Decode.list userWithIdDecoder) + +userWithIdDecoder : Decode.Decoder (UserId, User) +userWithIdDecoder = + Decode.map2 (,) + (Decode.field "id" userIdDecoder) + userDecoder + +userIdDecoder : Decoder UserId +userIdDecoder = Decode.int + +userDecoder : Decoder User +userDecoder = + Decode.map2 User + (Decode.field "name" Decode.string) + (Decode.field "email" Decode.string) + +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 new file mode 100644 index 0000000..61d42a7 --- /dev/null +++ b/src/client/Model/View.elm @@ -0,0 +1,12 @@ +module Model.View exposing + ( View(..) + ) + +import Model.Payment exposing (Payments) + +import SignIn.Model as SignInModel +import LoggedIn.Model as LoggedInModel + +type View = + SignInView SignInModel.Model + | LoggedInView LoggedInModel.Model -- cgit v1.2.3