From edca79a7e2bfed1a08de780cc6ab7eac430ef950 Mon Sep 17 00:00:00 2001 From: Joris Date: Tue, 5 Apr 2016 13:39:48 +0200 Subject: Add a statistics empty page --- src/client/elm/LoggedIn/Action.elm | 4 +- src/client/elm/LoggedIn/Income/Action.elm | 9 +++ src/client/elm/LoggedIn/Income/Model.elm | 46 +++++++++++++++ src/client/elm/LoggedIn/Income/Update.elm | 25 ++++++++ src/client/elm/LoggedIn/Income/View.elm | 95 +++++++++++++++++++++++++++++++ src/client/elm/LoggedIn/Model.elm | 6 +- src/client/elm/LoggedIn/Stat/View.elm | 10 ++++ src/client/elm/LoggedIn/Update.elm | 14 ++--- 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 | 95 ------------------------------- src/client/elm/LoggedIn/View.elm | 6 +- src/client/elm/Route.elm | 9 ++- src/client/elm/View/Header.elm | 53 +++++++++-------- src/server/Design/Header.hs | 30 +++++----- src/server/Model/Message/Key.hs | 6 +- src/server/Model/Message/Translations.hs | 19 +++++-- 18 files changed, 267 insertions(+), 240 deletions(-) create mode 100644 src/client/elm/LoggedIn/Income/Action.elm create mode 100644 src/client/elm/LoggedIn/Income/Model.elm create mode 100644 src/client/elm/LoggedIn/Income/Update.elm create mode 100644 src/client/elm/LoggedIn/Income/View.elm create mode 100644 src/client/elm/LoggedIn/Stat/View.elm delete mode 100644 src/client/elm/LoggedIn/User/Action.elm delete mode 100644 src/client/elm/LoggedIn/User/Model.elm delete mode 100644 src/client/elm/LoggedIn/User/Update.elm delete mode 100644 src/client/elm/LoggedIn/User/View.elm diff --git a/src/client/elm/LoggedIn/Action.elm b/src/client/elm/LoggedIn/Action.elm index 719e534..b33ab09 100644 --- a/src/client/elm/LoggedIn/Action.elm +++ b/src/client/elm/LoggedIn/Action.elm @@ -8,12 +8,12 @@ import Model.Payment exposing (Payment, PaymentId, Frequency) import Model.Income exposing (IncomeId) import LoggedIn.Home.Action as HomeAction -import LoggedIn.User.Action as UserAction +import LoggedIn.Income.Action as IncomeAction type Action = NoOp | HomeAction HomeAction.Action - | UserAction UserAction.Action + | IncomeAction IncomeAction.Action | AddPayment String String Frequency | ValidateAddPayment PaymentId String Int Frequency diff --git a/src/client/elm/LoggedIn/Income/Action.elm b/src/client/elm/LoggedIn/Income/Action.elm new file mode 100644 index 0000000..68b343a --- /dev/null +++ b/src/client/elm/LoggedIn/Income/Action.elm @@ -0,0 +1,9 @@ +module LoggedIn.Income.Action + ( Action(..) + ) where + +import Form exposing (Form) + +type Action = + NoOp + | AddIncomeAction Form.Action diff --git a/src/client/elm/LoggedIn/Income/Model.elm b/src/client/elm/LoggedIn/Income/Model.elm new file mode 100644 index 0000000..fdfb964 --- /dev/null +++ b/src/client/elm/LoggedIn/Income/Model.elm @@ -0,0 +1,46 @@ +module LoggedIn.Income.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/Income/Update.elm b/src/client/elm/LoggedIn/Income/Update.elm new file mode 100644 index 0000000..4e673fa --- /dev/null +++ b/src/client/elm/LoggedIn/Income/Update.elm @@ -0,0 +1,25 @@ +module LoggedIn.Income.Update + ( update + ) where + +import Effects exposing (Effects) +import Form exposing (Form) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Income.Model as IncomeModel +import LoggedIn.Income.Action as IncomeAction + +update : LoggedData -> IncomeAction.Action -> IncomeModel.Model -> (IncomeModel.Model, Effects IncomeAction.Action) +update loggedData action model = + case action of + + IncomeAction.NoOp -> + ( model + , Effects.none + ) + + IncomeAction.AddIncomeAction formAction -> + ( { model | addIncome = Form.update formAction model.addIncome } + , Effects.none + ) diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm new file mode 100644 index 0000000..010b503 --- /dev/null +++ b/src/client/elm/LoggedIn/Income/View.elm @@ -0,0 +1,95 @@ +module LoggedIn.Income.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.Income.Model as IncomeModel + +import Mailbox + +import Action +import LoggedIn.Action as LoggedInAction +import LoggedIn.Income.Action as IncomeAction + +import LoggedIn.View.Date exposing (renderShortDate) +import LoggedIn.View.Price exposing (price) + +import Utils.Maybe exposing (isJust) + +view : LoggedData -> IncomeModel.Model -> Html +view loggedData incomeModel = + div + [] + [ h1 [] [ text <| getMessage "AddIncome" loggedData.translations ] + , addIncomeView loggedData incomeModel.addIncome + , h1 [] [ text <| getMessage "MonthlyNetIncomes" loggedData.translations ] + , incomesView loggedData + ] + +addIncomeView : LoggedData -> Form () IncomeModel.AddIncome -> Html +addIncomeView loggedData addIncome = + let + formAddress = Signal.forwardTo Mailbox.address (Action.UpdateLoggedIn << LoggedInAction.IncomeAction << IncomeAction.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/Model.elm b/src/client/elm/LoggedIn/Model.elm index b1639ff..8309528 100644 --- a/src/client/elm/LoggedIn/Model.elm +++ b/src/client/elm/LoggedIn/Model.elm @@ -11,11 +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 +import LoggedIn.Income.Model as IncomeModel type alias Model = { home : HomeModel.Model - , user : UserModel.Model + , income : IncomeModel.Model , users : Users , me : UserId , payments : Payments @@ -25,7 +25,7 @@ type alias Model = init : Init -> Model init initData = { home = HomeModel.init - , user = UserModel.init + , income = IncomeModel.init , users = initData.users , me = initData.me , payments = initData.payments diff --git a/src/client/elm/LoggedIn/Stat/View.elm b/src/client/elm/LoggedIn/Stat/View.elm new file mode 100644 index 0000000..e5d1c08 --- /dev/null +++ b/src/client/elm/LoggedIn/Stat/View.elm @@ -0,0 +1,10 @@ +module LoggedIn.Stat.View + ( view + ) where + +import Html exposing (..) + +import LoggedData exposing (LoggedData) + +view : LoggedData -> Html +view loggedData = text "Stats" diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm index 4598b27..8330310 100644 --- a/src/client/elm/LoggedIn/Update.elm +++ b/src/client/elm/LoggedIn/Update.elm @@ -23,8 +23,8 @@ import LoggedIn.Model as LoggedInModel import LoggedIn.Home.Action as HomeAction import LoggedIn.Home.Update as HomeUpdate -import LoggedIn.User.Action as UserAction -import LoggedIn.User.Update as UserUpdate +import LoggedIn.Income.Action as IncomeAction +import LoggedIn.Income.Update as IncomeUpdate import LoggedIn.Home.AddPayment.Action as AddPaymentAction import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate @@ -47,11 +47,11 @@ 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.IncomeAction incomeAction -> + case IncomeUpdate.update loggedData incomeAction loggedIn.income of + (income, effects) -> + ( { loggedIn | income = income } + , Effects.map LoggedInAction.IncomeAction effects ) LoggedInAction.AddPayment name cost frequency -> diff --git a/src/client/elm/LoggedIn/User/Action.elm b/src/client/elm/LoggedIn/User/Action.elm deleted file mode 100644 index c5f8d47..0000000 --- a/src/client/elm/LoggedIn/User/Action.elm +++ /dev/null @@ -1,9 +0,0 @@ -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 deleted file mode 100644 index 4f96a80..0000000 --- a/src/client/elm/LoggedIn/User/Model.elm +++ /dev/null @@ -1,46 +0,0 @@ -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 deleted file mode 100644 index f44fee4..0000000 --- a/src/client/elm/LoggedIn/User/Update.elm +++ /dev/null @@ -1,25 +0,0 @@ -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 deleted file mode 100644 index 74e2ae2..0000000 --- a/src/client/elm/LoggedIn/User/View.elm +++ /dev/null @@ -1,95 +0,0 @@ -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 -> UserModel.Model -> Html -view loggedData userModel = - div - [] - [ 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 f9620cc..b1ec4d3 100644 --- a/src/client/elm/LoggedIn/View.elm +++ b/src/client/elm/LoggedIn/View.elm @@ -14,7 +14,8 @@ import LoggedData import LoggedIn.Model as LoggedInModel import LoggedIn.Home.View as HomeView -import LoggedIn.User.View as UserView +import LoggedIn.Income.View as UserView +import LoggedIn.Stat.View as StatView view : Model -> LoggedInModel.Model -> Html view model loggedIn = @@ -22,4 +23,5 @@ view model loggedIn = in case TransitRouter.getRoute model of Empty -> text "" Home -> HomeView.view loggedData loggedIn.home - User -> UserView.view loggedData loggedIn.user + Income -> UserView.view loggedData loggedIn.income + Stat -> StatView.view loggedData diff --git a/src/client/elm/Route.elm b/src/client/elm/Route.elm index 8f8518f..0ed4203 100644 --- a/src/client/elm/Route.elm +++ b/src/client/elm/Route.elm @@ -11,13 +11,15 @@ import RouteParser exposing (..) type Route = Empty | Home - | User + | Income + | Stat matchers : List (Matcher Route) matchers = [ static Empty "" , static Home "/" - , static User "/user" + , static Income "/income" + , static Stat "/statistics" ] toPath : Route -> String @@ -25,4 +27,5 @@ toPath route = case route of Empty -> "" Home -> "/" - User -> "/user" + Income -> "/income" + Stat -> "/statistics" diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm index fb0e880..7a6fefc 100644 --- a/src/client/elm/View/Header.elm +++ b/src/client/elm/View/Header.elm @@ -21,28 +21,31 @@ import View.Click exposing (clickTo) renderHeader : Address Action -> Model -> Html renderHeader address model = - header - [] - [ a - ( [ class "title" ] ++ clickTo Home) - [ text (getMessage "SharedCost" model.translations) ] - , case model.view of - LoggedInView { me, users } -> - div - [ class "signedPanel" ] - [ a - ( [ class "user" ] ++ clickTo User) - [ Dict.get me users - |> Maybe.map .name - |> Maybe.withDefault "" - |> text - ] - , button - [ class "icon" - , onClick address SignOut - ] - [ renderIcon "power-off" ] - ] - _ -> - text "" - ] + let item route name additionalClasses = + a + ([ class ("item " ++ additionalClasses) ] ++ clickTo route) + [ text (getMessage name model.translations) ] + in + header + [] + ( [item Home "SharedCost" "title"] ++ + case model.view of + LoggedInView { me, users } -> + [ item Income "Income" "" + , item Stat "Statistics" "" + , button + [ class "signOut item" + , onClick address SignOut + ] + [ renderIcon "power-off" ] + , div + [ class "name" ] + [ Dict.get me users + |> Maybe.map .name + |> Maybe.withDefault "" + |> text + ] + ] + _ -> + [] + ) diff --git a/src/server/Design/Header.hs b/src/server/Design/Header.hs index c4f9332..3b4f35c 100644 --- a/src/server/Design/Header.hs +++ b/src/server/Design/Header.hs @@ -22,32 +22,30 @@ headerDesign = height headerHeight marginBottom blockMarginBottom position relative + backgroundColor C.red + color C.white - (".title" <> ".user" <> ".icon") ? do - color C.white - backgroundColor C.red + ".item" ? do + float floatLeft + paddingLeft headerPadding + paddingRight headerPadding hover & backgroundColor darkenedRed focus & backgroundColor darkenedRed ".title" ? do - display block - width (pct 100) height (pct 100) fontSize (px 35) textAlign (alignSide sideLeft) paddingLeft headerPadding paddingRight headerPadding - ".signedPanel" ? do - float floatRight - height (pct 100) - display flex - position absolute - top (px 0) - right (px 0) + (".name" <> ".signOut") ? float floatRight - ".user" <> ".icon" ? do - paddingLeft headerPadding - paddingRight headerPadding + ".name" ? do + paddingLeft headerPadding + paddingRight headerPadding - ".icon" ? fontSize iconFontSize + ".signOut" ? do + height (pct 100) + fontSize iconFontSize + color C.white diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index 9d1c053..83d0467 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -63,11 +63,15 @@ data Key = | SingularMonthlyCount | PluralMonthlyCount + -- Statistics + + | Statistics + -- Income | AddIncome - | Incomes | Income + | MonthlyNetIncomes | IncomeNotDeleted -- Http error diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index 9db4a76..8c1ba08 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -244,6 +244,13 @@ m l PluralMonthlyCount = French -> "{1} paiements mensuels comptabilisant {2}" ] +-- Statistics + +m l Statistics = + case l of + English -> "Statistics" + French -> "Statistiques" + -- Income m l AddIncome = @@ -251,15 +258,15 @@ m l AddIncome = English -> "Add a monthly net income" French -> "Ajouter un revenu mensuel net" -m l Incomes = +m l Income = case l of - English -> "Monthly net incomes" - French -> "Revenus mensuels nets" + English -> "Income" + French -> "Revenu" -m l Income = +m l MonthlyNetIncomes = case l of - English -> "Monthly net income: {1}" - French -> "Revenu mensuel net : {1}" + English -> "Monthly net incomes" + French -> "Revenus mensuels nets" m l IncomeNotDeleted = case l of -- cgit v1.2.3