aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm')
-rw-r--r--src/client/elm/Model/Action/AccountAction.elm4
-rw-r--r--src/client/elm/Model/Income.elm65
-rw-r--r--src/client/elm/Model/Init.elm4
-rw-r--r--src/client/elm/Model/Payer.elm78
-rw-r--r--src/client/elm/Model/Payment.elm8
-rw-r--r--src/client/elm/Model/User.elm6
-rw-r--r--src/client/elm/Model/View/LoggedIn/Account.elm31
-rw-r--r--src/client/elm/Model/View/LoggedInView.elm2
-rw-r--r--src/client/elm/Server.elm8
-rw-r--r--src/client/elm/Update/LoggedIn.elm36
-rw-r--r--src/client/elm/Update/LoggedIn/Account.elm23
-rw-r--r--src/client/elm/View/LoggedIn/Account.elm2
12 files changed, 131 insertions, 136 deletions
diff --git a/src/client/elm/Model/Action/AccountAction.elm b/src/client/elm/Model/Action/AccountAction.elm
index 520f3ab..3e156a5 100644
--- a/src/client/elm/Model/Action/AccountAction.elm
+++ b/src/client/elm/Model/Action/AccountAction.elm
@@ -5,13 +5,13 @@ module Model.Action.AccountAction
import Time exposing (Time)
import Model.User exposing (UserId)
+import Model.Income exposing (IncomeId)
type AccountAction =
NoOp
| ToggleDetail
- | UpdatePayer UserId Time Int
| ToggleIncomeEdition
| UpdateIncomeEdition String
| UpdateEditionError String
| UpdateIncome Time Int
- | ValidateUpdateIncome Time Int
+ | ValidateUpdateIncome IncomeId Time Int
diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm
index 97a5652..f364a8b 100644
--- a/src/client/elm/Model/Income.elm
+++ b/src/client/elm/Model/Income.elm
@@ -1,6 +1,9 @@
module Model.Income
- ( Income
- , incomeDecoder
+ ( Incomes
+ , Income
+ , IncomeId
+ , incomesDecoder
+ , incomeIdDecoder
, incomeDefinedForAll
, cumulativeIncomesSince
) where
@@ -8,26 +11,46 @@ module Model.Income
import Json.Decode as Json exposing ((:=))
import Time exposing (Time, hour)
import List exposing (..)
+import Dict exposing (Dict)
import Model.Date exposing (timeDecoder)
-import Model.User exposing (UserId)
+import Model.User exposing (UserId, userIdDecoder)
import Utils.Maybe exposing (isJust, catMaybes, maybeToList)
+type alias Incomes = Dict IncomeId Income
+
+type alias IncomeId = Int
+
type alias Income =
- { creation : Time
+ { userId : UserId
+ , creation : Time
, amount : Int
}
+incomesDecoder : Json.Decoder Incomes
+incomesDecoder = Json.map Dict.fromList (Json.list incomeWithIdDecoder)
+
+incomeWithIdDecoder : Json.Decoder (IncomeId, Income)
+incomeWithIdDecoder =
+ Json.object2 (,)
+ ("id" := incomeIdDecoder)
+ incomeDecoder
+
+incomeIdDecoder : Json.Decoder IncomeId
+incomeIdDecoder = Json.int
+
incomeDecoder : Json.Decoder Income
incomeDecoder =
- Json.object2 Income
+ Json.object3 Income
+ ("userId" := userIdDecoder)
("creation" := timeDecoder)
("amount" := Json.int)
-incomeDefinedForAll : List (List Income) -> Maybe Time
-incomeDefinedForAll usersIncomes =
- let firstIncomes = map (head << sortBy .creation) usersIncomes
+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 .creation) userIncomes
in if all isJust firstIncomes
then head << reverse << List.sort << map .creation << catMaybes <| firstIncomes
else Nothing
@@ -38,37 +61,39 @@ cumulativeIncomesSince currentTime since incomes =
getOrderedIncomesSince : Time -> List Income -> List Income
getOrderedIncomesSince time incomes =
- let mbStarterIncome = getIncomesAt time incomes
+ let mbStarterIncome = getIncomeAt time incomes
orderedIncomesSince = filter (\income -> income.creation >= time) incomes
in (maybeToList mbStarterIncome) ++ orderedIncomesSince
-getIncomesAt : Time -> List Income -> Maybe Income
-getIncomesAt time incomes =
+getIncomeAt : Time -> List Income -> Maybe Income
+getIncomeAt time incomes =
case incomes of
[x] ->
if x.creation < time
- then Just { creation = time, amount = x.amount }
+ then Just { userId = x.userId, 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)
+ then Just { userId = x2.userId, creation = time, amount = x2.amount }
+ else getIncomeAt time (x2 :: xs)
[] ->
Nothing
cumulativeIncome : Time -> List Income -> Int
cumulativeIncome currentTime incomes =
- getIncomesWithDuration (incomes ++ [{ creation = currentTime, amount = 0 }])
+ getIncomesWithDuration currentTime (List.sortBy .creation incomes)
|> map durationIncome
|> sum
-getIncomesWithDuration : List Income -> List (Float, Int)
-getIncomesWithDuration incomes =
+getIncomesWithDuration : Time -> List Income -> List (Float, Int)
+getIncomesWithDuration currentTime incomes =
case incomes of
- (income1 :: income2 :: xs) ->
- (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration (income2 :: xs))
- _ ->
+ [] ->
[]
+ [income] ->
+ [(currentTime - income.creation, income.amount)]
+ (income1 :: income2 :: xs) ->
+ (income2.creation - income1.creation, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs))
durationIncome : (Float, Int) -> Int
durationIncome (duration, income) =
diff --git a/src/client/elm/Model/Init.elm b/src/client/elm/Model/Init.elm
index 490321b..d9dbc36 100644
--- a/src/client/elm/Model/Init.elm
+++ b/src/client/elm/Model/Init.elm
@@ -3,7 +3,7 @@ module Model.Init
) where
import Model.Payment exposing (Payments)
-import Model.Payer exposing (Payers)
+import Model.Income exposing (Incomes)
import Model.User exposing (Users, UserId)
type alias Init =
@@ -12,5 +12,5 @@ type alias Init =
, payments : Payments
, monthlyPayments : Payments
, paymentsCount : Int
- , payers : Payers
+ , incomes : Incomes
}
diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm
index f39a612..9ae1dfa 100644
--- a/src/client/elm/Model/Payer.elm
+++ b/src/client/elm/Model/Payer.elm
@@ -2,8 +2,6 @@ module Model.Payer
( Payers
, Payer
, ExceedingPayer
- , payersDecoder
- , updatePayers
, getOrderedExceedingPayers
) where
@@ -12,8 +10,10 @@ import Dict exposing (..)
import List
import Maybe
import Time exposing (Time)
+import Date
-import Model.User exposing (UserId, userIdDecoder)
+import Model.Payment exposing (Payments, totalPayments)
+import Model.User exposing (Users, UserId, userIdDecoder)
import Model.Income exposing (..)
import Utils.Dict exposing (mapValues)
@@ -27,54 +27,22 @@ type alias Payer =
, 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 =
+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
- in case payersIncomeDefinedForAll payers of
+ in case incomeDefinedForAll (Dict.keys users) incomes of
Just since ->
- let postPaymentPayers =
- payers
- |> mapValues (getPostPaymentPayer currentTime since)
+ let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers
mbMaxRatio =
postPaymentPayers
|> Dict.toList
@@ -91,9 +59,31 @@ getOrderedExceedingPayers currentTime payers =
Nothing ->
exceedingPayersOnPreIncome
-payersIncomeDefinedForAll : Payers -> Maybe Time
-payersIncomeDefinedForAll payers =
- incomeDefinedForAll (List.map (.incomes << snd) << Dict.toList <| payers)
+getPayers : Time -> Users -> Incomes -> Payments -> Payers
+getPayers currentTime users incomes payments =
+ let incomesDefined = incomeDefinedForAll (Dict.keys users) incomes
+ in Dict.keys users
+ |> List.map (\userId ->
+ ( userId
+ , { preIncomePaymentSum =
+ totalPayments
+ (\p -> (Date.toTime p.creation) < (Maybe.withDefault currentTime incomesDefined))
+ userId
+ payments
+ , postIncomePaymentSum =
+ totalPayments
+ (\p ->
+ case incomesDefined of
+ Nothing -> False
+ Just t -> (Date.toTime p.creation) >= t
+ )
+ userId
+ payments
+ , incomes = List.filter ((==) userId << .userId) (Dict.values incomes)
+ }
+ )
+ )
+ |> Dict.fromList
exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer
exceedingPayersFromAmounts userAmounts =
diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm
index 31aba1d..80579e2 100644
--- a/src/client/elm/Model/Payment.elm
+++ b/src/client/elm/Model/Payment.elm
@@ -7,6 +7,7 @@ module Model.Payment
, paymentIdDecoder
, deletePayment
, PaymentFrequency(..)
+ , totalPayments
) where
import Date exposing (..)
@@ -49,3 +50,10 @@ paymentIdDecoder = Json.int
deletePayment : PaymentId -> Payments -> Payments
deletePayment 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
diff --git a/src/client/elm/Model/User.elm b/src/client/elm/Model/User.elm
index 1412913..aac5dd5 100644
--- a/src/client/elm/Model/User.elm
+++ b/src/client/elm/Model/User.elm
@@ -29,15 +29,15 @@ userWithIdDecoder =
("id" := userIdDecoder)
userDecoder
+userIdDecoder : Json.Decoder UserId
+userIdDecoder = Json.int
+
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
diff --git a/src/client/elm/Model/View/LoggedIn/Account.elm b/src/client/elm/Model/View/LoggedIn/Account.elm
index d03d84f..ec75397 100644
--- a/src/client/elm/Model/View/LoggedIn/Account.elm
+++ b/src/client/elm/Model/View/LoggedIn/Account.elm
@@ -14,40 +14,33 @@ import String
import Utils.Dict exposing (mapValues)
import Model.Translations exposing (..)
-import Model.Payer exposing (..)
+import Model.Income exposing (..)
import Model.User exposing (UserId)
type alias Account =
{ me : UserId
- , payers : Payers
+ , incomes : Incomes
, visibleDetail : Bool
, incomeEdition : Maybe IncomeEdition
}
-initAccount : UserId -> Payers -> Account
-initAccount me payers =
+initAccount : UserId -> Incomes -> Account
+initAccount me incomes =
{ me = me
- , payers =
- payers
- |> mapValues
- (\payer ->
- { payer | incomes = List.sortBy .creation payer.incomes }
- )
+ , incomes = 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
+ account.incomes
+ |> Dict.filter (\_ income -> income.userId == account.me)
+ |> Dict.values
+ |> List.sortBy .creation
+ |> List.reverse
+ |> List.head
+ |> Maybe.map .amount
type alias IncomeEdition =
{ income : String
diff --git a/src/client/elm/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm
index 2df3525..e33c58b 100644
--- a/src/client/elm/Model/View/LoggedInView.elm
+++ b/src/client/elm/Model/View/LoggedInView.elm
@@ -28,7 +28,7 @@ initLoggedInView init =
{ users = init.users
, add = initAddPayment Punctual
, monthly = initMonthly init.monthlyPayments
- , account = initAccount init.me init.payers
+ , account = initAccount init.me init.incomes
, payments = init.payments
, paymentsCount = init.paymentsCount
, paymentEdition = Nothing
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index c1fb445..314ca01 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -17,7 +17,7 @@ import Time exposing (Time)
import Utils.Http exposing (..)
import Model.Payment exposing (..)
-import Model.Payer exposing (Payers, payersDecoder)
+import Model.Income exposing (incomesDecoder, incomeIdDecoder, IncomeId)
import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder)
import Model.Init exposing (Init)
@@ -28,7 +28,7 @@ init =
`Task.andMap` (Http.get paymentsDecoder "/payments")
`Task.andMap` (Http.get paymentsDecoder "/monthlyPayments")
`Task.andMap` (Http.get ("number" := Json.int) "/payments/count")
- `Task.andMap` (Http.get payersDecoder "/payers")
+ `Task.andMap` (Http.get incomesDecoder "/incomes")
signIn : String -> Task Http.Error ()
signIn email =
@@ -45,10 +45,10 @@ deletePayment payment frequency =
post ("payment/delete?id=" ++ (toString payment.id))
|> Task.map (always ())
-setIncome : Time -> Int -> Task Http.Error ()
+setIncome : Time -> Int -> Task Http.Error IncomeId
setIncome currentTime amount =
post ("/income?amount=" ++ (toString amount))
- |> Task.map (always ())
+ |> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder)
signOut : Task Http.Error ()
signOut =
diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm
index dfc2a1b..300c63a 100644
--- a/src/client/elm/Update/LoggedIn.elm
+++ b/src/client/elm/Update/LoggedIn.elm
@@ -71,17 +71,15 @@ updateLoggedIn model action loggedInView =
newAdd = initAddPayment frequency
in case frequency of
Punctual ->
- let (newAccount, accountEffects) =
- updateAccount (Account.UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account
- in ( { loggedInView
- | currentPage = 1
- , add = newAdd
- , account = newAccount
- , payments = newPayment :: loggedInView.payments
- , paymentsCount = loggedInView.paymentsCount + 1
- }
- , Effects.map UpdateAccount accountEffects
- )
+ ( { loggedInView
+ | currentPage = 1
+ , add = newAdd
+ , account = loggedInView.account
+ , payments = newPayment :: loggedInView.payments
+ , paymentsCount = loggedInView.paymentsCount + 1
+ }
+ , Effects.none
+ )
Monthly ->
( { loggedInView
| add = newAdd
@@ -112,15 +110,13 @@ updateLoggedIn model action loggedInView =
, Effects.none
)
Punctual ->
- let (newAccount, accountEffects) =
- updateAccount (Account.UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account
- in ( { loggedInView
- | account = newAccount
- , payments = deletePayment payment.id loggedInView.payments
- , paymentsCount = loggedInView.paymentsCount - 1
- }
- , Effects.map UpdateAccount accountEffects
- )
+ ( { loggedInView
+ | account = loggedInView.account
+ , payments = deletePayment payment.id loggedInView.payments
+ , paymentsCount = loggedInView.paymentsCount - 1
+ }
+ , Effects.none
+ )
UpdatePage page ->
( { loggedInView | currentPage = page }
diff --git a/src/client/elm/Update/LoggedIn/Account.elm b/src/client/elm/Update/LoggedIn/Account.elm
index 1773b9a..233efa9 100644
--- a/src/client/elm/Update/LoggedIn/Account.elm
+++ b/src/client/elm/Update/LoggedIn/Account.elm
@@ -10,7 +10,6 @@ import Effects exposing (Effects)
import Server
-import Model.Payer exposing (updatePayers)
import Model.Action.AccountAction exposing (..)
import Model.View.LoggedIn.Account exposing (..)
@@ -28,11 +27,6 @@ updateAccount action account =
, Effects.none
)
- UpdatePayer userId creation amountDiff ->
- ( { account | payers = updatePayers account.payers userId creation amountDiff }
- , Effects.none
- )
-
ToggleIncomeEdition ->
( { account | incomeEdition =
if isJust account.incomeEdition
@@ -67,25 +61,14 @@ updateAccount action account =
UpdateIncome currentTime amount ->
( account
, Server.setIncome currentTime amount
- |> Task.map (always (ValidateUpdateIncome currentTime amount))
+ |> Task.map (\incomeId -> (ValidateUpdateIncome incomeId currentTime amount))
|> flip Task.onError (always <| Task.succeed NoOp)
|> Effects.task
)
- ValidateUpdateIncome currentTime amount ->
+ ValidateUpdateIncome incomeId currentTime amount ->
( { account
- | payers =
- account.payers
- |> Dict.update account.me (\mbPayer ->
- case mbPayer of
- Just payer ->
- Just
- { payer
- | incomes = payer.incomes ++ [{ creation = currentTime, amount = amount }]
- }
- Nothing ->
- Nothing
- )
+ | incomes = Dict.insert incomeId { userId = account.me, creation = currentTime, amount = amount } account.incomes
, incomeEdition = Nothing
}
, Effects.none
diff --git a/src/client/elm/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm
index d8884f1..5bbf73e 100644
--- a/src/client/elm/View/LoggedIn/Account.elm
+++ b/src/client/elm/View/LoggedIn/Account.elm
@@ -48,7 +48,7 @@ exceedingPayers address model loggedInView =
[ class "header"
, onClick address (UpdateLoggedIn << UpdateAccount <| ToggleDetail)
]
- ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.account.payers))
+ ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.users loggedInView.account.incomes loggedInView.payments))
++ [ expand ExpandDown loggedInView.account.visibleDetail ]
)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 01:45:07 +0000