From 75804df1cb231033f94183e41cdf79d36d8f6710 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 21 Aug 2016 14:30:40 +0200 Subject: Show a message if there is an error during a server request --- README.md | 2 +- src/client/elm/Dialog/AddIncome/View.elm | 10 ++-- src/client/elm/Dialog/AddPayment/View.elm | 10 ++-- src/client/elm/LoggedIn/Home/Header/View.elm | 6 +-- .../elm/LoggedIn/Home/View/ExceedingPayers.elm | 2 +- src/client/elm/LoggedIn/Home/View/Table.elm | 24 +++++----- src/client/elm/LoggedIn/Income/View.elm | 14 +++--- src/client/elm/LoggedIn/Income/View/Table.elm | 22 ++++----- src/client/elm/LoggedIn/Msg.elm | 14 +----- src/client/elm/LoggedIn/Stat/View.elm | 2 +- src/client/elm/LoggedIn/Update.elm | 49 ------------------- src/client/elm/Model.elm | 3 ++ src/client/elm/Model/Income.elm | 4 +- src/client/elm/Model/Translations.elm | 6 +-- src/client/elm/Msg.elm | 10 ++++ src/client/elm/SignIn/Update.elm | 2 +- src/client/elm/SignIn/View.elm | 6 +-- src/client/elm/Update.elm | 53 ++++++++++++++++++++- src/client/elm/View.elm | 16 +++---- src/client/elm/View/Date.elm | 8 ++-- src/client/elm/View/Errors.elm | 21 +++++++++ src/client/elm/View/Form.elm | 8 ++-- src/client/elm/View/Header.elm | 4 +- src/client/elm/View/Plural.elm | 4 +- src/server/Controller/Payment.hs | 2 +- src/server/Design/Errors.hs | 55 ++++++++++++++++++++++ src/server/Design/Global.hs | 2 + src/server/Model/Message/Key.hs | 10 ++++ src/server/Model/Message/Translations.hs | 37 +++++++++++++++ 29 files changed, 266 insertions(+), 140 deletions(-) create mode 100644 src/client/elm/View/Errors.elm create mode 100644 src/server/Design/Errors.hs diff --git a/README.md b/README.md index 45255f7..e7d9cfe 100644 --- a/README.md +++ b/README.md @@ -34,6 +34,6 @@ See [application.conf](application.conf). TODO ---- -- Server error message +- CRUD animation (loading, created-updated-deleted element) - Dates after today must be forbidden - Weekly notifications about added, modified, deleted payments and incomes diff --git a/src/client/elm/Dialog/AddIncome/View.elm b/src/client/elm/Dialog/AddIncome/View.elm index cc1ac13..c628d37 100644 --- a/src/client/elm/Dialog/AddIncome/View.elm +++ b/src/client/elm/Dialog/AddIncome/View.elm @@ -35,11 +35,11 @@ button : String -> LoggedData -> List (String, Field) -> String -> Html Msg -> M button className loggedData initialForm title buttonContent tooltip = let dialogConfig = { className = "incomeDialog" - , title = getMessage title loggedData.translations + , title = getMessage loggedData.translations title , body = \model -> addIncomeForm loggedData model.addIncome - , confirm = getMessage "Confirm" loggedData.translations + , confirm = getMessage loggedData.translations "Confirm" , confirmMsg = submitForm << .addIncome - , undo = getMessage "Undo" loggedData.translations + , undo = getMessage loggedData.translations "Undo" } in Html.button ( ( case tooltip of @@ -68,8 +68,8 @@ submitForm addIncome = Just data -> case data.id of Just incomeId -> - Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.EditIncome incomeId data.amount data.date + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.EditIncome incomeId data.amount data.date Nothing -> - Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.CreateIncome data.amount data.date + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.CreateIncome data.amount data.date Nothing -> Msg.Dialog <| Dialog.Update <| DialogMsg.AddIncomeMsg <| Form.Submit diff --git a/src/client/elm/Dialog/AddPayment/View.elm b/src/client/elm/Dialog/AddPayment/View.elm index 3ffe200..df1ad3b 100644 --- a/src/client/elm/Dialog/AddPayment/View.elm +++ b/src/client/elm/Dialog/AddPayment/View.elm @@ -36,11 +36,11 @@ button : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe Strin button loggedData initialForm title buttonContent tooltip = let dialogConfig = { className = "paymentDialog" - , title = getMessage title loggedData.translations + , title = getMessage loggedData.translations title , body = \model -> addPaymentForm loggedData model.addPayment - , confirm = getMessage "Confirm" loggedData.translations + , confirm = getMessage loggedData.translations "Confirm" , confirmMsg = submitForm << .addPayment - , undo = getMessage "Undo" loggedData.translations + , undo = getMessage loggedData.translations "Undo" } in Html.button ( ( case tooltip of @@ -75,8 +75,8 @@ submitForm addPayment = Just data -> case data.id of Just paymentId -> - Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.EditPayment paymentId data.name data.cost data.date data.frequency + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.EditPayment paymentId data.name data.cost data.date data.frequency Nothing -> - Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.CreatePayment data.name data.cost data.date data.frequency + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.CreatePayment data.name data.cost data.date data.frequency Nothing -> Msg.Dialog <| Dialog.Update <| DialogMsg.AddPaymentMsg <| Form.Submit diff --git a/src/client/elm/LoggedIn/Home/Header/View.elm b/src/client/elm/LoggedIn/Home/Header/View.elm index e6b2444..b67fb3b 100644 --- a/src/client/elm/LoggedIn/Home/Header/View.elm +++ b/src/client/elm/LoggedIn/Home/Header/View.elm @@ -46,7 +46,7 @@ view loggedData { search } payments frequency = loggedData (AddPayment.initialAdd loggedData.translations currentDate frequency) "AddPayment" - (text (getMessage "AddPayment" loggedData.translations)) + (text (getMessage loggedData.translations "AddPayment")) Nothing ] , Html.div @@ -78,7 +78,7 @@ infos loggedData payments = [ class "infos" ] [ span [ class "total" ] - [ text <| getParamMessage [ count, sum ] "Worth" loggedData.translations ] + [ text <| getParamMessage [ count, sum ] loggedData.translations "Worth" ] , span [ class "partition" ] [ text <| paymentsPartition loggedData payments ] @@ -95,7 +95,7 @@ paymentsPartition loggedData payments = |> List.sortBy fst |> List.reverse |> List.map (\(sum, user) -> - getParamMessage [ user.name, Format.price loggedData.conf sum ] "By" loggedData.translations + getParamMessage [ user.name, Format.price loggedData.conf sum ] loggedData.translations "By" ) ) diff --git a/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm b/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm index 15f5cf5..6f2439c 100644 --- a/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm +++ b/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm @@ -24,7 +24,7 @@ view loggedData = in div [ class "exceedingPayers" ] ( if List.isEmpty exceedingPayers - then [ text <| getMessage "PaymentsAreBalanced" loggedData.translations ] + then [ text <| getMessage loggedData.translations "PaymentsAreBalanced" ] else (List.map (exceedingPayer loggedData) exceedingPayers) ) diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm index 6c12f31..6423bf9 100644 --- a/src/client/elm/LoggedIn/Home/View/Table.elm +++ b/src/client/elm/LoggedIn/Home/View/Table.elm @@ -48,7 +48,7 @@ view loggedData homeModel payments frequency = then div [ class "emptyTableMsg" ] - [ text <| getMessage "NoPayment" loggedData.translations ] + [ text <| getMessage loggedData.translations "NoPayment" ] else text "" ] @@ -57,11 +57,11 @@ headerLine : LoggedData -> Frequency -> Html Msg headerLine loggedData frequency = div [ class "header" ] - [ div [ class "cell category" ] [ text <| getMessage "Name" loggedData.translations ] - , div [ class "cell cost" ] [ text <| getMessage "Cost" loggedData.translations ] - , div [ class "cell user" ] [ text <| getMessage "Payer" loggedData.translations ] + [ div [ class "cell category" ] [ text <| getMessage loggedData.translations "Name" ] + , div [ class "cell cost" ] [ text <| getMessage loggedData.translations "Cost" ] + , div [ class "cell user" ] [ text <| getMessage loggedData.translations "Payer" ] , case frequency of - Punctual -> div [ class "cell date" ] [ text <| getMessage "Date" loggedData.translations ] + Punctual -> div [ class "cell date" ] [ text <| getMessage loggedData.translations "Date" ] Monthly -> text "" , div [ class "cell" ] [] , div [ class "cell" ] [] @@ -108,7 +108,7 @@ paymentLine loggedData homeModel frequency payment = (AddPayment.initialClone loggedData.translations currentDate payment) "ClonePayment" (FontAwesome.clone Color.chestnutRose 18) - (Just (getMessage "Clone" loggedData.translations)) + (Just (getMessage loggedData.translations "Clone")) ] , div [ class "cell button" ] @@ -121,7 +121,7 @@ paymentLine loggedData homeModel frequency payment = (AddPayment.initialEdit loggedData.translations payment) "EditPayment" (FontAwesome.pencil Color.chestnutRose 18) - (Just (getMessage "Edit" loggedData.translations)) + (Just (getMessage loggedData.translations "Edit")) ] , div [ class "cell button" ] @@ -131,14 +131,14 @@ paymentLine loggedData homeModel frequency payment = else let dialogConfig = { className = "deletePaymentDialog" - , title = getMessage "ConfirmPaymentDelete" loggedData.translations + , title = getMessage loggedData.translations "ConfirmPaymentDelete" , body = always <| text "" - , confirm = getMessage "Confirm" loggedData.translations - , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.DeletePayment payment.id - , undo = getMessage "Undo" loggedData.translations + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeletePayment payment.id + , undo = getMessage loggedData.translations "Undo" } in button - ( Tooltip.show Msg.Tooltip (getMessage "Delete" loggedData.translations) + ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] ) [ FontAwesome.trash Color.chestnutRose 18 ] diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm index 5a2c18e..2c5bcaf 100644 --- a/src/client/elm/LoggedIn/Income/View.elm +++ b/src/client/elm/LoggedIn/Income/View.elm @@ -50,13 +50,13 @@ view loggedData incomeModel = Nothing -> text "" , div [ class "textual monthlyNetIncomes" ] - [ h1 [] [ text <| getMessage "MonthlyNetIncomes" loggedData.translations ] + [ h1 [] [ text <| getMessage loggedData.translations "MonthlyNetIncomes" ] , AddIncome.button "addIncome" loggedData (AddIncome.initialAdd loggedData.translations (Date.fromTime loggedData.currentTime)) "AddIncome" - (text (getMessage "AddIncome" loggedData.translations)) + (text (getMessage loggedData.translations "AddIncome")) Nothing ] , Table.view loggedData incomeModel @@ -67,7 +67,7 @@ cumulativeIncomesView loggedData since = let longDate = Date.longView (Date.fromTime since) loggedData.translations in div [ class "textual" ] - [ h1 [] [ text <| getParamMessage [longDate] "CumulativeIncomesSince" loggedData.translations ] + [ h1 [] [ text <| getParamMessage [longDate] loggedData.translations "CumulativeIncomesSince" ] , ul [] ( Dict.toList loggedData.users @@ -95,11 +95,11 @@ incomeView loggedData (incomeId, income) = , text <| Format.price loggedData.conf income.amount , let dialogConfig = { className = "deleteIncomeDialog" - , title = getMessage "ConfirmIncomeDelete" loggedData.translations + , title = getMessage loggedData.translations "ConfirmIncomeDelete" , body = always <| text "" - , confirm = getMessage "Confirm" loggedData.translations - , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId - , undo = getMessage "Undo" loggedData.translations + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeleteIncome incomeId + , undo = getMessage loggedData.translations "Undo" } in button [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] diff --git a/src/client/elm/LoggedIn/Income/View/Table.elm b/src/client/elm/LoggedIn/Income/View/Table.elm index cf82772..dcf6d78 100644 --- a/src/client/elm/LoggedIn/Income/View/Table.elm +++ b/src/client/elm/LoggedIn/Income/View/Table.elm @@ -49,7 +49,7 @@ view loggedData incomeModel = then div [ class "emptyTableMsg" ] - [ text <| getMessage "NoPayment" loggedData.translations ] + [ text <| getMessage loggedData.translations "NoPayment" ] else text "" ] @@ -58,9 +58,9 @@ headerLine : LoggedData -> Html Msg headerLine loggedData = div [ class "header" ] - [ div [ class "cell name" ] [ text <| getMessage "Name" loggedData.translations ] - , div [ class "cell income" ] [ text <| getMessage "Income" loggedData.translations ] - , div [ class "cell date" ] [ text <| getMessage "Date" loggedData.translations ] + [ div [ class "cell name" ] [ text <| getMessage loggedData.translations "Name" ] + , div [ class "cell income" ] [ text <| getMessage loggedData.translations "Income" ] + , div [ class "cell date" ] [ text <| getMessage loggedData.translations "Date" ] , div [ class "cell" ] [] , div [ class "cell" ] [] , div [ class "cell" ] [] @@ -92,7 +92,7 @@ paymentLine loggedData incomeModel (incomeId, income) = (AddIncome.initialClone loggedData.translations currentDate income) "CloneIncome" (FontAwesome.clone Color.chestnutRose 18) - (Just (getMessage "Clone" loggedData.translations)) + (Just (getMessage loggedData.translations "Clone")) ] , div [ class "cell button" ] @@ -106,7 +106,7 @@ paymentLine loggedData incomeModel (incomeId, income) = (AddIncome.initialEdit loggedData.translations incomeId income) "EditIncome" (FontAwesome.pencil Color.chestnutRose 18) - (Just (getMessage "Edit" loggedData.translations)) + (Just (getMessage loggedData.translations "Edit")) ] , div [ class "cell button" ] @@ -116,14 +116,14 @@ paymentLine loggedData incomeModel (incomeId, income) = else let dialogConfig = { className = "deleteIncomeDialog" - , title = getMessage "ConfirmIncomeDelete" loggedData.translations + , title = getMessage loggedData.translations "ConfirmIncomeDelete" , body = always <| text "" - , confirm = getMessage "Confirm" loggedData.translations - , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId - , undo = getMessage "Undo" loggedData.translations + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeleteIncome incomeId + , undo = getMessage loggedData.translations "Undo" } in button - ( Tooltip.show Msg.Tooltip (getMessage "Delete" loggedData.translations) + ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] ) [ FontAwesome.trash Color.chestnutRose 18 ] diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm index 9bb87b9..ff275e2 100644 --- a/src/client/elm/LoggedIn/Msg.elm +++ b/src/client/elm/LoggedIn/Msg.elm @@ -4,7 +4,7 @@ module LoggedIn.Msg exposing import Date exposing (Date) -import Model.Payment exposing (Payment, PaymentId, Frequency) +import Model.Payment exposing (PaymentId, Frequency) import Model.Income exposing (IncomeId) import LoggedIn.Home.Msg as HomeMsg @@ -14,21 +14,9 @@ type Msg = NoOp | HomeMsg HomeMsg.Msg | IncomeMsg IncomeMsg.Msg - - | CreatePayment String Int Date Frequency | ValidateCreatePayment PaymentId String Int Date Frequency - - | EditPayment PaymentId String Int Date Frequency | ValidateEditPayment PaymentId String Int Date Frequency - - | DeletePayment PaymentId | ValidateDeletePayment PaymentId - - | CreateIncome Int Date | ValidateCreateIncome IncomeId Int Date - - | EditIncome IncomeId Int Date | ValidateEditIncome IncomeId Int Date - - | DeleteIncome IncomeId | ValidateDeleteIncome IncomeId diff --git a/src/client/elm/LoggedIn/Stat/View.elm b/src/client/elm/LoggedIn/Stat/View.elm index a6faf5c..946005a 100644 --- a/src/client/elm/LoggedIn/Stat/View.elm +++ b/src/client/elm/LoggedIn/Stat/View.elm @@ -27,7 +27,7 @@ view loggedData = monthPaymentMean = getMonthPaymentMean loggedData paymentsByMonth in div [ class "stat textual" ] - [ h1 [] [ text (getParamMessage [ Format.price loggedData.conf monthPaymentMean ] "ByMonthsAndMean" loggedData.translations) ] + [ h1 [] [ text (getParamMessage [ Format.price loggedData.conf monthPaymentMean ] loggedData.translations "ByMonthsAndMean") ] , ul [] ( List.map (monthDetail loggedData) paymentsByMonth) diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm index 68e840e..06cd623 100644 --- a/src/client/elm/LoggedIn/Update.elm +++ b/src/client/elm/LoggedIn/Update.elm @@ -13,7 +13,6 @@ import Platform.Cmd exposing (Cmd) import Form import Model exposing (Model) -import Model.Translations exposing (getMessage) import Model.Payment as Payment exposing (Payment, Frequency(..)) import Model.Income as Income exposing (Income) @@ -59,14 +58,6 @@ update model msg loggedIn = , Cmd.map LoggedInMsg.IncomeMsg cmd ) - LoggedInMsg.CreatePayment name cost date frequency -> - ( loggedIn - , Server.createPayment name cost date frequency - |> Task.perform - (always LoggedInMsg.NoOp) - (\paymentId -> LoggedInMsg.ValidateCreatePayment paymentId name cost date frequency) - ) - LoggedInMsg.ValidateCreatePayment paymentId name cost date frequency -> update model (LoggedInMsg.HomeMsg <| HomeMsg.SearchMsg (Form.Reset (HomeModel.searchInitial frequency))) loggedIn :> update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1) @@ -77,28 +68,12 @@ update model msg loggedIn = ) ) - LoggedInMsg.EditPayment paymentId name cost date frequency -> - ( loggedIn - , Server.editPayment paymentId name cost date frequency - |> Task.perform - (always LoggedInMsg.NoOp) - (always <| LoggedInMsg.ValidateEditPayment paymentId name cost date frequency) - ) - LoggedInMsg.ValidateEditPayment paymentId name cost date frequency -> let updatedPayment = Payment paymentId name cost date loggedIn.me frequency in ( { loggedIn | payments = Payment.edit updatedPayment loggedIn.payments } , Cmd.none ) - LoggedInMsg.DeletePayment paymentId -> - ( loggedIn - , Server.deletePayment paymentId - |> Task.perform - (always LoggedInMsg.NoOp) - (always (LoggedInMsg.ValidateDeletePayment paymentId)) - ) - LoggedInMsg.ValidateDeletePayment paymentId -> let payments = Payment.delete paymentId loggedIn.payments frequency = @@ -122,14 +97,6 @@ update model msg loggedIn = , Cmd.none ) - LoggedInMsg.CreateIncome amount date -> - ( loggedIn - , Server.createIncome amount date - |> Task.perform - (always LoggedInMsg.NoOp) - (\incomeId -> (LoggedInMsg.ValidateCreateIncome incomeId amount date)) - ) - LoggedInMsg.ValidateCreateIncome incomeId amount date -> let newIncome = { userId = loggedIn.me, amount = amount, time = Date.toTime date } loggedInIncome = loggedIn.income @@ -140,14 +107,6 @@ update model msg loggedIn = , Cmd.none ) - LoggedInMsg.EditIncome incomeId amount date -> - ( loggedIn - , Server.editIncome incomeId amount date - |> Task.perform - (always LoggedInMsg.NoOp) - (always <| LoggedInMsg.ValidateEditIncome incomeId amount date) - ) - LoggedInMsg.ValidateEditIncome incomeId amount date -> let updatedIncome = Income loggedIn.me (Date.toTime date) amount updateIncome mbIncome = @@ -158,14 +117,6 @@ update model msg loggedIn = , Cmd.none ) - LoggedInMsg.DeleteIncome incomeId -> - ( loggedIn - , Server.deleteIncome incomeId - |> Task.perform - (always LoggedInMsg.NoOp) - (always <| LoggedInMsg.ValidateDeleteIncome incomeId) - ) - LoggedInMsg.ValidateDeleteIncome incomeId -> ( { loggedIn | incomes = Dict.remove incomeId loggedIn.incomes } , Cmd.none diff --git a/src/client/elm/Model.elm b/src/client/elm/Model.elm index aa4b314..a1d2bff 100644 --- a/src/client/elm/Model.elm +++ b/src/client/elm/Model.elm @@ -33,6 +33,7 @@ type alias Model = , translations : Translations , conf : Conf , page : Page + , errors : List String , dialog : Dialog.Model DialogModel.Model DialogMsg.Msg Msg , tooltip : Tooltip.Model } @@ -58,6 +59,7 @@ init payload result = , translations = translations , conf = conf , page = page + , errors = [] , dialog = Dialog.init DialogModel.init Msg.Dialog , tooltip = Tooltip.init windowSize.width windowSize.height } @@ -67,6 +69,7 @@ init payload result = , translations = [] , conf = { currency = "" } , page = page + , errors = [ error ] , dialog = Dialog.init DialogModel.init Msg.Dialog , tooltip = Tooltip.init 0 0 } diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm index 06ba772..a5ca34b 100644 --- a/src/client/elm/Model/Income.elm +++ b/src/client/elm/Model/Income.elm @@ -81,8 +81,8 @@ getIncomeAt time incomes = then Just { userId = x.userId, time = time, amount = x.amount } else Nothing x1 :: x2 :: xs -> - if x1.time < time && x2.time > time - then Just { userId = x2.userId, time = time, amount = x2.amount } + if x1.time < time && x2.time >= time + then Just { userId = x1.userId, time = time, amount = x1.amount } else getIncomeAt time (x2 :: xs) [] -> Nothing diff --git a/src/client/elm/Model/Translations.elm b/src/client/elm/Model/Translations.elm index 9499dde..57409b0 100644 --- a/src/client/elm/Model/Translations.elm +++ b/src/client/elm/Model/Translations.elm @@ -49,11 +49,11 @@ partDecoderWithTag tag = ----- -getMessage : String -> Translations -> String +getMessage : Translations -> String -> String getMessage = getParamMessage [] -getParamMessage : List String -> String -> Translations -> String -getParamMessage values key translations = +getParamMessage : List String -> Translations -> String -> String +getParamMessage values translations key = getTranslation key translations |> Maybe.map (\parts -> String.concat (List.map (replacePart values) parts)) |> withDefault key diff --git a/src/client/elm/Msg.elm b/src/client/elm/Msg.elm index 93e7f80..49d13ca 100644 --- a/src/client/elm/Msg.elm +++ b/src/client/elm/Msg.elm @@ -2,11 +2,14 @@ module Msg exposing ( Msg(..) ) +import Date exposing (Date) import Time exposing (Time) import Page exposing (Page) import Model.Init exposing (Init) +import Model.Payment exposing (PaymentId, Frequency) +import Model.Income exposing (IncomeId) import Dialog import Dialog.Model as DialogModel @@ -24,7 +27,14 @@ type Msg = | GoLoggedInView Init | UpdateSignIn SignInMsg.Msg | UpdateLoggedIn LoggedInMsg.Msg + | CreatePayment String Int Date Frequency + | EditPayment PaymentId String Int Date Frequency + | DeletePayment PaymentId + | CreateIncome Int Date + | EditIncome IncomeId Int Date + | DeleteIncome IncomeId | GoSignInView | SignOut + | Error String | Dialog (Dialog.Msg DialogModel.Model DialogMsg.Msg Msg) | Tooltip Tooltip.Msg diff --git a/src/client/elm/SignIn/Update.elm b/src/client/elm/SignIn/Update.elm index 7ada45c..98de777 100644 --- a/src/client/elm/SignIn/Update.elm +++ b/src/client/elm/SignIn/Update.elm @@ -21,7 +21,7 @@ update translations msg signInView = ValidLogin -> { signInView | login = "" - , result = Just (Ok (getMessage "SignInEmailSent" translations)) + , result = Just (Ok (getMessage translations "SignInEmailSent")) , waitingServer = False } ErrorLogin message -> diff --git a/src/client/elm/SignIn/View.elm b/src/client/elm/SignIn/View.elm index daaa527..f23ca09 100644 --- a/src/client/elm/SignIn/View.elm +++ b/src/client/elm/SignIn/View.elm @@ -38,7 +38,7 @@ view model signInModel = [] [ if signInModel.waitingServer then FontAwesome.spinner Color.white 20 - else text (getMessage "SignIn" model.translations) + else text (getMessage model.translations "SignIn") ] ] , div @@ -54,10 +54,10 @@ signInResult model signInModel = Ok login -> div [ class "success" ] - [ text (getMessage "SignInEmailSent" model.translations) ] + [ text (getMessage model.translations "SignInEmailSent") ] Err error -> div [ class "error" ] - [ text (getMessage error model.translations) ] + [ text (getMessage model.translations error) ] Nothing -> text "" diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm index 817a191..e66414e 100644 --- a/src/client/elm/Update.elm +++ b/src/client/elm/Update.elm @@ -66,12 +66,63 @@ update msg model = UpdateLoggedIn loggedInMsg -> applyLoggedIn model loggedInMsg + CreatePayment name cost date frequency -> + ( model + , Server.createPayment name cost date frequency + |> Task.perform + (always <| Error "CreatePaymentError") + (\paymentId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreatePayment paymentId name cost date frequency) + ) + + EditPayment paymentId name cost date frequency -> + ( model + , Server.editPayment paymentId name cost date frequency + |> Task.perform + (always <| Error "EditPaymentError") + (always <| UpdateLoggedIn <| LoggedInMsg.ValidateEditPayment paymentId name cost date frequency) + ) + + DeletePayment paymentId -> + ( model + , Server.deletePayment paymentId + |> Task.perform + (always <| Error "DeletePaymentError") + (always <| UpdateLoggedIn <| LoggedInMsg.ValidateDeletePayment paymentId) + ) + + CreateIncome amount date -> + ( model + , Server.createIncome amount date + |> Task.perform + (always <| Error "CreateIncomeError") + (\incomeId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreateIncome incomeId amount date) + ) + + EditIncome incomeId amount date -> + ( model + , Server.editIncome incomeId amount date + |> Task.perform + (always <| Error "EditIncomeError") + (always <| UpdateLoggedIn <| LoggedInMsg.ValidateEditIncome incomeId amount date) + ) + + DeleteIncome incomeId -> + ( model + , Server.deleteIncome incomeId + |> Task.perform + (always <| Error "DeleteIncomeError") + (always <| UpdateLoggedIn <| LoggedInMsg.ValidateDeleteIncome incomeId) + ) + SignOut -> ( model , Server.signOut - |> Task.perform (always NoOp) (always GoSignInView) + |> Task.perform (always <| Error "SignOutError") (always GoSignInView) ) + Error error -> + ({ model | errors = model.errors ++ [ error ] }, Cmd.none) + Dialog dialogMsg -> Dialog.update DialogUpdate.update dialogMsg model.dialog.model model.dialog |> Tuple.mapFst (\dialog -> { model | dialog = dialog }) diff --git a/src/client/elm/View.elm b/src/client/elm/View.elm index 00833cb..4a0822f 100644 --- a/src/client/elm/View.elm +++ b/src/client/elm/View.elm @@ -14,6 +14,7 @@ import Dialog import Tooltip import View.Header as Header +import View.Errors as Errors import SignIn.View as SignInView import LoggedIn.View as LoggedInView @@ -25,15 +26,12 @@ view model = div [] [ Header.view model - , mainView model + , case model.view of + SignInView signIn -> + SignInView.view model signIn + LoggedInView loggedIn -> + LoggedInView.view model loggedIn + , Errors.view model.translations model.errors , Dialog.view model.dialog , Html.map Msg.Tooltip <| Tooltip.view model.tooltip ] - -mainView : Model -> Html Msg -mainView model = - case model.view of - SignInView signIn -> - SignInView.view model signIn - LoggedInView loggedIn -> - LoggedInView.view model loggedIn diff --git a/src/client/elm/View/Date.elm b/src/client/elm/View/Date.elm index 21bbfc4..35806ba 100644 --- a/src/client/elm/View/Date.elm +++ b/src/client/elm/View/Date.elm @@ -17,19 +17,19 @@ shortView date translations = , String.pad 2 '0' (toString (Date.monthToInt (Date.month date))) , toString (Date.year date) ] - in getParamMessage params "ShortDate" translations + in getParamMessage params translations "ShortDate" longView : Date -> Translations -> String longView date translations = let params = [ toString (Date.day date) - , (getMessage (getMonthKey (Date.month date)) translations) + , (getMessage translations (getMonthKey (Date.month date))) , toString (Date.year date) ] - in getParamMessage params "LongDate" translations + in getParamMessage params translations "LongDate" monthView : Translations -> Month -> String -monthView translations month = getMessage (getMonthKey month) translations +monthView translations month = getMessage translations (getMonthKey month) getMonthKey : Month -> String getMonthKey month = diff --git a/src/client/elm/View/Errors.elm b/src/client/elm/View/Errors.elm new file mode 100644 index 0000000..3e25c99 --- /dev/null +++ b/src/client/elm/View/Errors.elm @@ -0,0 +1,21 @@ +module View.Errors exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Model.Translations exposing (Translations, getMessage) + +view : Translations -> List String -> Html msg +view translations errors = + ul + [ class "errors" ] + ( List.map (errorView translations) errors) + +errorView : Translations -> String -> Html msg +errorView translations error = + li + [ class "error" ] + [ text <| getMessage translations error ] diff --git a/src/client/elm/View/Form.elm b/src/client/elm/View/Form.elm index 5f642fb..dcde47d 100644 --- a/src/client/elm/View/Form.elm +++ b/src/client/elm/View/Form.elm @@ -40,7 +40,7 @@ textInput translations form formName fieldName = ] , label [ for (formName ++ fieldName) ] - [ text (Translations.getMessage (formName ++ fieldName) translations) ] + [ text (Translations.getMessage translations (formName ++ fieldName)) ] , button [ type' "button" , onClick (Form.Input fieldName Field.EmptyField) @@ -63,7 +63,7 @@ radioInputs translations form formName radioName fieldNames = ] [ div [ class "title" ] - [ text (Translations.getMessage (formName ++ radioName) translations) ] + [ text (Translations.getMessage translations (formName ++ radioName) ) ] , div [ class "radioInputs" ] (List.map (radioInput translations field formName) fieldNames) @@ -85,7 +85,7 @@ radioInput translations field formName fieldName = ] , label [ for (formName ++ fieldName) ] - [ text (Translations.getMessage (formName ++ fieldName) translations) + [ text (Translations.getMessage translations (formName ++ fieldName)) ] ] @@ -94,7 +94,7 @@ formError translations error = let errorElement error params = div [ class "errorMessage" ] - [ text (Translations.getParamMessage params error translations) ] + [ text (Translations.getParamMessage params translations error) ] in case error of CustomError key -> errorElement key [] SmallerIntThan n -> errorElement "SmallerIntThan" [toString n] diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm index d5969b9..08a429f 100644 --- a/src/client/elm/View/Header.elm +++ b/src/client/elm/View/Header.elm @@ -22,7 +22,7 @@ view : Model -> Html Msg view model = header [] - ( [ div [ class "title" ] [ text (getMessage "SharedCost" model.translations) ] ] + ( [ div [ class "title" ] [ text (getMessage model.translations "SharedCost") ] ] ++ let item page name = a [ href (Page.toHash page) @@ -31,7 +31,7 @@ view model = , ("current", model.page == page) ] ] - [ text (getMessage name model.translations) + [ text (getMessage model.translations name) ] in case model.view of LoggedInView { me, users } -> diff --git a/src/client/elm/View/Plural.elm b/src/client/elm/View/Plural.elm index ab91f06..c36eaca 100644 --- a/src/client/elm/View/Plural.elm +++ b/src/client/elm/View/Plural.elm @@ -6,6 +6,6 @@ import Model.Translations exposing (Translations, getMessage) plural : Translations -> Int -> String -> String -> String plural translations n single multiple = - let singleMessage = getMessage single translations - multipleMessage = getMessage multiple translations + let singleMessage = getMessage translations single + multipleMessage = getMessage translations multiple in (toString n) ++ " " ++ if n <= 1 then singleMessage else multipleMessage diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index 96ac469..9155a78 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -28,7 +28,7 @@ import qualified Model.Json.EditPayment as Json list :: ActionM () list = - Secure.loggedAction (\_ -> do + Secure.loggedAction (\_ -> (liftIO $ runDb Payment.list) >>= json ) diff --git a/src/server/Design/Errors.hs b/src/server/Design/Errors.hs new file mode 100644 index 0000000..57aaeee --- /dev/null +++ b/src/server/Design/Errors.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Design.Errors + ( design + ) where + +import Clay + +import Design.Color as Color + +design :: Css +design = do + position fixed + top (px 20) + left (pct 50) + "transform" -: "translateX(-50%)" + margin (px 0) (px 0) (px 0) (px 0) + disapearKeyframes + + ".error" ? do + disapearAnimation + let errorColor = Color.chestnutRose -. 15 + color errorColor + border solid (px 2) errorColor + backgroundColor Color.white + borderRadius (px 5) (px 5) (px 5) (px 5) + padding (px 5) (px 5) (px 5) (px 5) + + before & display none + +disapearAnimation :: Css +disapearAnimation = do + animationName "disapear" + animationDelay (sec 5) + animationDuration (sec 1) + animationFillMode forwards + +disapearKeyframes :: Css +disapearKeyframes = keyframes + "disapear" + [ ( 10 + , do + opacity 0 + height (px 40) + lineHeight (px 40) + marginBottom (px 10) + ) + , ( 100 + , do + opacity 0 + height (px 0) + lineHeight (px 0) + marginBottom (px 0) + ) + ] diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs index 26c1a42..e742978 100644 --- a/src/server/Design/Global.hs +++ b/src/server/Design/Global.hs @@ -12,6 +12,7 @@ import qualified Design.Header as Header import qualified Design.SignIn as SignIn import qualified Design.LoggedIn as LoggedIn import qualified Design.Form as Form +import qualified Design.Errors as Errors import qualified Design.Dialog as Dialog import qualified Design.Tooltip as Tooltip @@ -29,6 +30,7 @@ global = do header ? Header.design ".signIn" ? SignIn.design ".loggedIn" ? LoggedIn.design + ".errors" ? Errors.design ".dialog" ? Dialog.design ".tooltip" ? Tooltip.design Form.design diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index 9126b61..8deca69 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -115,6 +115,16 @@ data Key = | SmallerIntThan | GreaterIntThan + -- Errors + + | CreatePaymentError + | EditPaymentError + | DeletePaymentError + | CreateIncomeError + | EditIncomeError + | DeleteIncomeError + | SignOutError + -- Dialog | Confirm diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index 4b698d7..994a56c 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -446,6 +446,43 @@ m l GreaterIntThan = English -> "Integer smaller than {1} or equal required" French -> "Entier inférieur ou égal à {1} requis" +-- Errors + +m l CreatePaymentError = + case l of + English -> "Error at payment creation" + French -> "Erreur lors de la création du paiement" + +m l EditPaymentError = + case l of + English -> "Error at payment edition" + French -> "Erreur lors de la modification du paiement" + +m l DeletePaymentError = + case l of + English -> "Error at payment deletion" + French -> "Erreur lors de la suppression du paiement" + +m l CreateIncomeError = + case l of + English -> "Error at income creation" + French -> "Erreur lors de la création du revenu" + +m l EditIncomeError = + case l of + English -> "Error at income edition" + French -> "Erreur lors de la modification du revenu" + +m l DeleteIncomeError = + case l of + English -> "Error at income deletion" + French -> "Erreur lors de la suppression du revenu" + +m l SignOutError = + case l of + English -> "Error at sign out" + French -> "Erreur lors de la déconnexion" + -- Dialog m l Confirm = -- cgit v1.2.3