aboutsummaryrefslogtreecommitdiff
path: root/src/client
diff options
context:
space:
mode:
Diffstat (limited to 'src/client')
-rw-r--r--src/client/Model/View/LoggedIn/Account.elm27
-rw-r--r--src/client/ServerCommunication.elm9
-rw-r--r--src/client/Update/LoggedIn/Account.elm31
-rw-r--r--src/client/View/LoggedIn/Account.elm67
-rw-r--r--src/client/View/LoggedIn/Add.elm1
5 files changed, 126 insertions, 9 deletions
diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/Model/View/LoggedIn/Account.elm
index 410345c..7f0fbe3 100644
--- a/src/client/Model/View/LoggedIn/Account.elm
+++ b/src/client/Model/View/LoggedIn/Account.elm
@@ -1,14 +1,28 @@
module Model.View.LoggedIn.Account
( Account
+ , IncomeEdition
, initAccount
+ , initIncomeEdition
+ , validateIncome
) where
+import Result as Result exposing (Result(..))
+
+import Utils.Validation exposing (..)
+
+import Model.Translations exposing (..)
import Model.Payers exposing (..)
type alias Account =
{ payers : Payers
, income : Maybe Int
, visibleDetail : Bool
+ , incomeEdition : Maybe IncomeEdition
+ }
+
+type alias IncomeEdition =
+ { income : String
+ , error : Maybe String
}
initAccount : Payers -> Maybe Int -> Account
@@ -16,4 +30,17 @@ initAccount payers income =
{ payers = payers
, income = income
, visibleDetail = False
+ , incomeEdition = Nothing
}
+
+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 "IncomeMustBeNonNullNumber" translations) ((/=) 0))
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index 5736f77..47d8c27 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -18,12 +18,14 @@ import Update as U
import Update.SignIn exposing (..)
import Update.LoggedIn as UL
import Update.LoggedIn.Monthly as UM
+import Update.LoggedIn.Account as UA
type Communication =
NoCommunication
| SignIn String
| AddPayment UserId String Int
| AddMonthlyPayment String Int
+ | SetIncome Int
| DeletePayment PaymentId UserId Int Int
| DeleteMonthlyPayment PaymentId
| UpdatePage Int
@@ -48,6 +50,7 @@ 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)
DeleteMonthlyPayment paymentId -> Just (deletePaymentRequest paymentId)
UpdatePage page -> Just (updatePageRequest page)
@@ -88,10 +91,12 @@ serverResult communication response =
Task.succeed <| U.UpdateLoggedIn (UL.AddPayment userId name cost payments)
))
AddMonthlyPayment name cost ->
- decodeOkResponse
+ decodeResponse
("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 ->
Http.send Http.defaultSettings (updatePageRequest currentPage)
|> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments ->
@@ -100,7 +105,7 @@ serverResult communication response =
DeleteMonthlyPayment id ->
Task.succeed <| U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id))
UpdatePage page ->
- decodeOkResponse
+ decodeResponse
paymentsDecoder
(\payments -> Task.succeed <| U.UpdateLoggedIn (UL.UpdatePage page payments))
response
diff --git a/src/client/Update/LoggedIn/Account.elm b/src/client/Update/LoggedIn/Account.elm
index ab07c2e..2d9cd87 100644
--- a/src/client/Update/LoggedIn/Account.elm
+++ b/src/client/Update/LoggedIn/Account.elm
@@ -3,13 +3,21 @@ module Update.LoggedIn.Account
, updateAccount
) where
+import Maybe
+
import Model.User exposing (UserId)
import Model.Payers exposing (..)
import Model.View.LoggedIn.Account exposing (..)
+import Utils.Maybe exposing (isJust)
+
type AccountAction =
ToggleDetail
| UpdatePayer UserId Int
+ | ToggleIncomeEdition
+ | UpdateIncomeEdition String
+ | UpdateEditionError String
+ | UpdateIncome Int
updateAccount : AccountAction -> Account -> Account
updateAccount action account =
@@ -18,3 +26,26 @@ updateAccount action account =
{ account | visibleDetail <- not account.visibleDetail }
UpdatePayer userId cost ->
{ account | payers <- updatePayers account.payers userId cost }
+ ToggleIncomeEdition ->
+ { account | incomeEdition <-
+ if isJust account.incomeEdition
+ then Nothing
+ else Just (initIncomeEdition (Maybe.withDefault 0 account.income))
+ }
+ UpdateIncomeEdition income ->
+ case account.incomeEdition of
+ Just incomeEdition ->
+ { account | incomeEdition <- Just { incomeEdition | income <- income } }
+ Nothing ->
+ account
+ UpdateEditionError error ->
+ case account.incomeEdition of
+ Just incomeEdition ->
+ { account | incomeEdition <- Just { incomeEdition | error <- Just error } }
+ Nothing ->
+ account
+ UpdateIncome amount ->
+ { account
+ | income <- Just amount
+ , incomeEdition <- Nothing
+ }
diff --git a/src/client/View/LoggedIn/Account.elm b/src/client/View/LoggedIn/Account.elm
index 88f39c3..253647a 100644
--- a/src/client/View/LoggedIn/Account.elm
+++ b/src/client/View/LoggedIn/Account.elm
@@ -3,10 +3,13 @@ module View.LoggedIn.Account
) where
import Html exposing (..)
+import Html as H exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import List
+import ServerCommunication as SC exposing (serverCommunications)
+
import Update exposing (..)
import Update.LoggedIn exposing (..)
import Update.LoggedIn.Account exposing (..)
@@ -16,10 +19,13 @@ import Model.User exposing (getUserName)
import Model.Payers exposing (..)
import Model.View.LoggedInView exposing (LoggedInView)
import Model.Translations exposing (getParamMessage, getMessage)
-import Model.View.LoggedIn.Account exposing (Account)
+import Model.View.LoggedIn.Account exposing (..)
import View.Expand exposing (..)
import View.Price exposing (price)
+import View.Events exposing (onSubmitPrevDefault)
+
+import Utils.Either exposing (toMaybeError)
account : Model -> LoggedInView -> Html
account model loggedInView =
@@ -64,11 +70,58 @@ exceedingPayer model loggedInView payer =
income : Model -> Account -> Html
income model account =
+ case account.incomeEdition of
+ Just edition ->
+ incomeEdition model account edition
+ Nothing ->
+ incomeRead model account
+
+incomeRead : Model -> Account -> Html
+incomeRead model account =
div
[ class "income" ]
- ( case account.income of
- Nothing ->
- [ text (getMessage "NoIncome" model.translations) ]
- Just income ->
- [ text (getParamMessage [price model income] "Income" model.translations) ]
- )
+ [ ( case account.income of
+ Nothing ->
+ text (getMessage "NoIncome" model.translations)
+ Just income ->
+ text (getParamMessage [price model income] "Income" model.translations)
+ )
+ , toggleIncomeEdition "editIncomeEdition" (getMessage "Edit" model.translations)
+ ]
+
+incomeEdition : Model -> Account -> IncomeEdition -> Html
+incomeEdition model account edition =
+ H.form
+ [ case validateIncome edition.income model.translations of
+ Ok validatedAmount ->
+ onSubmitPrevDefault serverCommunications.address (SC.SetIncome validatedAmount)
+ Err error ->
+ onSubmitPrevDefault actions.address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error)
+ , class "income"
+ ]
+ [ label
+ [ for "incomeInput" ]
+ [ text (getMessage "NewIncome" model.translations) ]
+ , input
+ [ id "incomeInput"
+ , value edition.income
+ , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAccount << UpdateIncomeEdition)
+ , maxlength 10
+ ]
+ []
+ , button
+ [ class "validateIncomeEdition" ]
+ [ text (getMessage "Validate" model.translations) ]
+ , toggleIncomeEdition "undoIncomeEdition" (getMessage "Undo" model.translations)
+ , case edition.error of
+ Just error -> div [ class "error" ] [ text error ]
+ Nothing -> text ""
+ ]
+
+toggleIncomeEdition : String -> String -> Html
+toggleIncomeEdition className name =
+ button
+ [ class className
+ , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleIncomeEdition)
+ ]
+ [ text name ]
diff --git a/src/client/View/LoggedIn/Add.elm b/src/client/View/LoggedIn/Add.elm
index bae3853..2167a7f 100644
--- a/src/client/View/LoggedIn/Add.elm
+++ b/src/client/View/LoggedIn/Add.elm
@@ -37,6 +37,7 @@ addPayment model loggedInView =
in onSubmitPrevDefault serverCommunications.address action
(resName, resCost) ->
onSubmitPrevDefault actions.address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
+ , class "addPayment"
]
[ addPaymentName loggedInView.add
, addPaymentCost model loggedInView.add
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-03 20:22:05 +0000