From a48e79e2f7c1ab1ffb52b86ef9e900c75c5d023b Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 12 Sep 2015 23:57:16 +0200 Subject: Adding UI income read-only --- src/client/Main.elm | 6 ++- src/client/Model/View/LoggedIn/Account.elm | 19 ++++++++ src/client/Model/View/LoggedInView.elm | 9 ++-- src/client/Update.elm | 6 +-- src/client/Update/LoggedIn.elm | 9 ++-- src/client/Update/LoggedIn/Account.elm | 20 ++++++++ src/client/View/Expand.elm | 25 ++++++++++ src/client/View/LoggedIn.elm | 4 +- src/client/View/LoggedIn/Account.elm | 74 +++++++++++++++++++++++++++++ src/client/View/LoggedIn/Add.elm | 24 ++++++++-- src/client/View/LoggedIn/ExceedingPayer.elm | 35 -------------- src/client/View/LoggedIn/Monthly.elm | 54 ++++++++++++--------- src/client/View/LoggedIn/Paging.elm | 5 +- src/client/View/LoggedIn/Table.elm | 14 ++++-- src/client/View/Price.elm | 38 +++++++++++++++ 15 files changed, 264 insertions(+), 78 deletions(-) create mode 100644 src/client/Model/View/LoggedIn/Account.elm create mode 100644 src/client/Update/LoggedIn/Account.elm create mode 100644 src/client/View/Expand.elm create mode 100644 src/client/View/LoggedIn/Account.elm delete mode 100644 src/client/View/LoggedIn/ExceedingPayer.elm create mode 100644 src/client/View/Price.elm (limited to 'src/client') diff --git a/src/client/Main.elm b/src/client/Main.elm index 0b579d7..621fb97 100644 --- a/src/client/Main.elm +++ b/src/client/Main.elm @@ -66,7 +66,8 @@ goLoggedInView = Task.andThen getPayments <| \payments -> Task.andThen getPaymentsCount <| \paymentsCount -> Task.andThen getPayers <| \payers -> - Signal.send actions.address (GoLoggedInView users me monthlyPayments payments paymentsCount payers) + Task.andThen getIncome <| \income -> + Signal.send actions.address (GoLoggedInView users me monthlyPayments payments paymentsCount payers income) getUsers : Task Http.Error Users getUsers = Http.get usersDecoder "/users" @@ -86,6 +87,9 @@ getPaymentsCount = Http.get ("number" := Json.int) "/payments/count" getPayers : Task Http.Error Payers getPayers = Http.get payersDecoder "/payments/total" +getIncome : Task Http.Error (Maybe Int) +getIncome = Http.get (Json.maybe ("income" := Json.int)) "/income" + --------------------------------------- port serverCommunicationsPort : Signal (Task Http.RawError ()) diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/Model/View/LoggedIn/Account.elm new file mode 100644 index 0000000..410345c --- /dev/null +++ b/src/client/Model/View/LoggedIn/Account.elm @@ -0,0 +1,19 @@ +module Model.View.LoggedIn.Account + ( Account + , initAccount + ) where + +import Model.Payers exposing (..) + +type alias Account = + { payers : Payers + , income : Maybe Int + , visibleDetail : Bool + } + +initAccount : Payers -> Maybe Int -> Account +initAccount payers income = + { payers = payers + , income = income + , visibleDetail = False + } diff --git a/src/client/Model/View/LoggedInView.elm b/src/client/Model/View/LoggedInView.elm index cf7f552..12a7294 100644 --- a/src/client/Model/View/LoggedInView.elm +++ b/src/client/Model/View/LoggedInView.elm @@ -9,28 +9,29 @@ import Model.Payers exposing (Payers) import Model.View.LoggedIn.Add exposing (..) import Model.View.LoggedIn.Edition exposing (..) import Model.View.LoggedIn.Monthly exposing (..) +import Model.View.LoggedIn.Account exposing (..) type alias LoggedInView = { users : Users , me : UserId , add : AddPayment , monthly : Monthly + , account : Account , payments : Payments , paymentsCount : Int - , payers : Payers , paymentEdition : Maybe Edition , currentPage : Int } -initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> LoggedInView -initLoggedInView users me monthlyPayments payments paymentsCount payers = +initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> Maybe Int -> LoggedInView +initLoggedInView users me monthlyPayments payments paymentsCount payers income = { users = users , me = me , add = initAddPayment Punctual , monthly = initMonthly monthlyPayments + , account = initAccount payers income , payments = payments , paymentsCount = paymentsCount - , payers = payers , paymentEdition = Nothing , currentPage = 1 } diff --git a/src/client/Update.elm b/src/client/Update.elm index 23e5c84..4389140 100644 --- a/src/client/Update.elm +++ b/src/client/Update.elm @@ -23,7 +23,7 @@ type Action = | GoSignInView | SignInError String | UpdateSignIn SignInAction - | GoLoggedInView Users UserId Payments Payments Int Payers + | GoLoggedInView Users UserId Payments Payments Int Payers (Maybe Int) | UpdateLoggedIn LoggedAction actions : Signal.Mailbox Action @@ -38,8 +38,8 @@ updateModel action model = { model | currentTime <- time } GoSignInView -> { model | view <- V.SignInView initSignInView } - GoLoggedInView users me monthlyPayments payments paymentsCount payers -> - { model | view <- V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers) } + GoLoggedInView users me monthlyPayments payments paymentsCount payers mbIncome -> + { model | view <- V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers mbIncome) } SignInError msg -> let signInView = { initSignInView | result <- Just (Err msg) } in { model | view <- V.SignInView signInView } diff --git a/src/client/Update/LoggedIn.elm b/src/client/Update/LoggedIn.elm index 03eb137..07f3426 100644 --- a/src/client/Update/LoggedIn.elm +++ b/src/client/Update/LoggedIn.elm @@ -9,12 +9,12 @@ import Dict import Model exposing (Model) import Model.User exposing (UserId) import Model.Payment exposing (..) -import Model.Payers exposing (..) import Model.View.LoggedInView exposing (..) import Model.View.LoggedIn.Add exposing (..) import Update.LoggedIn.Add exposing (..) import Update.LoggedIn.Monthly as UM +import Update.LoggedIn.Account as UA type LoggedAction = UpdateAdd AddPaymentAction @@ -25,6 +25,7 @@ type LoggedAction = | DeletePayment UserId Int Payments | UpdatePage Int Payments | UpdateMonthly UM.MonthlyAction + | UpdateAccount UA.AccountAction updateLoggedIn : Model -> LoggedAction -> LoggedInView -> LoggedInView updateLoggedIn model action loggedInView = @@ -38,7 +39,7 @@ updateLoggedIn model action loggedInView = | payments <- payments , currentPage <- 1 , add <- initAddPayment Punctual - , payers <- updatePayers loggedInView.payers userId cost + , account <- UA.updateAccount (UA.UpdatePayer userId cost) loggedInView.account , paymentsCount <- loggedInView.paymentsCount + 1 } AddMonthlyPayment id name cost -> @@ -53,7 +54,7 @@ updateLoggedIn model action loggedInView = DeletePayment userId cost payments -> { loggedInView | payments <- payments - , payers <- updatePayers loggedInView.payers userId -cost + , account <- UA.updateAccount (UA.UpdatePayer userId -cost) loggedInView.account , paymentsCount <- loggedInView.paymentsCount - 1 } UpdatePage page payments -> @@ -63,3 +64,5 @@ updateLoggedIn model action loggedInView = } UpdateMonthly monthlyAction -> { loggedInView | monthly <- UM.updateMonthly monthlyAction loggedInView.monthly } + UpdateAccount accountAction -> + { loggedInView | account <- UA.updateAccount accountAction loggedInView.account } diff --git a/src/client/Update/LoggedIn/Account.elm b/src/client/Update/LoggedIn/Account.elm new file mode 100644 index 0000000..ab07c2e --- /dev/null +++ b/src/client/Update/LoggedIn/Account.elm @@ -0,0 +1,20 @@ +module Update.LoggedIn.Account + ( AccountAction(..) + , updateAccount + ) where + +import Model.User exposing (UserId) +import Model.Payers exposing (..) +import Model.View.LoggedIn.Account exposing (..) + +type AccountAction = + ToggleDetail + | UpdatePayer UserId Int + +updateAccount : AccountAction -> Account -> Account +updateAccount action account = + case action of + ToggleDetail -> + { account | visibleDetail <- not account.visibleDetail } + UpdatePayer userId cost -> + { account | payers <- updatePayers account.payers userId cost } diff --git a/src/client/View/Expand.elm b/src/client/View/Expand.elm new file mode 100644 index 0000000..53b4fe5 --- /dev/null +++ b/src/client/View/Expand.elm @@ -0,0 +1,25 @@ +module View.Expand + ( expand + , ExpandType(..) + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) + +import View.Icon exposing (renderIcon) + +type ExpandType = ExpandUp | ExpandDown + +expand : ExpandType -> Bool -> Html +expand expandType isExpanded = + div + [ class "expand" ] + [ renderIcon (chevronIcon expandType isExpanded) ] + +chevronIcon : ExpandType -> Bool -> String +chevronIcon expandType isExpanded = + case (expandType, isExpanded) of + (ExpandUp, True) -> "chevron-down" + (ExpandUp, False) -> "chevron-up" + (ExpandDown, True) -> "chevron-up" + (ExpandDown, False) -> "chevron-down" diff --git a/src/client/View/LoggedIn.elm b/src/client/View/LoggedIn.elm index e4577a2..20c99d3 100644 --- a/src/client/View/LoggedIn.elm +++ b/src/client/View/LoggedIn.elm @@ -9,9 +9,9 @@ import Model exposing (Model) import Model.Payment exposing (Payments) import Model.View.LoggedInView exposing (LoggedInView) -import View.LoggedIn.ExceedingPayer exposing (exceedingPayers) import View.LoggedIn.Add exposing (addPayment) import View.LoggedIn.Monthly exposing (monthlyPayments) +import View.LoggedIn.Account exposing (account) import View.LoggedIn.Table exposing (paymentsTable) import View.LoggedIn.Paging exposing (paymentsPaging) @@ -23,7 +23,7 @@ renderLoggedIn model loggedInView = , div [ class "expandables" ] [ monthlyPayments model loggedInView - , exceedingPayers model loggedInView + , account model loggedInView ] , paymentsTable model loggedInView , paymentsPaging loggedInView diff --git a/src/client/View/LoggedIn/Account.elm b/src/client/View/LoggedIn/Account.elm new file mode 100644 index 0000000..e2b8e7e --- /dev/null +++ b/src/client/View/LoggedIn/Account.elm @@ -0,0 +1,74 @@ +module View.LoggedIn.Account + ( account + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import List + +import Update exposing (..) +import Update.LoggedIn exposing (..) +import Update.LoggedIn.Account exposing (..) + +import Model exposing (Model) +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 View.Expand exposing (..) +import View.Price exposing (price) + +account : Model -> LoggedInView -> Html +account model loggedInView = + let account = loggedInView.account + in div + [ classList + [ ("account", True) + , ("detail", account.visibleDetail) + ] + ] + [ exceedingPayers model loggedInView + , if account.visibleDetail + then income model account + else text "" + ] + +exceedingPayers : Model -> LoggedInView -> Html +exceedingPayers model loggedInView = + button + [ class "exceedingPayers" + , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleDetail) + ] + ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers loggedInView.account.payers)) + ++ [ expand ExpandDown loggedInView.account.visibleDetail ] + ) + +exceedingPayer : Model -> LoggedInView -> ExceedingPayer -> Html +exceedingPayer model loggedInView payer = + div + [ class "exceedingPayer" ] + [ span + [ class "userName" ] + [ payer.userId + |> getUserName loggedInView.users + |> Maybe.withDefault "−" + |> text + ] + , span + [ class "amount" ] + [ text ("+ " ++ (price model payer.amount)) ] + ] + +income : Model -> Account -> Html +income 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) ] + ) diff --git a/src/client/View/LoggedIn/Add.elm b/src/client/View/LoggedIn/Add.elm index acdda2d..bae3853 100644 --- a/src/client/View/LoggedIn/Add.elm +++ b/src/client/View/LoggedIn/Add.elm @@ -50,7 +50,11 @@ addPayment model loggedInView = addPaymentName : AddPayment -> Html addPaymentName addPayment = div - [ class ("name " ++ (if isJust addPayment.nameError then "error" else "")) ] + [ classList + [ ("name", True) + , ("error", isJust addPayment.nameError) + ] + ] [ input [ id "nameInput" , value addPayment.name @@ -71,7 +75,11 @@ addPaymentName addPayment = addPaymentCost : Model -> AddPayment -> Html addPaymentCost model addPayment = div - [ class ("cost " ++ (if isJust addPayment.costError then "error" else "")) ] + [ classList + [ ("cost", True) + , ("error", isJust addPayment.costError) + ] + ] [ input [ id "costInput" , value addPayment.cost @@ -97,9 +105,17 @@ paymentFrequency model addPayment = , onClick actions.address (UpdateLoggedIn << UpdateAdd <| ToggleFrequency) ] [ div - [ class ("punctual" ++ if addPayment.frequency == Punctual then " selected" else "") ] + [ classList + [ ("punctual", True) + , ("selected", addPayment.frequency == Punctual) + ] + ] [ text (getMessage "Punctual" model.translations) ] , div - [ class ("monthly" ++ if addPayment.frequency == Monthly then " selected" else "") ] + [ classList + [ ("monthly", True) + , ("selected", addPayment.frequency == Monthly) + ] + ] [ text (getMessage "Monthly" model.translations) ] ] diff --git a/src/client/View/LoggedIn/ExceedingPayer.elm b/src/client/View/LoggedIn/ExceedingPayer.elm deleted file mode 100644 index ea848b6..0000000 --- a/src/client/View/LoggedIn/ExceedingPayer.elm +++ /dev/null @@ -1,35 +0,0 @@ -module View.LoggedIn.ExceedingPayer - ( exceedingPayers - ) where - -import Html exposing (..) -import Html.Attributes exposing (..) -import List - -import Model exposing (Model) -import Model.User exposing (getUserName) -import Model.Payers exposing (..) -import Model.View.LoggedInView exposing (LoggedInView) -import Model.Translations exposing (getMessage) - -exceedingPayers : Model -> LoggedInView -> Html -exceedingPayers model loggedInView = - div - [ class "exceedingPayers" ] - (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers loggedInView.payers)) - -exceedingPayer : Model -> LoggedInView -> ExceedingPayer -> Html -exceedingPayer model loggedInView payer = - div - [ class "exceedingPayer" ] - [ span - [ class "userName" ] - [ payer.userId - |> getUserName loggedInView.users - |> Maybe.withDefault "−" - |> text - ] - , span - [ class "amount" ] - [ text ("+ " ++ (toString payer.amount) ++ " " ++ (getMessage "MoneySymbol" model.translations)) ] - ] diff --git a/src/client/View/LoggedIn/Monthly.elm b/src/client/View/LoggedIn/Monthly.elm index 17c354a..518724b 100644 --- a/src/client/View/LoggedIn/Monthly.elm +++ b/src/client/View/LoggedIn/Monthly.elm @@ -21,37 +21,40 @@ import Model.Translations exposing (getMessage, getParamMessage) import ServerCommunication as SC exposing (serverCommunications) import View.Icon exposing (renderIcon) +import View.Expand exposing (..) +import View.Price exposing (price) monthlyPayments : Model -> LoggedInView -> Html monthlyPayments model loggedInView = let monthly = loggedInView.monthly - in if List.isEmpty monthly.payments - then - text "" - else - div - [ class ("monthlyPayments" ++ if monthly.visibleDetail then " detail" else "") ] - [ monthlyCount model monthly - , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text "" + in div + [ classList + [ ("monthlyPayments", True) + , ("detail", monthly.visibleDetail) ] + ] + [ monthlyCount model monthly + , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text "" + ] monthlyCount : Model -> Monthly -> Html monthlyCount model monthly = let count = List.length monthly.payments total = List.sum << List.map .cost <| monthly.payments key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount" - in button - [ class "count" - , onClick actions.address (UpdateLoggedIn << UpdateMonthly <| ToggleDetail) - ] - [ text (getParamMessage [toString count, toString total] key model.translations) - , div - [ class "expand" ] - [ if monthly.visibleDetail - then renderIcon "chevron-up" - else renderIcon "chevron-down" + in if count == 0 + then + div + [ class "count" ] + [ text (getMessage "NoMonthlyPayment" model.translations) ] + else + button + [ class "count" + , onClick actions.address (UpdateLoggedIn << UpdateMonthly <| ToggleDetail) + ] + [ text (getParamMessage [toString count, price model total] key model.translations) + , expand ExpandDown monthly.visibleDetail ] - ] paymentsTable : Model -> LoggedInView -> Monthly -> Html paymentsTable model loggedInView monthly = @@ -65,13 +68,20 @@ paymentsTable model loggedInView monthly = paymentLine : Model -> LoggedInView -> Payment -> Html paymentLine model loggedInView payment = a - [ class ("row" ++ (if loggedInView.paymentEdition == Just payment.id then " edition" else "")) + [ classList + [ ("row", True) + , ("edition", loggedInView.paymentEdition == Just payment.id) + ] , onClick actions.address (UpdateLoggedIn (ToggleEdit payment.id)) ] [ div [ class "cell category" ] [ text (payment.name) ] , div - [ class ("cell cost" ++ if payment.cost < 0 then " refund" else "") ] - [ text (toString payment.cost ++ " " ++ getMessage "MoneySymbol" model.translations) ] + [ classList + [ ("cell cost", True) + , ("refund", payment.cost < 0) + ] + ] + [ text (price model payment.cost) ] , div [ class "cell delete" , onClick serverCommunications.address (SC.DeleteMonthlyPayment payment.id) diff --git a/src/client/View/LoggedIn/Paging.elm b/src/client/View/LoggedIn/Paging.elm index 5d5f2db..93d7f1d 100644 --- a/src/client/View/LoggedIn/Paging.elm +++ b/src/client/View/LoggedIn/Paging.elm @@ -90,7 +90,10 @@ paymentsPage : LoggedInView -> Int -> Html paymentsPage loggedInView page = let onCurrentPage = page == loggedInView.currentPage in button - [ class ("page" ++ (if onCurrentPage then " current" else "")) + [ classList + [ ("page", True) + , ("current", onCurrentPage) + ] , onClick serverCommunications.address <| if onCurrentPage then SC.NoCommunication else SC.UpdatePage page ] diff --git a/src/client/View/LoggedIn/Table.elm b/src/client/View/LoggedIn/Table.elm index 0c65e50..d98cee6 100644 --- a/src/client/View/LoggedIn/Table.elm +++ b/src/client/View/LoggedIn/Table.elm @@ -25,6 +25,7 @@ import Update.LoggedIn exposing (..) import View.Icon exposing (renderIcon) import View.Date exposing (..) +import View.Price exposing (price) paymentsTable : Model -> LoggedInView -> Html paymentsTable model loggedInView = @@ -53,13 +54,20 @@ paymentLines model loggedInView = paymentLine : Model -> LoggedInView -> Payment -> Html paymentLine model loggedInView payment = a - [ class ("row" ++ (if loggedInView.paymentEdition == Just payment.id then " edition" else "")) + [ classList + [ ("row", True) + , ("edition", loggedInView.paymentEdition == Just payment.id) + ] , onClick actions.address (UpdateLoggedIn (ToggleEdit payment.id)) ] [ div [ class "cell category" ] [ text payment.name ] , div - [ class ("cell cost" ++ if payment.cost < 0 then " refund" else "") ] - [ text ((toString payment.cost) ++ " " ++ (getMessage "MoneySymbol" model.translations)) ] + [ classList + [ ("cell cost", True) + , ("refund", payment.cost < 0) + ] + ] + [ text (price model payment.cost) ] , div [ class "cell user" ] [ payment.userId diff --git a/src/client/View/Price.elm b/src/client/View/Price.elm new file mode 100644 index 0000000..cb8abd2 --- /dev/null +++ b/src/client/View/Price.elm @@ -0,0 +1,38 @@ +module View.Price + ( price + ) where + +import String exposing (..) + +import Model exposing (Model) +import Model.Translations exposing (getMessage) + +price : Model -> Int -> String +price model amount = + ( formatInt amount + ++ " " + ++ getMessage "MoneySymbol" model.translations + ) + +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) -- cgit v1.2.3