aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm')
-rw-r--r--src/client/elm/Main.elm4
-rw-r--r--src/client/elm/Model/Action.elm4
-rw-r--r--src/client/elm/Model/Action/LoggedInAction.elm4
-rw-r--r--src/client/elm/Model/Communication.elm15
-rw-r--r--src/client/elm/Server.elm65
-rw-r--r--src/client/elm/ServerCommunication.elm69
-rw-r--r--src/client/elm/Update.elm28
-rw-r--r--src/client/elm/Update/LoggedIn.elm17
-rw-r--r--src/client/elm/View/Header.elm3
-rw-r--r--src/client/elm/View/LoggedIn/Account.elm3
-rw-r--r--src/client/elm/View/LoggedIn/AddPayment.elm5
-rw-r--r--src/client/elm/View/LoggedIn/Monthly.elm5
-rw-r--r--src/client/elm/View/LoggedIn/Table.elm3
-rw-r--r--src/client/elm/View/SignIn.elm2
14 files changed, 109 insertions, 118 deletions
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) ]
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-23 00:49:29 +0000