From 8cd63a64abafe21378c35c2489d49f24c9ece3c9 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 4 Apr 2016 01:27:36 +0200 Subject: Add income list CRUD in user page --- elm-package.json | 4 +- src/client/elm/LoggedIn/Action.elm | 18 +++- src/client/elm/LoggedIn/Home/Account/Action.elm | 14 --- src/client/elm/LoggedIn/Home/Account/Model.elm | 60 ------------- src/client/elm/LoggedIn/Home/Account/Update.elm | 49 ----------- src/client/elm/LoggedIn/Home/Account/View.elm | 108 ++---------------------- src/client/elm/LoggedIn/Home/Action.elm | 2 - src/client/elm/LoggedIn/Home/Model.elm | 3 - src/client/elm/LoggedIn/Home/Update.elm | 9 -- src/client/elm/LoggedIn/Home/View/Date.elm | 59 ------------- src/client/elm/LoggedIn/Home/View/Monthly.elm | 4 +- src/client/elm/LoggedIn/Home/View/Price.elm | 37 -------- src/client/elm/LoggedIn/Home/View/Table.elm | 6 +- src/client/elm/LoggedIn/Model.elm | 3 + src/client/elm/LoggedIn/Update.elm | 52 ++++++++---- src/client/elm/LoggedIn/User/Action.elm | 9 ++ src/client/elm/LoggedIn/User/Model.elm | 46 ++++++++++ src/client/elm/LoggedIn/User/Update.elm | 25 ++++++ src/client/elm/LoggedIn/User/View.elm | 90 +++++++++++++++++++- src/client/elm/LoggedIn/View.elm | 3 +- src/client/elm/LoggedIn/View/Date.elm | 44 ++++++++++ src/client/elm/LoggedIn/View/Price.elm | 37 ++++++++ src/client/elm/Server.elm | 22 +++-- src/client/elm/Utils/Date.elm | 39 +++++++++ src/client/elm/Utils/Http.elm | 11 ++- src/server/Controller/Income.hs | 28 +++++- src/server/Controller/Payment.hs | 6 +- src/server/Design/LoggedIn/Expandables.hs | 42 +-------- src/server/Main.hs | 12 ++- src/server/Model/Database.hs | 1 + src/server/Model/Income.hs | 36 +++++--- src/server/Model/Message/Key.hs | 13 ++- src/server/Model/Message/Translations.hs | 49 ++++------- 33 files changed, 465 insertions(+), 476 deletions(-) delete mode 100644 src/client/elm/LoggedIn/Home/Account/Action.elm delete mode 100644 src/client/elm/LoggedIn/Home/Account/Model.elm delete mode 100644 src/client/elm/LoggedIn/Home/Account/Update.elm delete mode 100644 src/client/elm/LoggedIn/Home/View/Date.elm delete mode 100644 src/client/elm/LoggedIn/Home/View/Price.elm create mode 100644 src/client/elm/LoggedIn/User/Action.elm create mode 100644 src/client/elm/LoggedIn/User/Model.elm create mode 100644 src/client/elm/LoggedIn/User/Update.elm create mode 100644 src/client/elm/LoggedIn/View/Date.elm create mode 100644 src/client/elm/LoggedIn/View/Price.elm create mode 100644 src/client/elm/Utils/Date.elm diff --git a/elm-package.json b/elm-package.json index ee5a333..91ac937 100644 --- a/elm-package.json +++ b/elm-package.json @@ -13,6 +13,8 @@ "evancz/start-app": "2.0.2 <= v < 3.0.0", "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" + "etaque/elm-route-parser": "2.2.0 <= v < 3.0.0", + "etaque/elm-simple-form": "2.0.1 <= v < 3.0.0", + "rluiten/elm-date-extra": "3.0.0 <= v < 4.0.0" } } diff --git a/src/client/elm/LoggedIn/Action.elm b/src/client/elm/LoggedIn/Action.elm index 93bb04d..719e534 100644 --- a/src/client/elm/LoggedIn/Action.elm +++ b/src/client/elm/LoggedIn/Action.elm @@ -2,17 +2,27 @@ module LoggedIn.Action ( Action(..) ) where +import Date exposing (Date) + import Model.Payment exposing (Payment, PaymentId, Frequency) import Model.Income exposing (IncomeId) import LoggedIn.Home.Action as HomeAction +import LoggedIn.User.Action as UserAction type Action = NoOp | HomeAction HomeAction.Action + | UserAction UserAction.Action + | AddPayment String String Frequency | ValidateAddPayment PaymentId String Int Frequency - | DeletePayment Payment Frequency - | ValidateDeletePayment Payment Frequency - | UpdateIncome Int - | ValidateUpdateIncome IncomeId Int + + | DeletePayment PaymentId + | ValidateDeletePayment PaymentId + + | AddIncome Date Int + | ValidateAddIncome IncomeId Date Int + + | DeleteIncome IncomeId + | ValidateDeleteIncome IncomeId diff --git a/src/client/elm/LoggedIn/Home/Account/Action.elm b/src/client/elm/LoggedIn/Home/Account/Action.elm deleted file mode 100644 index 4ce3b20..0000000 --- a/src/client/elm/LoggedIn/Home/Account/Action.elm +++ /dev/null @@ -1,14 +0,0 @@ -module LoggedIn.Home.Account.Action - ( Action(..) - ) where - -import Time exposing (Time) - -import Model.User exposing (UserId) - -type Action = - NoOp - | ToggleDetail - | ToggleIncomeEdition - | UpdateIncomeEdition String - | UpdateEditionError String diff --git a/src/client/elm/LoggedIn/Home/Account/Model.elm b/src/client/elm/LoggedIn/Home/Account/Model.elm deleted file mode 100644 index d04f865..0000000 --- a/src/client/elm/LoggedIn/Home/Account/Model.elm +++ /dev/null @@ -1,60 +0,0 @@ -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 = - { visibleDetail : Bool - , incomeEdition : Maybe IncomeEdition - } - -init : Model -init = - { visibleDetail = False - , incomeEdition = Nothing - } - -getCurrentIncome : Incomes -> UserId -> Model -> Maybe Int -getCurrentIncome incomes me account = - incomes - |> Dict.filter (\_ income -> income.userId == 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 deleted file mode 100644 index 59f1402..0000000 --- a/src/client/elm/LoggedIn/Home/Account/Update.elm +++ /dev/null @@ -1,49 +0,0 @@ -module LoggedIn.Home.Account.Update - ( update - ) where - -import Maybe - -import Effects exposing (Effects) - -import LoggedData exposing (LoggedData) - -import LoggedIn.Home.Account.Action as AccountAction -import LoggedIn.Home.Account.Model as AccountModel - -import Utils.Maybe exposing (isJust) - -update : LoggedData -> AccountAction.Action -> AccountModel.Model -> (AccountModel.Model, Effects AccountAction.Action) -update loggedData 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 loggedData.incomes loggedData.me account))) - } - , Effects.none - ) - - AccountAction.UpdateIncomeEdition income -> - ( case account.incomeEdition of - Nothing -> account - Just incomeEdition -> { account | incomeEdition = Just { incomeEdition | income = income } } - , Effects.none - ) - - AccountAction.UpdateEditionError error -> - ( case account.incomeEdition of - Nothing -> account - Just incomeEdition -> { account | incomeEdition = Just { incomeEdition | error = Just error } } - , Effects.none - ) diff --git a/src/client/elm/LoggedIn/Home/Account/View.elm b/src/client/elm/LoggedIn/Home/Account/View.elm index a7d3e0c..63fb997 100644 --- a/src/client/elm/LoggedIn/Home/Account/View.elm +++ b/src/client/elm/LoggedIn/Home/Account/View.elm @@ -2,61 +2,26 @@ module LoggedIn.Home.Account.View ( view ) where -import List -import Signal - import Html exposing (..) -import Html as H exposing (..) import Html.Attributes exposing (..) -import Html.Events exposing (..) import LoggedData exposing (LoggedData) -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 LoggedIn.View.Price exposing (price) import Model exposing (Model) import Model.User exposing (getUserName) -import Model.Translations exposing (getParamMessage, getMessage) -import Action -import Mailbox - -import View.Events exposing (onSubmitPrevDefault) - -import Utils.Either exposing (toMaybeError) view : LoggedData -> HomeModel.Model -> Html view loggedData homeModel = - let account = homeModel.account - in div - [ classList - [ ("account", True) - , ("detail", account.visibleDetail) - ] - ] - [ exceedingPayers loggedData homeModel - , if account.visibleDetail - then income loggedData account - else text "" - ] - -exceedingPayers : LoggedData -> HomeModel.Model -> Html -exceedingPayers loggedData homeModel = - button - [ class "header" - , onClick Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.ToggleDetail) + div + [ class "account" ] + [ div + [ class "header" ] + (List.map (exceedingPayer loggedData homeModel) (getOrderedExceedingPayers loggedData.currentTime loggedData.users loggedData.incomes loggedData.payments)) ] - ( (List.map (exceedingPayer loggedData homeModel) (getOrderedExceedingPayers loggedData.currentTime loggedData.users loggedData.incomes loggedData.payments)) - ++ [ expand ExpandDown homeModel.account.visibleDetail ] - ) exceedingPayer : LoggedData -> HomeModel.Model -> ExceedingPayer -> Html exceedingPayer loggedData homeModel payer = @@ -73,64 +38,3 @@ exceedingPayer loggedData homeModel payer = [ class "amount" ] [ text ("+ " ++ (price loggedData.conf payer.amount)) ] ] - -income : LoggedData -> AccountModel.Model -> Html -income loggedData account = - case account.incomeEdition of - Nothing -> - incomeRead loggedData account - Just edition -> - incomeEdition loggedData account edition - -incomeRead : LoggedData -> AccountModel.Model -> Html -incomeRead loggedData account = - div - [ class "income" ] - [ ( case AccountModel.getCurrentIncome loggedData.incomes loggedData.me account of - Nothing -> - text (getMessage "NoIncome" loggedData.translations) - Just income -> - text (getParamMessage [price loggedData.conf income] "Income" loggedData.translations) - ) - , toggleIncomeEdition loggedData "editIncomeEdition" (getMessage "Edit" loggedData.translations) - ] - -incomeEdition : LoggedData -> AccountModel.Model -> AccountModel.IncomeEdition -> Html -incomeEdition loggedData account edition = - H.form - [ case AccountModel.validateIncome edition.income loggedData.translations of - Ok validatedAmount -> - onSubmitPrevDefault Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.UpdateIncome validatedAmount) - Err error -> - onSubmitPrevDefault Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount << AccountAction.UpdateEditionError <| error) - , class "income" - ] - [ label - [ for "incomeInput" ] - [ text (getMessage "NewIncome" loggedData.translations) ] - , input - [ id "incomeInput" - , value edition.income - , on "input" targetValue (Signal.message Mailbox.address << Action.UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount << AccountAction.UpdateIncomeEdition) - , maxlength 10 - ] - [] - , button - [ type' "submit" - , class "validateIncomeEdition" - ] - [ text (getMessage "Validate" loggedData.translations) ] - , toggleIncomeEdition loggedData "undoIncomeEdition" (getMessage "Undo" loggedData.translations) - , case edition.error of - Just error -> div [ class "error" ] [ text error ] - Nothing -> text "" - ] - -toggleIncomeEdition : LoggedData -> String -> String -> Html -toggleIncomeEdition loggedData className name = - button - [ type' "button" - , class className - , onClick Mailbox.address (Action.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 index 7db705d..1590fb8 100644 --- a/src/client/elm/LoggedIn/Home/Action.elm +++ b/src/client/elm/LoggedIn/Home/Action.elm @@ -4,13 +4,11 @@ module LoggedIn.Home.Action import Model.Payment exposing (PaymentId) -import LoggedIn.Home.Account.Action as AccountAction import LoggedIn.Home.AddPayment.Action as AddPaymentAction type Action = NoOp | UpdateAdd AddPaymentAction.Action - | UpdateAccount AccountAction.Action | ToggleEdit PaymentId | UpdatePage Int | ShowMonthlyDetail diff --git a/src/client/elm/LoggedIn/Home/Model.elm b/src/client/elm/LoggedIn/Home/Model.elm index cd8b4d0..26af63c 100644 --- a/src/client/elm/LoggedIn/Home/Model.elm +++ b/src/client/elm/LoggedIn/Home/Model.elm @@ -8,12 +8,10 @@ import LoggedIn.Home.Model.Payer exposing (Payers) import Model.User exposing (Users, UserId) import Model.Payment exposing (PaymentId, Payments, Frequency(..)) -import LoggedIn.Home.Account.Model as AccountModel import LoggedIn.Home.AddPayment.Model as AddPaymentModel type alias Model = { add : AddPaymentModel.Model - , account : AccountModel.Model , paymentEdition : Maybe PaymentId , currentPage : Int , monthlyDetail : Bool @@ -22,7 +20,6 @@ type alias Model = init : Model init = { add = AddPaymentModel.init Punctual - , account = AccountModel.init , paymentEdition = Nothing , currentPage = 1 , monthlyDetail = False diff --git a/src/client/elm/LoggedIn/Home/Update.elm b/src/client/elm/LoggedIn/Home/Update.elm index b43ebb7..cebdc70 100644 --- a/src/client/elm/LoggedIn/Home/Update.elm +++ b/src/client/elm/LoggedIn/Home/Update.elm @@ -9,9 +9,6 @@ import LoggedData exposing (LoggedData) import LoggedIn.Home.Action as HomeAction import LoggedIn.Home.Model as HomeModel -import LoggedIn.Home.Account.Action as AccountAction -import LoggedIn.Home.Account.Update as AccountUpdate - import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate update : LoggedData -> HomeAction.Action -> HomeModel.Model -> (HomeModel.Model, Effects HomeAction.Action) @@ -25,12 +22,6 @@ update loggedData action homeModel = , Effects.none ) - HomeAction.UpdateAccount accountAction -> - let (newAccount, accountEffects) = AccountUpdate.update loggedData accountAction homeModel.account - in ( { homeModel | account = newAccount } - , Effects.map HomeAction.UpdateAccount accountEffects - ) - HomeAction.ToggleEdit id -> ( { homeModel | paymentEdition = if homeModel.paymentEdition == Just id then Nothing else Just id } , Effects.none diff --git a/src/client/elm/LoggedIn/Home/View/Date.elm b/src/client/elm/LoggedIn/Home/View/Date.elm deleted file mode 100644 index 2cc55fe..0000000 --- a/src/client/elm/LoggedIn/Home/View/Date.elm +++ /dev/null @@ -1,59 +0,0 @@ -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/Monthly.elm b/src/client/elm/LoggedIn/Home/View/Monthly.elm index aa0e3a5..c001331 100644 --- a/src/client/elm/LoggedIn/Home/View/Monthly.elm +++ b/src/client/elm/LoggedIn/Home/View/Monthly.elm @@ -12,7 +12,7 @@ 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.View.Price exposing (price) import LoggedIn.Home.View.Expand exposing (..) import Model.Payment as Payment exposing (Payments, Payment, monthly) @@ -84,7 +84,7 @@ paymentLine loggedData homeModel payment = [ text (price loggedData.conf payment.cost) ] , div [ class "cell delete" - , onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.DeletePayment payment Payment.Monthly) + , onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.DeletePayment payment.id) ] [ button [] [ renderIcon "times" ] ] diff --git a/src/client/elm/LoggedIn/Home/View/Price.elm b/src/client/elm/LoggedIn/Home/View/Price.elm deleted file mode 100644 index 2e208f9..0000000 --- a/src/client/elm/LoggedIn/Home/View/Price.elm +++ /dev/null @@ -1,37 +0,0 @@ -module LoggedIn.Home.View.Price - ( price - ) where - -import String exposing (..) - -import Model.Conf exposing (Conf) - -price : Conf -> Int -> String -price conf amount = - ( formatInt amount - ++ " " - ++ 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 index 1d69fb9..71aa4e5 100644 --- a/src/client/elm/LoggedIn/Home/View/Table.elm +++ b/src/client/elm/LoggedIn/Home/View/Table.elm @@ -16,8 +16,8 @@ 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 LoggedIn.View.Date exposing (..) +import LoggedIn.View.Price exposing (price) import Model.User exposing (getUserName) import Model.Payment as Payment exposing (..) @@ -90,7 +90,7 @@ paymentLine loggedData homeModel payment = div [ class "cell delete" ] [ button - [ onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.DeletePayment payment Punctual)] + [ onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.DeletePayment payment.id)] [ renderIcon "times" ] ] else diff --git a/src/client/elm/LoggedIn/Model.elm b/src/client/elm/LoggedIn/Model.elm index cc1ade7..b1639ff 100644 --- a/src/client/elm/LoggedIn/Model.elm +++ b/src/client/elm/LoggedIn/Model.elm @@ -11,9 +11,11 @@ import Model.User exposing (Users, UserId) import Model.Income exposing (Incomes) import LoggedIn.Home.Model as HomeModel +import LoggedIn.User.Model as UserModel type alias Model = { home : HomeModel.Model + , user : UserModel.Model , users : Users , me : UserId , payments : Payments @@ -23,6 +25,7 @@ type alias Model = init : Init -> Model init initData = { home = HomeModel.init + , user = UserModel.init , users = initData.users , me = initData.me , payments = initData.payments diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm index fd141c8..4598b27 100644 --- a/src/client/elm/LoggedIn/Update.elm +++ b/src/client/elm/LoggedIn/Update.elm @@ -8,7 +8,7 @@ import Task import Effects exposing (Effects) import Http exposing (Error(..)) -import Date +import Date exposing (Date) import Model exposing (Model) import Model.Translations exposing (getMessage) @@ -23,7 +23,8 @@ import LoggedIn.Model as LoggedInModel import LoggedIn.Home.Action as HomeAction import LoggedIn.Home.Update as HomeUpdate -import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.User.Action as UserAction +import LoggedIn.User.Update as UserUpdate import LoggedIn.Home.AddPayment.Action as AddPaymentAction import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate @@ -46,6 +47,13 @@ update model action loggedIn = , Effects.map LoggedInAction.HomeAction effects ) + LoggedInAction.UserAction userAction -> + case UserUpdate.update loggedData userAction loggedIn.user of + (user, effects) -> + ( { loggedIn | user = user } + , Effects.map LoggedInAction.UserAction effects + ) + LoggedInAction.AddPayment name cost frequency -> update model (LoggedInAction.HomeAction <| HomeAction.UpdateAdd <| AddPaymentAction.WaitingServer) loggedIn |> Tuple.mapSnd (\effect -> @@ -85,30 +93,42 @@ update model action loggedIn = in { loggedIn | payments = newPayment :: loggedIn.payments } ) - LoggedInAction.DeletePayment payment frequency -> + LoggedInAction.DeletePayment paymentId -> ( loggedIn - , Server.deletePayment payment frequency - |> Task.map (always (LoggedInAction.ValidateDeletePayment payment frequency)) + , Server.deletePayment paymentId + |> Task.map (always (LoggedInAction.ValidateDeletePayment paymentId)) |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp) |> Effects.task ) - LoggedInAction.ValidateDeletePayment payment frequency -> - ( { loggedIn | payments = deletePayment payment.id loggedIn.payments } + LoggedInAction.ValidateDeletePayment paymentId -> + ( { loggedIn | payments = deletePayment paymentId loggedIn.payments } , Effects.none ) - LoggedInAction.UpdateIncome amount -> + LoggedInAction.AddIncome creation amount -> ( loggedIn - , Server.setIncome amount - |> Task.map (\incomeId -> (LoggedInAction.ValidateUpdateIncome incomeId amount)) + , Server.addIncome creation amount + |> Task.map (\incomeId -> (LoggedInAction.ValidateAddIncome incomeId creation amount)) |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp) |> Effects.task ) - LoggedInAction.ValidateUpdateIncome incomeId amount -> - update model (LoggedInAction.HomeAction <| HomeAction.UpdateAccount <| AccountAction.ToggleIncomeEdition) loggedIn - |> Tuple.mapFst (\loggedIn -> - let newIncome = { userId = loggedIn.me, creation = model.currentTime, amount = amount } - in { loggedIn | incomes = Dict.insert incomeId newIncome loggedIn.incomes } - ) + LoggedInAction.ValidateAddIncome incomeId creation amount -> + let newIncome = { userId = loggedIn.me, creation = (Date.toTime creation), amount = amount } + in ( { loggedIn | incomes = Dict.insert incomeId newIncome loggedIn.incomes } + , Effects.none + ) + + LoggedInAction.DeleteIncome incomeId -> + ( loggedIn + , Server.deleteIncome incomeId + |> Task.map (always <| LoggedInAction.ValidateDeleteIncome incomeId) + |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp) + |> Effects.task + ) + + LoggedInAction.ValidateDeleteIncome incomeId -> + ( { loggedIn | incomes = Dict.remove incomeId loggedIn.incomes } + , Effects.none + ) diff --git a/src/client/elm/LoggedIn/User/Action.elm b/src/client/elm/LoggedIn/User/Action.elm new file mode 100644 index 0000000..c5f8d47 --- /dev/null +++ b/src/client/elm/LoggedIn/User/Action.elm @@ -0,0 +1,9 @@ +module LoggedIn.User.Action + ( Action(..) + ) where + +import Form exposing (Form) + +type Action = + NoOp + | AddIncomeAction Form.Action diff --git a/src/client/elm/LoggedIn/User/Model.elm b/src/client/elm/LoggedIn/User/Model.elm new file mode 100644 index 0000000..4f96a80 --- /dev/null +++ b/src/client/elm/LoggedIn/User/Model.elm @@ -0,0 +1,46 @@ +module LoggedIn.User.Model + ( Model + , AddIncome + , init + ) where + +import String exposing (toInt, split) +import Date exposing (Date) +import Date.Utils exposing (dateFromFields) +import Utils.Date exposing (numToMonth) + +import Form exposing (Form) +import Form.Validate as Validate exposing (..) +import Form.Error exposing (Error(InvalidString)) + +type alias Model = + { addIncome : Form () AddIncome + } + +type alias AddIncome = + { creation : Date + , amount : Int + } + +init : Model +init = + { addIncome = Form.initial [] validate + } + +validate : Validation () AddIncome +validate = + form2 AddIncome + (get "creation" dateValidation) + (get "amount" (int `andThen` (minInt 1))) + +dateValidation : Validation () Date +dateValidation = + customValidation string (\str -> + case split "/" str of + [day, month, year] -> + case (toInt day, toInt month, toInt year) of + (Ok dayNum, Ok monthNum, Ok yearNum) -> + Ok (dateFromFields yearNum (numToMonth monthNum) dayNum 0 0 0 0) + _ -> Err InvalidString + _ -> Err InvalidString + ) diff --git a/src/client/elm/LoggedIn/User/Update.elm b/src/client/elm/LoggedIn/User/Update.elm new file mode 100644 index 0000000..f44fee4 --- /dev/null +++ b/src/client/elm/LoggedIn/User/Update.elm @@ -0,0 +1,25 @@ +module LoggedIn.User.Update + ( update + ) where + +import Effects exposing (Effects) +import Form exposing (Form) + +import LoggedData exposing (LoggedData) + +import LoggedIn.User.Model as UserModel +import LoggedIn.User.Action as UserAction + +update : LoggedData -> UserAction.Action -> UserModel.Model -> (UserModel.Model, Effects UserAction.Action) +update loggedData action model = + case action of + + UserAction.NoOp -> + ( model + , Effects.none + ) + + UserAction.AddIncomeAction formAction -> + ( { model | addIncome = Form.update formAction model.addIncome } + , Effects.none + ) diff --git a/src/client/elm/LoggedIn/User/View.elm b/src/client/elm/LoggedIn/User/View.elm index 35ea940..74e2ae2 100644 --- a/src/client/elm/LoggedIn/User/View.elm +++ b/src/client/elm/LoggedIn/User/View.elm @@ -2,10 +2,94 @@ module LoggedIn.User.View ( view ) where +import Dict +import Date + import Html exposing (..) +import Html.Events exposing (..) +import Html.Attributes exposing (..) +import Form exposing (Form) +import Form.Input as Input + +import LoggedData exposing (LoggedData) + +import Model.Income exposing (IncomeId, Income) +import Model.Translations exposing (getMessage) +import LoggedIn.User.Model as UserModel + +import Mailbox + +import Action +import LoggedIn.Action as LoggedInAction +import LoggedIn.User.Action as UserAction + +import LoggedIn.View.Date exposing (renderShortDate) +import LoggedIn.View.Price exposing (price) + +import Utils.Maybe exposing (isJust) -view : LoggedData -> Html -view loggedData = +view : LoggedData -> UserModel.Model -> Html +view loggedData userModel = div [] - [ text "Hey" ] + [ h1 [] [ text <| getMessage "AddIncome" loggedData.translations ] + , addIncomeView loggedData userModel.addIncome + , h1 [] [ text <| getMessage "Incomes" loggedData.translations ] + , incomesView loggedData + ] + +addIncomeView : LoggedData -> Form () UserModel.AddIncome -> Html +addIncomeView loggedData addIncome = + let + formAddress = Signal.forwardTo Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.UserAction << UserAction.AddIncomeAction) + errorFor error field = + if isJust field.liveError + then div [ class "error" ] [ text (getMessage error loggedData.translations) ] + else text "" + creation = Form.getFieldAsString "creation" addIncome + amount = Form.getFieldAsString "amount" addIncome + in + div + [] + [ label [] [ text "Creation" ] + , Input.textInput creation formAddress [] + , errorFor "DateValidationError" creation + + , label [] [ text "amount" ] + , Input.textInput amount formAddress [] + , errorFor "IncomeValidationError" amount + + , button + [ case Form.getOutput addIncome of + Just data -> + onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.AddIncome data.creation data.amount) + Nothing -> + onClick formAddress Form.Submit + ] + [ text (getMessage "Add" loggedData.translations) ] + ] + +incomesView : LoggedData -> Html +incomesView loggedData = + ol + [] + ( loggedData.incomes + |> Dict.toList + |> List.filter ((==) loggedData.me << .userId << snd) + |> List.sortBy (.creation << snd) + |> List.reverse + |> List.map (incomeView loggedData) + ) + +incomeView : LoggedData -> (IncomeId, Income) -> Html +incomeView loggedData (incomeId, income) = + li + [] + [ text <| renderShortDate (Date.fromTime income.creation) loggedData.translations + , text " − " + , text <| price loggedData.conf income.amount + , text " − " + , button + [ onClick Mailbox.address (Action.UpdateLoggedIn <| LoggedInAction.DeleteIncome incomeId) ] + [ text "x" ] + ] diff --git a/src/client/elm/LoggedIn/View.elm b/src/client/elm/LoggedIn/View.elm index 5f7ae71..f9620cc 100644 --- a/src/client/elm/LoggedIn/View.elm +++ b/src/client/elm/LoggedIn/View.elm @@ -14,6 +14,7 @@ import LoggedData import LoggedIn.Model as LoggedInModel import LoggedIn.Home.View as HomeView +import LoggedIn.User.View as UserView view : Model -> LoggedInModel.Model -> Html view model loggedIn = @@ -21,4 +22,4 @@ view model loggedIn = in case TransitRouter.getRoute model of Empty -> text "" Home -> HomeView.view loggedData loggedIn.home - User -> text "" + User -> UserView.view loggedData loggedIn.user diff --git a/src/client/elm/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/View/Date.elm new file mode 100644 index 0000000..f9528d4 --- /dev/null +++ b/src/client/elm/LoggedIn/View/Date.elm @@ -0,0 +1,44 @@ +module LoggedIn.View.Date + ( renderShortDate + , renderLongDate + ) where + +import Date exposing (..) +import Utils.Date exposing (monthToNum) +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 (monthToNum (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 + +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/Price.elm b/src/client/elm/LoggedIn/View/Price.elm new file mode 100644 index 0000000..2bfed23 --- /dev/null +++ b/src/client/elm/LoggedIn/View/Price.elm @@ -0,0 +1,37 @@ +module LoggedIn.View.Price + ( price + ) where + +import String exposing (..) + +import Model.Conf exposing (Conf) + +price : Conf -> Int -> String +price conf amount = + ( formatInt amount + ++ " " + ++ 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/Server.elm b/src/client/elm/Server.elm index be052bb..36adb33 100644 --- a/src/client/elm/Server.elm +++ b/src/client/elm/Server.elm @@ -2,7 +2,8 @@ module Server ( signIn , addPayment , deletePayment - , setIncome + , addIncome + , deleteIncome , signOut ) where @@ -10,7 +11,7 @@ import Signal import Task as Task exposing (Task) import Http import Json.Decode as Json exposing ((:=)) -import Date +import Date exposing (Date) import Utils.Http exposing (..) @@ -29,16 +30,21 @@ addPayment name cost frequency = post ("/api/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency)) |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder) -deletePayment : Payment -> Frequency -> Task Http.Error () -deletePayment payment frequency = - post ("/api/payment/delete?id=" ++ (toString payment.id)) +deletePayment : PaymentId -> Task Http.Error () +deletePayment paymentId = + delete ("/api/payment/delete?id=" ++ (toString paymentId)) |> Task.map (always ()) -setIncome : Int -> Task Http.Error IncomeId -setIncome amount = - post ("/api/income?amount=" ++ (toString amount)) +addIncome : Date -> Int -> Task Http.Error IncomeId +addIncome creation amount = + post ("/api/income?creation=" ++ (toString << Date.toTime <| creation) ++ "&amount=" ++ (toString amount)) |> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder) +deleteIncome : IncomeId -> Task Http.Error () +deleteIncome incomeId = + delete ("/api/income/delete?id=" ++ (toString incomeId)) + |> Task.map (always ()) + signOut : Task Http.Error () signOut = post "/api/signOut" diff --git a/src/client/elm/Utils/Date.elm b/src/client/elm/Utils/Date.elm new file mode 100644 index 0000000..7a245bc --- /dev/null +++ b/src/client/elm/Utils/Date.elm @@ -0,0 +1,39 @@ +module Utils.Date + ( monthToNum + , numToMonth + ) where + +import Date exposing (..) + +monthToNum : Month -> Int +monthToNum 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 + +numToMonth : Int -> Month +numToMonth n = + case n of + 1 -> Jan + 2 -> Feb + 3 -> Mar + 4 -> Apr + 5 -> May + 6 -> Jun + 7 -> Jul + 8 -> Aug + 9 -> Sep + 10 -> Oct + 11 -> Nov + 12 -> Dec + _ -> Jan diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm index bd6e2ac..b394af4 100644 --- a/src/client/elm/Utils/Http.elm +++ b/src/client/elm/Utils/Http.elm @@ -1,5 +1,6 @@ module Utils.Http ( post + , delete , decodeHttpValue , errorKey ) where @@ -9,8 +10,14 @@ import Task exposing (..) import Json.Decode as Json exposing (Decoder) post : String -> Task Error Value -post url = - { verb = "POST" +post = request "POST" + +delete : String -> Task Error Value +delete = request "DELETE" + +request : String -> String -> Task Error Value +request method url = + { verb = method , headers = [] , url = url , body = empty diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs index 51861d3..4474d51 100644 --- a/src/server/Controller/Income.hs +++ b/src/server/Controller/Income.hs @@ -2,21 +2,29 @@ module Controller.Income ( getIncomes - , setIncome + , addIncome + , deleteOwnIncome ) where import Web.Scotty +import Network.HTTP.Types.Status (ok200, badRequest400) + import Control.Monad.IO.Class (liftIO) import Database.Persist +import Data.Text (Text) +import qualified Data.Text.Lazy as TL +import Data.Time.Clock (UTCTime) + import qualified Secure import Json (jsonId) import Model.Database import qualified Model.Income as Income +import qualified Model.Message.Key as Key getIncomes :: ActionM () getIncomes = @@ -24,8 +32,20 @@ getIncomes = (liftIO $ map Income.getJsonIncome <$> runDb Income.getIncomes) >>= json ) -setIncome :: Int -> ActionM () -setIncome amount = +addIncome :: UTCTime -> Int -> ActionM () +addIncome creation amount = + Secure.loggedAction (\user -> + (liftIO . runDb $ Income.addIncome (entityKey user) creation amount) >>= jsonId + ) + +deleteOwnIncome :: Text -> ActionM () +deleteOwnIncome incomeId = Secure.loggedAction (\user -> do - (liftIO . runDb $ Income.setIncome (entityKey user) amount) >>= jsonId + deleted <- liftIO . runDb $ Income.deleteOwnIncome user (textToKey incomeId) + if deleted + then + status ok200 + else do + status badRequest400 + text . TL.pack . show $ Key.IncomeNotDeleted ) diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index 204794a..7e8d0a3 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -3,7 +3,7 @@ module Controller.Payment ( getPayments , createPayment - , deletePayment + , deleteOwnPayment ) where import Web.Scotty @@ -46,8 +46,8 @@ createPayment name cost frequency = jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)] ) -deletePayment :: Text -> ActionM () -deletePayment paymentId = +deleteOwnPayment :: Text -> ActionM () +deleteOwnPayment paymentId = Secure.loggedAction (\user -> do deleted <- liftIO . runDb $ P.deleteOwnPayment user (textToKey paymentId) if deleted diff --git a/src/server/Design/LoggedIn/Expandables.hs b/src/server/Design/LoggedIn/Expandables.hs index 8ef42cd..a3be877 100644 --- a/src/server/Design/LoggedIn/Expandables.hs +++ b/src/server/Design/LoggedIn/Expandables.hs @@ -4,8 +4,8 @@ module Design.LoggedIn.Expandables ( expandablesDesign ) where -import Data.Monoid ((<>)) - +-- import Data.Monoid ((<>)) +-- import Clay import Design.Color as C @@ -22,42 +22,8 @@ expandablesDesign = right blockPadding bottom (px 2) - ".monthlyPayments" ? do - expandBlock C.blue C.white (px inputHeight) - - ".account" ? do - expandBlock C.green C.white (px inputHeight) - - ".header" |> ".exceedingPayer" ? do - lineHeight (px inputHeight) - ".userName" ? marginRight (px 10) - - ".income" ? do - backgroundColor C.lightGrey - padding (px 0) (px 20) (px 0) (px 20) - position relative - lineHeight (px rowHeightPx) - - input ? do - defaultInput inputHeight - marginLeft (px 20) - marginTop (px (-5)) - width (px 100) - - button ? do - marginLeft (px 20) - paddingLeft (px 15) - paddingRight (px 15) - marginTop (px (-5)) - - ".validateIncomeEdition" <> ".editIncomeEdition" ? - defaultButton C.red C.white (px inputHeight) focusLighten - - ".undoIncomeEdition" ? - defaultButton C.blue C.white (px inputHeight) focusLighten + ".monthlyPayments" ? expandBlock C.blue C.white (px inputHeight) - ".error" ? do - color C.redError - lineHeight (px 30) + ".account" ? expandBlock C.green C.white (px inputHeight) ".detail" |> ".header" ? borderRadius radius radius 0 0 diff --git a/src/server/Main.hs b/src/server/Main.hs index c6e930a..0642288 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -11,6 +11,7 @@ import MonthlyPaymentJob (monthlyPaymentJobListener) import Data.Text (Text) import qualified Data.Text.IO as T +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Controller.Index import Controller.SignIn @@ -62,14 +63,21 @@ api conf = do -- Users get "/api/users" getUsers + get "/api/whoAmI" whoAmI -- Incomes get "/api/incomes" getIncomes + post "/api/income" $ do + creation <- param "creation" :: ActionM Int amount <- param "amount" :: ActionM Int - setIncome amount + addIncome (posixSecondsToUTCTime $ (fromIntegral creation) / 1000) amount + + delete "/api/income/delete" $ do + incomeId <- param "id" :: ActionM Text + deleteOwnIncome incomeId -- Payments @@ -83,4 +91,4 @@ api conf = do post "/api/payment/delete" $ do paymentId <- param "id" :: ActionM Text - deletePayment paymentId + deleteOwnPayment paymentId diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs index 58160c3..0915afe 100644 --- a/src/server/Model/Database.hs +++ b/src/server/Model/Database.hs @@ -57,6 +57,7 @@ Income userId UserId creation UTCTime amount Int + deletedAt UTCTime Maybe deriving Show |] diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs index 2177617..c0cac45 100644 --- a/src/server/Model/Income.hs +++ b/src/server/Model/Income.hs @@ -1,11 +1,11 @@ module Model.Income ( getJsonIncome - , getFirstIncome , getIncomes - , setIncome + , addIncome + , deleteOwnIncome ) where -import Data.Time.Clock (getCurrentTime) +import Data.Time.Clock (UTCTime, getCurrentTime) import Control.Monad.IO.Class (liftIO) @@ -20,13 +20,23 @@ getJsonIncome incomeEntity = where income = entityVal incomeEntity getIncomes :: Persist [Entity Income] -getIncomes = selectList [] [] - -getFirstIncome :: UserId -> Persist (Maybe Income) -getFirstIncome userId = - fmap entityVal <$> selectFirst [IncomeUserId ==. userId] [Asc IncomeCreation] - -setIncome :: UserId -> Int -> Persist IncomeId -setIncome userId amount = do - now <- liftIO getCurrentTime - insert (Income userId now amount) +getIncomes = selectList [IncomeDeletedAt ==. Nothing] [] + +addIncome :: UserId -> UTCTime -> Int -> Persist IncomeId +addIncome userId creation amount = do + insert (Income userId creation amount Nothing) + +deleteOwnIncome :: Entity User -> IncomeId -> Persist Bool +deleteOwnIncome user incomeId = do + mbIncome <- get incomeId + case mbIncome of + Just income -> + if incomeUserId income == entityKey user + then do + now <- liftIO getCurrentTime + update incomeId [IncomeDeletedAt =. Just now] + return True + else + return False + Nothing -> + return False diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index 8f5cf2a..9d1c053 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -51,9 +51,8 @@ data Key = | CategoryRequired | CostRequired - | IncomeRequired - | IncomeMustBeNonNullNumber - | IncomeMustBePositiveNumber + | DateValidationError + | IncomeValidationError -- Payments @@ -66,12 +65,10 @@ data Key = -- Income + | AddIncome + | Incomes | Income - | NoIncome - | Edit - | Validate - | Undo - | NewIncome + | IncomeNotDeleted -- Http error diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index f41a417..9db4a76 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -198,17 +198,12 @@ m l CostRequired = English -> "Type a positive cost." French -> "Entre un coût positif." -m l IncomeRequired = +m l DateValidationError = case l of - English -> "Type an income." - French -> "Entre un revenu." + English -> "The date must be day/month/year" + French -> "La date doit avoir la forme jour/mois/année" -m l IncomeMustBeNonNullNumber = - case l of - English -> "The income must be a non-null integer." - French -> "Le revenu doit être un entier non nul." - -m l IncomeMustBePositiveNumber = +m l IncomeValidationError = case l of English -> "The income must be a positive integer." French -> "Le revenu doit être un entier positif." @@ -251,37 +246,25 @@ m l PluralMonthlyCount = -- Income -m l Income = - T.concat - [ case l of - English -> "Monthly net income: {1}" - French -> "Revenu mensuel net : {1}" - ] - -m l NoIncome = +m l AddIncome = case l of - English -> "Income not given" - French -> "Revenu non renseigné" + English -> "Add a monthly net income" + French -> "Ajouter un revenu mensuel net" -m l Edit = +m l Incomes = case l of - English -> "Edit" - French -> "Éditer" + English -> "Monthly net incomes" + French -> "Revenus mensuels nets" -m l Validate = - case l of - English -> "Validate" - French -> "Valider" - -m l Undo = +m l Income = case l of - English -> "Undo" - French -> "Annuler" + English -> "Monthly net income: {1}" + French -> "Revenu mensuel net : {1}" -m l NewIncome = +m l IncomeNotDeleted = case l of - English -> "New income" - French -> "Nouveau revenu" + English -> "The income could not have been deleted." + French -> "Le revenu n'a pas pu être supprimé." -- Http error -- cgit v1.2.3