aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/client/elm/Model/Action.elm2
-rw-r--r--src/client/elm/Model/Action/AddPaymentAction.elm1
-rw-r--r--src/client/elm/Model/Action/LoggedInAction.elm3
-rw-r--r--src/client/elm/Model/Action/SignInAction.elm2
-rw-r--r--src/client/elm/Model/View/LoggedIn/AddPayment.elm2
-rw-r--r--src/client/elm/Model/View/SignInView.elm4
-rw-r--r--src/client/elm/ServerCommunication.elm2
-rw-r--r--src/client/elm/Update.elm21
-rw-r--r--src/client/elm/Update/LoggedIn.elm105
-rw-r--r--src/client/elm/Update/LoggedIn/AddPayment.elm2
-rw-r--r--src/client/elm/Update/SignIn.elm6
-rw-r--r--src/client/elm/View/LoggedIn/AddPayment.elm29
-rw-r--r--src/client/elm/View/SignIn.elm7
-rw-r--r--src/server/Design/Helper.hs2
-rw-r--r--src/server/Design/LoggedIn/Add.hs2
-rw-r--r--src/server/Main.hs1
16 files changed, 131 insertions, 60 deletions
diff --git a/src/client/elm/Model/Action.elm b/src/client/elm/Model/Action.elm
index d0fe597..033467d 100644
--- a/src/client/elm/Model/Action.elm
+++ b/src/client/elm/Model/Action.elm
@@ -17,7 +17,7 @@ type Action =
| ServerCommunication Communication
| SignIn String
| UpdateTime Time
- | GoSignInView
| GoLoggedInView Users UserId Payments Payments Int Payers
| UpdateSignIn SignInAction
| UpdateLoggedIn LoggedInAction
+ | GoSignInView
diff --git a/src/client/elm/Model/Action/AddPaymentAction.elm b/src/client/elm/Model/Action/AddPaymentAction.elm
index 172f35f..a109a49 100644
--- a/src/client/elm/Model/Action/AddPaymentAction.elm
+++ b/src/client/elm/Model/Action/AddPaymentAction.elm
@@ -7,3 +7,4 @@ type AddPaymentAction =
| UpdateCost String
| AddError (Maybe String) (Maybe String)
| ToggleFrequency
+ | WaitingServer
diff --git a/src/client/elm/Model/Action/LoggedInAction.elm b/src/client/elm/Model/Action/LoggedInAction.elm
index aaf3c7f..18d2224 100644
--- a/src/client/elm/Model/Action/LoggedInAction.elm
+++ b/src/client/elm/Model/Action/LoggedInAction.elm
@@ -10,7 +10,8 @@ import Model.Action.AddPaymentAction exposing (AddPaymentAction)
type LoggedInAction =
UpdateAdd AddPaymentAction
| UpdatePayments Payments
- | AddPayment PaymentId String Int PaymentFrequency
+ | AddPayment String Int PaymentFrequency
+ | ValidateAddPayment PaymentId String Int PaymentFrequency
| DeletePayment Payment PaymentFrequency
| ToggleEdit PaymentId
| UpdatePage Int
diff --git a/src/client/elm/Model/Action/SignInAction.elm b/src/client/elm/Model/Action/SignInAction.elm
index ed64c1d..eaa9f8b 100644
--- a/src/client/elm/Model/Action/SignInAction.elm
+++ b/src/client/elm/Model/Action/SignInAction.elm
@@ -3,5 +3,5 @@ module Model.Action.SignInAction
) where
type SignInAction =
- Connecting
+ WaitingServer
| ErrorLogin String
diff --git a/src/client/elm/Model/View/LoggedIn/AddPayment.elm b/src/client/elm/Model/View/LoggedIn/AddPayment.elm
index fc4d3a0..3a14b00 100644
--- a/src/client/elm/Model/View/LoggedIn/AddPayment.elm
+++ b/src/client/elm/Model/View/LoggedIn/AddPayment.elm
@@ -18,6 +18,7 @@ type alias AddPayment =
, cost : String
, costError : Maybe String
, frequency : PaymentFrequency
+ , waitingServer : Bool
}
initAddPayment : PaymentFrequency -> AddPayment
@@ -27,6 +28,7 @@ initAddPayment frequency =
, cost = ""
, costError = Nothing
, frequency = frequency
+ , waitingServer = False
}
validateName : String -> Translations -> Result String String
diff --git a/src/client/elm/Model/View/SignInView.elm b/src/client/elm/Model/View/SignInView.elm
index cf7e6b2..a950867 100644
--- a/src/client/elm/Model/View/SignInView.elm
+++ b/src/client/elm/Model/View/SignInView.elm
@@ -4,12 +4,12 @@ module Model.View.SignInView
) where
type alias SignInView =
- { connecting : Bool
+ { waitingServer : Bool
, error : Maybe String
}
initSignInView : SignInView
initSignInView =
- { connecting = False
+ { waitingServer = False
, error = Nothing
}
diff --git a/src/client/elm/ServerCommunication.elm b/src/client/elm/ServerCommunication.elm
index 53612d8..7c46d79 100644
--- a/src/client/elm/ServerCommunication.elm
+++ b/src/client/elm/ServerCommunication.elm
@@ -35,7 +35,7 @@ sendRequest communication =
AddPayment name cost frequency ->
post (addPaymentURL name cost frequency)
|> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
- |> Task.map (\paymentId -> (U.UpdateLoggedIn (UL.AddPayment paymentId name cost frequency)))
+ |> Task.map (\paymentId -> (U.UpdateLoggedIn (UL.ValidateAddPayment paymentId name cost frequency)))
DeletePayment payment frequency ->
post (deletePaymentURL payment.id)
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index 73dde9b..a33d47d 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -31,7 +31,7 @@ update action model =
(model, Effects.none)
SignIn assertion ->
- ( applySignIn model (SignInAction.Connecting)
+ ( applySignIn model (SignInAction.WaitingServer)
, sendRequest (Communication.SignIn assertion)
|> flip Task.onError (\_ ->
Task.succeed (UpdateSignIn (SignInAction.ErrorLogin (getMessage "ErrorSignIn" model.translations)))
@@ -61,16 +61,23 @@ update action model =
(applySignIn model signInAction, Effects.none)
UpdateLoggedIn loggedInAction ->
- (applyLoggedIn model loggedInAction, Effects.none)
+ applyLoggedIn model loggedInAction
applySignIn : Model -> SignInAction -> Model
applySignIn model signInAction =
case model.view of
- V.SignInView signInView -> { model | view = V.SignInView (updateSignIn signInAction signInView) }
- _ -> model
+ V.SignInView signInView ->
+ { model | view = V.SignInView (updateSignIn signInAction signInView) }
+ _ ->
+ model
-applyLoggedIn : Model -> LoggedInAction -> Model
+applyLoggedIn : Model -> LoggedInAction -> (Model, Effects Action)
applyLoggedIn model loggedInAction =
case model.view of
- V.LoggedInView loggedInView -> { model | view = V.LoggedInView (updateLoggedIn model loggedInAction loggedInView) }
- _ -> model
+ V.LoggedInView loggedInView ->
+ let (loggedInView, effects) = updateLoggedIn model loggedInAction loggedInView
+ in ( { model | view = V.LoggedInView loggedInView }
+ , effects
+ )
+ _ ->
+ (model, Effects.none)
diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm
index 704dd7f..fe53af7 100644
--- a/src/client/elm/Update/LoggedIn.elm
+++ b/src/client/elm/Update/LoggedIn.elm
@@ -5,12 +5,20 @@ module Update.LoggedIn
import Date
import Dict
+import Effects exposing (Effects)
+import Task
+
+import ServerCommunication exposing (sendRequest)
+
import Model exposing (Model)
import Model.User exposing (UserId)
import Model.Payment exposing (..)
+import Model.Action exposing (..)
import Model.Action.LoggedInAction exposing (..)
import Model.Action.AccountAction exposing (..)
import Model.Action.MonthlyAction as Monthly
+import Model.Action.AddPaymentAction as AddPayment
+import Model.Communication as Communication exposing (Communication)
import Model.View.LoggedInView exposing (..)
import Model.View.LoggedIn.AddPayment exposing (..)
@@ -18,49 +26,82 @@ import Update.LoggedIn.AddPayment exposing (updateAddPayment)
import Update.LoggedIn.Monthly exposing (updateMonthly)
import Update.LoggedIn.Account exposing (updateAccount)
-updateLoggedIn : Model -> LoggedInAction -> LoggedInView -> LoggedInView
+updateLoggedIn : Model -> LoggedInAction -> LoggedInView -> (LoggedInView, Effects Action)
updateLoggedIn model action loggedInView =
case action of
+
UpdateAdd addPaymentAction ->
- { loggedInView | add = updateAddPayment addPaymentAction loggedInView.add }
+ ( { loggedInView | add = updateAddPayment addPaymentAction loggedInView.add }
+ , Effects.none
+ )
+
UpdatePayments payments ->
- { loggedInView | payments = payments }
- AddPayment paymentId name cost frequency ->
+ ( { loggedInView | payments = payments }
+ , Effects.none
+ )
+
+ AddPayment name cost frequency ->
+ ( { loggedInView | add = updateAddPayment AddPayment.WaitingServer loggedInView.add }
+ , sendRequest (Communication.AddPayment name cost frequency)
+ |> flip Task.onError (always <| Task.succeed NoOp)
+ |> Effects.task
+ )
+
+ ValidateAddPayment paymentId name cost frequency ->
let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedInView.account.me
newAdd = initAddPayment frequency
- in if frequency == Punctual
- then
- { loggedInView
- | currentPage = 1
- , add = newAdd
- , account = updateAccount (UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account
- , payments = newPayment :: loggedInView.payments
- , paymentsCount = loggedInView.paymentsCount + 1
- }
- else
- { loggedInView
- | add = newAdd
- , monthly = updateMonthly (Monthly.AddPayment newPayment) loggedInView.monthly
- }
+ in case frequency of
+ Punctual ->
+ ( { loggedInView
+ | currentPage = 1
+ , add = newAdd
+ , account = updateAccount (UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account
+ , payments = newPayment :: loggedInView.payments
+ , paymentsCount = loggedInView.paymentsCount + 1
+ }
+ , Effects.none
+ )
+ Monthly ->
+ ( { loggedInView
+ | add = newAdd
+ , monthly = updateMonthly (Monthly.AddPayment newPayment) loggedInView.monthly
+ }
+ , Effects.none
+ )
+
ToggleEdit id ->
- { loggedInView | paymentEdition = if loggedInView.paymentEdition == Just id then Nothing else Just id }
+ ( { loggedInView | paymentEdition = if loggedInView.paymentEdition == Just id then Nothing else Just id }
+ , Effects.none
+ )
+
DeletePayment payment frequency ->
case frequency of
Monthly ->
- { loggedInView
- | monthly = updateMonthly (Monthly.DeletePayment payment) loggedInView.monthly
- }
+ ( { loggedInView
+ | monthly = updateMonthly (Monthly.DeletePayment payment) loggedInView.monthly
+ }
+ , Effects.none
+ )
Punctual ->
- { loggedInView
- | account = updateAccount (UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account
- , payments = deletePayment payment.id loggedInView.payments
- , paymentsCount = loggedInView.paymentsCount - 1
- }
+ ( { loggedInView
+ | account = updateAccount (UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account
+ , payments = deletePayment payment.id loggedInView.payments
+ , paymentsCount = loggedInView.paymentsCount - 1
+ }
+ , Effects.none
+ )
+
UpdatePage page ->
- { loggedInView
- | currentPage = page
- }
+ ( { loggedInView | currentPage = page }
+ , Effects.none
+ )
+
UpdateMonthly monthlyAction ->
- { loggedInView | monthly = updateMonthly monthlyAction loggedInView.monthly }
+ ( { loggedInView | monthly = updateMonthly monthlyAction loggedInView.monthly }
+ , Effects.none
+ )
+
UpdateAccount accountAction ->
- { loggedInView | account = updateAccount accountAction loggedInView.account }
+ ( { loggedInView | account = updateAccount accountAction loggedInView.account }
+ , Effects.none
+ )
diff --git a/src/client/elm/Update/LoggedIn/AddPayment.elm b/src/client/elm/Update/LoggedIn/AddPayment.elm
index 978980d..3eb2ea4 100644
--- a/src/client/elm/Update/LoggedIn/AddPayment.elm
+++ b/src/client/elm/Update/LoggedIn/AddPayment.elm
@@ -22,3 +22,5 @@ updateAddPayment action addPayment =
{ addPayment
| frequency = if addPayment.frequency == Punctual then Monthly else Punctual
}
+ WaitingServer ->
+ { addPayment | waitingServer = True }
diff --git a/src/client/elm/Update/SignIn.elm b/src/client/elm/Update/SignIn.elm
index 5e8a9bb..94963c8 100644
--- a/src/client/elm/Update/SignIn.elm
+++ b/src/client/elm/Update/SignIn.elm
@@ -8,10 +8,10 @@ import Model.View.SignInView exposing (..)
updateSignIn : SignInAction -> SignInView -> SignInView
updateSignIn action signInView =
case action of
- Connecting ->
- { signInView | connecting = True }
+ WaitingServer ->
+ { signInView | waitingServer = True }
ErrorLogin message ->
{ signInView
| error = Just message
- , connecting = False
+ , waitingServer = False
}
diff --git a/src/client/elm/View/LoggedIn/AddPayment.elm b/src/client/elm/View/LoggedIn/AddPayment.elm
index 5739a95..283d392 100644
--- a/src/client/elm/View/LoggedIn/AddPayment.elm
+++ b/src/client/elm/View/LoggedIn/AddPayment.elm
@@ -14,7 +14,7 @@ import Model exposing (Model)
import Model.Payment exposing (PaymentFrequency(..))
import Model.Translations exposing (getMessage)
import Model.Action exposing (..)
-import Model.Action.LoggedInAction exposing (..)
+import Model.Action.LoggedInAction as LoggedInAction exposing (..)
import Model.Action.AddPaymentAction exposing (..)
import Model.Communication as Communication
@@ -22,7 +22,7 @@ import Model.View.LoggedIn.AddPayment exposing (..)
import Model.View.LoggedInView exposing (LoggedInView)
import View.Events exposing (onSubmitPrevDefault)
-import View.Icon exposing (renderIcon)
+import View.Icon exposing (..)
import Utils.Maybe exposing (isJust)
import Utils.Either exposing (toMaybeError)
@@ -30,11 +30,16 @@ import Utils.Either exposing (toMaybeError)
addPayment : Address Action -> Model -> LoggedInView -> Html
addPayment address model loggedInView =
H.form
- [ case (validateName loggedInView.add.name model.translations, validateCost loggedInView.add.cost model.translations) of
- (Ok name, Ok cost) ->
- onSubmitPrevDefault address (ServerCommunication (Communication.AddPayment name cost loggedInView.add.frequency))
- (resName, resCost) ->
- onSubmitPrevDefault address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
+ [ let update =
+ if loggedInView.add.waitingServer
+ then NoOp
+ else
+ case (validateName loggedInView.add.name model.translations, validateCost loggedInView.add.cost model.translations) of
+ (Ok name, Ok cost) ->
+ UpdateLoggedIn <| LoggedInAction.AddPayment name cost loggedInView.add.frequency
+ (resName, resCost) ->
+ UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost)
+ in onSubmitPrevDefault address update
, class "addPayment"
]
[ addPaymentName address loggedInView.add
@@ -42,8 +47,14 @@ addPayment address model loggedInView =
, paymentFrequency address model loggedInView.add
, button
[ type' "submit"
- , class "add" ]
- [ text (getMessage "Add" model.translations)]
+ , classList
+ [ ("add", True)
+ , ("waitingServer", loggedInView.add.waitingServer)
+ ]
+ ]
+ [ text (getMessage "Add" model.translations)
+ , if loggedInView.add.waitingServer then renderSpinIcon else text ""
+ ]
]
addPaymentName : Address Action -> AddPayment -> Html
diff --git a/src/client/elm/View/SignIn.elm b/src/client/elm/View/SignIn.elm
index ba16561..4b9f2bb 100644
--- a/src/client/elm/View/SignIn.elm
+++ b/src/client/elm/View/SignIn.elm
@@ -25,9 +25,12 @@ renderSignIn address model signInView =
div
[ class "signIn" ]
[ button
- [ onClick operations.address Persona.SignIn ]
+ ( if signInView.waitingServer
+ then []
+ else [ onClick operations.address Persona.SignIn ]
+ )
[ span [] [ text (getMessage "SignIn" model.translations) ]
- , if signInView.connecting
+ , if signInView.waitingServer
then renderSpinIcon
else renderIcon "power-off"
]
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index bd11766..40218f8 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -47,7 +47,7 @@ iconButton backgroundCol textCol h = do
display inlineBlock
marginLeft (px 20)
i ? do
- marginLeft (px 20)
+ marginLeft (px 15)
marginRight (px 20)
hover & i ? transform (scale 1.2 1.2)
diff --git a/src/server/Design/LoggedIn/Add.hs b/src/server/Design/LoggedIn/Add.hs
index 579cead..3bdfb65 100644
--- a/src/server/Design/LoggedIn/Add.hs
+++ b/src/server/Design/LoggedIn/Add.hs
@@ -65,6 +65,8 @@ addDesign =
defaultButton C.red C.white (px inputHeight)
paddingLeft (px 15)
paddingRight (px 15)
+ i ? marginLeft (px 10)
+ ".waitingServer" & ("cursor" -: "not-allowed")
".name.error" <> ".cost.error" ? do
input ? borderColor C.redError
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 3ac489e..9f21873 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -5,6 +5,7 @@ import Web.Scotty
import Network.Wai.Middleware.Static
import Control.Concurrent (forkIO)
+
import MonthlyPaymentJob (monthlyPaymentJobListener)
import Data.Text (Text)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 16:35:47 +0000