From 6ca60e32f0cbde913d171cd84ed7009ab4281284 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 13 Sep 2015 14:38:08 +0200 Subject: Adding UI to modify the income --- database-shm | Bin 32768 -> 0 bytes database-wal | Bin 6320 -> 0 bytes src/client/Model/View/LoggedIn/Account.elm | 27 ++++++++++++ src/client/ServerCommunication.elm | 9 +++- src/client/Update/LoggedIn/Account.elm | 31 +++++++++++++ src/client/View/LoggedIn/Account.elm | 67 ++++++++++++++++++++++++++--- src/client/View/LoggedIn/Add.elm | 1 + src/server/Design/Helper.hs | 7 +++ src/server/Design/LoggedIn.hs | 4 -- src/server/Design/LoggedIn/Add.hs | 4 +- src/server/Design/LoggedIn/Expandables.hs | 27 +++++++++++- src/server/Model/Message/Key.hs | 6 +++ src/server/Model/Message/Translations.hs | 32 ++++++++++++++ 13 files changed, 199 insertions(+), 16 deletions(-) delete mode 100644 database-shm delete mode 100644 database-wal diff --git a/database-shm b/database-shm deleted file mode 100644 index 494f47a..0000000 Binary files a/database-shm and /dev/null differ diff --git a/database-wal b/database-wal deleted file mode 100644 index 4d24ee6..0000000 Binary files a/database-wal and /dev/null differ diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/Model/View/LoggedIn/Account.elm index 410345c..7f0fbe3 100644 --- a/src/client/Model/View/LoggedIn/Account.elm +++ b/src/client/Model/View/LoggedIn/Account.elm @@ -1,14 +1,28 @@ module Model.View.LoggedIn.Account ( Account + , IncomeEdition , initAccount + , initIncomeEdition + , validateIncome ) where +import Result as Result exposing (Result(..)) + +import Utils.Validation exposing (..) + +import Model.Translations exposing (..) import Model.Payers exposing (..) type alias Account = { payers : Payers , income : Maybe Int , visibleDetail : Bool + , incomeEdition : Maybe IncomeEdition + } + +type alias IncomeEdition = + { income : String + , error : Maybe String } initAccount : Payers -> Maybe Int -> Account @@ -16,4 +30,17 @@ initAccount payers income = { payers = payers , income = income , visibleDetail = False + , incomeEdition = Nothing } + +initIncomeEdition : Int -> IncomeEdition +initIncomeEdition income = + { income = toString income + , error = Nothing + } + +validateIncome : String -> Translations -> Result String Int +validateIncome amount translations = + amount + |> validateNonEmpty (getMessage "IncomeRequired" translations) + |> flip Result.andThen (validateNumber (getMessage "IncomeMustBeNonNullNumber" translations) ((/=) 0)) diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm index 5736f77..47d8c27 100644 --- a/src/client/ServerCommunication.elm +++ b/src/client/ServerCommunication.elm @@ -18,12 +18,14 @@ import Update as U import Update.SignIn exposing (..) import Update.LoggedIn as UL import Update.LoggedIn.Monthly as UM +import Update.LoggedIn.Account as UA type Communication = NoCommunication | SignIn String | AddPayment UserId String Int | AddMonthlyPayment String Int + | SetIncome Int | DeletePayment PaymentId UserId Int Int | DeleteMonthlyPayment PaymentId | UpdatePage Int @@ -48,6 +50,7 @@ getRequest communication = SignIn login -> Just (simple "post" ("/signIn?login=" ++ login)) AddPayment userId name cost -> Just (addPaymentRequest name cost Punctual) AddMonthlyPayment name cost -> Just (addPaymentRequest name cost Monthly) + SetIncome amount -> Just (simple "post" ("/income?amount=" ++ (toString amount))) DeletePayment paymentId _ _ _ -> Just (deletePaymentRequest paymentId) DeleteMonthlyPayment paymentId -> Just (deletePaymentRequest paymentId) UpdatePage page -> Just (updatePageRequest page) @@ -88,10 +91,12 @@ serverResult communication response = Task.succeed <| U.UpdateLoggedIn (UL.AddPayment userId name cost payments) )) AddMonthlyPayment name cost -> - decodeOkResponse + decodeResponse ("id" := paymentIdDecoder) (\id -> Task.succeed <| U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost)) response + SetIncome amount -> + Task.succeed <| U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome amount)) DeletePayment id userId cost currentPage -> Http.send Http.defaultSettings (updatePageRequest currentPage) |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments -> @@ -100,7 +105,7 @@ serverResult communication response = DeleteMonthlyPayment id -> Task.succeed <| U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id)) UpdatePage page -> - decodeOkResponse + decodeResponse paymentsDecoder (\payments -> Task.succeed <| U.UpdateLoggedIn (UL.UpdatePage page payments)) response diff --git a/src/client/Update/LoggedIn/Account.elm b/src/client/Update/LoggedIn/Account.elm index ab07c2e..2d9cd87 100644 --- a/src/client/Update/LoggedIn/Account.elm +++ b/src/client/Update/LoggedIn/Account.elm @@ -3,13 +3,21 @@ module Update.LoggedIn.Account , updateAccount ) where +import Maybe + import Model.User exposing (UserId) import Model.Payers exposing (..) import Model.View.LoggedIn.Account exposing (..) +import Utils.Maybe exposing (isJust) + type AccountAction = ToggleDetail | UpdatePayer UserId Int + | ToggleIncomeEdition + | UpdateIncomeEdition String + | UpdateEditionError String + | UpdateIncome Int updateAccount : AccountAction -> Account -> Account updateAccount action account = @@ -18,3 +26,26 @@ updateAccount action account = { account | visibleDetail <- not account.visibleDetail } UpdatePayer userId cost -> { account | payers <- updatePayers account.payers userId cost } + ToggleIncomeEdition -> + { account | incomeEdition <- + if isJust account.incomeEdition + then Nothing + else Just (initIncomeEdition (Maybe.withDefault 0 account.income)) + } + UpdateIncomeEdition income -> + case account.incomeEdition of + Just incomeEdition -> + { account | incomeEdition <- Just { incomeEdition | income <- income } } + Nothing -> + account + UpdateEditionError error -> + case account.incomeEdition of + Just incomeEdition -> + { account | incomeEdition <- Just { incomeEdition | error <- Just error } } + Nothing -> + account + UpdateIncome amount -> + { account + | income <- Just amount + , incomeEdition <- Nothing + } diff --git a/src/client/View/LoggedIn/Account.elm b/src/client/View/LoggedIn/Account.elm index 88f39c3..253647a 100644 --- a/src/client/View/LoggedIn/Account.elm +++ b/src/client/View/LoggedIn/Account.elm @@ -3,10 +3,13 @@ module View.LoggedIn.Account ) where import Html exposing (..) +import Html as H exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) import List +import ServerCommunication as SC exposing (serverCommunications) + import Update exposing (..) import Update.LoggedIn exposing (..) import Update.LoggedIn.Account exposing (..) @@ -16,10 +19,13 @@ import Model.User exposing (getUserName) import Model.Payers exposing (..) import Model.View.LoggedInView exposing (LoggedInView) import Model.Translations exposing (getParamMessage, getMessage) -import Model.View.LoggedIn.Account exposing (Account) +import Model.View.LoggedIn.Account exposing (..) import View.Expand exposing (..) import View.Price exposing (price) +import View.Events exposing (onSubmitPrevDefault) + +import Utils.Either exposing (toMaybeError) account : Model -> LoggedInView -> Html account model loggedInView = @@ -64,11 +70,58 @@ exceedingPayer model loggedInView payer = income : Model -> Account -> Html income model account = + case account.incomeEdition of + Just edition -> + incomeEdition model account edition + Nothing -> + incomeRead model account + +incomeRead : Model -> Account -> Html +incomeRead model account = div [ class "income" ] - ( case account.income of - Nothing -> - [ text (getMessage "NoIncome" model.translations) ] - Just income -> - [ text (getParamMessage [price model income] "Income" model.translations) ] - ) + [ ( case account.income of + Nothing -> + text (getMessage "NoIncome" model.translations) + Just income -> + text (getParamMessage [price model income] "Income" model.translations) + ) + , toggleIncomeEdition "editIncomeEdition" (getMessage "Edit" model.translations) + ] + +incomeEdition : Model -> Account -> IncomeEdition -> Html +incomeEdition model account edition = + H.form + [ case validateIncome edition.income model.translations of + Ok validatedAmount -> + onSubmitPrevDefault serverCommunications.address (SC.SetIncome validatedAmount) + Err error -> + onSubmitPrevDefault actions.address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error) + , class "income" + ] + [ label + [ for "incomeInput" ] + [ text (getMessage "NewIncome" model.translations) ] + , input + [ id "incomeInput" + , value edition.income + , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAccount << UpdateIncomeEdition) + , maxlength 10 + ] + [] + , button + [ class "validateIncomeEdition" ] + [ text (getMessage "Validate" model.translations) ] + , toggleIncomeEdition "undoIncomeEdition" (getMessage "Undo" model.translations) + , case edition.error of + Just error -> div [ class "error" ] [ text error ] + Nothing -> text "" + ] + +toggleIncomeEdition : String -> String -> Html +toggleIncomeEdition className name = + button + [ class className + , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleIncomeEdition) + ] + [ text name ] diff --git a/src/client/View/LoggedIn/Add.elm b/src/client/View/LoggedIn/Add.elm index bae3853..2167a7f 100644 --- a/src/client/View/LoggedIn/Add.elm +++ b/src/client/View/LoggedIn/Add.elm @@ -37,6 +37,7 @@ addPayment model loggedInView = in onSubmitPrevDefault serverCommunications.address action (resName, resCost) -> onSubmitPrevDefault actions.address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost)) + , class "addPayment" ] [ addPaymentName loggedInView.add , addPaymentCost model loggedInView.add diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs index 53839c1..6e2fde3 100644 --- a/src/server/Design/Helper.hs +++ b/src/server/Design/Helper.hs @@ -6,6 +6,7 @@ module Design.Helper , defaultInput , centeredWithMargin , expandBlock + , verticalCentering ) where import Clay @@ -60,3 +61,9 @@ expandBlock headerBackground headerColor headerHeight = do position relative paddingLeft blockPadding paddingRight (px 55) + +verticalCentering :: Css +verticalCentering = do + position absolute + top (pct 50) + "transform" -: "translateY(-50%)" diff --git a/src/server/Design/LoggedIn.hs b/src/server/Design/LoggedIn.hs index 6bfa034..35a30a6 100644 --- a/src/server/Design/LoggedIn.hs +++ b/src/server/Design/LoggedIn.hs @@ -6,10 +6,6 @@ module Design.LoggedIn import Clay -import Design.Color as C -import Design.Helper -import Design.Constants - import Design.LoggedIn.Add import Design.LoggedIn.Expandables import Design.LoggedIn.Table diff --git a/src/server/Design/LoggedIn/Add.hs b/src/server/Design/LoggedIn/Add.hs index 6d4de69..579cead 100644 --- a/src/server/Design/LoggedIn/Add.hs +++ b/src/server/Design/LoggedIn/Add.hs @@ -15,7 +15,7 @@ import Design.Constants addDesign :: Css addDesign = - form ? do + form # ".addPayment" ? do centeredWithMargin marginBottom blockMarginBottom display flex @@ -28,7 +28,7 @@ addDesign = label ? do fontWeight bold display inlineBlock - width (px 40) + width (px 50) textAlign (alignSide sideCenter) backgroundColor C.darkGrey color C.white diff --git a/src/server/Design/LoggedIn/Expandables.hs b/src/server/Design/LoggedIn/Expandables.hs index 3807da4..66a9b06 100644 --- a/src/server/Design/LoggedIn/Expandables.hs +++ b/src/server/Design/LoggedIn/Expandables.hs @@ -4,6 +4,8 @@ module Design.LoggedIn.Expandables ( expandablesDesign ) where +import Data.Monoid ((<>)) + import Clay import Design.Color as C @@ -31,7 +33,30 @@ expandablesDesign = ".income" ? do backgroundColor C.lightGrey - lineHeight rowHeight padding (px 0) (px 20) (px 0) (px 20) + position relative + lineHeight rowHeight + + 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) + + ".undoIncomeEdition" ? + defaultButton C.blue C.white (px inputHeight) + + ".error" ? do + color C.redError + lineHeight (px 30) ".detail" |> ".header" ? borderRadius radius radius 0 0 diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index 9f16f6b..bd2b567 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -45,6 +45,8 @@ data Key = | CategoryRequired | CostRequired | CostMustBeNonNullNumber + | IncomeRequired + | IncomeMustBeNonNullNumber -- Payments @@ -60,5 +62,9 @@ data Key = | Income | NoIncome + | Edit + | Validate + | Undo + | NewIncome deriving (Enum, Bounded, Show) diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index 8c27a2d..8c6a233 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -193,6 +193,16 @@ m l CostMustBeNonNullNumber = English -> "The cost must be a non-null integer." French -> "Le coût doit être un entier non nul." +m l IncomeRequired = + case l of + English -> "Type an income." + French -> "Entre un revenu." + +m l IncomeMustBeNonNullNumber = + case l of + English -> "The income must be a non-null integer." + French -> "Le revenu doit être un entier non nul." + -- Payments m l Add = @@ -235,6 +245,8 @@ m l PluralMonthlyCount = French -> "{1} paiements mensuels comptabilisant {2}" ] +-- Income + m l Income = T.concat [ case l of @@ -246,3 +258,23 @@ m l NoIncome = case l of English -> "Income not given" French -> "Revenu non renseigné" + +m l Edit = + case l of + English -> "Edit" + French -> "Éditer" + +m l Validate = + case l of + English -> "Validate" + French -> "Valider" + +m l Undo = + case l of + English -> "Undo" + French -> "Annuler" + +m l NewIncome = + case l of + English -> "New income" + French -> "Nouveau revenu" -- cgit v1.2.3