From 5c110716cfda6e616a795edd12f2012b132dca9f Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 2 Apr 2017 17:51:12 +0200 Subject: Add a chart on payments by month by categories --- src/client/LoggedIn/Model.elm | 28 +++++----- src/client/LoggedIn/Msg.elm | 9 ++-- src/client/LoggedIn/Stat/Model.elm | 34 ++++++++++++ src/client/LoggedIn/Stat/Msg.elm | 7 +++ src/client/LoggedIn/Stat/Update.elm | 24 +++++++++ src/client/LoggedIn/Stat/View.elm | 101 +++++++++++++++++++++--------------- src/client/LoggedIn/Update.elm | 73 ++++++++++++++------------ src/client/LoggedIn/View.elm | 4 +- 8 files changed, 184 insertions(+), 96 deletions(-) create mode 100644 src/client/LoggedIn/Stat/Model.elm create mode 100644 src/client/LoggedIn/Stat/Msg.elm create mode 100644 src/client/LoggedIn/Stat/Update.elm (limited to 'src/client/LoggedIn') diff --git a/src/client/LoggedIn/Model.elm b/src/client/LoggedIn/Model.elm index 6c858a6..f4fad94 100644 --- a/src/client/LoggedIn/Model.elm +++ b/src/client/LoggedIn/Model.elm @@ -5,17 +5,18 @@ module LoggedIn.Model exposing import Time exposing (Time) +import LoggedIn.Home.Model as Home +import LoggedIn.Stat.Model as Stat +import Model.Category exposing (Categories) +import Model.Income exposing (Incomes) import Model.Init exposing (..) import Model.Payment exposing (Payments) -import Model.User exposing (Users, UserId) -import Model.Income exposing (Incomes) -import Model.Category exposing (Categories) import Model.PaymentCategory exposing (PaymentCategories) - -import LoggedIn.Home.Model as Home +import Model.User exposing (Users, UserId) type alias Model = { home : Home.Model + , stat : Stat.Model , users : Users , me : UserId , payments : Payments @@ -24,13 +25,14 @@ type alias Model = , paymentCategories : PaymentCategories } -init : Init -> Model -init initData = +init : Time -> Init -> Model +init time { users, me, payments, incomes, categories, paymentCategories } = { home = Home.init - , users = initData.users - , me = initData.me - , payments = initData.payments - , incomes = initData.incomes - , categories = initData.categories - , paymentCategories = initData.paymentCategories + , stat = Stat.init time paymentCategories payments + , users = users + , me = me + , payments = payments + , incomes = incomes + , categories = categories + , paymentCategories = paymentCategories } diff --git a/src/client/LoggedIn/Msg.elm b/src/client/LoggedIn/Msg.elm index d00e2cb..d9b3bce 100644 --- a/src/client/LoggedIn/Msg.elm +++ b/src/client/LoggedIn/Msg.elm @@ -4,16 +4,17 @@ module LoggedIn.Msg exposing import Date exposing (Date) -import Model.Payment exposing (PaymentId) +import LoggedIn.Home.Msg as Home +import LoggedIn.Stat.Msg as Stat +import Model.Category exposing (CategoryId) import Model.Frequency exposing (Frequency) import Model.Income exposing (IncomeId) -import Model.Category exposing (CategoryId) - -import LoggedIn.Home.Msg as Home +import Model.Payment exposing (PaymentId) type Msg = NoOp | HomeMsg Home.Msg + | StatMsg Stat.Msg | ValidateCreatePayment PaymentId String Int Date CategoryId Frequency | ValidateEditPayment PaymentId String Int Date CategoryId Frequency | ValidateDeletePayment PaymentId diff --git a/src/client/LoggedIn/Stat/Model.elm b/src/client/LoggedIn/Stat/Model.elm new file mode 100644 index 0000000..bfc66f2 --- /dev/null +++ b/src/client/LoggedIn/Stat/Model.elm @@ -0,0 +1,34 @@ +module LoggedIn.Stat.Model exposing + ( Model + , init + , getPaymentsByMonthByCategory + ) + +import Date exposing (Month) +import List.Extra as List +import Time exposing (Time) + +import Model.Category exposing (CategoryId) +import Model.Conf exposing (Conf) +import Model.Payment as Payment exposing (Payments) +import Model.PaymentCategory as PaymentCategory exposing (PaymentCategories) + +type alias Model = + { paymentsByMonthByCategory : List ((Month, Int), List (CategoryId, Int)) + } + +init : Time -> PaymentCategories -> Payments -> Model +init currentTime paymentCategories payments = + { paymentsByMonthByCategory = getPaymentsByMonthByCategory currentTime paymentCategories payments + } + +getPaymentsByMonthByCategory : Time -> PaymentCategories -> Payments -> List ((Month, Int), List (CategoryId, Int)) +getPaymentsByMonthByCategory currentTime paymentCategories payments = + Payment.punctual payments + |> Payment.groupAndSortByMonth + |> List.map (\(m, payments) -> + ( m + , PaymentCategory.groupPaymentsByCategory paymentCategories payments + |> List.map (Tuple.mapSecond (List.sum << List.map .cost)) + ) + ) diff --git a/src/client/LoggedIn/Stat/Msg.elm b/src/client/LoggedIn/Stat/Msg.elm new file mode 100644 index 0000000..d517544 --- /dev/null +++ b/src/client/LoggedIn/Stat/Msg.elm @@ -0,0 +1,7 @@ +module LoggedIn.Stat.Msg exposing + ( Msg(..) + ) + +type Msg = + NoOp + | UpdateChart diff --git a/src/client/LoggedIn/Stat/Update.elm b/src/client/LoggedIn/Stat/Update.elm new file mode 100644 index 0000000..2415733 --- /dev/null +++ b/src/client/LoggedIn/Stat/Update.elm @@ -0,0 +1,24 @@ +module LoggedIn.Stat.Update exposing + ( update + ) + +import LoggedData exposing (LoggedData) +import LoggedIn.Stat.Model as Stat +import LoggedIn.Stat.Msg as Stat + +update : LoggedData -> Stat.Msg -> Stat.Model -> (Stat.Model, Cmd Stat.Msg) +update loggedData msg model = + case msg of + + Stat.NoOp -> + ( model + , Cmd.none + ) + + Stat.UpdateChart -> + let { currentTime, paymentCategories, payments } = loggedData + in ( { model + | paymentsByMonthByCategory = Stat.getPaymentsByMonthByCategory currentTime paymentCategories payments + } + , Cmd.none + ) diff --git a/src/client/LoggedIn/Stat/View.elm b/src/client/LoggedIn/Stat/View.elm index f57316a..e389c67 100644 --- a/src/client/LoggedIn/Stat/View.elm +++ b/src/client/LoggedIn/Stat/View.elm @@ -3,60 +3,75 @@ module LoggedIn.Stat.View exposing ) import Date exposing (Month) - +import Dict import Html exposing (..) import Html.Attributes exposing (..) +import List.Extra as List +import Time exposing (Time) +import Chart.Api as Chart import LoggedData exposing (LoggedData) - -import Msg exposing (Msg) - -import Model.Payment as Payment exposing (Payments) -import Model.Conf exposing (Conf) -import Model.Translations exposing (getMessage, getParamMessage) - +import LoggedIn.Stat.Model as Stat import LoggedIn.View.Format as Format +import Model.Category exposing (CategoryId, Categories) +import Model.Conf exposing (Conf) +import Model.Payment as Payment exposing (Payments) +import Model.PaymentCategory as PaymentCategory exposing (PaymentCategories) +import Model.Translations exposing (Translations, getMessage, getParamMessage) +import Msg exposing (Msg) +import Utils.List as List import View.Date as Date import View.Plural exposing (plural) -import Utils.List as List +view : LoggedData -> Stat.Model -> Html Msg +view loggedData { paymentsByMonthByCategory } = + div + [ class "stat withMargin" ] + [ renderChart loggedData paymentsByMonthByCategory ] -view : LoggedData -> Html Msg -view loggedData = - let paymentsByMonth = Payment.groupAndSortByMonth (Payment.punctual loggedData.payments) - monthPaymentMean = getMonthPaymentMean loggedData paymentsByMonth - in div - [ class "stat withMargin" ] - [ h1 [] [ text (getParamMessage [ Format.price loggedData.conf monthPaymentMean ] loggedData.translations "ByMonthsAndMean") ] - , ul - [] - ( List.map (monthDetail loggedData) paymentsByMonth) - ] +renderChart : LoggedData -> List ((Month, Int), List (CategoryId, Int)) -> Html msg +renderChart { currentTime, paymentCategories, categories, conf, translations } paymentsByMonthByCategory = + let monthPaymentMean = getMonthPaymentMean currentTime paymentsByMonthByCategory + title = getParamMessage [ Format.price conf monthPaymentMean ] translations "ByMonthsAndMean" + keys = + paymentsByMonthByCategory + |> List.map (\((month, year), _) -> Date.shortMonthAndYear month year translations) + series = + categories + |> Dict.toList + |> List.map (\(categoryId, category) -> + { values = + List.map + (\(_, paymentsByCategory) -> + paymentsByCategory + |> List.find (\(c, _) -> c == categoryId) + |> Maybe.map (toFloat << Tuple.second) + |> Maybe.withDefault 0 + ) + paymentsByMonthByCategory + , color = category.color + , label = category.name + } + ) + totalSerie = + { values = + List.transpose (List.map .values series) + |> List.map List.sum + , color = "black" + , label = getMessage translations "Total" + } + in Chart.from keys (series ++ [totalSerie]) + |> Chart.withSize { x = 2000, y = 900 } + |> Chart.withTitle title + |> Chart.withOrdinate 10 (Format.price conf << truncate) + |> Chart.toHtml -getMonthPaymentMean : LoggedData -> List ((Month, Int), Payments) -> Int -getMonthPaymentMean loggedData paymentsByMonth = - paymentsByMonth +getMonthPaymentMean : Time -> List ((Month, Int), List (CategoryId, Int)) -> Int +getMonthPaymentMean currentTime paymentsByMonthByCategory = + paymentsByMonthByCategory |> List.filter (\((month, year), _) -> - let currentDate = Date.fromTime loggedData.currentTime + let currentDate = Date.fromTime currentTime in not (Date.month currentDate == month && Date.year currentDate == year) ) - |> List.map (List.sum << List.map .cost << Tuple.second) + |> List.map (List.sum << List.map Tuple.second << Tuple.second) |> List.mean - -monthDetail : LoggedData -> ((Month, Int), Payments) -> Html Msg -monthDetail loggedData ((month, year), payments) = - li - [] - [ text (Date.monthView loggedData.translations month) - , text " " - , text (toString year) - , text " − " - , text (paymentsSum loggedData.conf payments) - ] - -paymentsSum : Conf -> Payments -> String -paymentsSum conf payments = - payments - |> List.map .cost - |> List.sum - |> Format.price conf diff --git a/src/client/LoggedIn/Update.elm b/src/client/LoggedIn/Update.elm index 753b1d3..a1d5f7d 100644 --- a/src/client/LoggedIn/Update.elm +++ b/src/client/LoggedIn/Update.elm @@ -2,55 +2,60 @@ module LoggedIn.Update exposing ( update ) +import Date exposing (Date) import Dict -import String -import Task - +import Form import Http exposing (Error(..)) -import Date exposing (Date) import Platform.Cmd exposing (Cmd) +import String +import Task -import Form - +import LoggedData +import LoggedIn.Home.Model as Home +import LoggedIn.Home.Msg as Home +import LoggedIn.Home.Update as Home +import LoggedIn.Model as LoggedInModel +import LoggedIn.Msg as LoggedIn +import LoggedIn.Stat.Model as Stat +import LoggedIn.Stat.Msg as Stat +import LoggedIn.Stat.Update as Stat import Model exposing (Model) -import Model.Payment as Payment exposing (Payment) +import Model.Category exposing (Category) import Model.Frequency exposing (Frequency(..)) import Model.Income as Income exposing (Income) -import Model.Category exposing (Category) +import Model.Payment as Payment exposing (Payment) import Model.PaymentCategory as PaymentCategory - import Server -import LoggedData - -import LoggedIn.Msg as LoggedInMsg -import LoggedIn.Model as LoggedInModel - -import LoggedIn.Home.Msg as Home -import LoggedIn.Home.Update as Home -import LoggedIn.Home.Model as Home import Utils.Cmd exposing ((:>)) -update : Model -> LoggedInMsg.Msg -> LoggedInModel.Model -> (LoggedInModel.Model, Cmd LoggedInMsg.Msg) +update : Model -> LoggedIn.Msg -> LoggedInModel.Model -> (LoggedInModel.Model, Cmd LoggedIn.Msg) update model msg loggedIn = - let loggedData = LoggedData.build model loggedIn + let loggedData = LoggedData.build model.currentTime model.translations model.conf loggedIn in case msg of - LoggedInMsg.NoOp -> + LoggedIn.NoOp -> ( loggedIn , Cmd.none ) - LoggedInMsg.HomeMsg homeMsg -> + LoggedIn.HomeMsg homeMsg -> case Home.update loggedData homeMsg loggedIn.home of (home, effects) -> ( { loggedIn | home = home } - , Cmd.map LoggedInMsg.HomeMsg effects + , Cmd.map LoggedIn.HomeMsg effects + ) + + LoggedIn.StatMsg statMsg -> + case Stat.update loggedData statMsg loggedIn.stat of + (stat, effects) -> + ( { loggedIn | stat = stat } + , Cmd.map LoggedIn.StatMsg effects ) - LoggedInMsg.ValidateCreatePayment paymentId name cost date category frequency -> - update model (LoggedInMsg.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial frequency))) loggedIn - :> update model (LoggedInMsg.HomeMsg <| Home.UpdatePage 1) + LoggedIn.ValidateCreatePayment paymentId name cost date category frequency -> + update model (LoggedIn.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial frequency))) loggedIn + :> update model (LoggedIn.HomeMsg <| Home.UpdatePage 1) :> (\loggedIn -> let newPayment = Payment paymentId name cost date loggedIn.me frequency in ( { loggedIn @@ -61,7 +66,7 @@ update model msg loggedIn = ) ) - LoggedInMsg.ValidateEditPayment paymentId name cost date category frequency -> + LoggedIn.ValidateEditPayment paymentId name cost date category frequency -> let updatedPayment = Payment paymentId name cost date loggedIn.me frequency mbOldPayment = Payment.find paymentId loggedIn.payments in ( { loggedIn @@ -76,7 +81,7 @@ update model msg loggedIn = , Cmd.none ) - LoggedInMsg.ValidateDeletePayment paymentId -> + LoggedIn.ValidateDeletePayment paymentId -> let payments = Payment.delete paymentId loggedIn.payments frequency = case Form.getOutput loggedIn.home.search of @@ -88,7 +93,7 @@ update model msg loggedIn = ) in if switchToPunctual then - update model (LoggedInMsg.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial Punctual))) loggedIn + update model (LoggedIn.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial Punctual))) loggedIn :> (\loggedIn -> ( { loggedIn | payments = payments } , Cmd.none @@ -99,34 +104,34 @@ update model msg loggedIn = , Cmd.none ) - LoggedInMsg.ValidateCreateIncome incomeId amount date -> + LoggedIn.ValidateCreateIncome incomeId amount date -> let newIncome = { userId = loggedIn.me, amount = amount, time = Date.toTime date } in ( { loggedIn | incomes = Dict.insert incomeId newIncome loggedIn.incomes } , Cmd.none ) - LoggedInMsg.ValidateEditIncome incomeId amount date -> + LoggedIn.ValidateEditIncome incomeId amount date -> let updateIncome _ = Just <| Income loggedIn.me (Date.toTime date) amount in ( { loggedIn | incomes = Dict.update incomeId updateIncome loggedIn.incomes } , Cmd.none ) - LoggedInMsg.ValidateDeleteIncome incomeId -> + LoggedIn.ValidateDeleteIncome incomeId -> ( { loggedIn | incomes = Dict.remove incomeId loggedIn.incomes } , Cmd.none ) - LoggedInMsg.ValidateCreateCategory categoryId name color -> + LoggedIn.ValidateCreateCategory categoryId name color -> let newCategory = { name = name, color = color } in ( { loggedIn | categories = Dict.insert categoryId newCategory loggedIn.categories } , Cmd.none ) - LoggedInMsg.ValidateEditCategory categoryId name color -> + LoggedIn.ValidateEditCategory categoryId name color -> let updateCategory _ = Just <| Category name color in ( { loggedIn | categories = Dict.update categoryId updateCategory loggedIn.categories } , Cmd.none) - LoggedInMsg.ValidateDeleteCategory categoryId -> + LoggedIn.ValidateDeleteCategory categoryId -> ( { loggedIn | categories = Dict.remove categoryId loggedIn.categories } , Cmd.none ) diff --git a/src/client/LoggedIn/View.elm b/src/client/LoggedIn/View.elm index ddc85d5..4936c6e 100644 --- a/src/client/LoggedIn/View.elm +++ b/src/client/LoggedIn/View.elm @@ -23,11 +23,11 @@ view : Model -> LoggedInModel.Model -> Html Msg view model loggedIn = div [ class "loggedIn" ] - [ let loggedData = LoggedData.build model loggedIn + [ let loggedData = LoggedData.build model.currentTime model.translations model.conf loggedIn in case model.page of Page.Home -> Home.view loggedData loggedIn.home Page.Income -> Income.view loggedData Page.Categories -> Categories.view loggedData - Page.Statistics -> Stat.view loggedData + Page.Statistics -> Stat.view loggedData loggedIn.stat Page.NotFound -> div [] [ text (getMessage model.translations "PageNotFound") ] ] -- cgit v1.2.3