diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/client/elm/Action.elm | 5 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Action.elm | 17 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Account/Action.elm (renamed from src/client/elm/LoggedIn/Account/Action.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Account/Model.elm (renamed from src/client/elm/LoggedIn/Account/Model.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Account/Update.elm (renamed from src/client/elm/LoggedIn/Account/Update.elm) | 6 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Account/View.elm (renamed from src/client/elm/LoggedIn/Account/View.elm) | 48 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Action.elm | 22 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/AddPayment/Action.elm (renamed from src/client/elm/LoggedIn/AddPayment/Action.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/AddPayment/Model.elm (renamed from src/client/elm/LoggedIn/AddPayment/Model.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/AddPayment/Update.elm (renamed from src/client/elm/LoggedIn/AddPayment/Update.elm) | 6 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/AddPayment/View.elm (renamed from src/client/elm/LoggedIn/AddPayment/View.elm) | 34 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Model.elm | 37 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Model/Payer.elm (renamed from src/client/elm/LoggedIn/Model/Payer.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Monthly/Action.elm (renamed from src/client/elm/LoggedIn/Monthly/Action.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Monthly/Model.elm (renamed from src/client/elm/LoggedIn/Monthly/Model.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Monthly/Update.elm (renamed from src/client/elm/LoggedIn/Monthly/Update.elm) | 6 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Monthly/View.elm (renamed from src/client/elm/LoggedIn/Monthly/View.elm) | 40 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/Update.elm | 139 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/View.elm | 34 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/View/Date.elm (renamed from src/client/elm/LoggedIn/View/Date.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/View/Expand.elm (renamed from src/client/elm/LoggedIn/View/Expand.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/View/Paging.elm (renamed from src/client/elm/LoggedIn/View/Paging.elm) | 48 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/View/Price.elm (renamed from src/client/elm/LoggedIn/View/Price.elm) | 2 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Home/View/Table.elm (renamed from src/client/elm/LoggedIn/View/Table.elm) | 40 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Model.elm | 26 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/Update.elm | 134 | ||||
-rw-r--r-- | src/client/elm/LoggedIn/View.elm | 31 | ||||
-rw-r--r-- | src/client/elm/Main.elm | 48 | ||||
-rw-r--r-- | src/client/elm/Model.elm | 5 | ||||
-rw-r--r-- | src/client/elm/Route.elm | 25 | ||||
-rw-r--r-- | src/client/elm/Server.elm | 22 | ||||
-rw-r--r-- | src/client/elm/SignIn/View.elm | 1 | ||||
-rw-r--r-- | src/client/elm/Update.elm | 21 | ||||
-rw-r--r-- | src/client/elm/Utils/Effects.elm | 10 | ||||
-rw-r--r-- | src/client/elm/View/Click.elm | 24 | ||||
-rw-r--r-- | src/client/elm/View/Header.elm | 15 | ||||
-rw-r--r-- | src/client/js/main.js | 5 | ||||
-rw-r--r-- | src/server/Design/Header.hs | 2 | ||||
-rw-r--r-- | src/server/Main.hs | 59 |
39 files changed, 568 insertions, 362 deletions
diff --git a/src/client/elm/Action.elm b/src/client/elm/Action.elm index 33954dc..38c0def 100644 --- a/src/client/elm/Action.elm +++ b/src/client/elm/Action.elm @@ -5,6 +5,10 @@ module Action import Time exposing (Time) import Signal exposing (Address) +import TransitRouter + +import Route exposing (Route) + import Model.Init exposing (Init) import SignIn.Action as SignInAction @@ -18,4 +22,5 @@ type Action = | UpdateSignIn SignInAction.Action | UpdateLoggedIn LoggedInAction.Action | GoSignInView + | RouterAction (TransitRouter.Action Route) | SignOut diff --git a/src/client/elm/LoggedIn/Action.elm b/src/client/elm/LoggedIn/Action.elm index 2872f1a..4f9bcc1 100644 --- a/src/client/elm/LoggedIn/Action.elm +++ b/src/client/elm/LoggedIn/Action.elm @@ -2,21 +2,8 @@ module LoggedIn.Action ( Action(..) ) where -import Model.Payment exposing (Payments, Payment, PaymentId, PaymentFrequency) - -import LoggedIn.Account.Action as AccountAction -import LoggedIn.AddPayment.Action as AddPaymentAction -import LoggedIn.Monthly.Action as MonthlyAction +import LoggedIn.Home.Action as HomeAction type Action = NoOp - | UpdateAdd AddPaymentAction.Action - | UpdatePayments Payments - | AddPayment String String PaymentFrequency - | ValidateAddPayment PaymentId String Int PaymentFrequency - | DeletePayment Payment PaymentFrequency - | ValidateDeletePayment Payment PaymentFrequency - | ToggleEdit PaymentId - | UpdatePage Int - | UpdateMonthly MonthlyAction.Action - | UpdateAccount AccountAction.Action + | HomeAction HomeAction.Action diff --git a/src/client/elm/LoggedIn/Account/Action.elm b/src/client/elm/LoggedIn/Home/Account/Action.elm index 66ccfaa..61dae42 100644 --- a/src/client/elm/LoggedIn/Account/Action.elm +++ b/src/client/elm/LoggedIn/Home/Account/Action.elm @@ -1,4 +1,4 @@ -module LoggedIn.Account.Action +module LoggedIn.Home.Account.Action ( Action(..) ) where diff --git a/src/client/elm/LoggedIn/Account/Model.elm b/src/client/elm/LoggedIn/Home/Account/Model.elm index 2d0c4a3..d8bf748 100644 --- a/src/client/elm/LoggedIn/Account/Model.elm +++ b/src/client/elm/LoggedIn/Home/Account/Model.elm @@ -1,4 +1,4 @@ -module LoggedIn.Account.Model +module LoggedIn.Home.Account.Model ( Model , IncomeEdition , init diff --git a/src/client/elm/LoggedIn/Account/Update.elm b/src/client/elm/LoggedIn/Home/Account/Update.elm index a3d9745..8d002a3 100644 --- a/src/client/elm/LoggedIn/Account/Update.elm +++ b/src/client/elm/LoggedIn/Home/Account/Update.elm @@ -1,4 +1,4 @@ -module LoggedIn.Account.Update +module LoggedIn.Home.Account.Update ( update ) where @@ -10,8 +10,8 @@ import Effects exposing (Effects) import Server -import LoggedIn.Account.Action as AccountAction -import LoggedIn.Account.Model as AccountModel +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.Account.Model as AccountModel import Utils.Maybe exposing (isJust) diff --git a/src/client/elm/LoggedIn/Account/View.elm b/src/client/elm/LoggedIn/Home/Account/View.elm index 5d96da6..252f8cf 100644 --- a/src/client/elm/LoggedIn/Account/View.elm +++ b/src/client/elm/LoggedIn/Home/Account/View.elm @@ -1,4 +1,4 @@ -module LoggedIn.Account.View +module LoggedIn.Home.Account.View ( view ) where @@ -11,13 +11,15 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import LoggedIn.Action as LoggedInAction -import LoggedIn.Model as LoggedInModel -import LoggedIn.Model.Payer exposing (..) -import LoggedIn.View.Price exposing (price) -import LoggedIn.View.Expand exposing (..) -import LoggedIn.Account.Action as AccountAction -import LoggedIn.Account.Model as AccountModel +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel +import LoggedIn.Home.Model.Payer exposing (..) +import LoggedIn.Home.View.Price exposing (price) +import LoggedIn.Home.View.Expand exposing (..) + +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.Account.Model as AccountModel import Model exposing (Model) import Model.User exposing (getUserName) @@ -28,39 +30,39 @@ import View.Events exposing (onSubmitPrevDefault) import Utils.Either exposing (toMaybeError) -view : Address Action -> Model -> LoggedInModel.Model -> Html -view address model loggedInModel = - let account = loggedInModel.account +view : Address Action -> Model -> HomeModel.Model -> Html +view address model homeModel = + let account = homeModel.account in div [ classList [ ("account", True) , ("detail", account.visibleDetail) ] ] - [ exceedingPayers address model loggedInModel + [ exceedingPayers address model homeModel , if account.visibleDetail then income address model account else text "" ] -exceedingPayers : Address Action -> Model -> LoggedInModel.Model -> Html -exceedingPayers address model loggedInModel = +exceedingPayers : Address Action -> Model -> HomeModel.Model -> Html +exceedingPayers address model homeModel = button [ class "header" - , onClick address (UpdateLoggedIn << LoggedInAction.UpdateAccount <| AccountAction.ToggleDetail) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.ToggleDetail) ] - ( (List.map (exceedingPayer model loggedInModel) (getOrderedExceedingPayers model.currentTime loggedInModel.users loggedInModel.account.incomes loggedInModel.payments)) - ++ [ expand ExpandDown loggedInModel.account.visibleDetail ] + ( (List.map (exceedingPayer model homeModel) (getOrderedExceedingPayers model.currentTime homeModel.users homeModel.account.incomes homeModel.payments)) + ++ [ expand ExpandDown homeModel.account.visibleDetail ] ) -exceedingPayer : Model -> LoggedInModel.Model -> ExceedingPayer -> Html -exceedingPayer model loggedInModel payer = +exceedingPayer : Model -> HomeModel.Model -> ExceedingPayer -> Html +exceedingPayer model homeModel payer = div [ class "exceedingPayer" ] [ span [ class "userName" ] [ payer.userId - |> getUserName loggedInModel.users + |> getUserName homeModel.users |> Maybe.withDefault "−" |> text ] @@ -95,9 +97,9 @@ incomeEdition address model account edition = H.form [ case AccountModel.validateIncome edition.income model.translations of Ok validatedAmount -> - onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.UpdateAccount <| AccountAction.UpdateIncome model.currentTime validatedAmount) + onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.UpdateIncome model.currentTime validatedAmount) Err error -> - onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.UpdateAccount << AccountAction.UpdateEditionError <| error) + onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount << AccountAction.UpdateEditionError <| error) , class "income" ] [ label @@ -106,7 +108,7 @@ incomeEdition address model account edition = , input [ id "incomeInput" , value edition.income - , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.UpdateAccount << AccountAction.UpdateIncomeEdition) + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount << AccountAction.UpdateIncomeEdition) , maxlength 10 ] [] @@ -126,6 +128,6 @@ toggleIncomeEdition address className name = button [ type' "button" , class className - , onClick address (UpdateLoggedIn << LoggedInAction.UpdateAccount <| AccountAction.ToggleIncomeEdition) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.ToggleIncomeEdition) ] [ text name ] diff --git a/src/client/elm/LoggedIn/Home/Action.elm b/src/client/elm/LoggedIn/Home/Action.elm new file mode 100644 index 0000000..d6d82d0 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Action.elm @@ -0,0 +1,22 @@ +module LoggedIn.Home.Action + ( Action(..) + ) where + +import Model.Payment exposing (Payments, Payment, PaymentId, PaymentFrequency) + +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.AddPayment.Action as AddPaymentAction +import LoggedIn.Home.Monthly.Action as MonthlyAction + +type Action = + NoOp + | UpdateAdd AddPaymentAction.Action + | UpdatePayments Payments + | AddPayment String String PaymentFrequency + | ValidateAddPayment PaymentId String Int PaymentFrequency + | DeletePayment Payment PaymentFrequency + | ValidateDeletePayment Payment PaymentFrequency + | ToggleEdit PaymentId + | UpdatePage Int + | UpdateMonthly MonthlyAction.Action + | UpdateAccount AccountAction.Action diff --git a/src/client/elm/LoggedIn/AddPayment/Action.elm b/src/client/elm/LoggedIn/Home/AddPayment/Action.elm index 41d4f5b..095863f 100644 --- a/src/client/elm/LoggedIn/AddPayment/Action.elm +++ b/src/client/elm/LoggedIn/Home/AddPayment/Action.elm @@ -1,4 +1,4 @@ -module LoggedIn.AddPayment.Action +module LoggedIn.Home.AddPayment.Action ( Action(..) ) where diff --git a/src/client/elm/LoggedIn/AddPayment/Model.elm b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm index 2aa32c2..22b6883 100644 --- a/src/client/elm/LoggedIn/AddPayment/Model.elm +++ b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm @@ -1,4 +1,4 @@ -module LoggedIn.AddPayment.Model +module LoggedIn.Home.AddPayment.Model ( Model , init ) where diff --git a/src/client/elm/LoggedIn/AddPayment/Update.elm b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm index eb4384b..b8020f1 100644 --- a/src/client/elm/LoggedIn/AddPayment/Update.elm +++ b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm @@ -1,4 +1,4 @@ -module LoggedIn.AddPayment.Update +module LoggedIn.Home.AddPayment.Update ( update , addPaymentError ) where @@ -6,8 +6,8 @@ module LoggedIn.AddPayment.Update import Maybe import Json.Decode as Json exposing ((:=)) -import LoggedIn.AddPayment.Action as AddPaymentAction -import LoggedIn.AddPayment.Model as AddPaymentModel +import LoggedIn.Home.AddPayment.Action as AddPaymentAction +import LoggedIn.Home.AddPayment.Model as AddPaymentModel import Model.Translations exposing (Translations, getMessage) import Model.Payment exposing (PaymentFrequency(..)) diff --git a/src/client/elm/LoggedIn/AddPayment/View.elm b/src/client/elm/LoggedIn/Home/AddPayment/View.elm index 90f4f02..09d5fbf 100644 --- a/src/client/elm/LoggedIn/AddPayment/View.elm +++ b/src/client/elm/LoggedIn/Home/AddPayment/View.elm @@ -1,4 +1,4 @@ -module LoggedIn.AddPayment.View +module LoggedIn.Home.AddPayment.View ( view ) where @@ -10,10 +10,12 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import LoggedIn.Action as LoggedInAction -import LoggedIn.Model as LoggedInModel -import LoggedIn.AddPayment.Action as AddPaymentAction -import LoggedIn.AddPayment.Model as AddPaymentModel +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel + +import LoggedIn.Home.AddPayment.Action as AddPaymentAction +import LoggedIn.Home.AddPayment.Model as AddPaymentModel import Model exposing (Model) import Model.Payment exposing (PaymentFrequency(..)) @@ -26,30 +28,30 @@ import View.Icon exposing (..) import Utils.Maybe exposing (isJust) import Utils.Either exposing (toMaybeError) -view : Address Action -> Model -> LoggedInModel.Model -> Html -view address model loggedInModel = +view : Address Action -> Model -> HomeModel.Model -> Html +view address model homeModel = H.form [ let update = - if loggedInModel.add.waitingServer + if homeModel.add.waitingServer then Action.NoOp else - UpdateLoggedIn <| LoggedInAction.AddPayment loggedInModel.add.name loggedInModel.add.cost loggedInModel.add.frequency + UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.AddPayment homeModel.add.name homeModel.add.cost homeModel.add.frequency in onSubmitPrevDefault address update , class "addPayment" ] - [ addPaymentName address loggedInModel.add - , addPaymentCost address model loggedInModel.add - , paymentFrequency address model loggedInModel.add + [ addPaymentName address homeModel.add + , addPaymentCost address model homeModel.add + , paymentFrequency address model homeModel.add , button [ type' "submit" , classList [ ("add", True) - , ("waitingServer", loggedInModel.add.waitingServer) + , ("waitingServer", homeModel.add.waitingServer) ] ] [ text (getMessage "Add" model.translations) - , if loggedInModel.add.waitingServer then renderSpinIcon else text "" + , if homeModel.add.waitingServer then renderSpinIcon else text "" ] ] @@ -64,7 +66,7 @@ addPaymentName address addPayment = [ input [ id "nameInput" , value addPayment.name - , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.UpdateAdd << AddPaymentAction.UpdateName) + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd << AddPaymentAction.UpdateName) , maxlength 20 ] [] @@ -89,7 +91,7 @@ addPaymentCost address model addPayment = [ input [ id "costInput" , value addPayment.cost - , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.UpdateAdd << AddPaymentAction.UpdateCost) + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd << AddPaymentAction.UpdateCost) , maxlength 7 ] [] @@ -108,7 +110,7 @@ paymentFrequency address model addPayment = button [ type' "button" , class "frequency" - , onClick address (UpdateLoggedIn << LoggedInAction.UpdateAdd <| AddPaymentAction.ToggleFrequency) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd <| AddPaymentAction.ToggleFrequency) ] [ div [ classList diff --git a/src/client/elm/LoggedIn/Home/Model.elm b/src/client/elm/LoggedIn/Home/Model.elm new file mode 100644 index 0000000..14ab86c --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Model.elm @@ -0,0 +1,37 @@ +module LoggedIn.Home.Model + ( Model + , init + ) where + +import LoggedIn.Home.Model.Payer exposing (Payers) + +import Model.User exposing (Users, UserId) +import Model.Payment exposing (PaymentId, Payments, PaymentFrequency(..)) +import Model.Init exposing (..) + +import LoggedIn.Home.Account.Model as AccountModel +import LoggedIn.Home.AddPayment.Model as AddPaymentModel +import LoggedIn.Home.Monthly.Model as MonthlyModel + +type alias Model = + { users : Users + , add : AddPaymentModel.Model + , monthly : MonthlyModel.Model + , account : AccountModel.Model + , payments : Payments + , paymentsCount : Int + , paymentEdition : Maybe PaymentId + , currentPage : Int + } + +init : Init -> Model +init initData = + { users = initData.users + , add = AddPaymentModel.init Punctual + , monthly = MonthlyModel.init initData.monthlyPayments + , account = AccountModel.init initData.me initData.incomes + , payments = initData.payments + , paymentsCount = initData.paymentsCount + , paymentEdition = Nothing + , currentPage = 1 + } diff --git a/src/client/elm/LoggedIn/Model/Payer.elm b/src/client/elm/LoggedIn/Home/Model/Payer.elm index 9242610..65e3f0e 100644 --- a/src/client/elm/LoggedIn/Model/Payer.elm +++ b/src/client/elm/LoggedIn/Home/Model/Payer.elm @@ -1,4 +1,4 @@ -module LoggedIn.Model.Payer +module LoggedIn.Home.Model.Payer ( Payers , Payer , ExceedingPayer diff --git a/src/client/elm/LoggedIn/Monthly/Action.elm b/src/client/elm/LoggedIn/Home/Monthly/Action.elm index bf974f9..0a1faf4 100644 --- a/src/client/elm/LoggedIn/Monthly/Action.elm +++ b/src/client/elm/LoggedIn/Home/Monthly/Action.elm @@ -1,4 +1,4 @@ -module LoggedIn.Monthly.Action +module LoggedIn.Home.Monthly.Action ( Action(..) ) where diff --git a/src/client/elm/LoggedIn/Monthly/Model.elm b/src/client/elm/LoggedIn/Home/Monthly/Model.elm index 16009d6..7f6fd4c 100644 --- a/src/client/elm/LoggedIn/Monthly/Model.elm +++ b/src/client/elm/LoggedIn/Home/Monthly/Model.elm @@ -1,4 +1,4 @@ -module LoggedIn.Monthly.Model +module LoggedIn.Home.Monthly.Model ( Model , init ) where diff --git a/src/client/elm/LoggedIn/Monthly/Update.elm b/src/client/elm/LoggedIn/Home/Monthly/Update.elm index 62b40e6..70b2f9c 100644 --- a/src/client/elm/LoggedIn/Monthly/Update.elm +++ b/src/client/elm/LoggedIn/Home/Monthly/Update.elm @@ -1,9 +1,9 @@ -module LoggedIn.Monthly.Update +module LoggedIn.Home.Monthly.Update ( update ) where -import LoggedIn.Monthly.Action as MonthlyAction -import LoggedIn.Monthly.Model as MonthlyModel +import LoggedIn.Home.Monthly.Action as MonthlyAction +import LoggedIn.Home.Monthly.Model as MonthlyModel update : MonthlyAction.Action -> MonthlyModel.Model -> MonthlyModel.Model update action monthly = diff --git a/src/client/elm/LoggedIn/Monthly/View.elm b/src/client/elm/LoggedIn/Home/Monthly/View.elm index f4ae2c9..f5ab721 100644 --- a/src/client/elm/LoggedIn/Monthly/View.elm +++ b/src/client/elm/LoggedIn/Home/Monthly/View.elm @@ -1,4 +1,4 @@ -module LoggedIn.Monthly.View +module LoggedIn.Home.Monthly.View ( view ) where @@ -10,12 +10,14 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import LoggedIn.Action as LoggedInAction -import LoggedIn.Model as LoggedInModel -import LoggedIn.View.Price exposing (price) -import LoggedIn.View.Expand exposing (..) -import LoggedIn.Monthly.Action as MonthlyAction -import LoggedIn.Monthly.Model as MonthlyModel +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel +import LoggedIn.Home.View.Price exposing (price) +import LoggedIn.Home.View.Expand exposing (..) + +import LoggedIn.Home.Monthly.Action as MonthlyAction +import LoggedIn.Home.Monthly.Model as MonthlyModel import Model exposing (Model) import Model.Payment as Payment exposing (Payments, Payment) @@ -24,9 +26,9 @@ import Action exposing (..) import View.Icon exposing (renderIcon) -view : Address Action -> Model -> LoggedInModel.Model -> Html -view address model loggedInModel = - let monthly = loggedInModel.monthly +view : Address Action -> Model -> HomeModel.Model -> Html +view address model homeModel = + let monthly = homeModel.monthly in if List.length monthly.payments == 0 then text "" @@ -38,7 +40,7 @@ view address model loggedInModel = ] ] [ monthlyCount address model monthly - , if monthly.visibleDetail then paymentsTable address model loggedInModel monthly else text "" + , if monthly.visibleDetail then paymentsTable address model homeModel monthly else text "" ] monthlyCount : Address Action -> Model -> MonthlyModel.Model -> Html @@ -48,29 +50,29 @@ monthlyCount address model monthly = key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount" in button [ class "header" - , onClick address (UpdateLoggedIn << LoggedInAction.UpdateMonthly <| MonthlyAction.ToggleDetail) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateMonthly <| MonthlyAction.ToggleDetail) ] [ text (getParamMessage [toString count, price model total] key model.translations) , expand ExpandDown monthly.visibleDetail ] -paymentsTable : Address Action -> Model -> LoggedInModel.Model -> MonthlyModel.Model -> Html -paymentsTable address model loggedInModel monthly = +paymentsTable : Address Action -> Model -> HomeModel.Model -> MonthlyModel.Model -> Html +paymentsTable address model homeModel monthly = div [ class "table" ] ( monthly.payments |> List.sortBy (String.toLower << .name) - |> List.map (paymentLine address model loggedInModel) + |> List.map (paymentLine address model homeModel) ) -paymentLine : Address Action -> Model -> LoggedInModel.Model -> Payment -> Html -paymentLine address model loggedInModel payment = +paymentLine : Address Action -> Model -> HomeModel.Model -> Payment -> Html +paymentLine address model homeModel payment = a [ classList [ ("row", True) - , ("edition", loggedInModel.paymentEdition == Just payment.id) + , ("edition", homeModel.paymentEdition == Just payment.id) ] - , onClick address (UpdateLoggedIn (LoggedInAction.ToggleEdit payment.id)) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.ToggleEdit payment.id) ] [ div [ class "cell category" ] [ text (payment.name) ] , div @@ -82,7 +84,7 @@ paymentLine address model loggedInModel payment = [ text (price model payment.cost) ] , div [ class "cell delete" - , onClick address (UpdateLoggedIn <| LoggedInAction.DeletePayment payment Payment.Monthly) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.DeletePayment payment Payment.Monthly) ] [ button [] [ renderIcon "times" ] ] diff --git a/src/client/elm/LoggedIn/Home/Update.elm b/src/client/elm/LoggedIn/Home/Update.elm new file mode 100644 index 0000000..352c76b --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Update.elm @@ -0,0 +1,139 @@ +module LoggedIn.Home.Update + ( update + ) where + +import Date +import Dict +import Debug +import Task +import String + +import Effects exposing (Effects) +import Http exposing (Error(..)) + +import Server + +import LoggedIn.Home.Action as LoggedInAction +import LoggedIn.Home.Model as LoggedInModel + +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.Account.Update as AccountUpdate + +import LoggedIn.Home.AddPayment.Action as AddPaymentAction +import LoggedIn.Home.AddPayment.Model as AddPaymentModel +import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate + +import LoggedIn.Home.Monthly.Action as MonthlyAction +import LoggedIn.Home.Monthly.Model as MonthlyModel +import LoggedIn.Home.Monthly.Update as MonthlyUpdate + +import Model exposing (Model) +import Model.User exposing (UserId) +import Model.Payment exposing (..) +import Model.Translations exposing (Translations, getMessage) + +update : Model -> LoggedInAction.Action -> LoggedInModel.Model -> (LoggedInModel.Model, Effects LoggedInAction.Action) +update model action loggedInModel = + case action of + + LoggedInAction.NoOp -> (loggedInModel, Effects.none) + + LoggedInAction.UpdateAdd addPaymentAction -> + ( { loggedInModel | add = AddPaymentUpdate.update addPaymentAction loggedInModel.add } + , Effects.none + ) + + LoggedInAction.UpdatePayments payments -> + ( { loggedInModel | payments = payments } + , Effects.none + ) + + LoggedInAction.AddPayment name cost frequency -> + ( { loggedInModel | add = AddPaymentUpdate.update AddPaymentAction.WaitingServer loggedInModel.add } + , Server.addPayment name cost frequency + |> Task.map (\paymentId -> + case String.toInt cost of + Err _ -> + LoggedInAction.UpdateAdd (AddPaymentAction.AddError Nothing (Just (getMessage "CostRequired" model.translations))) + Ok costNumber -> + LoggedInAction.ValidateAddPayment paymentId name costNumber frequency + ) + |> flip Task.onError (\err -> + case err of + BadResponse 400 jsonErr -> + case AddPaymentUpdate.addPaymentError model.translations jsonErr of + Just addPaymentAction -> Task.succeed (LoggedInAction.UpdateAdd addPaymentAction) + Nothing -> Task.succeed LoggedInAction.NoOp + _ -> + Task.succeed LoggedInAction.NoOp + ) + |> Effects.task + ) + + LoggedInAction.ValidateAddPayment paymentId name cost frequency -> + let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedInModel.account.me + newAdd = AddPaymentModel.init frequency + in case frequency of + Punctual -> + ( { loggedInModel + | currentPage = 1 + , add = newAdd + , account = loggedInModel.account + , payments = newPayment :: loggedInModel.payments + , paymentsCount = loggedInModel.paymentsCount + 1 + } + , Effects.none + ) + Monthly -> + ( { loggedInModel + | add = newAdd + , monthly = MonthlyUpdate.update (MonthlyAction.AddPayment newPayment) loggedInModel.monthly + } + , Effects.none + ) + + LoggedInAction.ToggleEdit id -> + ( { loggedInModel | paymentEdition = if loggedInModel.paymentEdition == Just id then Nothing else Just id } + , Effects.none + ) + + LoggedInAction.DeletePayment payment frequency -> + ( loggedInModel + , Server.deletePayment payment frequency + |> Task.map (always (LoggedInAction.ValidateDeletePayment payment frequency)) + |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp) + |> Effects.task + ) + + LoggedInAction.ValidateDeletePayment payment frequency -> + case frequency of + Monthly -> + ( { loggedInModel + | monthly = MonthlyUpdate.update (MonthlyAction.DeletePayment payment) loggedInModel.monthly + } + , Effects.none + ) + Punctual -> + ( { loggedInModel + | account = loggedInModel.account + , payments = deletePayment payment.id loggedInModel.payments + , paymentsCount = loggedInModel.paymentsCount - 1 + } + , Effects.none + ) + + LoggedInAction.UpdatePage page -> + ( { loggedInModel | currentPage = page } + , Effects.none + ) + + LoggedInAction.UpdateMonthly monthlyAction -> + ( { loggedInModel | monthly = MonthlyUpdate.update monthlyAction loggedInModel.monthly } + , Effects.none + ) + + LoggedInAction.UpdateAccount accountAction -> + let (newAccount, accountEffects) = AccountUpdate.update accountAction loggedInModel.account + in ( { loggedInModel | account = newAccount } + , Effects.map LoggedInAction.UpdateAccount accountEffects + ) diff --git a/src/client/elm/LoggedIn/Home/View.elm b/src/client/elm/LoggedIn/Home/View.elm new file mode 100644 index 0000000..23da2c5 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View.elm @@ -0,0 +1,34 @@ +module LoggedIn.Home.View + ( view + ) where + +import Signal exposing (Address) + +import Html exposing (..) +import Html.Attributes exposing (..) + +import LoggedIn.Home.Model as LoggedInModel +import LoggedIn.Home.Account.View as AccountView +import LoggedIn.Home.AddPayment.View as AddPaymentView +import LoggedIn.Home.Monthly.View as MonthlyView + +import Model exposing (Model) +import Model.Payment exposing (Payments) +import Action exposing (Action) + +import LoggedIn.Home.View.Table exposing (paymentsTable) +import LoggedIn.Home.View.Paging exposing (paymentsPaging) + +view : Address Action -> Model -> LoggedInModel.Model -> Html +view address model loggedInModel = + div + [ class "loggedIn" ] + [ AddPaymentView.view address model loggedInModel + , div + [ class "expandables" ] + [ AccountView.view address model loggedInModel + , MonthlyView.view address model loggedInModel + ] + , paymentsTable address model loggedInModel + , paymentsPaging address loggedInModel + ] diff --git a/src/client/elm/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/Home/View/Date.elm index 62c8be5..2cc55fe 100644 --- a/src/client/elm/LoggedIn/View/Date.elm +++ b/src/client/elm/LoggedIn/Home/View/Date.elm @@ -1,4 +1,4 @@ -module LoggedIn.View.Date +module LoggedIn.Home.View.Date ( renderShortDate , renderLongDate ) where diff --git a/src/client/elm/LoggedIn/View/Expand.elm b/src/client/elm/LoggedIn/Home/View/Expand.elm index 1055c1b..514bf93 100644 --- a/src/client/elm/LoggedIn/View/Expand.elm +++ b/src/client/elm/LoggedIn/Home/View/Expand.elm @@ -1,4 +1,4 @@ -module LoggedIn.View.Expand +module LoggedIn.Home.View.Expand ( expand , ExpandType(..) ) where diff --git a/src/client/elm/LoggedIn/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm index 0a149e9..31aa032 100644 --- a/src/client/elm/LoggedIn/View/Paging.elm +++ b/src/client/elm/LoggedIn/Home/View/Paging.elm @@ -1,4 +1,4 @@ -module LoggedIn.View.Paging +module LoggedIn.Home.View.Paging ( paymentsPaging ) where @@ -9,7 +9,9 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import LoggedIn.Action as LoggedInAction -import LoggedIn.Model as LoggedInModel + +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel import Action exposing (..) import Model.Payment exposing (perPage) @@ -19,23 +21,23 @@ import View.Icon exposing (renderIcon) showedPages : Int showedPages = 5 -paymentsPaging : Address Action -> LoggedInModel.Model -> Html -paymentsPaging address loggedInModel = - let maxPage = ceiling (toFloat loggedInModel.paymentsCount / toFloat perPage) - pages = truncatePages loggedInModel.currentPage [1..maxPage] +paymentsPaging : Address Action -> HomeModel.Model -> Html +paymentsPaging address homeModel = + let maxPage = ceiling (toFloat homeModel.paymentsCount / toFloat perPage) + pages = truncatePages homeModel.currentPage [1..maxPage] in if maxPage == 1 then text "" else div [ class "pages" ] - ( ( if loggedInModel.currentPage > 1 - then [ firstPage address, previousPage address loggedInModel ] + ( ( if homeModel.currentPage > 1 + then [ firstPage address, previousPage address homeModel ] else [] ) - ++ ( List.map (paymentsPage address loggedInModel) pages) - ++ ( if loggedInModel.currentPage < maxPage - then [ nextPage address loggedInModel, lastPage address maxPage ] + ++ ( List.map (paymentsPage address homeModel) pages) + ++ ( if homeModel.currentPage < maxPage + then [ nextPage address homeModel, lastPage address maxPage ] else [] ) ) @@ -58,23 +60,23 @@ firstPage : Address Action -> Html firstPage address = button [ class "page" - , onClick address (UpdateLoggedIn (LoggedInAction.UpdatePage 1)) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| 1) ] [ renderIcon "fast-backward" ] -previousPage : Address Action -> LoggedInModel.Model -> Html -previousPage address loggedInModel = +previousPage : Address Action -> HomeModel.Model -> Html +previousPage address homeModel = button [ class "page" - , onClick address (UpdateLoggedIn (LoggedInAction.UpdatePage (loggedInModel.currentPage - 1))) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| homeModel.currentPage - 1) ] [ renderIcon "backward" ] -nextPage : Address Action -> LoggedInModel.Model -> Html -nextPage address loggedInModel = +nextPage : Address Action -> HomeModel.Model -> Html +nextPage address homeModel = button [ class "page" - , onClick address (UpdateLoggedIn (LoggedInAction.UpdatePage (loggedInModel.currentPage + 1))) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| homeModel.currentPage + 1) ] [ renderIcon "forward" ] @@ -82,19 +84,19 @@ lastPage : Address Action -> Int -> Html lastPage address maxPage = button [ class "page" - , onClick address (UpdateLoggedIn (LoggedInAction.UpdatePage maxPage)) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| maxPage) ] [ renderIcon "fast-forward" ] -paymentsPage : Address Action -> LoggedInModel.Model -> Int -> Html -paymentsPage address loggedInModel page = - let onCurrentPage = page == loggedInModel.currentPage +paymentsPage : Address Action -> HomeModel.Model -> Int -> Html +paymentsPage address homeModel page = + let onCurrentPage = page == homeModel.currentPage in button [ classList [ ("page", True) , ("current", onCurrentPage) ] , onClick address <| - if onCurrentPage then Action.NoOp else UpdateLoggedIn (LoggedInAction.UpdatePage page) + if onCurrentPage then Action.NoOp else UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| page ] [ text (toString page) ] diff --git a/src/client/elm/LoggedIn/View/Price.elm b/src/client/elm/LoggedIn/Home/View/Price.elm index e8b4c58..a3229a0 100644 --- a/src/client/elm/LoggedIn/View/Price.elm +++ b/src/client/elm/LoggedIn/Home/View/Price.elm @@ -1,4 +1,4 @@ -module LoggedIn.View.Price +module LoggedIn.Home.View.Price ( price ) where diff --git a/src/client/elm/LoggedIn/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm index 57167be..e49fd05 100644 --- a/src/client/elm/LoggedIn/View/Table.elm +++ b/src/client/elm/LoggedIn/Home/View/Table.elm @@ -1,4 +1,4 @@ -module LoggedIn.View.Table +module LoggedIn.Home.View.Table ( paymentsTable ) where @@ -12,9 +12,11 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import LoggedIn.Action as LoggedInAction -import LoggedIn.Model as LoggedInModel -import LoggedIn.View.Date exposing (..) -import LoggedIn.View.Price exposing (price) + +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel +import LoggedIn.Home.View.Date exposing (..) +import LoggedIn.Home.View.Price exposing (price) import Model exposing (Model) import Model.User exposing (getUserName) @@ -24,11 +26,11 @@ import Action exposing (..) import View.Icon exposing (renderIcon) -paymentsTable : Address Action -> Model -> LoggedInModel.Model -> Html -paymentsTable address model loggedInModel = +paymentsTable : Address Action -> Model -> HomeModel.Model -> Html +paymentsTable address model homeModel = div [ class "table" ] - ( headerLine model :: paymentLines address model loggedInModel) + ( headerLine model :: paymentLines address model homeModel) headerLine : Model -> Html headerLine model = @@ -41,23 +43,23 @@ headerLine model = , div [ class "cell" ] [] ] -paymentLines : Address Action -> Model -> LoggedInModel.Model -> List Html -paymentLines address model loggedInModel = - loggedInModel.payments +paymentLines : Address Action -> Model -> HomeModel.Model -> List Html +paymentLines address model homeModel = + homeModel.payments |> List.sortBy (Date.toTime << .creation) |> List.reverse - |> List.drop ((loggedInModel.currentPage - 1) * perPage) + |> List.drop ((homeModel.currentPage - 1) * perPage) |> List.take perPage - |> List.map (paymentLine address model loggedInModel) + |> List.map (paymentLine address model homeModel) -paymentLine : Address Action -> Model -> LoggedInModel.Model -> Payment -> Html -paymentLine address model loggedInModel payment = +paymentLine : Address Action -> Model -> HomeModel.Model -> Payment -> Html +paymentLine address model homeModel payment = a [ classList [ ("row", True) - , ("edition", loggedInModel.paymentEdition == Just payment.id) + , ("edition", homeModel.paymentEdition == Just payment.id) ] - , onClick address (UpdateLoggedIn (LoggedInAction.ToggleEdit payment.id)) + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.ToggleEdit <| payment.id) ] [ div [ class "cell category" ] [ text payment.name ] , div @@ -70,7 +72,7 @@ paymentLine address model loggedInModel payment = , div [ class "cell user" ] [ payment.userId - |> getUserName loggedInModel.users + |> getUserName homeModel.users |> Maybe.withDefault "−" |> text ] @@ -83,12 +85,12 @@ paymentLine address model loggedInModel payment = [ class "longDate" ] [ text (renderLongDate payment.creation model.translations) ] ] - , if loggedInModel.account.me == payment.userId + , if homeModel.account.me == payment.userId then div [ class "cell delete" ] [ button - [ onClick address (UpdateLoggedIn <| LoggedInAction.DeletePayment payment Punctual)] + [ onClick address (UpdateLoggedIn <| LoggedInAction.HomeAction <| HomeAction.DeletePayment payment Punctual)] [ renderIcon "times" ] ] else diff --git a/src/client/elm/LoggedIn/Model.elm b/src/client/elm/LoggedIn/Model.elm index 4d85e68..a86b464 100644 --- a/src/client/elm/LoggedIn/Model.elm +++ b/src/client/elm/LoggedIn/Model.elm @@ -3,35 +3,15 @@ module LoggedIn.Model , init ) where -import LoggedIn.Model.Payer exposing (Payers) - -import Model.User exposing (Users, UserId) -import Model.Payment exposing (PaymentId, Payments, PaymentFrequency(..)) import Model.Init exposing (..) -import LoggedIn.Account.Model as AccountModel -import LoggedIn.AddPayment.Model as AddPaymentModel -import LoggedIn.Monthly.Model as MonthlyModel +import LoggedIn.Home.Model as HomeModel type alias Model = - { users : Users - , add : AddPaymentModel.Model - , monthly : MonthlyModel.Model - , account : AccountModel.Model - , payments : Payments - , paymentsCount : Int - , paymentEdition : Maybe PaymentId - , currentPage : Int + { home : HomeModel.Model } init : Init -> Model init initData = - { users = initData.users - , add = AddPaymentModel.init Punctual - , monthly = MonthlyModel.init initData.monthlyPayments - , account = AccountModel.init initData.me initData.incomes - , payments = initData.payments - , paymentsCount = initData.paymentsCount - , paymentEdition = Nothing - , currentPage = 1 + { home = HomeModel.init initData } diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm index 3b8090a..189d901 100644 --- a/src/client/elm/LoggedIn/Update.elm +++ b/src/client/elm/LoggedIn/Update.elm @@ -2,138 +2,28 @@ module LoggedIn.Update ( update ) where -import Date -import Dict -import Debug -import Task -import String - import Effects exposing (Effects) -import Http exposing (Error(..)) -import Server +import Model exposing (Model) import LoggedIn.Action as LoggedInAction import LoggedIn.Model as LoggedInModel -import LoggedIn.Account.Action as AccountAction -import LoggedIn.Account.Update as AccountUpdate - -import LoggedIn.AddPayment.Action as AddPaymentAction -import LoggedIn.AddPayment.Model as AddPaymentModel -import LoggedIn.AddPayment.Update as AddPaymentUpdate - -import LoggedIn.Monthly.Action as MonthlyAction -import LoggedIn.Monthly.Model as MonthlyModel -import LoggedIn.Monthly.Update as MonthlyUpdate +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Update as HomeUpdate -import Model exposing (Model) -import Model.User exposing (UserId) -import Model.Payment exposing (..) -import Model.Translations exposing (Translations, getMessage) +type Action = HomeAction HomeAction.Action update : Model -> LoggedInAction.Action -> LoggedInModel.Model -> (LoggedInModel.Model, Effects LoggedInAction.Action) -update model action loggedInView = +update model action loggedIn = case action of - LoggedInAction.NoOp -> (loggedInView, Effects.none) - - LoggedInAction.UpdateAdd addPaymentAction -> - ( { loggedInView | add = AddPaymentUpdate.update addPaymentAction loggedInView.add } - , Effects.none - ) - - LoggedInAction.UpdatePayments payments -> - ( { loggedInView | payments = payments } - , Effects.none - ) - - LoggedInAction.AddPayment name cost frequency -> - ( { loggedInView | add = AddPaymentUpdate.update AddPaymentAction.WaitingServer loggedInView.add } - , Server.addPayment name cost frequency - |> Task.map (\paymentId -> - case String.toInt cost of - Err _ -> - LoggedInAction.UpdateAdd (AddPaymentAction.AddError Nothing (Just (getMessage "CostRequired" model.translations))) - Ok costNumber -> - LoggedInAction.ValidateAddPayment paymentId name costNumber frequency - ) - |> flip Task.onError (\err -> - case err of - BadResponse 400 jsonErr -> - case AddPaymentUpdate.addPaymentError model.translations jsonErr of - Just addPaymentAction -> Task.succeed (LoggedInAction.UpdateAdd addPaymentAction) - Nothing -> Task.succeed LoggedInAction.NoOp - _ -> - Task.succeed LoggedInAction.NoOp - ) - |> Effects.task - ) - - LoggedInAction.ValidateAddPayment paymentId name cost frequency -> - let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedInView.account.me - newAdd = AddPaymentModel.init frequency - in case frequency of - Punctual -> - ( { loggedInView - | currentPage = 1 - , add = newAdd - , account = loggedInView.account - , payments = newPayment :: loggedInView.payments - , paymentsCount = loggedInView.paymentsCount + 1 - } - , Effects.none - ) - Monthly -> - ( { loggedInView - | add = newAdd - , monthly = MonthlyUpdate.update (MonthlyAction.AddPayment newPayment) loggedInView.monthly - } - , Effects.none - ) - - LoggedInAction.ToggleEdit id -> - ( { loggedInView | paymentEdition = if loggedInView.paymentEdition == Just id then Nothing else Just id } - , Effects.none - ) - - LoggedInAction.DeletePayment payment frequency -> - ( loggedInView - , Server.deletePayment payment frequency - |> Task.map (always (LoggedInAction.ValidateDeletePayment payment frequency)) - |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp) - |> Effects.task - ) - - LoggedInAction.ValidateDeletePayment payment frequency -> - case frequency of - Monthly -> - ( { loggedInView - | monthly = MonthlyUpdate.update (MonthlyAction.DeletePayment payment) loggedInView.monthly - } - , Effects.none - ) - Punctual -> - ( { loggedInView - | account = loggedInView.account - , payments = deletePayment payment.id loggedInView.payments - , paymentsCount = loggedInView.paymentsCount - 1 - } - , Effects.none - ) - - LoggedInAction.UpdatePage page -> - ( { loggedInView | currentPage = page } - , Effects.none - ) - - LoggedInAction.UpdateMonthly monthlyAction -> - ( { loggedInView | monthly = MonthlyUpdate.update monthlyAction loggedInView.monthly } - , Effects.none - ) + LoggedInAction.NoOp -> + (loggedIn, Effects.none) - LoggedInAction.UpdateAccount accountAction -> - let (newAccount, accountEffects) = AccountUpdate.update accountAction loggedInView.account - in ( { loggedInView | account = newAccount } - , Effects.map LoggedInAction.UpdateAccount accountEffects + LoggedInAction.HomeAction homeAction -> + case HomeUpdate.update model homeAction loggedIn.home of + (home, effects) -> + ( { loggedIn | home = home } + , Effects.map LoggedInAction.HomeAction effects ) diff --git a/src/client/elm/LoggedIn/View.elm b/src/client/elm/LoggedIn/View.elm index c9980dc..27bf31a 100644 --- a/src/client/elm/LoggedIn/View.elm +++ b/src/client/elm/LoggedIn/View.elm @@ -5,30 +5,19 @@ module LoggedIn.View import Signal exposing (Address) import Html exposing (..) -import Html.Attributes exposing (..) -import LoggedIn.Model as LoggedInModel -import LoggedIn.Account.View as AccountView -import LoggedIn.AddPayment.View as AddPaymentView -import LoggedIn.Monthly.View as MonthlyView +import TransitRouter +import Route exposing (..) -import Model exposing (Model) -import Model.Payment exposing (Payments) import Action exposing (Action) +import Model exposing (Model) + +import LoggedIn.Model as LoggedInModel -import LoggedIn.View.Table exposing (paymentsTable) -import LoggedIn.View.Paging exposing (paymentsPaging) +import LoggedIn.Home.View as HomeView view : Address Action -> Model -> LoggedInModel.Model -> Html -view address model loggedInModel = - div - [ class "loggedIn" ] - [ AddPaymentView.view address model loggedInModel - , div - [ class "expandables" ] - [ AccountView.view address model loggedInModel - , MonthlyView.view address model loggedInModel - ] - , paymentsTable address model loggedInModel - , paymentsPaging address loggedInModel - ] +view address model loggedIn = + case TransitRouter.getRoute model of + Home -> HomeView.view address model loggedIn.home + User -> text "" diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm index 0ba25b7..ac70202 100644 --- a/src/client/elm/Main.elm +++ b/src/client/elm/Main.elm @@ -3,11 +3,12 @@ module Main ) where import Graphics.Element exposing (..) +import Json.Decode as Json import Html exposing (Html) import StartApp exposing (App) import Effects exposing (Effects, Never) -import Json.Decode as Json +import TransitRouter import Task exposing (..) import Time exposing (..) @@ -16,34 +17,48 @@ import Server import Action exposing (..) import Model exposing (Model, initialModel) -import Update exposing (update) +import Update exposing (update, routerConfig) import View exposing (view) import Utils.Maybe exposing (isJust) +import Utils.Effects as Effects main : Signal Html main = app.html app : App Model app = StartApp.start - { init = - case Json.decodeString Json.string signInError of - Ok signInError -> - ( initialModel initialTime translations conf (Just signInError) - , Effects.none - ) - Err _ -> - ( initialModel initialTime translations conf Nothing - , Server.init - |> Task.map GoLoggedInView - |> flip Task.onError (always <| Task.succeed GoSignInView) - |> Effects.task - ) + { init = initData `Effects.andThen` initRouter , view = view , update = update - , inputs = [ Signal.map UpdateTime (Time.every 1000) ] + , inputs = + [ Signal.map UpdateTime (Time.every 1000) + , Signal.map RouterAction TransitRouter.actions + ] } +-- Init + +initData : (Model, Effects Action) +initData = + case Json.decodeString Json.string signInError of + Ok signInError -> + ( initialModel initialTime translations conf (Just signInError) + , Effects.none + ) + Err _ -> + ( initialModel initialTime translations conf Nothing + , Server.init + |> Task.map GoLoggedInView + |> flip Task.onError (always <| Task.succeed GoSignInView) + |> Effects.task + ) + +initRouter : Model -> (Model, Effects Action) +initRouter model = TransitRouter.init routerConfig location model + +-- Output ports + port tasks : Signal (Task.Task Never ()) port tasks = app.tasks @@ -53,3 +68,4 @@ port initialTime : Time port translations : String port conf : String port signInError : String +port location : String diff --git a/src/client/elm/Model.elm b/src/client/elm/Model.elm index 3d2eb2b..e006e97 100644 --- a/src/client/elm/Model.elm +++ b/src/client/elm/Model.elm @@ -6,6 +6,9 @@ module Model import Time exposing (Time) import Json.Decode as Json +import TransitRouter +import Route exposing (..) + import Model.View exposing (..) import Model.Translations exposing (..) import Model.Conf exposing (..) @@ -19,6 +22,7 @@ type alias Model = , currentTime : Time , translations : Translations , conf : Conf + , transitRouter : TransitRouter.TransitRouter Route } initialModel : Time -> String -> String -> Maybe String -> Model @@ -36,4 +40,5 @@ initialModel initialTime translations conf mbSignInError = case Json.decodeString confDecoder conf of Ok conf -> conf Err _ -> { currency = "" } + , transitRouter = TransitRouter.empty Home } diff --git a/src/client/elm/Route.elm b/src/client/elm/Route.elm new file mode 100644 index 0000000..dd435a6 --- /dev/null +++ b/src/client/elm/Route.elm @@ -0,0 +1,25 @@ +module Route + ( Route(..) + , matchers + , toPath + ) where + +import Effects exposing (Effects) + +import RouteParser exposing (..) + +type Route = + Home + | User + +matchers : List (Matcher Route) +matchers = + [ static Home "/" + , static User "/user" + ] + +toPath : Route -> String +toPath route = + case route of + Home -> "/" + User -> "/user" diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm index 314ca01..b6928de 100644 --- a/src/client/elm/Server.elm +++ b/src/client/elm/Server.elm @@ -23,34 +23,34 @@ import Model.Init exposing (Init) init : Task Http.Error Init init = - Task.map Init (Http.get usersDecoder "/users") - `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI") - `Task.andMap` (Http.get paymentsDecoder "/payments") - `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments") - `Task.andMap` (Http.get ("number" := Json.int) "/payments/count") - `Task.andMap` (Http.get incomesDecoder "/incomes") + Task.map Init (Http.get usersDecoder "/api/users") + `Task.andMap` (Http.get ("id" := userIdDecoder) "/api/whoAmI") + `Task.andMap` (Http.get paymentsDecoder "/api/payments") + `Task.andMap` (Http.get paymentsDecoder "/api/monthlyPayments") + `Task.andMap` (Http.get ("number" := Json.int) "/api/payments/count") + `Task.andMap` (Http.get incomesDecoder "/api/incomes") signIn : String -> Task Http.Error () signIn email = - post ("/signIn?email=" ++ email) + post ("/api/signIn?email=" ++ email) |> Task.map (always ()) addPayment : String -> String -> PaymentFrequency -> Task Http.Error PaymentId addPayment name cost frequency = - post ("/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency)) + post ("/api/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency)) |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder) deletePayment : Payment -> PaymentFrequency -> Task Http.Error () deletePayment payment frequency = - post ("payment/delete?id=" ++ (toString payment.id)) + post ("/api/payment/delete?id=" ++ (toString payment.id)) |> Task.map (always ()) setIncome : Time -> Int -> Task Http.Error IncomeId setIncome currentTime amount = - post ("/income?amount=" ++ (toString amount)) + post ("/api/income?amount=" ++ (toString amount)) |> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder) signOut : Task Http.Error () signOut = - post "/signOut" + post "/api/signOut" |> Task.map (always ()) diff --git a/src/client/elm/SignIn/View.elm b/src/client/elm/SignIn/View.elm index 52fcde1..2269a4f 100644 --- a/src/client/elm/SignIn/View.elm +++ b/src/client/elm/SignIn/View.elm @@ -31,6 +31,7 @@ view address model signInModel = , on "input" targetValue (Signal.message address << UpdateSignIn << SignInAction.UpdateLogin) , type' "text" , autocomplete True + , name "email" ] [] , button diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm index 5cac028..7d56b36 100644 --- a/src/client/elm/Update.elm +++ b/src/client/elm/Update.elm @@ -1,10 +1,15 @@ module Update - ( update + ( routerConfig + , update ) where import Task import Effects exposing (Effects) +import TransitRouter +import RouteParser + +import Route exposing (Route) import Server @@ -24,6 +29,14 @@ import SignIn.Update as SignInUpdate import Utils.Http exposing (errorKey) +routerConfig : TransitRouter.Config Route Action Model +routerConfig = + { mountRoute = \_ _ model -> (model, Effects.none) + , getDurations = \_ _ _ -> (50, 200) + , actionWrapper = RouterAction + , routeDecoder = Maybe.withDefault Route.Home << RouteParser.match Route.matchers + } + update : Action -> Model -> (Model, Effects Action) update action model = case action of @@ -58,6 +71,12 @@ update action model = UpdateLoggedIn loggedInAction -> applyLoggedIn model loggedInAction + RouterAction routeAction -> + TransitRouter.update + routerConfig + (Debug.log "routeAction" routeAction) + model + SignOut -> ( model , Server.signOut diff --git a/src/client/elm/Utils/Effects.elm b/src/client/elm/Utils/Effects.elm new file mode 100644 index 0000000..544352f --- /dev/null +++ b/src/client/elm/Utils/Effects.elm @@ -0,0 +1,10 @@ +module Utils.Effects + ( andThen + ) where + +import Effects exposing (Effects) + +andThen : (a, Effects b) -> (a -> (a, Effects b)) -> (a, Effects b) +andThen a b = case a of + (ma, ea) -> case b ma of + (mb, eb) -> (mb, Effects.batch [ea, eb]) diff --git a/src/client/elm/View/Click.elm b/src/client/elm/View/Click.elm new file mode 100644 index 0000000..a722cac --- /dev/null +++ b/src/client/elm/View/Click.elm @@ -0,0 +1,24 @@ +module View.Click + ( clickTo + ) where + +import Signal +import Json.Decode as Json + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import TransitRouter +import Route exposing (Route, toPath) + +clickTo : Route -> List Attribute +clickTo route = + let path = toPath route + in [ href path + , onWithOptions + "click" + { stopPropagation = True, preventDefault = True } + Json.value + (\_ -> Signal.message TransitRouter.pushPathAddress path) + ] diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm index f1b0e76..5a37d9b 100644 --- a/src/client/elm/View/Header.elm +++ b/src/client/elm/View/Header.elm @@ -5,6 +5,8 @@ module View.Header import Signal exposing (Address) import Dict +import Route exposing (..) + import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) @@ -15,24 +17,25 @@ import Action exposing (..) import Model.View exposing (..) import View.Icon exposing (renderIcon) +import View.Click exposing (clickTo) renderHeader : Address Action -> Model -> Html renderHeader address model = header [] - [ button - [ class "title" ] + [ a + ( [ class "title" ] ++ clickTo Home) [ h1 [] [ text (getMessage "SharedCost" model.translations) ] ] , case model.view of - LoggedInView { users, account } -> + LoggedInView { home } -> div [ class "signedPanel" ] - [ button - [ class "user" ] - [ Dict.get account.me users + [ a + ( [ class "user" ] ++ clickTo User) + [ Dict.get home.account.me home.users |> Maybe.map .name |> Maybe.withDefault "" |> text diff --git a/src/client/js/main.js b/src/client/js/main.js index 0928ab5..1ab1287 100644 --- a/src/client/js/main.js +++ b/src/client/js/main.js @@ -1,9 +1,10 @@ // Remove query params -window.history.pushState({html: document.documentElement.innerHTML, pageTitle: document.title}, '', '/'); +window.history.pushState({html: document.documentElement.innerHTML, pageTitle: document.title}, '', location.pathname); Elm.fullscreen(Elm.Main, { initialTime: new Date().getTime(), translations: document.getElementById('messages').innerHTML, conf: document.getElementById('conf').innerHTML, - signInError: document.getElementById('signInError').innerHTML + signInError: document.getElementById('signInError').innerHTML, + location: location.pathname }); diff --git a/src/server/Design/Header.hs b/src/server/Design/Header.hs index 8a348ad..a06a830 100644 --- a/src/server/Design/Header.hs +++ b/src/server/Design/Header.hs @@ -23,7 +23,7 @@ headerDesign = marginBottom blockMarginBottom position relative - button ? do + ((".title" |> h1) <> ".user" <> ".icon") ? do color C.white backgroundColor C.red hover & backgroundColor darkenedRed diff --git a/src/server/Main.hs b/src/server/Main.hs index 4f74f8e..e4ad9f6 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -20,6 +20,7 @@ import Controller.Income import Model.Database (runMigrations) import Model.Frequency +import Conf (Conf) import qualified Conf main :: IO () @@ -35,7 +36,9 @@ main = do middleware $ staticPolicy (noDots >-> addBase "public") - get "/" $ + api conf + + notFound $ ( do signInToken <- param "signInToken" :: ActionM Text successOrError <- validateSignIn conf signInToken @@ -46,37 +49,43 @@ main = do (getIndex conf Nothing) ) `rescue` (\_ -> getIndex conf Nothing) - post "/signOut" signOut - -- SignIn +api :: Conf -> ScottyM () +api conf = do + -- Sign + + post "/api/signIn" $ do + email <- param "email" :: ActionM Text + signIn conf email + + post "/api/signOut" signOut + + -- Users - post "/signIn" $ do - email <- param "email" :: ActionM Text - signIn conf email + get "/api/users" getUsers + get "/api/whoAmI" whoAmI - -- Users + -- Incomes - get "/users" getUsers - get "/whoAmI" whoAmI - get "/incomes" getIncomes - post "/income" $ do - amount <- param "amount" :: ActionM Int - setIncome amount + get "/api/incomes" getIncomes + post "/api/income" $ do + amount <- param "amount" :: ActionM Int + setIncome amount - -- Payments + -- Payments - get "/payments" getPayments + get "/api/payments" getPayments - get "/monthlyPayments" getMonthlyPayments + get "/api/monthlyPayments" getMonthlyPayments - post "/payment/add" $ do - name <- param "name" :: ActionM Text - cost <- param "cost" :: ActionM Text - frequency <- param "frequency" :: ActionM Frequency - createPayment name cost frequency + post "/api/payment/add" $ do + name <- param "name" :: ActionM Text + cost <- param "cost" :: ActionM Text + frequency <- param "frequency" :: ActionM Frequency + createPayment name cost frequency - post "/payment/delete" $ do - paymentId <- param "id" :: ActionM Text - deletePayment paymentId + post "/api/payment/delete" $ do + paymentId <- param "id" :: ActionM Text + deletePayment paymentId - get "/payments/count" getPaymentsCount + get "/api/payments/count" getPaymentsCount |