From a8309988518af5bddf62d6a326d990fde4069b40 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Jan 2016 19:41:31 +0100 Subject: Set focus properties to button elements --- src/client/elm/Main.elm | 4 +- src/client/elm/Model/Action.elm | 4 +- src/client/elm/Model/Action/LoggedInAction.elm | 4 +- src/client/elm/Model/Communication.elm | 15 ------ src/client/elm/Server.elm | 65 ++++++++++++++++++++++++ src/client/elm/ServerCommunication.elm | 69 -------------------------- src/client/elm/Update.elm | 28 +++++++---- src/client/elm/Update/LoggedIn.elm | 17 +++++-- src/client/elm/View/Header.elm | 3 +- src/client/elm/View/LoggedIn/Account.elm | 3 +- src/client/elm/View/LoggedIn/AddPayment.elm | 5 +- src/client/elm/View/LoggedIn/Monthly.elm | 5 +- src/client/elm/View/LoggedIn/Table.elm | 3 +- src/client/elm/View/SignIn.elm | 2 +- 14 files changed, 109 insertions(+), 118 deletions(-) delete mode 100644 src/client/elm/Model/Communication.elm create mode 100644 src/client/elm/Server.elm delete mode 100644 src/client/elm/ServerCommunication.elm (limited to 'src/client') diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm index 34afa92..e8bbd54 100644 --- a/src/client/elm/Main.elm +++ b/src/client/elm/Main.elm @@ -20,7 +20,7 @@ import View exposing (view) import Persona as Persona exposing (operations) -import ServerCommunication exposing (initViewAction) +import Server main : Signal Html main = app.html @@ -29,7 +29,7 @@ app : App Model app = StartApp.start { init = ( initialModel initialTime translations config - , Effects.task initViewAction + , Effects.task Server.initViewAction ) , view = view , update = update diff --git a/src/client/elm/Model/Action.elm b/src/client/elm/Model/Action.elm index 033467d..ba47f2d 100644 --- a/src/client/elm/Model/Action.elm +++ b/src/client/elm/Model/Action.elm @@ -10,14 +10,14 @@ import Model.Payment exposing (Payments) import Model.Payer exposing (Payers) import Model.Action.SignInAction exposing (SignInAction) import Model.Action.LoggedInAction exposing (LoggedInAction) -import Model.Communication exposing (Communication) type Action = NoOp - | ServerCommunication Communication | SignIn String + | SetIncome Time Int | UpdateTime Time | GoLoggedInView Users UserId Payments Payments Int Payers | UpdateSignIn SignInAction | UpdateLoggedIn LoggedInAction | GoSignInView + | SignOut diff --git a/src/client/elm/Model/Action/LoggedInAction.elm b/src/client/elm/Model/Action/LoggedInAction.elm index 18d2224..ef81b09 100644 --- a/src/client/elm/Model/Action/LoggedInAction.elm +++ b/src/client/elm/Model/Action/LoggedInAction.elm @@ -8,11 +8,13 @@ import Model.Action.AccountAction exposing (AccountAction) import Model.Action.AddPaymentAction exposing (AddPaymentAction) type LoggedInAction = - UpdateAdd AddPaymentAction + NoOp + | UpdateAdd AddPaymentAction | UpdatePayments Payments | AddPayment String Int PaymentFrequency | ValidateAddPayment PaymentId String Int PaymentFrequency | DeletePayment Payment PaymentFrequency + | ValidateDeletePayment Payment PaymentFrequency | ToggleEdit PaymentId | UpdatePage Int | UpdateMonthly MonthlyAction diff --git a/src/client/elm/Model/Communication.elm b/src/client/elm/Model/Communication.elm deleted file mode 100644 index b8da175..0000000 --- a/src/client/elm/Model/Communication.elm +++ /dev/null @@ -1,15 +0,0 @@ -module Model.Communication - ( Communication(..) - ) where - -import Time exposing (Time) - -import Model.User exposing (UserId) -import Model.Payment exposing (..) - -type Communication = - SignIn String - | SetIncome Time Int - | AddPayment String Int PaymentFrequency - | DeletePayment Payment PaymentFrequency - | SignOut diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm new file mode 100644 index 0000000..cb65868 --- /dev/null +++ b/src/client/elm/Server.elm @@ -0,0 +1,65 @@ +module Server + ( signIn + , addPayment + , deletePayment + , setIncome + , signOut + , initViewAction + ) where + +import Signal +import Task as Task exposing (Task) +import Http +import Json.Decode as Json exposing ((:=)) +import Date +import Time exposing (Time) +import Debug + +import SimpleHTTP exposing (..) + +import Model.Action as U exposing (Action) +import Model.Action.LoggedInAction as UL exposing (LoggedInAction) +import Model.Action.MonthlyAction as UM exposing (MonthlyAction) +import Model.Action.AccountAction as UA exposing (AccountAction) +import Model.Payment exposing (..) +import Model.Payer exposing (Payers, payersDecoder) +import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) + +import Update.SignIn exposing (updateSignIn) + +signIn : String -> Task Http.Error Action +signIn assertion = + post ("/signIn?assertion=" ++ assertion) + |> flip Task.andThen (always initViewAction) + +addPayment : String -> Int -> PaymentFrequency -> Task Http.Error LoggedInAction +addPayment name cost frequency = + post ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)) + |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder) + |> Task.map (\paymentId -> (UL.ValidateAddPayment paymentId name cost frequency)) + +deletePayment : Payment -> PaymentFrequency -> Task Http.Error LoggedInAction +deletePayment payment frequency = + post ("payment/delete?id=" ++ (toString payment.id)) + |> Task.map (always (UL.ValidateDeletePayment payment frequency)) + +setIncome : Time -> Int -> Task Http.Error Action +setIncome currentTime amount = + post ("/income?amount=" ++ (toString amount)) + |> Task.map (always (U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount)))) + +signOut : Task Http.Error Action +signOut = + post "/signOut" + |> Task.map (always U.GoSignInView) + +initViewAction = Task.onError loggedInView (always <| Task.succeed U.GoSignInView) + +loggedInView : Task Http.Error Action +loggedInView = + Task.map U.GoLoggedInView (Http.get usersDecoder "/users") + `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI") + `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments") + `Task.andMap` (Http.get paymentsDecoder "/payments") + `Task.andMap` (Http.get ("number" := Json.int) "/payments/count") + `Task.andMap` (Http.get payersDecoder "/payers") diff --git a/src/client/elm/ServerCommunication.elm b/src/client/elm/ServerCommunication.elm deleted file mode 100644 index 7c46d79..0000000 --- a/src/client/elm/ServerCommunication.elm +++ /dev/null @@ -1,69 +0,0 @@ -module ServerCommunication - ( sendRequest - , initViewAction - ) where - -import Signal -import Task as Task exposing (Task) -import Http -import Json.Decode as Json exposing ((:=)) -import Date -import Time exposing (Time) -import Debug - -import SimpleHTTP exposing (..) - -import Model.Communication exposing (..) -import Model.Action as U exposing (Action) -import Model.Action.LoggedInAction as UL -import Model.Action.MonthlyAction as UM -import Model.Action.AccountAction as UA -import Model.Payment exposing (..) -import Model.Payer exposing (Payers, payersDecoder) -import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) - -import Update.SignIn exposing (updateSignIn) - -sendRequest : Communication -> Task Http.Error U.Action -sendRequest communication = - case communication of - - SignIn assertion -> - post ("/signIn?assertion=" ++ assertion) - |> flip Task.andThen (always initViewAction) - - AddPayment name cost frequency -> - post (addPaymentURL name cost frequency) - |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder) - |> Task.map (\paymentId -> (U.UpdateLoggedIn (UL.ValidateAddPayment paymentId name cost frequency))) - - DeletePayment payment frequency -> - post (deletePaymentURL payment.id) - |> Task.map (always (U.UpdateLoggedIn (UL.DeletePayment payment frequency))) - - SetIncome currentTime amount -> - post ("/income?amount=" ++ (toString amount)) - |> Task.map (always (U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount)))) - - SignOut -> - post "/signOut" - |> Task.map (always U.GoSignInView) - -addPaymentURL : String -> Int -> PaymentFrequency -> String -addPaymentURL name cost frequency = - "/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency) - -deletePaymentURL : PaymentId -> String -deletePaymentURL id = - "payment/delete?id=" ++ (toString id) - -initViewAction = Task.onError loggedInView (always <| Task.succeed U.GoSignInView) - -loggedInView : Task Http.Error Action -loggedInView = - Task.map U.GoLoggedInView (Http.get usersDecoder "/users") - `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI") - `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments") - `Task.andMap` (Http.get paymentsDecoder "/payments") - `Task.andMap` (Http.get ("number" := Json.int) "/payments/count") - `Task.andMap` (Http.get payersDecoder "/payers") diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm index a33d47d..b473c9d 100644 --- a/src/client/elm/Update.elm +++ b/src/client/elm/Update.elm @@ -6,7 +6,7 @@ import Task import Effects exposing (Effects) -import ServerCommunication exposing (sendRequest) +import Server import Model exposing (Model) import Model.Translations exposing (getMessage) @@ -16,7 +16,6 @@ import Model.Action.LoggedInAction exposing (LoggedInAction) import Model.View as V import Model.View.SignInView exposing (..) import Model.View.LoggedInView exposing (..) -import Model.Communication as Communication exposing (Communication) import Update.LoggedIn exposing (updateLoggedIn) import Update.SignIn exposing (updateSignIn) @@ -32,25 +31,25 @@ update action model = SignIn assertion -> ( applySignIn model (SignInAction.WaitingServer) - , sendRequest (Communication.SignIn assertion) + , Server.signIn assertion |> flip Task.onError (\_ -> Task.succeed (UpdateSignIn (SignInAction.ErrorLogin (getMessage "ErrorSignIn" model.translations))) ) |> Effects.task ) - GoLoggedInView users me monthlyPayments payments paymentsCount payers -> - ( { model | view = V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers) } - , Effects.none - ) - - ServerCommunication communication -> + SetIncome currentTime amount -> ( model - , sendRequest communication + , Server.setIncome currentTime amount |> flip Task.onError (always <| Task.succeed NoOp) |> Effects.task ) + GoLoggedInView users me monthlyPayments payments paymentsCount payers -> + ( { model | view = V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers) } + , Effects.none + ) + UpdateTime time -> ({ model | currentTime = time }, Effects.none) @@ -63,6 +62,13 @@ update action model = UpdateLoggedIn loggedInAction -> applyLoggedIn model loggedInAction + SignOut -> + ( model + , Server.signOut + |> flip Task.onError (always <| Task.succeed NoOp) + |> Effects.task + ) + applySignIn : Model -> SignInAction -> Model applySignIn model signInAction = case model.view of @@ -77,7 +83,7 @@ applyLoggedIn model loggedInAction = V.LoggedInView loggedInView -> let (loggedInView, effects) = updateLoggedIn model loggedInAction loggedInView in ( { model | view = V.LoggedInView loggedInView } - , effects + , Effects.map UpdateLoggedIn effects ) _ -> (model, Effects.none) diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm index fe53af7..69a1b75 100644 --- a/src/client/elm/Update/LoggedIn.elm +++ b/src/client/elm/Update/LoggedIn.elm @@ -8,17 +8,15 @@ import Dict import Effects exposing (Effects) import Task -import ServerCommunication exposing (sendRequest) +import Server 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 (..) @@ -26,10 +24,12 @@ import Update.LoggedIn.AddPayment exposing (updateAddPayment) import Update.LoggedIn.Monthly exposing (updateMonthly) import Update.LoggedIn.Account exposing (updateAccount) -updateLoggedIn : Model -> LoggedInAction -> LoggedInView -> (LoggedInView, Effects Action) +updateLoggedIn : Model -> LoggedInAction -> LoggedInView -> (LoggedInView, Effects LoggedInAction) updateLoggedIn model action loggedInView = case action of + NoOp -> (loggedInView, Effects.none) + UpdateAdd addPaymentAction -> ( { loggedInView | add = updateAddPayment addPaymentAction loggedInView.add } , Effects.none @@ -42,7 +42,7 @@ updateLoggedIn model action loggedInView = AddPayment name cost frequency -> ( { loggedInView | add = updateAddPayment AddPayment.WaitingServer loggedInView.add } - , sendRequest (Communication.AddPayment name cost frequency) + , Server.addPayment name cost frequency |> flip Task.onError (always <| Task.succeed NoOp) |> Effects.task ) @@ -75,6 +75,13 @@ updateLoggedIn model action loggedInView = ) DeletePayment payment frequency -> + ( loggedInView + , Server.deletePayment payment frequency + |> flip Task.onError (always <| Task.succeed NoOp) + |> Effects.task + ) + + ValidateDeletePayment payment frequency -> case frequency of Monthly -> ( { loggedInView diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm index 9d57c05..b8a5bf1 100644 --- a/src/client/elm/View/Header.elm +++ b/src/client/elm/View/Header.elm @@ -10,7 +10,6 @@ import Html.Events exposing (..) import Model exposing (Model) import Model.Translations exposing (getMessage) -import Model.Communication as Communication import Model.Action exposing (..) import Model.View exposing (..) @@ -27,7 +26,7 @@ renderHeader address model = LoggedInView _ -> button [ class "icon" - , onClick address (ServerCommunication Communication.SignOut) + , onClick address SignOut ] [ renderIcon "power-off" ] _ -> diff --git a/src/client/elm/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm index 9459740..a7c20d5 100644 --- a/src/client/elm/View/LoggedIn/Account.elm +++ b/src/client/elm/View/LoggedIn/Account.elm @@ -17,7 +17,6 @@ import Model.Translations exposing (getParamMessage, getMessage) import Model.Action exposing (..) import Model.Action.LoggedInAction exposing (..) import Model.Action.AccountAction exposing (..) -import Model.Communication as Communication import Model.View.LoggedInView exposing (LoggedInView) import Model.View.LoggedIn.Account exposing (..) @@ -95,7 +94,7 @@ incomeEdition address model account edition = H.form [ case validateIncome edition.income model.translations of Ok validatedAmount -> - onSubmitPrevDefault address (ServerCommunication <| Communication.SetIncome model.currentTime validatedAmount) + onSubmitPrevDefault address (SetIncome model.currentTime validatedAmount) Err error -> onSubmitPrevDefault address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error) , class "income" diff --git a/src/client/elm/View/LoggedIn/AddPayment.elm b/src/client/elm/View/LoggedIn/AddPayment.elm index 283d392..0b39591 100644 --- a/src/client/elm/View/LoggedIn/AddPayment.elm +++ b/src/client/elm/View/LoggedIn/AddPayment.elm @@ -13,10 +13,9 @@ import Html.Events exposing (..) import Model exposing (Model) import Model.Payment exposing (PaymentFrequency(..)) import Model.Translations exposing (getMessage) -import Model.Action exposing (..) +import Model.Action as Action exposing (..) import Model.Action.LoggedInAction as LoggedInAction exposing (..) import Model.Action.AddPaymentAction exposing (..) -import Model.Communication as Communication import Model.View.LoggedIn.AddPayment exposing (..) import Model.View.LoggedInView exposing (LoggedInView) @@ -32,7 +31,7 @@ addPayment address model loggedInView = H.form [ let update = if loggedInView.add.waitingServer - then NoOp + then Action.NoOp else case (validateName loggedInView.add.name model.translations, validateCost loggedInView.add.cost model.translations) of (Ok name, Ok cost) -> diff --git a/src/client/elm/View/LoggedIn/Monthly.elm b/src/client/elm/View/LoggedIn/Monthly.elm index c0294d7..2e9ff1e 100644 --- a/src/client/elm/View/LoggedIn/Monthly.elm +++ b/src/client/elm/View/LoggedIn/Monthly.elm @@ -13,9 +13,8 @@ import Model exposing (Model) import Model.Payment as Payment exposing (Payments, Payment) import Model.Translations exposing (getMessage, getParamMessage) import Model.Action exposing (..) -import Model.Action.LoggedInAction exposing (..) +import Model.Action.LoggedInAction as LoggedInAction exposing (..) import Model.Action.MonthlyAction exposing (..) -import Model.Communication as Communication import Model.View.LoggedIn.Monthly exposing (Monthly) import Model.View.LoggedInView exposing (LoggedInView) @@ -81,7 +80,7 @@ paymentLine address model loggedInView payment = [ text (price model payment.cost) ] , div [ class "cell delete" - , onClick address (ServerCommunication <| Communication.DeletePayment payment Payment.Monthly) + , onClick address (UpdateLoggedIn <| LoggedInAction.DeletePayment payment Payment.Monthly) ] [ button [] [ renderIcon "times" ] ] diff --git a/src/client/elm/View/LoggedIn/Table.elm b/src/client/elm/View/LoggedIn/Table.elm index cb3969b..ca5680f 100644 --- a/src/client/elm/View/LoggedIn/Table.elm +++ b/src/client/elm/View/LoggedIn/Table.elm @@ -17,7 +17,6 @@ import Model.Payment exposing (..) import Model.Translations exposing (getMessage) import Model.Action exposing (..) import Model.Action.LoggedInAction exposing (..) -import Model.Communication as Communication import Model.View.LoggedInView exposing (LoggedInView) import View.Icon exposing (renderIcon) @@ -88,7 +87,7 @@ paymentLine address model loggedInView payment = div [ class "cell delete" ] [ button - [ onClick address (ServerCommunication <| Communication.DeletePayment payment Punctual)] + [ onClick address (UpdateLoggedIn <| DeletePayment payment Punctual)] [ renderIcon "times" ] ] else diff --git a/src/client/elm/View/SignIn.elm b/src/client/elm/View/SignIn.elm index 4b9f2bb..c21c16c 100644 --- a/src/client/elm/View/SignIn.elm +++ b/src/client/elm/View/SignIn.elm @@ -26,7 +26,7 @@ renderSignIn address model signInView = [ class "signIn" ] [ button ( if signInView.waitingServer - then [] + then [ class "waitingServer" ] else [ onClick operations.address Persona.SignIn ] ) [ span [] [ text (getMessage "SignIn" model.translations) ] -- cgit v1.2.3