diff options
Diffstat (limited to 'src/client/elm')
31 files changed, 398 insertions, 429 deletions
diff --git a/src/client/elm/InitViewAction.elm b/src/client/elm/InitViewAction.elm index cdfc0fc..52ae08d 100644 --- a/src/client/elm/InitViewAction.elm +++ b/src/client/elm/InitViewAction.elm @@ -6,13 +6,13 @@ import Task exposing (..) import Http import Json.Decode as Json exposing ((:=)) -import Update exposing (Action(GoLoggedInView, GoSignInView)) +import Effects exposing (Never) +import Model.Action exposing (..) import Model.Payment exposing (Payments, paymentsDecoder) import Model.Payer exposing (Payers, payersDecoder) import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) -initViewAction : Task Http.Error Action initViewAction = Task.onError loggedInView (always <| Task.succeed GoSignInView) loggedInView : Task Http.Error Action diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm index f79d6a0..2f4acb6 100644 --- a/src/client/elm/Main.elm +++ b/src/client/elm/Main.elm @@ -5,85 +5,52 @@ module Main import Graphics.Element exposing (..) import Html exposing (Html) +import StartApp exposing (App) +import Effects exposing (Effects, Never) -import Http import Task exposing (..) import Time exposing (..) -import Json.Decode as Json -import Dict -import String import Model exposing (Model, initialModel) -import Model.Translations exposing (..) -import Model.Config exposing (..) +import Model.Action exposing (..) +import Model.Communication exposing (Communication(SignIn)) -import Update exposing (Action(..), actions, updateModel) -import Update.SignIn exposing (..) +import Update exposing (update) -import View.Page exposing (renderPage) - -import ServerCommunication as SC exposing (serverCommunications, sendRequest) +import View exposing (view) import Persona as Persona exposing (operations) import InitViewAction exposing (initViewAction) -import Sign - main : Signal Html -main = Signal.map renderPage model - -model : Signal Model -model = Signal.foldp updateModel (initialModel initialTime translations config) update - -update : Signal Action -update = Signal.mergeMany - [ Signal.map UpdateTime (Time.every 1000) - , actions.signal - ] - ---------------------------------------- +main = app.html + +app : App Model +app = StartApp.start + { init = + ( initialModel initialTime translations config + , Effects.task initViewAction + ) + , view = view + , update = update + , inputs = + [ Signal.map UpdateTime (Time.every 1000) + , Signal.map (ServerCommunication << SignIn) validateSignIn + ] + } + +port tasks : Signal (Task.Task Never ()) +port tasks = app.tasks + +-- Input ports port initialTime : Time - ---------------------------------------- - port translations : String - ---------------------------------------- - port config : String +port validateSignIn : Signal String ---------------------------------------- - -port ready : Signal String -port ready = Signal.constant "ready" - ---------------------------------------- - -port initView : Task Http.Error () -port initView = initViewAction `Task.andThen` (Signal.send actions.address) - ---------------------------------------- - -port serverCommunicationsPort : Signal (Task Http.Error ()) -port serverCommunicationsPort = - Signal.map - (\comm -> - sendRequest comm - |> flip Task.andThen (\action -> Signal.send actions.address action) - ) - (Signal.merge signCommunication serverCommunications.signal) - ---------------------------------------- - -port persona : Signal String -port persona = Signal.map Persona.toString operations.signal - ---------------------------------------- - -port sign : Signal Json.Value +-- Output ports -signCommunication : Signal SC.Communication -signCommunication = - Signal.map (Sign.toServerCommunication << Sign.decodeOperation) sign +port askSignIn : Signal String +port askSignIn = Signal.map toString operations.signal diff --git a/src/client/elm/Model/Action.elm b/src/client/elm/Model/Action.elm new file mode 100644 index 0000000..9d5d125 --- /dev/null +++ b/src/client/elm/Model/Action.elm @@ -0,0 +1,22 @@ +module Model.Action + ( Action(..) + ) where + +import Time exposing (Time) +import Signal exposing (Address) + +import Model.User exposing (Users, UserId) +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 + | UpdateTime Time + | GoSignInView + | GoLoggedInView Users UserId Payments Payments Int Payers + | UpdateSignIn SignInAction + | UpdateLoggedIn LoggedInAction diff --git a/src/client/elm/Model/Action/AccountAction.elm b/src/client/elm/Model/Action/AccountAction.elm new file mode 100644 index 0000000..feddbea --- /dev/null +++ b/src/client/elm/Model/Action/AccountAction.elm @@ -0,0 +1,15 @@ +module Model.Action.AccountAction + ( AccountAction(..) + ) where + +import Time exposing (Time) + +import Model.User exposing (UserId) + +type AccountAction = + ToggleDetail + | UpdatePayer UserId Time Int + | ToggleIncomeEdition + | UpdateIncomeEdition String + | UpdateEditionError String + | UpdateIncome Time Int diff --git a/src/client/elm/Model/Action/AddPaymentAction.elm b/src/client/elm/Model/Action/AddPaymentAction.elm new file mode 100644 index 0000000..172f35f --- /dev/null +++ b/src/client/elm/Model/Action/AddPaymentAction.elm @@ -0,0 +1,9 @@ +module Model.Action.AddPaymentAction + ( AddPaymentAction(..) + ) where + +type AddPaymentAction = + UpdateName String + | UpdateCost String + | AddError (Maybe String) (Maybe String) + | ToggleFrequency diff --git a/src/client/elm/Model/Action/LoggedInAction.elm b/src/client/elm/Model/Action/LoggedInAction.elm new file mode 100644 index 0000000..22a7d3d --- /dev/null +++ b/src/client/elm/Model/Action/LoggedInAction.elm @@ -0,0 +1,19 @@ +module Model.Action.LoggedInAction + ( LoggedInAction(..) + ) where + +import Model.Payment exposing (Payments, Payment, PaymentId) +import Model.Action.MonthlyAction exposing (MonthlyAction) +import Model.Action.AccountAction exposing (AccountAction) +import Model.Action.AddPaymentAction exposing (AddPaymentAction) + +type LoggedInAction = + UpdateAdd AddPaymentAction + | UpdatePayments Payments + | AddPayment PaymentId String Int + | AddMonthlyPayment PaymentId String Int + | ToggleEdit PaymentId + | DeletePayment Payment + | UpdatePage Int + | UpdateMonthly MonthlyAction + | UpdateAccount AccountAction diff --git a/src/client/elm/Model/Action/MonthlyAction.elm b/src/client/elm/Model/Action/MonthlyAction.elm new file mode 100644 index 0000000..d985ccc --- /dev/null +++ b/src/client/elm/Model/Action/MonthlyAction.elm @@ -0,0 +1,10 @@ +module Model.Action.MonthlyAction + ( MonthlyAction(..) + ) where + +import Model.Payment exposing (Payment, PaymentId) + +type MonthlyAction = + ToggleDetail + | AddPayment Payment + | DeletePayment PaymentId diff --git a/src/client/elm/Model/Action/SignInAction.elm b/src/client/elm/Model/Action/SignInAction.elm new file mode 100644 index 0000000..6673c11 --- /dev/null +++ b/src/client/elm/Model/Action/SignInAction.elm @@ -0,0 +1,6 @@ +module Model.Action.SignInAction + ( SignInAction(..) + ) where + +type SignInAction = + ErrorLogin String diff --git a/src/client/elm/Model/Communication.elm b/src/client/elm/Model/Communication.elm new file mode 100644 index 0000000..dc4d412 --- /dev/null +++ b/src/client/elm/Model/Communication.elm @@ -0,0 +1,18 @@ +module Model.Communication + ( Communication(..) + ) where + +import Time exposing (Time) + +import Model.User exposing (UserId) +import Model.Payment exposing (..) + +type Communication = + NoCommunication + | SignIn String + | AddPayment String Int + | AddMonthlyPayment String Int + | SetIncome Time Int + | DeletePayment Payment Int + | DeleteMonthlyPayment PaymentId + | SignOut diff --git a/src/client/elm/Model/View/LoggedIn/Add.elm b/src/client/elm/Model/View/LoggedIn/AddPayment.elm index c25c640..b70b0c6 100644 --- a/src/client/elm/Model/View/LoggedIn/Add.elm +++ b/src/client/elm/Model/View/LoggedIn/AddPayment.elm @@ -1,4 +1,4 @@ -module Model.View.LoggedIn.Add +module Model.View.LoggedIn.AddPayment ( AddPayment , Frequency(..) , initAddPayment diff --git a/src/client/elm/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm index 122c4be..712ce2d 100644 --- a/src/client/elm/Model/View/LoggedInView.elm +++ b/src/client/elm/Model/View/LoggedInView.elm @@ -6,7 +6,7 @@ module Model.View.LoggedInView import Model.User exposing (Users, UserId) import Model.Payment exposing (Payments) import Model.Payer exposing (Payers) -import Model.View.LoggedIn.Add exposing (..) +import Model.View.LoggedIn.AddPayment exposing (..) import Model.View.LoggedIn.Edition exposing (..) import Model.View.LoggedIn.Monthly exposing (..) import Model.View.LoggedIn.Account exposing (..) diff --git a/src/client/elm/Persona.elm b/src/client/elm/Persona.elm index e55d1b2..d5e1d6a 100644 --- a/src/client/elm/Persona.elm +++ b/src/client/elm/Persona.elm @@ -1,8 +1,6 @@ module Persona ( Operation(..) , operations - , fromString - , toString ) where type Operation = @@ -11,15 +9,3 @@ type Operation = operations : Signal.Mailbox Operation operations = Signal.mailbox NoOp - -fromString : String -> Operation -fromString str = - case str of - "SignIn" -> SignIn - _ -> NoOp - -toString : Operation -> String -toString operation = - case operation of - SignIn -> "SignIn" - _ -> "NoOp" diff --git a/src/client/elm/ServerCommunication.elm b/src/client/elm/ServerCommunication.elm index 62644f8..ff0937e 100644 --- a/src/client/elm/ServerCommunication.elm +++ b/src/client/elm/ServerCommunication.elm @@ -1,7 +1,5 @@ module ServerCommunication - ( Communication(..) - , sendRequest - , serverCommunications + ( sendRequest ) where import Signal @@ -14,31 +12,18 @@ import Debug import SimpleHTTP exposing (..) -import Model.User exposing (UserId) +import Model.Communication exposing (..) +import Model.Action as U +import Model.Action.LoggedInAction as UL +import Model.Action.MonthlyAction as UM +import Model.Action.AccountAction as UA +import Model.View.LoggedIn.AddPayment exposing (Frequency(..)) import Model.Payment exposing (..) -import Model.View.LoggedIn.Add exposing (Frequency(..)) -import Update as U exposing (actions) -import Update.SignIn exposing (..) -import Update.LoggedIn as UL -import Update.LoggedIn.Monthly as UM -import Update.LoggedIn.Account as UA +import Update.SignIn exposing (updateSignIn) import InitViewAction exposing (initViewAction) -type Communication = - NoCommunication - | SignIn String - | AddPayment String Int - | AddMonthlyPayment String Int - | SetIncome Time Int - | DeletePayment Payment Int - | DeleteMonthlyPayment PaymentId - | SignOut - -serverCommunications : Signal.Mailbox Communication -serverCommunications = Signal.mailbox NoCommunication - sendRequest : Communication -> Task Http.Error U.Action sendRequest communication = case communication of diff --git a/src/client/elm/Sign.elm b/src/client/elm/Sign.elm deleted file mode 100644 index 44f23b8..0000000 --- a/src/client/elm/Sign.elm +++ /dev/null @@ -1,43 +0,0 @@ -module Sign - ( Operation(..) - , decodeOperation - , toServerCommunication - ) where - -import Json.Decode as Json -import Json.Decode exposing (Value, Decoder, (:=)) -import Maybe - -import ServerCommunication as SC - -type Operation = - NoOp - | SignIn String - | SignOut - -decodeOperation : Value -> Operation -decodeOperation value = - Json.decodeValue operationDecoder value - |> Result.toMaybe - |> Maybe.withDefault NoOp - -toServerCommunication : Operation -> SC.Communication -toServerCommunication operation = - case operation of - NoOp -> SC.NoCommunication - SignIn assertion -> SC.SignIn assertion - SignOut -> SC.SignOut - -operationDecoder : Decoder Operation -operationDecoder = - ("operation" := Json.string) `Json.andThen` operationDecoderWithTag - -operationDecoderWithTag : String -> Decoder Operation -operationDecoderWithTag operation = - case operation of - "SignIn" -> - Json.map SignIn ("assertion" := Json.string) - "SignOut" -> - Json.succeed SignOut - _ -> - Json.succeed NoOp diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm index 62782a3..c955f8c 100644 --- a/src/client/elm/Update.elm +++ b/src/client/elm/Update.elm @@ -1,60 +1,62 @@ module Update - ( Action(..) - , actions - , updateModel + ( update ) where -import Time exposing (Time) +import Task + +import Effects exposing (Effects) + +import ServerCommunication exposing (sendRequest) import Model exposing (Model) -import Model.User exposing (Users, UserId) -import Model.Payment exposing (Payments) -import Model.Payer exposing (Payers) +import Model.Action exposing (..) import Model.View as V import Model.View.SignInView exposing (..) import Model.View.LoggedInView exposing (..) +import Model.Communication exposing (Communication) -import Update.SignIn exposing (..) -import Update.LoggedIn exposing (..) - -type Action = - NoOp - | UpdateTime Time - | GoLoadingView - | GoSignInView - | GoLoggedInView Users UserId Payments Payments Int Payers - | SignInError String - | UpdateSignIn SignInAction - | UpdateLoggedIn LoggedAction +import Update.LoggedIn exposing (updateLoggedIn) +import Update.SignIn exposing (updateSignIn) -actions : Signal.Mailbox Action -actions = Signal.mailbox NoOp - -updateModel : Action -> Model -> Model -updateModel action model = +update : Action -> Model -> (Model, Effects Action) +update action model = case action of + NoOp -> - model + (model, Effects.none) + + ServerCommunication communication -> + ( model + , sendRequest communication + |> flip Task.onError (always <| Task.succeed NoOp) + |> Effects.task + ) + UpdateTime time -> - { model | currentTime = time } - GoLoadingView -> - { model | view = V.LoadingView } + ({ model | currentTime = time }, Effects.none) + GoSignInView -> - { model | view = V.SignInView initSignInView } + ({ model | view = V.SignInView initSignInView }, Effects.none) + 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 } + ( { model | view = V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers) } + , Effects.none + ) + UpdateSignIn signInAction -> case model.view of V.SignInView signInView -> - { model | view = V.SignInView (updateSignIn signInAction signInView) } + ( { model | view = V.SignInView (updateSignIn signInAction signInView) } + , Effects.none + ) _ -> - model + (model, Effects.none) + UpdateLoggedIn loggedAction -> case model.view of V.LoggedInView loggedInView -> - { model | view = V.LoggedInView (updateLoggedIn model loggedAction loggedInView) } + ( { model | view = V.LoggedInView (updateLoggedIn model loggedAction loggedInView) } + , Effects.none + ) _ -> - model + (model, Effects.none) diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm index 38901b2..1553141 100644 --- a/src/client/elm/Update/LoggedIn.elm +++ b/src/client/elm/Update/LoggedIn.elm @@ -1,6 +1,5 @@ module Update.LoggedIn - ( LoggedAction(..) - , updateLoggedIn + ( updateLoggedIn ) where import Date @@ -9,25 +8,17 @@ import Dict import Model exposing (Model) import Model.User exposing (UserId) import Model.Payment exposing (..) +import Model.Action.LoggedInAction exposing (..) +import Model.Action.AccountAction exposing (..) +import Model.Action.MonthlyAction as Monthly import Model.View.LoggedInView exposing (..) -import Model.View.LoggedIn.Add exposing (..) +import Model.View.LoggedIn.AddPayment exposing (..) -import Update.LoggedIn.Add exposing (..) -import Update.LoggedIn.Monthly as UM -import Update.LoggedIn.Account as UA +import Update.LoggedIn.AddPayment exposing (updateAddPayment) +import Update.LoggedIn.Monthly exposing (updateMonthly) +import Update.LoggedIn.Account exposing (updateAccount) -type LoggedAction = - UpdateAdd AddPaymentAction - | UpdatePayments Payments - | AddPayment PaymentId String Int - | AddMonthlyPayment PaymentId String Int - | ToggleEdit PaymentId - | DeletePayment Payment - | UpdatePage Int - | UpdateMonthly UM.MonthlyAction - | UpdateAccount UA.AccountAction - -updateLoggedIn : Model -> LoggedAction -> LoggedInView -> LoggedInView +updateLoggedIn : Model -> LoggedInAction -> LoggedInView -> LoggedInView updateLoggedIn model action loggedInView = case action of UpdateAdd addPaymentAction -> @@ -39,7 +30,7 @@ updateLoggedIn model action loggedInView = in { loggedInView | currentPage = 1 , add = initAddPayment Punctual - , account = UA.updateAccount (UA.UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account + , account = updateAccount (UpdatePayer loggedInView.account.me model.currentTime cost) loggedInView.account , payments = newPayment :: loggedInView.payments , paymentsCount = loggedInView.paymentsCount + 1 } @@ -48,13 +39,13 @@ updateLoggedIn model action loggedInView = | add = initAddPayment Monthly , monthly = let payment = Payment id (Date.fromTime model.currentTime) name cost loggedInView.account.me - in UM.updateMonthly (UM.AddPayment payment) loggedInView.monthly + in updateMonthly (Monthly.AddPayment payment) loggedInView.monthly } ToggleEdit id -> { loggedInView | paymentEdition = if loggedInView.paymentEdition == Just id then Nothing else Just id } DeletePayment payment -> { loggedInView - | account = UA.updateAccount (UA.UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account + | account = updateAccount (UpdatePayer payment.userId (Date.toTime payment.creation) -payment.cost) loggedInView.account , payments = deletePayment payment.id loggedInView.payments , paymentsCount = loggedInView.paymentsCount - 1 } @@ -63,6 +54,6 @@ updateLoggedIn model action loggedInView = | currentPage = page } UpdateMonthly monthlyAction -> - { loggedInView | monthly = UM.updateMonthly monthlyAction loggedInView.monthly } + { loggedInView | monthly = updateMonthly monthlyAction loggedInView.monthly } UpdateAccount accountAction -> - { loggedInView | account = UA.updateAccount accountAction loggedInView.account } + { loggedInView | account = updateAccount accountAction loggedInView.account } diff --git a/src/client/elm/Update/LoggedIn/Account.elm b/src/client/elm/Update/LoggedIn/Account.elm index c7a66dd..496fab1 100644 --- a/src/client/elm/Update/LoggedIn/Account.elm +++ b/src/client/elm/Update/LoggedIn/Account.elm @@ -1,26 +1,16 @@ module Update.LoggedIn.Account - ( AccountAction(..) - , updateAccount + ( updateAccount ) where import Maybe -import Time exposing (Time) import Dict -import Model.User exposing (UserId) -import Model.Payer exposing (..) +import Model.Payer exposing (updatePayers) +import Model.Action.AccountAction exposing (..) import Model.View.LoggedIn.Account exposing (..) import Utils.Maybe exposing (isJust) -type AccountAction = - ToggleDetail - | UpdatePayer UserId Time Int - | ToggleIncomeEdition - | UpdateIncomeEdition String - | UpdateEditionError String - | UpdateIncome Time Int - updateAccount : AccountAction -> Account -> Account updateAccount action account = case action of diff --git a/src/client/elm/Update/LoggedIn/Add.elm b/src/client/elm/Update/LoggedIn/AddPayment.elm index 92bdb7e..62eda85 100644 --- a/src/client/elm/Update/LoggedIn/Add.elm +++ b/src/client/elm/Update/LoggedIn/AddPayment.elm @@ -1,15 +1,9 @@ -module Update.LoggedIn.Add - ( AddPaymentAction(..) - , updateAddPayment +module Update.LoggedIn.AddPayment + ( updateAddPayment ) where -import Model.View.LoggedIn.Add exposing (..) - -type AddPaymentAction = - UpdateName String - | UpdateCost String - | AddError (Maybe String) (Maybe String) - | ToggleFrequency +import Model.Action.AddPaymentAction exposing (..) +import Model.View.LoggedIn.AddPayment exposing (..) updateAddPayment : AddPaymentAction -> AddPayment -> AddPayment updateAddPayment action addPayment = diff --git a/src/client/elm/Update/LoggedIn/Monthly.elm b/src/client/elm/Update/LoggedIn/Monthly.elm index 275b3e8..2505091 100644 --- a/src/client/elm/Update/LoggedIn/Monthly.elm +++ b/src/client/elm/Update/LoggedIn/Monthly.elm @@ -1,16 +1,10 @@ module Update.LoggedIn.Monthly - ( MonthlyAction(..) - , updateMonthly + ( updateMonthly ) where -import Model.Payment exposing (Payment, PaymentId) +import Model.Action.MonthlyAction exposing (..) import Model.View.LoggedIn.Monthly exposing (..) -type MonthlyAction = - ToggleDetail - | AddPayment Payment - | DeletePayment PaymentId - updateMonthly : MonthlyAction -> Monthly -> Monthly updateMonthly action monthly = case action of diff --git a/src/client/elm/Update/SignIn.elm b/src/client/elm/Update/SignIn.elm index 961fb16..c0aaf33 100644 --- a/src/client/elm/Update/SignIn.elm +++ b/src/client/elm/Update/SignIn.elm @@ -1,13 +1,10 @@ module Update.SignIn - ( SignInAction(..) - , updateSignIn + ( updateSignIn ) where +import Model.Action.SignInAction exposing (..) import Model.View.SignInView exposing (..) -type SignInAction = - ErrorLogin String - updateSignIn : SignInAction -> SignInView -> SignInView updateSignIn action signInView = case action of diff --git a/src/client/elm/View.elm b/src/client/elm/View.elm new file mode 100644 index 0000000..473caae --- /dev/null +++ b/src/client/elm/View.elm @@ -0,0 +1,33 @@ +module View + ( view + ) where + +import Html exposing (..) +import Signal exposing (Address) + +import Model exposing (Model) +import Model.Action exposing (Action) +import Model.View exposing (..) + +import View.Header exposing (renderHeader) +import View.Loading exposing (renderLoading) +import View.SignIn exposing (renderSignIn) +import View.LoggedIn exposing (renderLoggedIn) + +view : Address Action -> Model -> Html +view address model = + div + [] + [ renderHeader address model + , renderMain address model + ] + +renderMain : Address Action -> Model -> Html +renderMain address model = + case model.view of + LoadingView -> + renderLoading address + SignInView signInView -> + renderSignIn address model signInView + LoggedInView loggedInView -> + renderLoggedIn address model loggedInView diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm index 0cc2137..9d57c05 100644 --- a/src/client/elm/View/Header.elm +++ b/src/client/elm/View/Header.elm @@ -2,20 +2,22 @@ module View.Header ( renderHeader ) where +import Signal exposing (Address) + import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import ServerCommunication as SC exposing (serverCommunications) - import Model exposing (Model) -import Model.View exposing (..) import Model.Translations exposing (getMessage) +import Model.Communication as Communication +import Model.Action exposing (..) +import Model.View exposing (..) import View.Icon exposing (renderIcon) -renderHeader : Model -> Html -renderHeader model = +renderHeader : Address Action -> Model -> Html +renderHeader address model = header [] [ h1 @@ -25,7 +27,7 @@ renderHeader model = LoggedInView _ -> button [ class "icon" - , onClick serverCommunications.address SC.SignOut + , onClick address (ServerCommunication Communication.SignOut) ] [ renderIcon "power-off" ] _ -> diff --git a/src/client/elm/View/Loading.elm b/src/client/elm/View/Loading.elm index f8c6cd6..cfd5d0f 100644 --- a/src/client/elm/View/Loading.elm +++ b/src/client/elm/View/Loading.elm @@ -2,7 +2,11 @@ module View.Loading ( renderLoading ) where +import Signal exposing (Address) + import Html exposing (..) -renderLoading : Html -renderLoading = text "" +import Model.Action exposing (Action) + +renderLoading : Address Action -> Html +renderLoading address = text "" diff --git a/src/client/elm/View/LoggedIn.elm b/src/client/elm/View/LoggedIn.elm index 96916e0..69d1294 100644 --- a/src/client/elm/View/LoggedIn.elm +++ b/src/client/elm/View/LoggedIn.elm @@ -2,29 +2,32 @@ module View.LoggedIn ( renderLoggedIn ) where +import Signal exposing (Address) + import Html exposing (..) import Html.Attributes exposing (..) import Model exposing (Model) import Model.Payment exposing (Payments) +import Model.Action exposing (Action) import Model.View.LoggedInView exposing (LoggedInView) -import View.LoggedIn.Add exposing (addPayment) +import View.LoggedIn.AddPayment exposing (addPayment) import View.LoggedIn.Monthly exposing (monthlyPayments) import View.LoggedIn.Account exposing (account) import View.LoggedIn.Table exposing (paymentsTable) import View.LoggedIn.Paging exposing (paymentsPaging) -renderLoggedIn : Model -> LoggedInView -> Html -renderLoggedIn model loggedInView = +renderLoggedIn : Address Action -> Model -> LoggedInView -> Html +renderLoggedIn address model loggedInView = div [ class "loggedIn" ] - [ addPayment model loggedInView + [ addPayment address model loggedInView , div [ class "expandables" ] - [ account model loggedInView - , monthlyPayments model loggedInView + [ account address model loggedInView + , monthlyPayments address model loggedInView ] - , paymentsTable model loggedInView - , paymentsPaging loggedInView + , paymentsTable address model loggedInView + , paymentsPaging address loggedInView ] diff --git a/src/client/elm/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm index 706f7cc..9459740 100644 --- a/src/client/elm/View/LoggedIn/Account.elm +++ b/src/client/elm/View/LoggedIn/Account.elm @@ -2,23 +2,24 @@ module View.LoggedIn.Account ( account ) where +import List +import Signal exposing (Address) + 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 (..) import Model exposing (Model) import Model.User exposing (getUserName) import Model.Payer exposing (..) -import Model.View.LoggedInView exposing (LoggedInView) 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 (..) import View.Expand exposing (..) @@ -27,8 +28,8 @@ import View.Events exposing (onSubmitPrevDefault) import Utils.Either exposing (toMaybeError) -account : Model -> LoggedInView -> Html -account model loggedInView = +account : Address Action -> Model -> LoggedInView -> Html +account address model loggedInView = let account = loggedInView.account in div [ classList @@ -36,17 +37,17 @@ account model loggedInView = , ("detail", account.visibleDetail) ] ] - [ exceedingPayers model loggedInView + [ exceedingPayers address model loggedInView , if account.visibleDetail - then income model account + then income address model account else text "" ] -exceedingPayers : Model -> LoggedInView -> Html -exceedingPayers model loggedInView = +exceedingPayers : Address Action -> Model -> LoggedInView -> Html +exceedingPayers address model loggedInView = button [ class "header" - , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleDetail) + , onClick address (UpdateLoggedIn << UpdateAccount <| ToggleDetail) ] ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.account.payers)) ++ [ expand ExpandDown loggedInView.account.visibleDetail ] @@ -68,16 +69,16 @@ exceedingPayer model loggedInView payer = [ text ("+ " ++ (price model payer.amount)) ] ] -income : Model -> Account -> Html -income model account = +income : Address Action -> Model -> Account -> Html +income address model account = case account.incomeEdition of - Just edition -> - incomeEdition model account edition Nothing -> - incomeRead model account + incomeRead address model account + Just edition -> + incomeEdition address model account edition -incomeRead : Model -> Account -> Html -incomeRead model account = +incomeRead : Address Action -> Model -> Account -> Html +incomeRead address model account = div [ class "income" ] [ ( case getCurrentIncome account of @@ -86,17 +87,17 @@ incomeRead model account = Just income -> text (getParamMessage [price model income] "Income" model.translations) ) - , toggleIncomeEdition "editIncomeEdition" (getMessage "Edit" model.translations) + , toggleIncomeEdition address "editIncomeEdition" (getMessage "Edit" model.translations) ] -incomeEdition : Model -> Account -> IncomeEdition -> Html -incomeEdition model account edition = +incomeEdition : Address Action -> Model -> Account -> IncomeEdition -> Html +incomeEdition address model account edition = H.form [ case validateIncome edition.income model.translations of Ok validatedAmount -> - onSubmitPrevDefault serverCommunications.address (SC.SetIncome model.currentTime validatedAmount) + onSubmitPrevDefault address (ServerCommunication <| Communication.SetIncome model.currentTime validatedAmount) Err error -> - onSubmitPrevDefault actions.address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error) + onSubmitPrevDefault address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error) , class "income" ] [ label @@ -105,7 +106,7 @@ incomeEdition model account edition = , input [ id "incomeInput" , value edition.income - , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAccount << UpdateIncomeEdition) + , on "input" targetValue (Signal.message address << UpdateLoggedIn << UpdateAccount << UpdateIncomeEdition) , maxlength 10 ] [] @@ -114,17 +115,17 @@ incomeEdition model account edition = , class "validateIncomeEdition" ] [ text (getMessage "Validate" model.translations) ] - , toggleIncomeEdition "undoIncomeEdition" (getMessage "Undo" model.translations) + , toggleIncomeEdition address "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 = +toggleIncomeEdition : Address Action -> String -> String -> Html +toggleIncomeEdition address className name = button [ type' "button" , class className - , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleIncomeEdition) + , onClick address (UpdateLoggedIn << UpdateAccount <| ToggleIncomeEdition) ] [ text name ] diff --git a/src/client/elm/View/LoggedIn/Add.elm b/src/client/elm/View/LoggedIn/AddPayment.elm index 2f580f9..0fbe28e 100644 --- a/src/client/elm/View/LoggedIn/Add.elm +++ b/src/client/elm/View/LoggedIn/AddPayment.elm @@ -1,22 +1,23 @@ -module View.LoggedIn.Add +module View.LoggedIn.AddPayment ( addPayment ) where -import Html as H exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) import Reads exposing (readInt) import Result exposing (..) +import Signal exposing (Address) -import ServerCommunication as SC exposing (serverCommunications) - -import Update exposing (..) -import Update.LoggedIn exposing (..) -import Update.LoggedIn.Add exposing (..) +import Html as H exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) import Model exposing (Model) -import Model.View.LoggedIn.Add exposing (..) import Model.Translations exposing (getMessage) +import Model.Action exposing (..) +import Model.Action.LoggedInAction exposing (..) +import Model.Action.AddPaymentAction exposing (..) +import Model.Communication as Communication + +import Model.View.LoggedIn.AddPayment exposing (..) import Model.View.LoggedInView exposing (LoggedInView) import View.Events exposing (onSubmitPrevDefault) @@ -25,31 +26,31 @@ import View.Icon exposing (renderIcon) import Utils.Maybe exposing (isJust) import Utils.Either exposing (toMaybeError) -addPayment : Model -> LoggedInView -> Html -addPayment model loggedInView = +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) -> let action = case loggedInView.add.frequency of - Punctual -> SC.AddPayment name cost - Monthly -> SC.AddMonthlyPayment name cost - in onSubmitPrevDefault serverCommunications.address action + Punctual -> Communication.AddPayment name cost + Monthly -> Communication.AddMonthlyPayment name cost + in onSubmitPrevDefault address (ServerCommunication action) (resName, resCost) -> - onSubmitPrevDefault actions.address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost)) + onSubmitPrevDefault address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost)) , class "addPayment" ] - [ addPaymentName loggedInView.add - , addPaymentCost model loggedInView.add - , paymentFrequency model loggedInView.add + [ addPaymentName address loggedInView.add + , addPaymentCost address model loggedInView.add + , paymentFrequency address model loggedInView.add , button [ type' "submit" , class "add" ] [ text (getMessage "Add" model.translations)] ] -addPaymentName : AddPayment -> Html -addPaymentName addPayment = +addPaymentName : Address Action -> AddPayment -> Html +addPaymentName address addPayment = div [ classList [ ("name", True) @@ -59,7 +60,7 @@ addPaymentName addPayment = [ input [ id "nameInput" , value addPayment.name - , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAdd << UpdateName) + , on "input" targetValue (Signal.message address << UpdateLoggedIn << UpdateAdd << UpdateName) , maxlength 20 ] [] @@ -73,8 +74,8 @@ addPaymentName addPayment = text "" ] -addPaymentCost : Model -> AddPayment -> Html -addPaymentCost model addPayment = +addPaymentCost : Address Action -> Model -> AddPayment -> Html +addPaymentCost address model addPayment = div [ classList [ ("cost", True) @@ -84,7 +85,7 @@ addPaymentCost model addPayment = [ input [ id "costInput" , value addPayment.cost - , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAdd << UpdateCost) + , on "input" targetValue (Signal.message address << UpdateLoggedIn << UpdateAdd << UpdateCost) , maxlength 7 ] [] @@ -98,12 +99,12 @@ addPaymentCost model addPayment = text "" ] -paymentFrequency : Model -> AddPayment -> Html -paymentFrequency model addPayment = +paymentFrequency : Address Action -> Model -> AddPayment -> Html +paymentFrequency address model addPayment = button [ type' "button" , class "frequency" - , onClick actions.address (UpdateLoggedIn << UpdateAdd <| ToggleFrequency) + , onClick address (UpdateLoggedIn << UpdateAdd <| ToggleFrequency) ] [ div [ classList diff --git a/src/client/elm/View/LoggedIn/Monthly.elm b/src/client/elm/View/LoggedIn/Monthly.elm index a274015..2c11993 100644 --- a/src/client/elm/View/LoggedIn/Monthly.elm +++ b/src/client/elm/View/LoggedIn/Monthly.elm @@ -3,29 +3,28 @@ module View.LoggedIn.Monthly ) where import String +import Signal exposing (Address) import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Update exposing (..) -import Update.LoggedIn exposing (..) -import Update.LoggedIn.Monthly exposing (..) - import Model exposing (Model) -import Model.View.LoggedIn.Monthly exposing (Monthly) import Model.Payment exposing (Payments, Payment) -import Model.View.LoggedInView exposing (LoggedInView) import Model.Translations exposing (getMessage, getParamMessage) - -import ServerCommunication as SC exposing (serverCommunications) +import Model.Action exposing (..) +import Model.Action.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) import View.Icon exposing (renderIcon) import View.Expand exposing (..) import View.Price exposing (price) -monthlyPayments : Model -> LoggedInView -> Html -monthlyPayments model loggedInView = +monthlyPayments : Address Action -> Model -> LoggedInView -> Html +monthlyPayments address model loggedInView = let monthly = loggedInView.monthly in if List.length monthly.payments == 0 then @@ -37,40 +36,40 @@ monthlyPayments model loggedInView = , ("detail", monthly.visibleDetail) ] ] - [ monthlyCount model monthly - , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text "" + [ monthlyCount address model monthly + , if monthly.visibleDetail then paymentsTable address model loggedInView monthly else text "" ] -monthlyCount : Model -> Monthly -> Html -monthlyCount model monthly = +monthlyCount : Address Action -> Model -> Monthly -> Html +monthlyCount address model monthly = let count = List.length monthly.payments total = List.sum << List.map .cost <| monthly.payments key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount" in button [ class "header" - , onClick actions.address (UpdateLoggedIn << UpdateMonthly <| ToggleDetail) + , onClick address (UpdateLoggedIn << UpdateMonthly <| ToggleDetail) ] [ text (getParamMessage [toString count, price model total] key model.translations) , expand ExpandDown monthly.visibleDetail ] -paymentsTable : Model -> LoggedInView -> Monthly -> Html -paymentsTable model loggedInView monthly = +paymentsTable : Address Action -> Model -> LoggedInView -> Monthly -> Html +paymentsTable address model loggedInView monthly = div [ class "table" ] ( monthly.payments |> List.sortBy (String.toLower << .name) - |> List.map (paymentLine model loggedInView) + |> List.map (paymentLine address model loggedInView) ) -paymentLine : Model -> LoggedInView -> Payment -> Html -paymentLine model loggedInView payment = +paymentLine : Address Action -> Model -> LoggedInView -> Payment -> Html +paymentLine address model loggedInView payment = a [ classList [ ("row", True) , ("edition", loggedInView.paymentEdition == Just payment.id) ] - , onClick actions.address (UpdateLoggedIn (ToggleEdit payment.id)) + , onClick address (UpdateLoggedIn (ToggleEdit payment.id)) ] [ div [ class "cell category" ] [ text (payment.name) ] , div @@ -82,7 +81,7 @@ paymentLine model loggedInView payment = [ text (price model payment.cost) ] , div [ class "cell delete" - , onClick serverCommunications.address (SC.DeleteMonthlyPayment payment.id) + , onClick address (ServerCommunication <| Communication.DeleteMonthlyPayment payment.id) ] [ button [] [ renderIcon "times" ] ] diff --git a/src/client/elm/View/LoggedIn/Paging.elm b/src/client/elm/View/LoggedIn/Paging.elm index e40c5aa..154686a 100644 --- a/src/client/elm/View/LoggedIn/Paging.elm +++ b/src/client/elm/View/LoggedIn/Paging.elm @@ -2,23 +2,24 @@ module View.LoggedIn.Paging ( paymentsPaging ) where +import Signal exposing (Address) + import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Model.Action exposing (..) +import Model.Action.LoggedInAction exposing (..) import Model.View.LoggedInView exposing (..) import Model.Payment exposing (perPage) -import Update exposing (..) -import Update.LoggedIn exposing (..) - import View.Icon exposing (renderIcon) showedPages : Int showedPages = 5 -paymentsPaging : LoggedInView -> Html -paymentsPaging loggedInView = +paymentsPaging : Address Action -> LoggedInView -> Html +paymentsPaging address loggedInView = let maxPage = ceiling (toFloat loggedInView.paymentsCount / toFloat perPage) pages = truncatePages loggedInView.currentPage [1..maxPage] in if maxPage == 1 @@ -28,12 +29,12 @@ paymentsPaging loggedInView = div [ class "pages" ] ( ( if loggedInView.currentPage > 1 - then [ firstPage, previousPage loggedInView ] + then [ firstPage address, previousPage address loggedInView ] else [] ) - ++ ( List.map (paymentsPage loggedInView) pages) + ++ ( List.map (paymentsPage address loggedInView) pages) ++ ( if loggedInView.currentPage < maxPage - then [ nextPage loggedInView, lastPage maxPage ] + then [ nextPage address loggedInView, lastPage address maxPage ] else [] ) ) @@ -52,47 +53,47 @@ truncatePages currentPage pages = [(currentPage - showedLeftPages)..(currentPage + showedRightPages)] in List.filter (flip List.member pages) truncatedPages -firstPage : Html -firstPage = +firstPage : Address Action -> Html +firstPage address = button [ class "page" - , onClick actions.address (UpdateLoggedIn (UpdatePage 1)) + , onClick address (UpdateLoggedIn (UpdatePage 1)) ] [ renderIcon "fast-backward" ] -previousPage : LoggedInView -> Html -previousPage loggedInView = +previousPage : Address Action -> LoggedInView -> Html +previousPage address loggedInView = button [ class "page" - , onClick actions.address (UpdateLoggedIn (UpdatePage (loggedInView.currentPage - 1))) + , onClick address (UpdateLoggedIn (UpdatePage (loggedInView.currentPage - 1))) ] [ renderIcon "backward" ] -nextPage : LoggedInView -> Html -nextPage loggedInView = +nextPage : Address Action -> LoggedInView -> Html +nextPage address loggedInView = button [ class "page" - , onClick actions.address (UpdateLoggedIn (UpdatePage (loggedInView.currentPage + 1))) + , onClick address (UpdateLoggedIn (UpdatePage (loggedInView.currentPage + 1))) ] [ renderIcon "forward" ] -lastPage : Int -> Html -lastPage maxPage = +lastPage : Address Action -> Int -> Html +lastPage address maxPage = button [ class "page" - , onClick actions.address (UpdateLoggedIn (UpdatePage maxPage)) + , onClick address (UpdateLoggedIn (UpdatePage maxPage)) ] [ renderIcon "fast-forward" ] -paymentsPage : LoggedInView -> Int -> Html -paymentsPage loggedInView page = +paymentsPage : Address Action -> LoggedInView -> Int -> Html +paymentsPage address loggedInView page = let onCurrentPage = page == loggedInView.currentPage in button [ classList [ ("page", True) , ("current", onCurrentPage) ] - , onClick actions.address <| + , onClick address <| if onCurrentPage then NoOp else UpdateLoggedIn (UpdatePage page) ] [ text (toString page) ] diff --git a/src/client/elm/View/LoggedIn/Table.elm b/src/client/elm/View/LoggedIn/Table.elm index 51a7b73..8590dc5 100644 --- a/src/client/elm/View/LoggedIn/Table.elm +++ b/src/client/elm/View/LoggedIn/Table.elm @@ -2,36 +2,33 @@ module View.LoggedIn.Table ( paymentsTable ) where -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) import Dict exposing (..) - -import Date import Date exposing (Date) - +import Signal exposing (Address) import String exposing (append) +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + import Model exposing (Model) import Model.User exposing (getUserName) import Model.Payment exposing (..) -import Model.View.LoggedInView exposing (LoggedInView) import Model.Translations exposing (getMessage) - -import ServerCommunication as SC exposing (serverCommunications) - -import Update exposing (..) -import Update.LoggedIn exposing (..) +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) import View.Date exposing (..) import View.Price exposing (price) -paymentsTable : Model -> LoggedInView -> Html -paymentsTable model loggedInView = +paymentsTable : Address Action -> Model -> LoggedInView -> Html +paymentsTable address model loggedInView = div [ class "table" ] - ( headerLine model :: paymentLines model loggedInView) + ( headerLine model :: paymentLines address model loggedInView) headerLine : Model -> Html headerLine model = @@ -44,23 +41,23 @@ headerLine model = , div [ class "cell" ] [] ] -paymentLines : Model -> LoggedInView -> List Html -paymentLines model loggedInView = +paymentLines : Address Action -> Model -> LoggedInView -> List Html +paymentLines address model loggedInView = loggedInView.payments |> List.sortBy (Date.toTime << .creation) |> List.reverse |> List.drop ((loggedInView.currentPage - 1) * perPage) |> List.take perPage - |> List.map (paymentLine model loggedInView) + |> List.map (paymentLine address model loggedInView) -paymentLine : Model -> LoggedInView -> Payment -> Html -paymentLine model loggedInView payment = +paymentLine : Address Action -> Model -> LoggedInView -> Payment -> Html +paymentLine address model loggedInView payment = a [ classList [ ("row", True) , ("edition", loggedInView.paymentEdition == Just payment.id) ] - , onClick actions.address (UpdateLoggedIn (ToggleEdit payment.id)) + , onClick address (UpdateLoggedIn (ToggleEdit payment.id)) ] [ div [ class "cell category" ] [ text payment.name ] , div @@ -91,7 +88,7 @@ paymentLine model loggedInView payment = div [ class "cell delete" ] [ button - [ onClick serverCommunications.address (SC.DeletePayment payment loggedInView.currentPage) ] + [ onClick address (ServerCommunication <| Communication.DeletePayment payment loggedInView.currentPage) ] [ renderIcon "times" ] ] else diff --git a/src/client/elm/View/Page.elm b/src/client/elm/View/Page.elm deleted file mode 100644 index 763734d..0000000 --- a/src/client/elm/View/Page.elm +++ /dev/null @@ -1,31 +0,0 @@ -module View.Page - ( renderPage - ) where - -import Html exposing (..) - -import Model exposing (Model) -import Model.View exposing (..) - -import View.Header exposing (renderHeader) -import View.Loading exposing (renderLoading) -import View.SignIn exposing (renderSignIn) -import View.LoggedIn exposing (renderLoggedIn) - -renderPage : Model -> Html -renderPage model = - div - [] - [ renderHeader model - , renderMain model - ] - -renderMain : Model -> Html -renderMain model = - case model.view of - LoadingView -> - renderLoading - SignInView signInView -> - renderSignIn model signInView - LoggedInView loggedInView -> - renderLoggedIn model loggedInView diff --git a/src/client/elm/View/SignIn.elm b/src/client/elm/View/SignIn.elm index d35d655..6d253e7 100644 --- a/src/client/elm/View/SignIn.elm +++ b/src/client/elm/View/SignIn.elm @@ -2,29 +2,26 @@ module View.SignIn ( renderSignIn ) where +import Json.Decode as Json +import Signal exposing (Address) + import Html as H exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import Json.Decode as Json - -import Update exposing (..) -import Update.SignIn exposing (..) - -import ServerCommunication as SC -import ServerCommunication exposing (serverCommunications) - -import Persona exposing (operations) - import Model exposing (Model) +import Model.Action exposing (..) +import Model.Action.SignInAction exposing (..) import Model.View.SignInView exposing (..) import Model.Translations exposing (getMessage) import View.Events exposing (onSubmitPrevDefault) import View.Icon exposing (renderIcon) -renderSignIn : Model -> SignInView -> Html -renderSignIn model signInView = +import Persona exposing (operations) + +renderSignIn : Address Action -> Model -> SignInView -> Html +renderSignIn address model signInView = div [ class "signIn" ] [ button |