aboutsummaryrefslogtreecommitdiff
path: root/src/client
diff options
context:
space:
mode:
Diffstat (limited to 'src/client')
-rw-r--r--src/client/Main.elm13
-rw-r--r--src/client/Model/Date.elm15
-rw-r--r--src/client/Model/Income.elm76
-rw-r--r--src/client/Model/Payer.elm129
-rw-r--r--src/client/Model/Payers.elm59
-rw-r--r--src/client/Model/Payment.elm4
-rw-r--r--src/client/Model/User.elm4
-rw-r--r--src/client/Model/View/LoggedIn/Account.elm43
-rw-r--r--src/client/Model/View/LoggedInView.elm10
-rw-r--r--src/client/ServerCommunication.elm17
-rw-r--r--src/client/Update.elm8
-rw-r--r--src/client/Update/LoggedIn.elm12
-rw-r--r--src/client/Update/LoggedIn/Account.elm29
-rw-r--r--src/client/Utils/Dict.elm11
-rw-r--r--src/client/Utils/List.elm6
-rw-r--r--src/client/Utils/Maybe.elm20
-rw-r--r--src/client/View/LoggedIn/Account.elm8
-rw-r--r--src/client/View/LoggedIn/Add.elm2
-rw-r--r--src/client/View/LoggedIn/Monthly.elm20
-rw-r--r--src/client/View/LoggedIn/Table.elm4
20 files changed, 361 insertions, 129 deletions
diff --git a/src/client/Main.elm b/src/client/Main.elm
index 621fb97..de98809 100644
--- a/src/client/Main.elm
+++ b/src/client/Main.elm
@@ -10,11 +10,12 @@ import Http
import Task exposing (..)
import Time exposing (..)
import Json.Decode as Json exposing ((:=))
+import Dict
import Model exposing (Model, initialModel)
import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder)
import Model.Payment exposing (Payments, paymentsDecoder, perPage)
-import Model.Payers exposing (Payers, payersDecoder)
+import Model.Payer exposing (Payers, payersDecoder)
import Model.Translations exposing (..)
import Update exposing (Action(..), actions, updateModel)
@@ -32,7 +33,7 @@ model = Signal.foldp updateModel (initialModel initialTime translations) update
update : Signal Action
update = Signal.mergeMany
- [ Signal.map UpdateTime (Time.every 30)
+ [ Signal.map UpdateTime (Time.every 1000)
, actions.signal
]
@@ -66,8 +67,7 @@ goLoggedInView =
Task.andThen getPayments <| \payments ->
Task.andThen getPaymentsCount <| \paymentsCount ->
Task.andThen getPayers <| \payers ->
- Task.andThen getIncome <| \income ->
- Signal.send actions.address (GoLoggedInView users me monthlyPayments payments paymentsCount payers income)
+ Signal.send actions.address (GoLoggedInView users me monthlyPayments payments paymentsCount payers)
getUsers : Task Http.Error Users
getUsers = Http.get usersDecoder "/users"
@@ -85,10 +85,7 @@ getPaymentsCount : Task Http.Error Int
getPaymentsCount = Http.get ("number" := Json.int) "/payments/count"
getPayers : Task Http.Error Payers
-getPayers = Http.get payersDecoder "/payments/total"
-
-getIncome : Task Http.Error (Maybe Int)
-getIncome = Http.get (Json.maybe ("income" := Json.int)) "/income"
+getPayers = Http.get payersDecoder "/payers"
---------------------------------------
diff --git a/src/client/Model/Date.elm b/src/client/Model/Date.elm
new file mode 100644
index 0000000..1c56de4
--- /dev/null
+++ b/src/client/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/Model/Income.elm b/src/client/Model/Income.elm
new file mode 100644
index 0000000..ce30772
--- /dev/null
+++ b/src/client/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 (UserId, List Income) -> Maybe Time
+incomeDefinedForAll usersIncomes =
+ let firstIncomes = map (head << sortBy .creation << snd) 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
new file mode 100644
index 0000000..af475bb
--- /dev/null
+++ b/src/client/Model/Payer.elm
@@ -0,0 +1,129 @@
+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 =
+ incomeDefinedForAll (Dict.toList << mapValues .incomes <| 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 mbIncomeDefinedForAll = incomeDefinedForAll (Dict.toList << mapValues .incomes <| payers)
+ exceedingPayersOnPreIncome =
+ payers
+ |> mapValues .preIncomePaymentSum
+ |> Dict.toList
+ |> exceedingPayersFromAmounts
+ in case mbIncomeDefinedForAll 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
+
+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/Payers.elm b/src/client/Model/Payers.elm
deleted file mode 100644
index 983e7b3..0000000
--- a/src/client/Model/Payers.elm
+++ /dev/null
@@ -1,59 +0,0 @@
-module Model.Payers
- ( Payers
- , ExceedingPayer
- , payersDecoder
- , updatePayers
- , getOrderedExceedingPayers
- ) where
-
-import Json.Decode as Json exposing (..)
-import Dict exposing (..)
-import List
-import Maybe
-
-import Model.User exposing (UserId, userIdDecoder)
-
-type alias Payers = Dict UserId Int
-
-payersDecoder : Decoder Payers
-payersDecoder = Json.map Dict.fromList (list payerDecoder)
-
-payerDecoder : Decoder (UserId, Int)
-payerDecoder =
- object2 (,)
- ("userId" := userIdDecoder)
- ("totalPayment" := int)
-
-updatePayers : Payers -> UserId -> Int -> Payers
-updatePayers payers userId amountDiff =
- Dict.update
- userId
- (\mbAmount ->
- case mbAmount of
- Just amount -> Just (amount + amountDiff)
- Nothing -> Nothing
- )
- payers
-
-type alias ExceedingPayer =
- { userId : UserId
- , amount : Int
- }
-
-getOrderedExceedingPayers : Payers -> List ExceedingPayer
-getOrderedExceedingPayers payers =
- let orderedPayers =
- Dict.toList payers
- |> List.map (\(userId, amount) -> ExceedingPayer userId amount)
- |> List.sortBy .amount
- maybeMinAmount =
- List.head orderedPayers
- |> Maybe.map .amount
- in case maybeMinAmount of
- Just minAmount ->
- orderedPayers
- |> List.map (\payer -> { payer | amount <- payer.amount - minAmount })
- |> List.filter (\payer -> payer.amount /= 0)
- |> List.reverse
- Nothing ->
- []
diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm
index 1f1c4ed..c4a8963 100644
--- a/src/client/Model/Payment.elm
+++ b/src/client/Model/Payment.elm
@@ -11,6 +11,7 @@ import Date exposing (..)
import Json.Decode as Json exposing ((:=))
import Model.User exposing (UserId, userIdDecoder)
+import Model.Date exposing (dateDecoder)
perPage : Int
perPage = 8
@@ -41,6 +42,3 @@ paymentDecoder =
paymentIdDecoder : Json.Decoder PaymentId
paymentIdDecoder = Json.int
-
-dateDecoder : Json.Decoder Date
-dateDecoder = Json.customDecoder Json.string Date.fromString
diff --git a/src/client/Model/User.elm b/src/client/Model/User.elm
index b0d62a6..1412913 100644
--- a/src/client/Model/User.elm
+++ b/src/client/Model/User.elm
@@ -25,7 +25,9 @@ usersDecoder = Json.map Dict.fromList (Json.list userWithIdDecoder)
userWithIdDecoder : Json.Decoder (UserId, User)
userWithIdDecoder =
- userDecoder `Json.andThen` (\user -> Json.map (\id -> (id, user)) ("id" := userIdDecoder))
+ Json.object2 (,)
+ ("id" := userIdDecoder)
+ userDecoder
userDecoder : Json.Decoder User
userDecoder =
diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/Model/View/LoggedIn/Account.elm
index 7f0fbe3..ab37b81 100644
--- a/src/client/Model/View/LoggedIn/Account.elm
+++ b/src/client/Model/View/LoggedIn/Account.elm
@@ -3,36 +3,57 @@ module Model.View.LoggedIn.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.Payers exposing (..)
+import Model.Payer exposing (..)
+import Model.User exposing (UserId)
type alias Account =
- { payers : Payers
- , income : Maybe Int
+ { 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
}
-initAccount : Payers -> Maybe Int -> Account
-initAccount payers income =
- { payers = payers
- , income = income
- , visibleDetail = False
- , incomeEdition = Nothing
- }
-
initIncomeEdition : Int -> IncomeEdition
initIncomeEdition income =
{ income = toString income
diff --git a/src/client/Model/View/LoggedInView.elm b/src/client/Model/View/LoggedInView.elm
index 12a7294..122c4be 100644
--- a/src/client/Model/View/LoggedInView.elm
+++ b/src/client/Model/View/LoggedInView.elm
@@ -5,7 +5,7 @@ module Model.View.LoggedInView
import Model.User exposing (Users, UserId)
import Model.Payment exposing (Payments)
-import Model.Payers exposing (Payers)
+import Model.Payer exposing (Payers)
import Model.View.LoggedIn.Add exposing (..)
import Model.View.LoggedIn.Edition exposing (..)
import Model.View.LoggedIn.Monthly exposing (..)
@@ -13,7 +13,6 @@ import Model.View.LoggedIn.Account exposing (..)
type alias LoggedInView =
{ users : Users
- , me : UserId
, add : AddPayment
, monthly : Monthly
, account : Account
@@ -23,13 +22,12 @@ type alias LoggedInView =
, currentPage : Int
}
-initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> Maybe Int -> LoggedInView
-initLoggedInView users me monthlyPayments payments paymentsCount payers income =
+initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> LoggedInView
+initLoggedInView users me monthlyPayments payments paymentsCount payers =
{ users = users
- , me = me
, add = initAddPayment Punctual
, monthly = initMonthly monthlyPayments
- , account = initAccount payers income
+ , account = initAccount me payers
, payments = payments
, paymentsCount = paymentsCount
, paymentEdition = Nothing
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index 47d8c27..55bf947 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -9,6 +9,7 @@ import Task as Task exposing (Task)
import Http
import Json.Decode exposing (..)
import Date
+import Time exposing (Time)
import Model.User exposing (UserId)
import Model.Payment exposing (..)
@@ -25,8 +26,8 @@ type Communication =
| SignIn String
| AddPayment UserId String Int
| AddMonthlyPayment String Int
- | SetIncome Int
- | DeletePayment PaymentId UserId Int Int
+ | SetIncome Time Int
+ | DeletePayment Payment Int
| DeleteMonthlyPayment PaymentId
| UpdatePage Int
| SignOut
@@ -50,8 +51,8 @@ getRequest communication =
SignIn login -> Just (simple "post" ("/signIn?login=" ++ login))
AddPayment userId name cost -> Just (addPaymentRequest name cost Punctual)
AddMonthlyPayment name cost -> Just (addPaymentRequest name cost Monthly)
- SetIncome amount -> Just (simple "post" ("/income?amount=" ++ (toString amount)))
- DeletePayment paymentId _ _ _ -> Just (deletePaymentRequest paymentId)
+ SetIncome _ amount -> Just (simple "post" ("/income?amount=" ++ (toString amount)))
+ DeletePayment payment _ -> Just (deletePaymentRequest payment.id)
DeleteMonthlyPayment paymentId -> Just (deletePaymentRequest paymentId)
UpdatePage page -> Just (updatePageRequest page)
SignOut -> Just (simple "post" "/signOut")
@@ -95,12 +96,12 @@ serverResult communication response =
("id" := paymentIdDecoder)
(\id -> Task.succeed <| U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost))
response
- SetIncome amount ->
- Task.succeed <| U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome amount))
- DeletePayment id userId cost currentPage ->
+ SetIncome currentTime amount ->
+ Task.succeed <| U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount))
+ DeletePayment payment currentPage ->
Http.send Http.defaultSettings (updatePageRequest currentPage)
|> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments ->
- Task.succeed <| U.UpdateLoggedIn (UL.DeletePayment userId cost payments)
+ Task.succeed <| U.UpdateLoggedIn (UL.DeletePayment payment payments)
))
DeleteMonthlyPayment id ->
Task.succeed <| U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id))
diff --git a/src/client/Update.elm b/src/client/Update.elm
index 4389140..3c4614a 100644
--- a/src/client/Update.elm
+++ b/src/client/Update.elm
@@ -9,7 +9,7 @@ import Time exposing (Time)
import Model exposing (Model)
import Model.User exposing (Users, UserId)
import Model.Payment exposing (Payments)
-import Model.Payers exposing (Payers)
+import Model.Payer exposing (Payers)
import Model.View as V
import Model.View.SignInView exposing (..)
import Model.View.LoggedInView exposing (..)
@@ -23,7 +23,7 @@ type Action =
| GoSignInView
| SignInError String
| UpdateSignIn SignInAction
- | GoLoggedInView Users UserId Payments Payments Int Payers (Maybe Int)
+ | GoLoggedInView Users UserId Payments Payments Int Payers
| UpdateLoggedIn LoggedAction
actions : Signal.Mailbox Action
@@ -38,8 +38,8 @@ updateModel action model =
{ model | currentTime <- time }
GoSignInView ->
{ model | view <- V.SignInView initSignInView }
- GoLoggedInView users me monthlyPayments payments paymentsCount payers mbIncome ->
- { model | view <- V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers mbIncome) }
+ GoLoggedInView users me monthlyPayments payments paymentsCount payers ->
+ { model | view <- V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers) }
SignInError msg ->
let signInView = { initSignInView | result <- Just (Err msg) }
in { model | view <- V.SignInView signInView }
diff --git a/src/client/Update/LoggedIn.elm b/src/client/Update/LoggedIn.elm
index 07f3426..e200b04 100644
--- a/src/client/Update/LoggedIn.elm
+++ b/src/client/Update/LoggedIn.elm
@@ -16,13 +16,15 @@ import Update.LoggedIn.Add exposing (..)
import Update.LoggedIn.Monthly as UM
import Update.LoggedIn.Account as UA
+import Utils.List exposing (find)
+
type LoggedAction =
UpdateAdd AddPaymentAction
| UpdatePayments Payments
| AddPayment UserId String Int Payments
| AddMonthlyPayment PaymentId String Int
| ToggleEdit PaymentId
- | DeletePayment UserId Int Payments
+ | DeletePayment Payment Payments
| UpdatePage Int Payments
| UpdateMonthly UM.MonthlyAction
| UpdateAccount UA.AccountAction
@@ -39,22 +41,22 @@ updateLoggedIn model action loggedInView =
| payments <- payments
, currentPage <- 1
, add <- initAddPayment Punctual
- , account <- UA.updateAccount (UA.UpdatePayer userId cost) loggedInView.account
+ , account <- UA.updateAccount (UA.UpdatePayer userId model.currentTime cost) loggedInView.account
, paymentsCount <- loggedInView.paymentsCount + 1
}
AddMonthlyPayment id name cost ->
{ loggedInView
| add <- initAddPayment Monthly
, monthly <-
- let payment = Payment id (Date.fromTime model.currentTime) name cost loggedInView.me
+ let payment = Payment id (Date.fromTime model.currentTime) name cost loggedInView.account.me
in UM.updateMonthly (UM.AddPayment payment) loggedInView.monthly
}
ToggleEdit id ->
{ loggedInView | paymentEdition <- if loggedInView.paymentEdition == Just id then Nothing else Just id }
- DeletePayment userId cost payments ->
+ DeletePayment payment payments ->
{ loggedInView
| payments <- payments
- , account <- UA.updateAccount (UA.UpdatePayer userId -cost) loggedInView.account
+ , account <- UA.updateAccount (UA.UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account
, paymentsCount <- loggedInView.paymentsCount - 1
}
UpdatePage page payments ->
diff --git a/src/client/Update/LoggedIn/Account.elm b/src/client/Update/LoggedIn/Account.elm
index 2d9cd87..cf4c834 100644
--- a/src/client/Update/LoggedIn/Account.elm
+++ b/src/client/Update/LoggedIn/Account.elm
@@ -4,33 +4,35 @@ module Update.LoggedIn.Account
) where
import Maybe
+import Time exposing (Time)
+import Dict
import Model.User exposing (UserId)
-import Model.Payers exposing (..)
+import Model.Payer exposing (..)
import Model.View.LoggedIn.Account exposing (..)
import Utils.Maybe exposing (isJust)
type AccountAction =
ToggleDetail
- | UpdatePayer UserId Int
+ | UpdatePayer UserId Time Int
| ToggleIncomeEdition
| UpdateIncomeEdition String
| UpdateEditionError String
- | UpdateIncome Int
+ | UpdateIncome Time Int
updateAccount : AccountAction -> Account -> Account
updateAccount action account =
case action of
ToggleDetail ->
{ account | visibleDetail <- not account.visibleDetail }
- UpdatePayer userId cost ->
- { account | payers <- updatePayers account.payers userId cost }
+ UpdatePayer userId creation amountDiff ->
+ { account | payers <- updatePayers account.payers userId creation amountDiff }
ToggleIncomeEdition ->
{ account | incomeEdition <-
if isJust account.incomeEdition
then Nothing
- else Just (initIncomeEdition (Maybe.withDefault 0 account.income))
+ else Just (initIncomeEdition (Maybe.withDefault 0 (getCurrentIncome account)))
}
UpdateIncomeEdition income ->
case account.incomeEdition of
@@ -44,8 +46,19 @@ updateAccount action account =
{ account | incomeEdition <- Just { incomeEdition | error <- Just error } }
Nothing ->
account
- UpdateIncome amount ->
+ UpdateIncome currentTime amount ->
{ account
- | income <- Just amount
+ | payers <-
+ account.payers
+ |> Dict.update account.me (\mbPayer ->
+ case mbPayer of
+ Just payer ->
+ Just
+ { payer
+ | incomes <- payer.incomes ++ [{ creation = currentTime, amount = amount }]
+ }
+ Nothing ->
+ Nothing
+ )
, incomeEdition <- Nothing
}
diff --git a/src/client/Utils/Dict.elm b/src/client/Utils/Dict.elm
new file mode 100644
index 0000000..dc01b17
--- /dev/null
+++ b/src/client/Utils/Dict.elm
@@ -0,0 +1,11 @@
+module Utils.Dict
+ ( mapValues
+ ) where
+
+import Dict as Dict exposing (..)
+
+mapValues : (a -> b) -> Dict comparable a -> Dict comparable b
+mapValues f = Dict.fromList << List.map (onSecond f) << Dict.toList
+
+onSecond : (a -> b) -> (comparable, a) -> (comparable, b)
+onSecond f tuple = case tuple of (x, y) -> (x, f y)
diff --git a/src/client/Utils/List.elm b/src/client/Utils/List.elm
new file mode 100644
index 0000000..f33e124
--- /dev/null
+++ b/src/client/Utils/List.elm
@@ -0,0 +1,6 @@
+module Utils.List
+ ( find
+ ) where
+
+find : (a -> Bool) -> List a -> Maybe a
+find predicate = List.head << List.filter predicate
diff --git a/src/client/Utils/Maybe.elm b/src/client/Utils/Maybe.elm
index 507d9a4..d954ae0 100644
--- a/src/client/Utils/Maybe.elm
+++ b/src/client/Utils/Maybe.elm
@@ -1,9 +1,27 @@
module Utils.Maybe
( isJust
+ , catMaybes
+ , maybeToList
) where
isJust : Maybe a -> Bool
isJust maybe =
case maybe of
- Just _ -> True
+ Just _ -> True
Nothing -> False
+
+catMaybes : List (Maybe a) -> List a
+catMaybes =
+ List.foldr
+ (\mb xs ->
+ case mb of
+ Just x -> x :: xs
+ Nothing -> xs
+ )
+ []
+
+maybeToList : Maybe a -> List a
+maybeToList mb =
+ case mb of
+ Just a -> [a]
+ Nothing -> []
diff --git a/src/client/View/LoggedIn/Account.elm b/src/client/View/LoggedIn/Account.elm
index 7e383f3..706f7cc 100644
--- a/src/client/View/LoggedIn/Account.elm
+++ b/src/client/View/LoggedIn/Account.elm
@@ -16,7 +16,7 @@ import Update.LoggedIn.Account exposing (..)
import Model exposing (Model)
import Model.User exposing (getUserName)
-import Model.Payers exposing (..)
+import Model.Payer exposing (..)
import Model.View.LoggedInView exposing (LoggedInView)
import Model.Translations exposing (getParamMessage, getMessage)
import Model.View.LoggedIn.Account exposing (..)
@@ -48,7 +48,7 @@ exceedingPayers model loggedInView =
[ class "header"
, onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleDetail)
]
- ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers loggedInView.account.payers))
+ ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.account.payers))
++ [ expand ExpandDown loggedInView.account.visibleDetail ]
)
@@ -80,7 +80,7 @@ incomeRead : Model -> Account -> Html
incomeRead model account =
div
[ class "income" ]
- [ ( case account.income of
+ [ ( case getCurrentIncome account of
Nothing ->
text (getMessage "NoIncome" model.translations)
Just income ->
@@ -94,7 +94,7 @@ incomeEdition model account edition =
H.form
[ case validateIncome edition.income model.translations of
Ok validatedAmount ->
- onSubmitPrevDefault serverCommunications.address (SC.SetIncome validatedAmount)
+ onSubmitPrevDefault serverCommunications.address (SC.SetIncome model.currentTime validatedAmount)
Err error ->
onSubmitPrevDefault actions.address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error)
, class "income"
diff --git a/src/client/View/LoggedIn/Add.elm b/src/client/View/LoggedIn/Add.elm
index 2167a7f..52d931a 100644
--- a/src/client/View/LoggedIn/Add.elm
+++ b/src/client/View/LoggedIn/Add.elm
@@ -32,7 +32,7 @@ addPayment model loggedInView =
(Ok name, Ok cost) ->
let action =
case loggedInView.add.frequency of
- Punctual -> SC.AddPayment loggedInView.me name cost
+ Punctual -> SC.AddPayment loggedInView.account.me name cost
Monthly -> SC.AddMonthlyPayment name cost
in onSubmitPrevDefault serverCommunications.address action
(resName, resCost) ->
diff --git a/src/client/View/LoggedIn/Monthly.elm b/src/client/View/LoggedIn/Monthly.elm
index 9195479..a274015 100644
--- a/src/client/View/LoggedIn/Monthly.elm
+++ b/src/client/View/LoggedIn/Monthly.elm
@@ -27,15 +27,19 @@ import View.Price exposing (price)
monthlyPayments : Model -> LoggedInView -> Html
monthlyPayments model loggedInView =
let monthly = loggedInView.monthly
- in div
- [ classList
- [ ("monthlyPayments", True)
- , ("detail", monthly.visibleDetail)
+ in if List.length monthly.payments == 0
+ then
+ text ""
+ else
+ div
+ [ classList
+ [ ("monthlyPayments", True)
+ , ("detail", monthly.visibleDetail)
+ ]
+ ]
+ [ monthlyCount model monthly
+ , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text ""
]
- ]
- [ monthlyCount model monthly
- , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text ""
- ]
monthlyCount : Model -> Monthly -> Html
monthlyCount model monthly =
diff --git a/src/client/View/LoggedIn/Table.elm b/src/client/View/LoggedIn/Table.elm
index d98cee6..9d28e81 100644
--- a/src/client/View/LoggedIn/Table.elm
+++ b/src/client/View/LoggedIn/Table.elm
@@ -84,12 +84,12 @@ paymentLine model loggedInView payment =
[ class "longDate" ]
[ text (renderLongDate payment.creation model.translations) ]
]
- , if loggedInView.me == payment.userId
+ , if loggedInView.account.me == payment.userId
then
div
[ class "cell delete" ]
[ button
- [ onClick serverCommunications.address (SC.DeletePayment payment.id payment.userId payment.cost loggedInView.currentPage) ]
+ [ onClick serverCommunications.address (SC.DeletePayment payment loggedInView.currentPage) ]
[ renderIcon "times" ]
]
else
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 21:38:28 +0000