From 166cd04e4b28770ede854dafc9ae30eae64102fe Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 28 Mar 2016 17:51:14 +0200 Subject: Create an empty but reachable user page --- elm-package.json | 7 +- src/client/elm/Action.elm | 5 + src/client/elm/LoggedIn/Account/Action.elm | 17 --- src/client/elm/LoggedIn/Account/Model.elm | 64 ---------- src/client/elm/LoggedIn/Account/Update.elm | 75 ----------- src/client/elm/LoggedIn/Account/View.elm | 131 ------------------- src/client/elm/LoggedIn/Action.elm | 17 +-- src/client/elm/LoggedIn/AddPayment/Action.elm | 11 -- src/client/elm/LoggedIn/AddPayment/Model.elm | 29 ----- src/client/elm/LoggedIn/AddPayment/Update.elm | 55 -------- src/client/elm/LoggedIn/AddPayment/View.elm | 127 ------------------- src/client/elm/LoggedIn/Home/Account/Action.elm | 17 +++ src/client/elm/LoggedIn/Home/Account/Model.elm | 64 ++++++++++ src/client/elm/LoggedIn/Home/Account/Update.elm | 75 +++++++++++ src/client/elm/LoggedIn/Home/Account/View.elm | 133 ++++++++++++++++++++ src/client/elm/LoggedIn/Home/Action.elm | 22 ++++ src/client/elm/LoggedIn/Home/AddPayment/Action.elm | 11 ++ src/client/elm/LoggedIn/Home/AddPayment/Model.elm | 29 +++++ src/client/elm/LoggedIn/Home/AddPayment/Update.elm | 55 ++++++++ src/client/elm/LoggedIn/Home/AddPayment/View.elm | 129 +++++++++++++++++++ src/client/elm/LoggedIn/Home/Model.elm | 37 ++++++ src/client/elm/LoggedIn/Home/Model/Payer.elm | 122 ++++++++++++++++++ src/client/elm/LoggedIn/Home/Monthly/Action.elm | 10 ++ src/client/elm/LoggedIn/Home/Monthly/Model.elm | 17 +++ src/client/elm/LoggedIn/Home/Monthly/Update.elm | 21 ++++ src/client/elm/LoggedIn/Home/Monthly/View.elm | 91 ++++++++++++++ src/client/elm/LoggedIn/Home/Update.elm | 139 +++++++++++++++++++++ src/client/elm/LoggedIn/Home/View.elm | 34 +++++ src/client/elm/LoggedIn/Home/View/Date.elm | 59 +++++++++ src/client/elm/LoggedIn/Home/View/Expand.elm | 25 ++++ src/client/elm/LoggedIn/Home/View/Paging.elm | 102 +++++++++++++++ src/client/elm/LoggedIn/Home/View/Price.elm | 38 ++++++ src/client/elm/LoggedIn/Home/View/Table.elm | 98 +++++++++++++++ src/client/elm/LoggedIn/Model.elm | 26 +--- src/client/elm/LoggedIn/Model/Payer.elm | 122 ------------------ src/client/elm/LoggedIn/Monthly/Action.elm | 10 -- src/client/elm/LoggedIn/Monthly/Model.elm | 17 --- src/client/elm/LoggedIn/Monthly/Update.elm | 21 ---- src/client/elm/LoggedIn/Monthly/View.elm | 89 ------------- src/client/elm/LoggedIn/Update.elm | 134 ++------------------ src/client/elm/LoggedIn/View.elm | 31 ++--- src/client/elm/LoggedIn/View/Date.elm | 59 --------- src/client/elm/LoggedIn/View/Expand.elm | 25 ---- src/client/elm/LoggedIn/View/Paging.elm | 100 --------------- src/client/elm/LoggedIn/View/Price.elm | 38 ------ src/client/elm/LoggedIn/View/Table.elm | 96 -------------- src/client/elm/Main.elm | 48 ++++--- src/client/elm/Model.elm | 5 + src/client/elm/Route.elm | 25 ++++ src/client/elm/Server.elm | 22 ++-- src/client/elm/SignIn/View.elm | 1 + src/client/elm/Update.elm | 21 +++- src/client/elm/Utils/Effects.elm | 10 ++ src/client/elm/View/Click.elm | 24 ++++ src/client/elm/View/Header.elm | 15 ++- src/client/js/main.js | 5 +- src/server/Design/Header.hs | 2 +- src/server/Main.hs | 59 +++++---- 58 files changed, 1539 insertions(+), 1332 deletions(-) delete mode 100644 src/client/elm/LoggedIn/Account/Action.elm delete mode 100644 src/client/elm/LoggedIn/Account/Model.elm delete mode 100644 src/client/elm/LoggedIn/Account/Update.elm delete mode 100644 src/client/elm/LoggedIn/Account/View.elm delete mode 100644 src/client/elm/LoggedIn/AddPayment/Action.elm delete mode 100644 src/client/elm/LoggedIn/AddPayment/Model.elm delete mode 100644 src/client/elm/LoggedIn/AddPayment/Update.elm delete mode 100644 src/client/elm/LoggedIn/AddPayment/View.elm create mode 100644 src/client/elm/LoggedIn/Home/Account/Action.elm create mode 100644 src/client/elm/LoggedIn/Home/Account/Model.elm create mode 100644 src/client/elm/LoggedIn/Home/Account/Update.elm create mode 100644 src/client/elm/LoggedIn/Home/Account/View.elm create mode 100644 src/client/elm/LoggedIn/Home/Action.elm create mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Action.elm create mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Model.elm create mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Update.elm create mode 100644 src/client/elm/LoggedIn/Home/AddPayment/View.elm create mode 100644 src/client/elm/LoggedIn/Home/Model.elm create mode 100644 src/client/elm/LoggedIn/Home/Model/Payer.elm create mode 100644 src/client/elm/LoggedIn/Home/Monthly/Action.elm create mode 100644 src/client/elm/LoggedIn/Home/Monthly/Model.elm create mode 100644 src/client/elm/LoggedIn/Home/Monthly/Update.elm create mode 100644 src/client/elm/LoggedIn/Home/Monthly/View.elm create mode 100644 src/client/elm/LoggedIn/Home/Update.elm create mode 100644 src/client/elm/LoggedIn/Home/View.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Date.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Expand.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Paging.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Price.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Table.elm delete mode 100644 src/client/elm/LoggedIn/Model/Payer.elm delete mode 100644 src/client/elm/LoggedIn/Monthly/Action.elm delete mode 100644 src/client/elm/LoggedIn/Monthly/Model.elm delete mode 100644 src/client/elm/LoggedIn/Monthly/Update.elm delete mode 100644 src/client/elm/LoggedIn/Monthly/View.elm delete mode 100644 src/client/elm/LoggedIn/View/Date.elm delete mode 100644 src/client/elm/LoggedIn/View/Expand.elm delete mode 100644 src/client/elm/LoggedIn/View/Paging.elm delete mode 100644 src/client/elm/LoggedIn/View/Price.elm delete mode 100644 src/client/elm/LoggedIn/View/Table.elm create mode 100644 src/client/elm/Route.elm create mode 100644 src/client/elm/Utils/Effects.elm create mode 100644 src/client/elm/View/Click.elm diff --git a/elm-package.json b/elm-package.json index d81bffd..ee5a333 100644 --- a/elm-package.json +++ b/elm-package.json @@ -11,7 +11,8 @@ "evancz/elm-html": "4.0.2 <= v < 5.0.0", "evancz/elm-http": "3.0.0 <= v < 4.0.0", "evancz/start-app": "2.0.2 <= v < 3.0.0", - "evancz/elm-effects": "2.0.1 <= v < 3.0.0" - }, - "native-modules": true + "evancz/elm-effects": "2.0.1 <= v < 3.0.0", + "etaque/elm-transit-router": "1.0.1 <= v < 2.0.0", + "etaque/elm-route-parser": "2.2.0 <= v < 3.0.0" + } } 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/Account/Action.elm b/src/client/elm/LoggedIn/Account/Action.elm deleted file mode 100644 index 66ccfaa..0000000 --- a/src/client/elm/LoggedIn/Account/Action.elm +++ /dev/null @@ -1,17 +0,0 @@ -module LoggedIn.Account.Action - ( Action(..) - ) where - -import Time exposing (Time) - -import Model.User exposing (UserId) -import Model.Income exposing (IncomeId) - -type Action = - NoOp - | ToggleDetail - | ToggleIncomeEdition - | UpdateIncomeEdition String - | UpdateEditionError String - | UpdateIncome Time Int - | ValidateUpdateIncome IncomeId Time Int diff --git a/src/client/elm/LoggedIn/Account/Model.elm b/src/client/elm/LoggedIn/Account/Model.elm deleted file mode 100644 index 2d0c4a3..0000000 --- a/src/client/elm/LoggedIn/Account/Model.elm +++ /dev/null @@ -1,64 +0,0 @@ -module LoggedIn.Account.Model - ( Model - , IncomeEdition - , init - , initIncomeEdition - , getCurrentIncome - , validateIncome - ) where - -import Result as Result exposing (Result(..)) -import Dict -import String - -import Utils.Dict exposing (mapValues) - -import Model.Translations exposing (..) -import Model.Income exposing (..) -import Model.User exposing (UserId) - -type alias Model = - { me : UserId - , incomes : Incomes - , visibleDetail : Bool - , incomeEdition : Maybe IncomeEdition - } - -init : UserId -> Incomes -> Model -init me incomes = - { me = me - , incomes = incomes - , visibleDetail = False - , incomeEdition = Nothing - } - -getCurrentIncome : Model -> Maybe Int -getCurrentIncome account = - account.incomes - |> Dict.filter (\_ income -> income.userId == account.me) - |> Dict.values - |> List.sortBy .creation - |> List.reverse - |> List.head - |> Maybe.map .amount - -type alias IncomeEdition = - { income : String - , error : Maybe String - } - -initIncomeEdition : Int -> IncomeEdition -initIncomeEdition income = - { income = toString income - , error = Nothing - } - -validateIncome : String -> Translations -> Result String Int -validateIncome amount translations = - case String.toInt amount of - Ok number -> - if number > 0 - then Ok number - else Err <| getMessage "IncomeMustBePositiveNumber" translations - Err _ -> - Err <| getMessage "IncomeRequired" translations diff --git a/src/client/elm/LoggedIn/Account/Update.elm b/src/client/elm/LoggedIn/Account/Update.elm deleted file mode 100644 index a3d9745..0000000 --- a/src/client/elm/LoggedIn/Account/Update.elm +++ /dev/null @@ -1,75 +0,0 @@ -module LoggedIn.Account.Update - ( update - ) where - -import Maybe -import Dict -import Task - -import Effects exposing (Effects) - -import Server - -import LoggedIn.Account.Action as AccountAction -import LoggedIn.Account.Model as AccountModel - -import Utils.Maybe exposing (isJust) - -update : AccountAction.Action -> AccountModel.Model -> (AccountModel.Model, Effects AccountAction.Action) -update action account = - case action of - - AccountAction.NoOp -> - (account, Effects.none) - - AccountAction.ToggleDetail -> - ( { account | visibleDetail = not account.visibleDetail } - , Effects.none - ) - - AccountAction.ToggleIncomeEdition -> - ( { account | incomeEdition = - if isJust account.incomeEdition - then Nothing - else Just (AccountModel.initIncomeEdition (Maybe.withDefault 0 (AccountModel.getCurrentIncome account))) - } - , Effects.none - ) - - AccountAction.UpdateIncomeEdition income -> - case account.incomeEdition of - Just incomeEdition -> - ( { account | incomeEdition = Just { incomeEdition | income = income } } - , Effects.none - ) - Nothing -> - ( account - , Effects.none - ) - - AccountAction.UpdateEditionError error -> - case account.incomeEdition of - Just incomeEdition -> - ( { account | incomeEdition = Just { incomeEdition | error = Just error } } - , Effects.none - ) - Nothing -> - ( account - , Effects.none - ) - - AccountAction.UpdateIncome currentTime amount -> - ( account - , Server.setIncome currentTime amount - |> Task.map (\incomeId -> (AccountAction.ValidateUpdateIncome incomeId currentTime amount)) - |> flip Task.onError (always <| Task.succeed AccountAction.NoOp) - |> Effects.task - ) - - AccountAction.ValidateUpdateIncome incomeId currentTime amount -> - ( { account - | incomes = Dict.insert incomeId { userId = account.me, creation = currentTime, amount = amount } account.incomes - , incomeEdition = Nothing - } - , Effects.none - ) diff --git a/src/client/elm/LoggedIn/Account/View.elm b/src/client/elm/LoggedIn/Account/View.elm deleted file mode 100644 index 5d96da6..0000000 --- a/src/client/elm/LoggedIn/Account/View.elm +++ /dev/null @@ -1,131 +0,0 @@ -module LoggedIn.Account.View - ( view - ) where - -import List -import Signal exposing (Address) - -import Html exposing (..) -import Html as H exposing (..) -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 Model exposing (Model) -import Model.User exposing (getUserName) -import Model.Translations exposing (getParamMessage, getMessage) -import Action exposing (..) - -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 - in div - [ classList - [ ("account", True) - , ("detail", account.visibleDetail) - ] - ] - [ exceedingPayers address model loggedInModel - , if account.visibleDetail - then income address model account - else text "" - ] - -exceedingPayers : Address Action -> Model -> LoggedInModel.Model -> Html -exceedingPayers address model loggedInModel = - button - [ class "header" - , onClick address (UpdateLoggedIn << LoggedInAction.UpdateAccount <| AccountAction.ToggleDetail) - ] - ( (List.map (exceedingPayer model loggedInModel) (getOrderedExceedingPayers model.currentTime loggedInModel.users loggedInModel.account.incomes loggedInModel.payments)) - ++ [ expand ExpandDown loggedInModel.account.visibleDetail ] - ) - -exceedingPayer : Model -> LoggedInModel.Model -> ExceedingPayer -> Html -exceedingPayer model loggedInModel payer = - div - [ class "exceedingPayer" ] - [ span - [ class "userName" ] - [ payer.userId - |> getUserName loggedInModel.users - |> Maybe.withDefault "−" - |> text - ] - , span - [ class "amount" ] - [ text ("+ " ++ (price model payer.amount)) ] - ] - -income : Address Action -> Model -> AccountModel.Model -> Html -income address model account = - case account.incomeEdition of - Nothing -> - incomeRead address model account - Just edition -> - incomeEdition address model account edition - -incomeRead : Address Action -> Model -> AccountModel.Model -> Html -incomeRead address model account = - div - [ class "income" ] - [ ( case AccountModel.getCurrentIncome account of - Nothing -> - text (getMessage "NoIncome" model.translations) - Just income -> - text (getParamMessage [price model income] "Income" model.translations) - ) - , toggleIncomeEdition address "editIncomeEdition" (getMessage "Edit" model.translations) - ] - -incomeEdition : Address Action -> Model -> AccountModel.Model -> AccountModel.IncomeEdition -> Html -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) - Err error -> - onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.UpdateAccount << AccountAction.UpdateEditionError <| error) - , class "income" - ] - [ label - [ for "incomeInput" ] - [ text (getMessage "NewIncome" model.translations) ] - , input - [ id "incomeInput" - , value edition.income - , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.UpdateAccount << AccountAction.UpdateIncomeEdition) - , maxlength 10 - ] - [] - , button - [ type' "submit" - , class "validateIncomeEdition" - ] - [ text (getMessage "Validate" model.translations) ] - , toggleIncomeEdition address "undoIncomeEdition" (getMessage "Undo" model.translations) - , case edition.error of - Just error -> div [ class "error" ] [ text error ] - Nothing -> text "" - ] - -toggleIncomeEdition : Address Action -> String -> String -> Html -toggleIncomeEdition address className name = - button - [ type' "button" - , class className - , onClick address (UpdateLoggedIn << LoggedInAction.UpdateAccount <| AccountAction.ToggleIncomeEdition) - ] - [ text name ] 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/AddPayment/Action.elm b/src/client/elm/LoggedIn/AddPayment/Action.elm deleted file mode 100644 index 41d4f5b..0000000 --- a/src/client/elm/LoggedIn/AddPayment/Action.elm +++ /dev/null @@ -1,11 +0,0 @@ -module LoggedIn.AddPayment.Action - ( Action(..) - ) where - -type Action = - NoOp - | UpdateName String - | UpdateCost String - | AddError (Maybe String) (Maybe String) - | ToggleFrequency - | WaitingServer diff --git a/src/client/elm/LoggedIn/AddPayment/Model.elm b/src/client/elm/LoggedIn/AddPayment/Model.elm deleted file mode 100644 index 2aa32c2..0000000 --- a/src/client/elm/LoggedIn/AddPayment/Model.elm +++ /dev/null @@ -1,29 +0,0 @@ -module LoggedIn.AddPayment.Model - ( Model - , init - ) where - -import Result as Result exposing (Result(..)) -import Json.Decode exposing ((:=)) - -import Model.Translations exposing (..) -import Model.Payment exposing (PaymentFrequency(..)) - -type alias Model = - { name : String - , nameError : Maybe String - , cost : String - , costError : Maybe String - , frequency : PaymentFrequency - , waitingServer : Bool - } - -init : PaymentFrequency -> Model -init frequency = - { name = "" - , nameError = Nothing - , cost = "" - , costError = Nothing - , frequency = frequency - , waitingServer = False - } diff --git a/src/client/elm/LoggedIn/AddPayment/Update.elm b/src/client/elm/LoggedIn/AddPayment/Update.elm deleted file mode 100644 index eb4384b..0000000 --- a/src/client/elm/LoggedIn/AddPayment/Update.elm +++ /dev/null @@ -1,55 +0,0 @@ -module LoggedIn.AddPayment.Update - ( update - , addPaymentError - ) where - -import Maybe -import Json.Decode as Json exposing ((:=)) - -import LoggedIn.AddPayment.Action as AddPaymentAction -import LoggedIn.AddPayment.Model as AddPaymentModel - -import Model.Translations exposing (Translations, getMessage) -import Model.Payment exposing (PaymentFrequency(..)) - -update : AddPaymentAction.Action -> AddPaymentModel.Model -> AddPaymentModel.Model -update action addPayment = - case action of - - AddPaymentAction.NoOp -> - addPayment - - AddPaymentAction.UpdateName name -> - { addPayment | name = name } - - AddPaymentAction.UpdateCost cost -> - { addPayment | cost = cost } - - AddPaymentAction.AddError nameError costError -> - { addPayment - | nameError = nameError - , costError = costError - , waitingServer = False - } - - AddPaymentAction.ToggleFrequency -> - { addPayment - | frequency = if addPayment.frequency == Punctual then Monthly else Punctual - } - - AddPaymentAction.WaitingServer -> - { addPayment | waitingServer = True } - -addPaymentError : Translations -> String -> Maybe AddPaymentAction.Action -addPaymentError translations jsonErr = - let decoder = - Json.object2 (,) - (Json.maybe <| "name" := Json.string) - (Json.maybe <| "cost" := Json.string) - in case Json.decodeString decoder jsonErr of - Err _ -> - Nothing - Ok (mbNameKey, mbCostKey) -> - Just <| AddPaymentAction.AddError - (Maybe.map (flip getMessage translations) mbNameKey) - (Maybe.map (flip getMessage translations) mbCostKey) diff --git a/src/client/elm/LoggedIn/AddPayment/View.elm b/src/client/elm/LoggedIn/AddPayment/View.elm deleted file mode 100644 index 90f4f02..0000000 --- a/src/client/elm/LoggedIn/AddPayment/View.elm +++ /dev/null @@ -1,127 +0,0 @@ -module LoggedIn.AddPayment.View - ( view - ) where - -import Result exposing (..) -import Signal exposing (Address) - -import Html as H exposing (..) -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 Model exposing (Model) -import Model.Payment exposing (PaymentFrequency(..)) -import Model.Translations exposing (getMessage) -import Action as Action exposing (..) - -import View.Events exposing (onSubmitPrevDefault) -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 = - H.form - [ let update = - if loggedInModel.add.waitingServer - then - Action.NoOp - else - UpdateLoggedIn <| LoggedInAction.AddPayment loggedInModel.add.name loggedInModel.add.cost loggedInModel.add.frequency - in onSubmitPrevDefault address update - , class "addPayment" - ] - [ addPaymentName address loggedInModel.add - , addPaymentCost address model loggedInModel.add - , paymentFrequency address model loggedInModel.add - , button - [ type' "submit" - , classList - [ ("add", True) - , ("waitingServer", loggedInModel.add.waitingServer) - ] - ] - [ text (getMessage "Add" model.translations) - , if loggedInModel.add.waitingServer then renderSpinIcon else text "" - ] - ] - -addPaymentName : Address Action -> AddPaymentModel.Model -> Html -addPaymentName address addPayment = - div - [ classList - [ ("name", True) - , ("error", isJust addPayment.nameError) - ] - ] - [ input - [ id "nameInput" - , value addPayment.name - , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.UpdateAdd << AddPaymentAction.UpdateName) - , maxlength 20 - ] - [] - , label - [ for "nameInput" ] - [ renderIcon "shopping-cart" ] - , case addPayment.nameError of - Just error -> - div [ class "errorMessage" ] [ text error ] - Nothing -> - text "" - ] - -addPaymentCost : Address Action -> Model -> AddPaymentModel.Model -> Html -addPaymentCost address model addPayment = - div - [ classList - [ ("cost", True) - , ("error", isJust addPayment.costError) - ] - ] - [ input - [ id "costInput" - , value addPayment.cost - , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.UpdateAdd << AddPaymentAction.UpdateCost) - , maxlength 7 - ] - [] - , label - [ for "costInput" ] - [ text model.conf.currency ] - , case addPayment.costError of - Just error -> - div [ class "errorMessage" ] [ text error ] - Nothing -> - text "" - ] - -paymentFrequency : Address Action -> Model -> AddPaymentModel.Model -> Html -paymentFrequency address model addPayment = - button - [ type' "button" - , class "frequency" - , onClick address (UpdateLoggedIn << LoggedInAction.UpdateAdd <| AddPaymentAction.ToggleFrequency) - ] - [ div - [ classList - [ ("punctual", True) - , ("selected", addPayment.frequency == Punctual) - ] - ] - [ text (getMessage "Punctual" model.translations) ] - , div - [ classList - [ ("monthly", True) - , ("selected", addPayment.frequency == Monthly) - ] - ] - [ text (getMessage "Monthly" model.translations) ] - ] diff --git a/src/client/elm/LoggedIn/Home/Account/Action.elm b/src/client/elm/LoggedIn/Home/Account/Action.elm new file mode 100644 index 0000000..61dae42 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Account/Action.elm @@ -0,0 +1,17 @@ +module LoggedIn.Home.Account.Action + ( Action(..) + ) where + +import Time exposing (Time) + +import Model.User exposing (UserId) +import Model.Income exposing (IncomeId) + +type Action = + NoOp + | ToggleDetail + | ToggleIncomeEdition + | UpdateIncomeEdition String + | UpdateEditionError String + | UpdateIncome Time Int + | ValidateUpdateIncome IncomeId Time Int diff --git a/src/client/elm/LoggedIn/Home/Account/Model.elm b/src/client/elm/LoggedIn/Home/Account/Model.elm new file mode 100644 index 0000000..d8bf748 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Account/Model.elm @@ -0,0 +1,64 @@ +module LoggedIn.Home.Account.Model + ( Model + , IncomeEdition + , init + , initIncomeEdition + , getCurrentIncome + , validateIncome + ) where + +import Result as Result exposing (Result(..)) +import Dict +import String + +import Utils.Dict exposing (mapValues) + +import Model.Translations exposing (..) +import Model.Income exposing (..) +import Model.User exposing (UserId) + +type alias Model = + { me : UserId + , incomes : Incomes + , visibleDetail : Bool + , incomeEdition : Maybe IncomeEdition + } + +init : UserId -> Incomes -> Model +init me incomes = + { me = me + , incomes = incomes + , visibleDetail = False + , incomeEdition = Nothing + } + +getCurrentIncome : Model -> Maybe Int +getCurrentIncome account = + account.incomes + |> Dict.filter (\_ income -> income.userId == account.me) + |> Dict.values + |> List.sortBy .creation + |> List.reverse + |> List.head + |> Maybe.map .amount + +type alias IncomeEdition = + { income : String + , error : Maybe String + } + +initIncomeEdition : Int -> IncomeEdition +initIncomeEdition income = + { income = toString income + , error = Nothing + } + +validateIncome : String -> Translations -> Result String Int +validateIncome amount translations = + case String.toInt amount of + Ok number -> + if number > 0 + then Ok number + else Err <| getMessage "IncomeMustBePositiveNumber" translations + Err _ -> + Err <| getMessage "IncomeRequired" translations diff --git a/src/client/elm/LoggedIn/Home/Account/Update.elm b/src/client/elm/LoggedIn/Home/Account/Update.elm new file mode 100644 index 0000000..8d002a3 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Account/Update.elm @@ -0,0 +1,75 @@ +module LoggedIn.Home.Account.Update + ( update + ) where + +import Maybe +import Dict +import Task + +import Effects exposing (Effects) + +import Server + +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.Account.Model as AccountModel + +import Utils.Maybe exposing (isJust) + +update : AccountAction.Action -> AccountModel.Model -> (AccountModel.Model, Effects AccountAction.Action) +update action account = + case action of + + AccountAction.NoOp -> + (account, Effects.none) + + AccountAction.ToggleDetail -> + ( { account | visibleDetail = not account.visibleDetail } + , Effects.none + ) + + AccountAction.ToggleIncomeEdition -> + ( { account | incomeEdition = + if isJust account.incomeEdition + then Nothing + else Just (AccountModel.initIncomeEdition (Maybe.withDefault 0 (AccountModel.getCurrentIncome account))) + } + , Effects.none + ) + + AccountAction.UpdateIncomeEdition income -> + case account.incomeEdition of + Just incomeEdition -> + ( { account | incomeEdition = Just { incomeEdition | income = income } } + , Effects.none + ) + Nothing -> + ( account + , Effects.none + ) + + AccountAction.UpdateEditionError error -> + case account.incomeEdition of + Just incomeEdition -> + ( { account | incomeEdition = Just { incomeEdition | error = Just error } } + , Effects.none + ) + Nothing -> + ( account + , Effects.none + ) + + AccountAction.UpdateIncome currentTime amount -> + ( account + , Server.setIncome currentTime amount + |> Task.map (\incomeId -> (AccountAction.ValidateUpdateIncome incomeId currentTime amount)) + |> flip Task.onError (always <| Task.succeed AccountAction.NoOp) + |> Effects.task + ) + + AccountAction.ValidateUpdateIncome incomeId currentTime amount -> + ( { account + | incomes = Dict.insert incomeId { userId = account.me, creation = currentTime, amount = amount } account.incomes + , incomeEdition = Nothing + } + , Effects.none + ) diff --git a/src/client/elm/LoggedIn/Home/Account/View.elm b/src/client/elm/LoggedIn/Home/Account/View.elm new file mode 100644 index 0000000..252f8cf --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Account/View.elm @@ -0,0 +1,133 @@ +module LoggedIn.Home.Account.View + ( view + ) where + +import List +import Signal exposing (Address) + +import Html exposing (..) +import Html as H exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +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) +import Model.Translations exposing (getParamMessage, getMessage) +import Action exposing (..) + +import View.Events exposing (onSubmitPrevDefault) + +import Utils.Either exposing (toMaybeError) + +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 homeModel + , if account.visibleDetail + then income address model account + else text "" + ] + +exceedingPayers : Address Action -> Model -> HomeModel.Model -> Html +exceedingPayers address model homeModel = + button + [ class "header" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.ToggleDetail) + ] + ( (List.map (exceedingPayer model homeModel) (getOrderedExceedingPayers model.currentTime homeModel.users homeModel.account.incomes homeModel.payments)) + ++ [ expand ExpandDown homeModel.account.visibleDetail ] + ) + +exceedingPayer : Model -> HomeModel.Model -> ExceedingPayer -> Html +exceedingPayer model homeModel payer = + div + [ class "exceedingPayer" ] + [ span + [ class "userName" ] + [ payer.userId + |> getUserName homeModel.users + |> Maybe.withDefault "−" + |> text + ] + , span + [ class "amount" ] + [ text ("+ " ++ (price model payer.amount)) ] + ] + +income : Address Action -> Model -> AccountModel.Model -> Html +income address model account = + case account.incomeEdition of + Nothing -> + incomeRead address model account + Just edition -> + incomeEdition address model account edition + +incomeRead : Address Action -> Model -> AccountModel.Model -> Html +incomeRead address model account = + div + [ class "income" ] + [ ( case AccountModel.getCurrentIncome account of + Nothing -> + text (getMessage "NoIncome" model.translations) + Just income -> + text (getParamMessage [price model income] "Income" model.translations) + ) + , toggleIncomeEdition address "editIncomeEdition" (getMessage "Edit" model.translations) + ] + +incomeEdition : Address Action -> Model -> AccountModel.Model -> AccountModel.IncomeEdition -> Html +incomeEdition address model account edition = + H.form + [ case AccountModel.validateIncome edition.income model.translations of + Ok validatedAmount -> + onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.UpdateIncome model.currentTime validatedAmount) + Err error -> + onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount << AccountAction.UpdateEditionError <| error) + , class "income" + ] + [ label + [ for "incomeInput" ] + [ text (getMessage "NewIncome" model.translations) ] + , input + [ id "incomeInput" + , value edition.income + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount << AccountAction.UpdateIncomeEdition) + , maxlength 10 + ] + [] + , button + [ type' "submit" + , class "validateIncomeEdition" + ] + [ text (getMessage "Validate" model.translations) ] + , toggleIncomeEdition address "undoIncomeEdition" (getMessage "Undo" model.translations) + , case edition.error of + Just error -> div [ class "error" ] [ text error ] + Nothing -> text "" + ] + +toggleIncomeEdition : Address Action -> String -> String -> Html +toggleIncomeEdition address className name = + button + [ type' "button" + , class className + , 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/Home/AddPayment/Action.elm b/src/client/elm/LoggedIn/Home/AddPayment/Action.elm new file mode 100644 index 0000000..095863f --- /dev/null +++ b/src/client/elm/LoggedIn/Home/AddPayment/Action.elm @@ -0,0 +1,11 @@ +module LoggedIn.Home.AddPayment.Action + ( Action(..) + ) where + +type Action = + NoOp + | UpdateName String + | UpdateCost String + | AddError (Maybe String) (Maybe String) + | ToggleFrequency + | WaitingServer diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Model.elm b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm new file mode 100644 index 0000000..22b6883 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm @@ -0,0 +1,29 @@ +module LoggedIn.Home.AddPayment.Model + ( Model + , init + ) where + +import Result as Result exposing (Result(..)) +import Json.Decode exposing ((:=)) + +import Model.Translations exposing (..) +import Model.Payment exposing (PaymentFrequency(..)) + +type alias Model = + { name : String + , nameError : Maybe String + , cost : String + , costError : Maybe String + , frequency : PaymentFrequency + , waitingServer : Bool + } + +init : PaymentFrequency -> Model +init frequency = + { name = "" + , nameError = Nothing + , cost = "" + , costError = Nothing + , frequency = frequency + , waitingServer = False + } diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Update.elm b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm new file mode 100644 index 0000000..b8020f1 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm @@ -0,0 +1,55 @@ +module LoggedIn.Home.AddPayment.Update + ( update + , addPaymentError + ) where + +import Maybe +import Json.Decode as Json exposing ((:=)) + +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(..)) + +update : AddPaymentAction.Action -> AddPaymentModel.Model -> AddPaymentModel.Model +update action addPayment = + case action of + + AddPaymentAction.NoOp -> + addPayment + + AddPaymentAction.UpdateName name -> + { addPayment | name = name } + + AddPaymentAction.UpdateCost cost -> + { addPayment | cost = cost } + + AddPaymentAction.AddError nameError costError -> + { addPayment + | nameError = nameError + , costError = costError + , waitingServer = False + } + + AddPaymentAction.ToggleFrequency -> + { addPayment + | frequency = if addPayment.frequency == Punctual then Monthly else Punctual + } + + AddPaymentAction.WaitingServer -> + { addPayment | waitingServer = True } + +addPaymentError : Translations -> String -> Maybe AddPaymentAction.Action +addPaymentError translations jsonErr = + let decoder = + Json.object2 (,) + (Json.maybe <| "name" := Json.string) + (Json.maybe <| "cost" := Json.string) + in case Json.decodeString decoder jsonErr of + Err _ -> + Nothing + Ok (mbNameKey, mbCostKey) -> + Just <| AddPaymentAction.AddError + (Maybe.map (flip getMessage translations) mbNameKey) + (Maybe.map (flip getMessage translations) mbCostKey) diff --git a/src/client/elm/LoggedIn/Home/AddPayment/View.elm b/src/client/elm/LoggedIn/Home/AddPayment/View.elm new file mode 100644 index 0000000..09d5fbf --- /dev/null +++ b/src/client/elm/LoggedIn/Home/AddPayment/View.elm @@ -0,0 +1,129 @@ +module LoggedIn.Home.AddPayment.View + ( view + ) where + +import Result exposing (..) +import Signal exposing (Address) + +import Html as H exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +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(..)) +import Model.Translations exposing (getMessage) +import Action as Action exposing (..) + +import View.Events exposing (onSubmitPrevDefault) +import View.Icon exposing (..) + +import Utils.Maybe exposing (isJust) +import Utils.Either exposing (toMaybeError) + +view : Address Action -> Model -> HomeModel.Model -> Html +view address model homeModel = + H.form + [ let update = + if homeModel.add.waitingServer + then + Action.NoOp + else + UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.AddPayment homeModel.add.name homeModel.add.cost homeModel.add.frequency + in onSubmitPrevDefault address update + , class "addPayment" + ] + [ addPaymentName address homeModel.add + , addPaymentCost address model homeModel.add + , paymentFrequency address model homeModel.add + , button + [ type' "submit" + , classList + [ ("add", True) + , ("waitingServer", homeModel.add.waitingServer) + ] + ] + [ text (getMessage "Add" model.translations) + , if homeModel.add.waitingServer then renderSpinIcon else text "" + ] + ] + +addPaymentName : Address Action -> AddPaymentModel.Model -> Html +addPaymentName address addPayment = + div + [ classList + [ ("name", True) + , ("error", isJust addPayment.nameError) + ] + ] + [ input + [ id "nameInput" + , value addPayment.name + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd << AddPaymentAction.UpdateName) + , maxlength 20 + ] + [] + , label + [ for "nameInput" ] + [ renderIcon "shopping-cart" ] + , case addPayment.nameError of + Just error -> + div [ class "errorMessage" ] [ text error ] + Nothing -> + text "" + ] + +addPaymentCost : Address Action -> Model -> AddPaymentModel.Model -> Html +addPaymentCost address model addPayment = + div + [ classList + [ ("cost", True) + , ("error", isJust addPayment.costError) + ] + ] + [ input + [ id "costInput" + , value addPayment.cost + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd << AddPaymentAction.UpdateCost) + , maxlength 7 + ] + [] + , label + [ for "costInput" ] + [ text model.conf.currency ] + , case addPayment.costError of + Just error -> + div [ class "errorMessage" ] [ text error ] + Nothing -> + text "" + ] + +paymentFrequency : Address Action -> Model -> AddPaymentModel.Model -> Html +paymentFrequency address model addPayment = + button + [ type' "button" + , class "frequency" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd <| AddPaymentAction.ToggleFrequency) + ] + [ div + [ classList + [ ("punctual", True) + , ("selected", addPayment.frequency == Punctual) + ] + ] + [ text (getMessage "Punctual" model.translations) ] + , div + [ classList + [ ("monthly", True) + , ("selected", addPayment.frequency == Monthly) + ] + ] + [ text (getMessage "Monthly" model.translations) ] + ] 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/Home/Model/Payer.elm b/src/client/elm/LoggedIn/Home/Model/Payer.elm new file mode 100644 index 0000000..65e3f0e --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Model/Payer.elm @@ -0,0 +1,122 @@ +module LoggedIn.Home.Model.Payer + ( Payers + , Payer + , ExceedingPayer + , getOrderedExceedingPayers + ) where + +import Json.Decode as Json exposing (..) +import Dict exposing (..) +import List +import Maybe +import Time exposing (Time) +import Date + +import Model.Payment exposing (Payments, totalPayments) +import Model.User exposing (Users, UserId, userIdDecoder) +import Model.Income exposing (..) + +import Utils.Dict exposing (mapValues) +import Utils.Maybe exposing (isJust) + +type alias Payers = Dict UserId Payer + +type alias Payer = + { preIncomePaymentSum : Int + , postIncomePaymentSum : Int + , incomes : List Income + } + +type alias ExceedingPayer = + { userId : UserId + , amount : Int + } + +getOrderedExceedingPayers : Time -> Users -> Incomes -> Payments -> List ExceedingPayer +getOrderedExceedingPayers currentTime users incomes payments = + let payers = getPayers currentTime users incomes payments + exceedingPayersOnPreIncome = + payers + |> mapValues .preIncomePaymentSum + |> Dict.toList + |> exceedingPayersFromAmounts + in case incomeDefinedForAll (Dict.keys users) incomes of + Just since -> + let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers + mbMaxRatio = + postPaymentPayers + |> Dict.toList + |> List.map (.ratio << snd) + |> List.maximum + in case mbMaxRatio of + Just maxRatio -> + postPaymentPayers + |> mapValues (getFinalDiff maxRatio) + |> Dict.toList + |> exceedingPayersFromAmounts + Nothing -> + exceedingPayersOnPreIncome + Nothing -> + exceedingPayersOnPreIncome + +getPayers : Time -> Users -> Incomes -> Payments -> Payers +getPayers currentTime users incomes payments = + let incomesDefined = incomeDefinedForAll (Dict.keys users) incomes + in Dict.keys users + |> List.map (\userId -> + ( userId + , { preIncomePaymentSum = + totalPayments + (\p -> (Date.toTime p.creation) < (Maybe.withDefault currentTime incomesDefined)) + userId + payments + , postIncomePaymentSum = + totalPayments + (\p -> + case incomesDefined of + Nothing -> False + Just t -> (Date.toTime p.creation) >= t + ) + userId + payments + , incomes = List.filter ((==) userId << .userId) (Dict.values incomes) + } + ) + ) + |> Dict.fromList + +exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer +exceedingPayersFromAmounts userAmounts = + let mbMinAmount = List.minimum << List.map snd <| userAmounts + in case mbMinAmount of + Nothing -> + [] + Just minAmount -> + userAmounts + |> List.map (\userAmount -> + { userId = fst userAmount + , amount = snd userAmount - minAmount + } + ) + |> List.filter (\payer -> payer.amount > 0) + +type alias PostPaymentPayer = + { preIncomePaymentSum : Int + , cumulativeIncome : Int + , ratio : Float + } + +getPostPaymentPayer : Time -> Time -> Payer -> PostPaymentPayer +getPostPaymentPayer currentTime since payer = + let cumulativeIncome = cumulativeIncomesSince currentTime since payer.incomes + in { preIncomePaymentSum = payer.preIncomePaymentSum + , cumulativeIncome = cumulativeIncome + , ratio = toFloat payer.postIncomePaymentSum / toFloat cumulativeIncome + } + +getFinalDiff : Float -> PostPaymentPayer -> Int +getFinalDiff maxRatio payer = + let postIncomeDiff = + -1 * (maxRatio - payer.ratio) * toFloat payer.cumulativeIncome + |> truncate + in postIncomeDiff + payer.preIncomePaymentSum diff --git a/src/client/elm/LoggedIn/Home/Monthly/Action.elm b/src/client/elm/LoggedIn/Home/Monthly/Action.elm new file mode 100644 index 0000000..0a1faf4 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Monthly/Action.elm @@ -0,0 +1,10 @@ +module LoggedIn.Home.Monthly.Action + ( Action(..) + ) where + +import Model.Payment exposing (Payment) + +type Action = + ToggleDetail + | AddPayment Payment + | DeletePayment Payment diff --git a/src/client/elm/LoggedIn/Home/Monthly/Model.elm b/src/client/elm/LoggedIn/Home/Monthly/Model.elm new file mode 100644 index 0000000..7f6fd4c --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Monthly/Model.elm @@ -0,0 +1,17 @@ +module LoggedIn.Home.Monthly.Model + ( Model + , init + ) where + +import Model.Payment exposing (Payments) + +type alias Model = + { payments : Payments + , visibleDetail : Bool + } + +init : Payments -> Model +init payments = + { payments = payments + , visibleDetail = False + } diff --git a/src/client/elm/LoggedIn/Home/Monthly/Update.elm b/src/client/elm/LoggedIn/Home/Monthly/Update.elm new file mode 100644 index 0000000..70b2f9c --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Monthly/Update.elm @@ -0,0 +1,21 @@ +module LoggedIn.Home.Monthly.Update + ( update + ) where + +import LoggedIn.Home.Monthly.Action as MonthlyAction +import LoggedIn.Home.Monthly.Model as MonthlyModel + +update : MonthlyAction.Action -> MonthlyModel.Model -> MonthlyModel.Model +update action monthly = + case action of + MonthlyAction.ToggleDetail -> + { monthly | visibleDetail = not monthly.visibleDetail } + MonthlyAction.AddPayment payment -> + { monthly + | payments = payment :: monthly.payments + , visibleDetail = True + } + MonthlyAction.DeletePayment payment -> + { monthly + | payments = List.filter (((/=) payment.id) << .id) monthly.payments + } diff --git a/src/client/elm/LoggedIn/Home/Monthly/View.elm b/src/client/elm/LoggedIn/Home/Monthly/View.elm new file mode 100644 index 0000000..f5ab721 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Monthly/View.elm @@ -0,0 +1,91 @@ +module LoggedIn.Home.Monthly.View + ( view + ) where + +import String +import Signal exposing (Address) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +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) +import Model.Translations exposing (getMessage, getParamMessage) +import Action exposing (..) + +import View.Icon exposing (renderIcon) + +view : Address Action -> Model -> HomeModel.Model -> Html +view address model homeModel = + let monthly = homeModel.monthly + in if List.length monthly.payments == 0 + then + text "" + else + div + [ classList + [ ("monthlyPayments", True) + , ("detail", monthly.visibleDetail) + ] + ] + [ monthlyCount address model monthly + , if monthly.visibleDetail then paymentsTable address model homeModel monthly else text "" + ] + +monthlyCount : Address Action -> Model -> MonthlyModel.Model -> 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 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 -> 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 homeModel) + ) + +paymentLine : Address Action -> Model -> HomeModel.Model -> Payment -> Html +paymentLine address model homeModel payment = + a + [ classList + [ ("row", True) + , ("edition", homeModel.paymentEdition == Just payment.id) + ] + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.ToggleEdit payment.id) + ] + [ div [ class "cell category" ] [ text (payment.name) ] + , div + [ classList + [ ("cell cost", True) + , ("refund", payment.cost < 0) + ] + ] + [ text (price model payment.cost) ] + , div + [ class "cell delete" + , 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/Home/View/Date.elm b/src/client/elm/LoggedIn/Home/View/Date.elm new file mode 100644 index 0000000..2cc55fe --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Date.elm @@ -0,0 +1,59 @@ +module LoggedIn.Home.View.Date + ( renderShortDate + , renderLongDate + ) where + +import Date exposing (..) +import String + +import Model.Translations exposing (..) + +renderShortDate : Date -> Translations -> String +renderShortDate date translations = + let params = + [ String.pad 2 '0' (toString (Date.day date)) + , String.pad 2 '0' (toString (getMonthNumber (Date.month date))) + , toString (Date.year date) + ] + in getParamMessage params "ShortDate" translations + +renderLongDate : Date -> Translations -> String +renderLongDate date translations = + let params = + [ toString (Date.day date) + , (getMessage (getMonthKey (Date.month date)) translations) + , toString (Date.year date) + ] + in getParamMessage params "LongDate" translations + +getMonthNumber : Month -> Int +getMonthNumber month = + case month of + Jan -> 1 + Feb -> 2 + Mar -> 3 + Apr -> 4 + May -> 5 + Jun -> 6 + Jul -> 7 + Aug -> 8 + Sep -> 9 + Oct -> 10 + Nov -> 11 + Dec -> 12 + +getMonthKey : Month -> String +getMonthKey month = + case month of + Jan -> "January" + Feb -> "February" + Mar -> "March" + Apr -> "April" + May -> "May" + Jun -> "June" + Jul -> "July" + Aug -> "August" + Sep -> "September" + Oct -> "October" + Nov -> "November" + Dec -> "December" diff --git a/src/client/elm/LoggedIn/Home/View/Expand.elm b/src/client/elm/LoggedIn/Home/View/Expand.elm new file mode 100644 index 0000000..514bf93 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Expand.elm @@ -0,0 +1,25 @@ +module LoggedIn.Home.View.Expand + ( expand + , ExpandType(..) + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) + +import View.Icon exposing (renderIcon) + +type ExpandType = ExpandUp | ExpandDown + +expand : ExpandType -> Bool -> Html +expand expandType isExpanded = + div + [ class "expand" ] + [ renderIcon (chevronIcon expandType isExpanded) ] + +chevronIcon : ExpandType -> Bool -> String +chevronIcon expandType isExpanded = + case (expandType, isExpanded) of + (ExpandUp, True) -> "chevron-down" + (ExpandUp, False) -> "chevron-up" + (ExpandDown, True) -> "chevron-up" + (ExpandDown, False) -> "chevron-down" diff --git a/src/client/elm/LoggedIn/Home/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm new file mode 100644 index 0000000..31aa032 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Paging.elm @@ -0,0 +1,102 @@ +module LoggedIn.Home.View.Paging + ( paymentsPaging + ) where + +import Signal exposing (Address) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel + +import Action exposing (..) +import Model.Payment exposing (perPage) + +import View.Icon exposing (renderIcon) + +showedPages : Int +showedPages = 5 + +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 homeModel.currentPage > 1 + then [ firstPage address, previousPage address homeModel ] + else [] + ) + ++ ( List.map (paymentsPage address homeModel) pages) + ++ ( if homeModel.currentPage < maxPage + then [ nextPage address homeModel, lastPage address maxPage ] + else [] + ) + ) + +truncatePages : Int -> List Int -> List Int +truncatePages currentPage pages = + let totalPages = List.length pages + showedLeftPages = ceiling ((toFloat showedPages - 1) / 2) + showedRightPages = floor ((toFloat showedPages - 1) / 2) + truncatedPages = + if currentPage < showedLeftPages then + [1..showedPages] + else if currentPage > totalPages - showedRightPages then + [(totalPages - showedPages)..totalPages] + else + [(currentPage - showedLeftPages)..(currentPage + showedRightPages)] + in List.filter (flip List.member pages) truncatedPages + +firstPage : Address Action -> Html +firstPage address = + button + [ class "page" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| 1) + ] + [ renderIcon "fast-backward" ] + +previousPage : Address Action -> HomeModel.Model -> Html +previousPage address homeModel = + button + [ class "page" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| homeModel.currentPage - 1) + ] + [ renderIcon "backward" ] + +nextPage : Address Action -> HomeModel.Model -> Html +nextPage address homeModel = + button + [ class "page" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| homeModel.currentPage + 1) + ] + [ renderIcon "forward" ] + +lastPage : Address Action -> Int -> Html +lastPage address maxPage = + button + [ class "page" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| maxPage) + ] + [ renderIcon "fast-forward" ] + +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.HomeAction << HomeAction.UpdatePage <| page + ] + [ text (toString page) ] diff --git a/src/client/elm/LoggedIn/Home/View/Price.elm b/src/client/elm/LoggedIn/Home/View/Price.elm new file mode 100644 index 0000000..a3229a0 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Price.elm @@ -0,0 +1,38 @@ +module LoggedIn.Home.View.Price + ( price + ) where + +import String exposing (..) + +import Model exposing (Model) +import Model.Translations exposing (getMessage) + +price : Model -> Int -> String +price model amount = + ( formatInt amount + ++ " " + ++ model.conf.currency + ) + +formatInt : Int -> String +formatInt n = + abs n + |> toString + |> toList + |> List.reverse + |> group 3 + |> List.intersperse [' '] + |> List.concat + |> List.reverse + |> fromList + |> append (if n < 0 then "-" else "") + +group : Int -> List a -> List (List a) +group n xs = + if List.length xs <= n + then + [xs] + else + let take = List.take n xs + drop = List.drop n xs + in take :: (group n drop) diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm new file mode 100644 index 0000000..e49fd05 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Table.elm @@ -0,0 +1,98 @@ +module LoggedIn.Home.View.Table + ( paymentsTable + ) where + +import Dict exposing (..) +import Date exposing (Date) +import Signal exposing (Address) +import String exposing (append) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +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) +import Model.Payment exposing (..) +import Model.Translations exposing (getMessage) +import Action exposing (..) + +import View.Icon exposing (renderIcon) + +paymentsTable : Address Action -> Model -> HomeModel.Model -> Html +paymentsTable address model homeModel = + div + [ class "table" ] + ( headerLine model :: paymentLines address model homeModel) + +headerLine : Model -> Html +headerLine model = + div + [ class "header" ] + [ div [ class "cell category" ] [ renderIcon "shopping-cart" ] + , div [ class "cell cost" ] [ text model.conf.currency ] + , div [ class "cell user" ] [ renderIcon "user" ] + , div [ class "cell date" ] [ renderIcon "calendar" ] + , div [ class "cell" ] [] + ] + +paymentLines : Address Action -> Model -> HomeModel.Model -> List Html +paymentLines address model homeModel = + homeModel.payments + |> List.sortBy (Date.toTime << .creation) + |> List.reverse + |> List.drop ((homeModel.currentPage - 1) * perPage) + |> List.take perPage + |> List.map (paymentLine address model homeModel) + +paymentLine : Address Action -> Model -> HomeModel.Model -> Payment -> Html +paymentLine address model homeModel payment = + a + [ classList + [ ("row", True) + , ("edition", homeModel.paymentEdition == Just payment.id) + ] + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.ToggleEdit <| payment.id) + ] + [ div [ class "cell category" ] [ text payment.name ] + , div + [ classList + [ ("cell cost", True) + , ("refund", payment.cost < 0) + ] + ] + [ text (price model payment.cost) ] + , div + [ class "cell user" ] + [ payment.userId + |> getUserName homeModel.users + |> Maybe.withDefault "−" + |> text + ] + , div + [ class "cell date" ] + [ span + [ class "shortDate" ] + [ text (renderShortDate payment.creation model.translations) ] + , span + [ class "longDate" ] + [ text (renderLongDate payment.creation model.translations) ] + ] + , if homeModel.account.me == payment.userId + then + div + [ class "cell delete" ] + [ button + [ onClick address (UpdateLoggedIn <| LoggedInAction.HomeAction <| HomeAction.DeletePayment payment Punctual)] + [ renderIcon "times" ] + ] + else + div [ class "cell" ] [] + ] 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/Model/Payer.elm b/src/client/elm/LoggedIn/Model/Payer.elm deleted file mode 100644 index 9242610..0000000 --- a/src/client/elm/LoggedIn/Model/Payer.elm +++ /dev/null @@ -1,122 +0,0 @@ -module LoggedIn.Model.Payer - ( Payers - , Payer - , ExceedingPayer - , getOrderedExceedingPayers - ) where - -import Json.Decode as Json exposing (..) -import Dict exposing (..) -import List -import Maybe -import Time exposing (Time) -import Date - -import Model.Payment exposing (Payments, totalPayments) -import Model.User exposing (Users, UserId, userIdDecoder) -import Model.Income exposing (..) - -import Utils.Dict exposing (mapValues) -import Utils.Maybe exposing (isJust) - -type alias Payers = Dict UserId Payer - -type alias Payer = - { preIncomePaymentSum : Int - , postIncomePaymentSum : Int - , incomes : List Income - } - -type alias ExceedingPayer = - { userId : UserId - , amount : Int - } - -getOrderedExceedingPayers : Time -> Users -> Incomes -> Payments -> List ExceedingPayer -getOrderedExceedingPayers currentTime users incomes payments = - let payers = getPayers currentTime users incomes payments - exceedingPayersOnPreIncome = - payers - |> mapValues .preIncomePaymentSum - |> Dict.toList - |> exceedingPayersFromAmounts - in case incomeDefinedForAll (Dict.keys users) incomes of - Just since -> - let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers - mbMaxRatio = - postPaymentPayers - |> Dict.toList - |> List.map (.ratio << snd) - |> List.maximum - in case mbMaxRatio of - Just maxRatio -> - postPaymentPayers - |> mapValues (getFinalDiff maxRatio) - |> Dict.toList - |> exceedingPayersFromAmounts - Nothing -> - exceedingPayersOnPreIncome - Nothing -> - exceedingPayersOnPreIncome - -getPayers : Time -> Users -> Incomes -> Payments -> Payers -getPayers currentTime users incomes payments = - let incomesDefined = incomeDefinedForAll (Dict.keys users) incomes - in Dict.keys users - |> List.map (\userId -> - ( userId - , { preIncomePaymentSum = - totalPayments - (\p -> (Date.toTime p.creation) < (Maybe.withDefault currentTime incomesDefined)) - userId - payments - , postIncomePaymentSum = - totalPayments - (\p -> - case incomesDefined of - Nothing -> False - Just t -> (Date.toTime p.creation) >= t - ) - userId - payments - , incomes = List.filter ((==) userId << .userId) (Dict.values incomes) - } - ) - ) - |> Dict.fromList - -exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer -exceedingPayersFromAmounts userAmounts = - let mbMinAmount = List.minimum << List.map snd <| userAmounts - in case mbMinAmount of - Nothing -> - [] - Just minAmount -> - userAmounts - |> List.map (\userAmount -> - { userId = fst userAmount - , amount = snd userAmount - minAmount - } - ) - |> List.filter (\payer -> payer.amount > 0) - -type alias PostPaymentPayer = - { preIncomePaymentSum : Int - , cumulativeIncome : Int - , ratio : Float - } - -getPostPaymentPayer : Time -> Time -> Payer -> PostPaymentPayer -getPostPaymentPayer currentTime since payer = - let cumulativeIncome = cumulativeIncomesSince currentTime since payer.incomes - in { preIncomePaymentSum = payer.preIncomePaymentSum - , cumulativeIncome = cumulativeIncome - , ratio = toFloat payer.postIncomePaymentSum / toFloat cumulativeIncome - } - -getFinalDiff : Float -> PostPaymentPayer -> Int -getFinalDiff maxRatio payer = - let postIncomeDiff = - -1 * (maxRatio - payer.ratio) * toFloat payer.cumulativeIncome - |> truncate - in postIncomeDiff + payer.preIncomePaymentSum diff --git a/src/client/elm/LoggedIn/Monthly/Action.elm b/src/client/elm/LoggedIn/Monthly/Action.elm deleted file mode 100644 index bf974f9..0000000 --- a/src/client/elm/LoggedIn/Monthly/Action.elm +++ /dev/null @@ -1,10 +0,0 @@ -module LoggedIn.Monthly.Action - ( Action(..) - ) where - -import Model.Payment exposing (Payment) - -type Action = - ToggleDetail - | AddPayment Payment - | DeletePayment Payment diff --git a/src/client/elm/LoggedIn/Monthly/Model.elm b/src/client/elm/LoggedIn/Monthly/Model.elm deleted file mode 100644 index 16009d6..0000000 --- a/src/client/elm/LoggedIn/Monthly/Model.elm +++ /dev/null @@ -1,17 +0,0 @@ -module LoggedIn.Monthly.Model - ( Model - , init - ) where - -import Model.Payment exposing (Payments) - -type alias Model = - { payments : Payments - , visibleDetail : Bool - } - -init : Payments -> Model -init payments = - { payments = payments - , visibleDetail = False - } diff --git a/src/client/elm/LoggedIn/Monthly/Update.elm b/src/client/elm/LoggedIn/Monthly/Update.elm deleted file mode 100644 index 62b40e6..0000000 --- a/src/client/elm/LoggedIn/Monthly/Update.elm +++ /dev/null @@ -1,21 +0,0 @@ -module LoggedIn.Monthly.Update - ( update - ) where - -import LoggedIn.Monthly.Action as MonthlyAction -import LoggedIn.Monthly.Model as MonthlyModel - -update : MonthlyAction.Action -> MonthlyModel.Model -> MonthlyModel.Model -update action monthly = - case action of - MonthlyAction.ToggleDetail -> - { monthly | visibleDetail = not monthly.visibleDetail } - MonthlyAction.AddPayment payment -> - { monthly - | payments = payment :: monthly.payments - , visibleDetail = True - } - MonthlyAction.DeletePayment payment -> - { monthly - | payments = List.filter (((/=) payment.id) << .id) monthly.payments - } diff --git a/src/client/elm/LoggedIn/Monthly/View.elm b/src/client/elm/LoggedIn/Monthly/View.elm deleted file mode 100644 index f4ae2c9..0000000 --- a/src/client/elm/LoggedIn/Monthly/View.elm +++ /dev/null @@ -1,89 +0,0 @@ -module LoggedIn.Monthly.View - ( view - ) where - -import String -import Signal exposing (Address) - -import Html exposing (..) -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 Model exposing (Model) -import Model.Payment as Payment exposing (Payments, Payment) -import Model.Translations exposing (getMessage, getParamMessage) -import Action exposing (..) - -import View.Icon exposing (renderIcon) - -view : Address Action -> Model -> LoggedInModel.Model -> Html -view address model loggedInModel = - let monthly = loggedInModel.monthly - in if List.length monthly.payments == 0 - then - text "" - else - div - [ classList - [ ("monthlyPayments", True) - , ("detail", monthly.visibleDetail) - ] - ] - [ monthlyCount address model monthly - , if monthly.visibleDetail then paymentsTable address model loggedInModel monthly else text "" - ] - -monthlyCount : Address Action -> Model -> MonthlyModel.Model -> 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 address (UpdateLoggedIn << LoggedInAction.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 = - div - [ class "table" ] - ( monthly.payments - |> List.sortBy (String.toLower << .name) - |> List.map (paymentLine address model loggedInModel) - ) - -paymentLine : Address Action -> Model -> LoggedInModel.Model -> Payment -> Html -paymentLine address model loggedInModel payment = - a - [ classList - [ ("row", True) - , ("edition", loggedInModel.paymentEdition == Just payment.id) - ] - , onClick address (UpdateLoggedIn (LoggedInAction.ToggleEdit payment.id)) - ] - [ div [ class "cell category" ] [ text (payment.name) ] - , div - [ classList - [ ("cell cost", True) - , ("refund", payment.cost < 0) - ] - ] - [ text (price model payment.cost) ] - , div - [ class "cell delete" - , onClick address (UpdateLoggedIn <| LoggedInAction.DeletePayment payment Payment.Monthly) - ] - [ button [] [ renderIcon "times" ] - ] - ] 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/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/View/Date.elm deleted file mode 100644 index 62c8be5..0000000 --- a/src/client/elm/LoggedIn/View/Date.elm +++ /dev/null @@ -1,59 +0,0 @@ -module LoggedIn.View.Date - ( renderShortDate - , renderLongDate - ) where - -import Date exposing (..) -import String - -import Model.Translations exposing (..) - -renderShortDate : Date -> Translations -> String -renderShortDate date translations = - let params = - [ String.pad 2 '0' (toString (Date.day date)) - , String.pad 2 '0' (toString (getMonthNumber (Date.month date))) - , toString (Date.year date) - ] - in getParamMessage params "ShortDate" translations - -renderLongDate : Date -> Translations -> String -renderLongDate date translations = - let params = - [ toString (Date.day date) - , (getMessage (getMonthKey (Date.month date)) translations) - , toString (Date.year date) - ] - in getParamMessage params "LongDate" translations - -getMonthNumber : Month -> Int -getMonthNumber month = - case month of - Jan -> 1 - Feb -> 2 - Mar -> 3 - Apr -> 4 - May -> 5 - Jun -> 6 - Jul -> 7 - Aug -> 8 - Sep -> 9 - Oct -> 10 - Nov -> 11 - Dec -> 12 - -getMonthKey : Month -> String -getMonthKey month = - case month of - Jan -> "January" - Feb -> "February" - Mar -> "March" - Apr -> "April" - May -> "May" - Jun -> "June" - Jul -> "July" - Aug -> "August" - Sep -> "September" - Oct -> "October" - Nov -> "November" - Dec -> "December" diff --git a/src/client/elm/LoggedIn/View/Expand.elm b/src/client/elm/LoggedIn/View/Expand.elm deleted file mode 100644 index 1055c1b..0000000 --- a/src/client/elm/LoggedIn/View/Expand.elm +++ /dev/null @@ -1,25 +0,0 @@ -module LoggedIn.View.Expand - ( expand - , ExpandType(..) - ) where - -import Html exposing (..) -import Html.Attributes exposing (..) - -import View.Icon exposing (renderIcon) - -type ExpandType = ExpandUp | ExpandDown - -expand : ExpandType -> Bool -> Html -expand expandType isExpanded = - div - [ class "expand" ] - [ renderIcon (chevronIcon expandType isExpanded) ] - -chevronIcon : ExpandType -> Bool -> String -chevronIcon expandType isExpanded = - case (expandType, isExpanded) of - (ExpandUp, True) -> "chevron-down" - (ExpandUp, False) -> "chevron-up" - (ExpandDown, True) -> "chevron-up" - (ExpandDown, False) -> "chevron-down" diff --git a/src/client/elm/LoggedIn/View/Paging.elm b/src/client/elm/LoggedIn/View/Paging.elm deleted file mode 100644 index 0a149e9..0000000 --- a/src/client/elm/LoggedIn/View/Paging.elm +++ /dev/null @@ -1,100 +0,0 @@ -module LoggedIn.View.Paging - ( paymentsPaging - ) where - -import Signal exposing (Address) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import LoggedIn.Action as LoggedInAction -import LoggedIn.Model as LoggedInModel - -import Action exposing (..) -import Model.Payment exposing (perPage) - -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] - in if maxPage == 1 - then - text "" - else - div - [ class "pages" ] - ( ( if loggedInModel.currentPage > 1 - then [ firstPage address, previousPage address loggedInModel ] - else [] - ) - ++ ( List.map (paymentsPage address loggedInModel) pages) - ++ ( if loggedInModel.currentPage < maxPage - then [ nextPage address loggedInModel, lastPage address maxPage ] - else [] - ) - ) - -truncatePages : Int -> List Int -> List Int -truncatePages currentPage pages = - let totalPages = List.length pages - showedLeftPages = ceiling ((toFloat showedPages - 1) / 2) - showedRightPages = floor ((toFloat showedPages - 1) / 2) - truncatedPages = - if currentPage < showedLeftPages then - [1..showedPages] - else if currentPage > totalPages - showedRightPages then - [(totalPages - showedPages)..totalPages] - else - [(currentPage - showedLeftPages)..(currentPage + showedRightPages)] - in List.filter (flip List.member pages) truncatedPages - -firstPage : Address Action -> Html -firstPage address = - button - [ class "page" - , onClick address (UpdateLoggedIn (LoggedInAction.UpdatePage 1)) - ] - [ renderIcon "fast-backward" ] - -previousPage : Address Action -> LoggedInModel.Model -> Html -previousPage address loggedInModel = - button - [ class "page" - , onClick address (UpdateLoggedIn (LoggedInAction.UpdatePage (loggedInModel.currentPage - 1))) - ] - [ renderIcon "backward" ] - -nextPage : Address Action -> LoggedInModel.Model -> Html -nextPage address loggedInModel = - button - [ class "page" - , onClick address (UpdateLoggedIn (LoggedInAction.UpdatePage (loggedInModel.currentPage + 1))) - ] - [ renderIcon "forward" ] - -lastPage : Address Action -> Int -> Html -lastPage address maxPage = - button - [ class "page" - , onClick address (UpdateLoggedIn (LoggedInAction.UpdatePage maxPage)) - ] - [ renderIcon "fast-forward" ] - -paymentsPage : Address Action -> LoggedInModel.Model -> Int -> Html -paymentsPage address loggedInModel page = - let onCurrentPage = page == loggedInModel.currentPage - in button - [ classList - [ ("page", True) - , ("current", onCurrentPage) - ] - , onClick address <| - if onCurrentPage then Action.NoOp else UpdateLoggedIn (LoggedInAction.UpdatePage page) - ] - [ text (toString page) ] diff --git a/src/client/elm/LoggedIn/View/Price.elm b/src/client/elm/LoggedIn/View/Price.elm deleted file mode 100644 index e8b4c58..0000000 --- a/src/client/elm/LoggedIn/View/Price.elm +++ /dev/null @@ -1,38 +0,0 @@ -module LoggedIn.View.Price - ( price - ) where - -import String exposing (..) - -import Model exposing (Model) -import Model.Translations exposing (getMessage) - -price : Model -> Int -> String -price model amount = - ( formatInt amount - ++ " " - ++ model.conf.currency - ) - -formatInt : Int -> String -formatInt n = - abs n - |> toString - |> toList - |> List.reverse - |> group 3 - |> List.intersperse [' '] - |> List.concat - |> List.reverse - |> fromList - |> append (if n < 0 then "-" else "") - -group : Int -> List a -> List (List a) -group n xs = - if List.length xs <= n - then - [xs] - else - let take = List.take n xs - drop = List.drop n xs - in take :: (group n drop) diff --git a/src/client/elm/LoggedIn/View/Table.elm b/src/client/elm/LoggedIn/View/Table.elm deleted file mode 100644 index 57167be..0000000 --- a/src/client/elm/LoggedIn/View/Table.elm +++ /dev/null @@ -1,96 +0,0 @@ -module LoggedIn.View.Table - ( paymentsTable - ) where - -import Dict exposing (..) -import Date exposing (Date) -import Signal exposing (Address) -import String exposing (append) - -import Html exposing (..) -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 Model exposing (Model) -import Model.User exposing (getUserName) -import Model.Payment exposing (..) -import Model.Translations exposing (getMessage) -import Action exposing (..) - -import View.Icon exposing (renderIcon) - -paymentsTable : Address Action -> Model -> LoggedInModel.Model -> Html -paymentsTable address model loggedInModel = - div - [ class "table" ] - ( headerLine model :: paymentLines address model loggedInModel) - -headerLine : Model -> Html -headerLine model = - div - [ class "header" ] - [ div [ class "cell category" ] [ renderIcon "shopping-cart" ] - , div [ class "cell cost" ] [ text model.conf.currency ] - , div [ class "cell user" ] [ renderIcon "user" ] - , div [ class "cell date" ] [ renderIcon "calendar" ] - , div [ class "cell" ] [] - ] - -paymentLines : Address Action -> Model -> LoggedInModel.Model -> List Html -paymentLines address model loggedInModel = - loggedInModel.payments - |> List.sortBy (Date.toTime << .creation) - |> List.reverse - |> List.drop ((loggedInModel.currentPage - 1) * perPage) - |> List.take perPage - |> List.map (paymentLine address model loggedInModel) - -paymentLine : Address Action -> Model -> LoggedInModel.Model -> Payment -> Html -paymentLine address model loggedInModel payment = - a - [ classList - [ ("row", True) - , ("edition", loggedInModel.paymentEdition == Just payment.id) - ] - , onClick address (UpdateLoggedIn (LoggedInAction.ToggleEdit payment.id)) - ] - [ div [ class "cell category" ] [ text payment.name ] - , div - [ classList - [ ("cell cost", True) - , ("refund", payment.cost < 0) - ] - ] - [ text (price model payment.cost) ] - , div - [ class "cell user" ] - [ payment.userId - |> getUserName loggedInModel.users - |> Maybe.withDefault "−" - |> text - ] - , div - [ class "cell date" ] - [ span - [ class "shortDate" ] - [ text (renderShortDate payment.creation model.translations) ] - , span - [ class "longDate" ] - [ text (renderLongDate payment.creation model.translations) ] - ] - , if loggedInModel.account.me == payment.userId - then - div - [ class "cell delete" ] - [ button - [ onClick address (UpdateLoggedIn <| LoggedInAction.DeletePayment payment Punctual)] - [ renderIcon "times" ] - ] - else - div [ class "cell" ] [] - ] 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 -- cgit v1.2.3