diff options
Diffstat (limited to 'src')
27 files changed, 645 insertions, 248 deletions
diff --git a/src/client/Chart/Api.elm b/src/client/Chart/Api.elm new file mode 100644 index 0000000..693f362 --- /dev/null +++ b/src/client/Chart/Api.elm @@ -0,0 +1,41 @@ +module Chart.Api exposing + ( from + , withSize + , withTitle + , withOrdinate + , toHtml + ) + +import Html exposing (Html) +import Svg exposing (..) +import Svg.Attributes exposing (..) + +import Chart.Model as Chart exposing (Chart, Serie, Vec2, View) +import Chart.View as Chart + +from : List String -> List Serie -> Chart +from keys series = + { keys = keys + , series = series + , size = { x = 600, y = 400 } + , title = "" + , scaleColor = "#DDDDDD" + , formatOrdinate = toString + , ordinateLines = 5 + } + +withSize : Vec2 -> Chart -> Chart +withSize size chart = { chart | size = size } + +withTitle : String -> Chart -> Chart +withTitle title chart = { chart | title = title } + +withOrdinate : Int -> (Float -> String) -> Chart -> Chart +withOrdinate lines format chart = + { chart + | formatOrdinate = format + , ordinateLines = lines + } + +toHtml : Chart -> Html msg +toHtml chart = Chart.view chart diff --git a/src/client/Chart/Model.elm b/src/client/Chart/Model.elm new file mode 100644 index 0000000..b5c176f --- /dev/null +++ b/src/client/Chart/Model.elm @@ -0,0 +1,73 @@ +module Chart.Model exposing + ( Chart + , Serie + , maxScale + , Vec2 + , View + , mkView + , bounds + ) + +import List.Extra as List + +type alias Chart = + { keys : List String + , series : List Serie + , size : Vec2 + , title : String + , scaleColor : String + , formatOrdinate : Float -> String + , ordinateLines : Int + } + +type alias Serie = + { values : List Float + , color : String + , label : String + } + +maxScale : Chart -> Float +maxScale { keys, series } = + List.range 0 (List.length keys - 1) + |> List.map (\i -> + series + |> List.map (truncate << Maybe.withDefault 0 << List.getAt i << .values) + |> List.maximum + |> Maybe.withDefault 0 + ) + |> List.maximum + |> Maybe.withDefault 0 + |> upperBound + +upperBound : Int -> Float +upperBound n = toFloat (upperBoundInt 0 n) + +upperBoundInt : Int -> Int -> Int +upperBoundInt count n = + if n < 10 + then + (n + 1) * (10 ^ count) + else + upperBoundInt (count + 1) (n // 10) + +type alias Vec2 = + { x : Float + , y : Float + } + +type alias View = + { fx : Float -> Float + , fy : Float -> Float + } + +mkView : Vec2 -> Vec2 -> View +mkView p1 p2 = + { fx = \x -> p1.x + x * (p2.x - p1.x) + , fy = \y -> p1.y + y * (p2.y - p1.y) + } + +bounds : View -> (Vec2, Vec2) +bounds { fx, fy } = + ( { x = fx 0, y = fy 0 } + , { x = fx 1, y = fy 1 } + ) diff --git a/src/client/Chart/View.elm b/src/client/Chart/View.elm new file mode 100644 index 0000000..af8b4b7 --- /dev/null +++ b/src/client/Chart/View.elm @@ -0,0 +1,182 @@ +module Chart.View exposing + ( view + ) + +import Html exposing (Html) +import List.Extra as List +import Svg exposing (..) +import Svg.Attributes exposing (..) + +import Chart.Model as Chart exposing (Chart, Serie, Vec2, View) +import Utils.List as List + +view : Chart -> Html msg +view chart = + let { size, title, series } = chart + titleHeight = 100 + captionHeight = 50 + in svg + [ width << toString <| size.x + , height << toString <| size.y + , viewBox ("0 0 " ++ (toString size.x) ++ " " ++ (toString size.y)) + ] + ( [ renderTitle (Chart.mkView { x = 0, y = 0 } { x = size.x, y = titleHeight }) title ] + ++ renderSeriesAndScales (Chart.mkView { x = 50, y = titleHeight } { x = size.x, y = size.y - captionHeight }) chart + ++ renderCaptions (Chart.mkView { x = 0, y = size.y - captionHeight } { x = size.x, y = size.y }) series + ) + +renderTitle : View -> String -> Svg msg +renderTitle view title = + text_ + [ x << toString <| view.fx 0.5 + , y << toString <| view.fy 0.5 + , textAnchor "middle" + , dominantBaseline "middle" + , fontSize "20" + ] + [ text title ] + +renderSeriesAndScales : View -> Chart -> List (Svg msg) +renderSeriesAndScales view chart = + let { keys, series, scaleColor, formatOrdinate } = chart + (p1, p2) = Chart.bounds view + ordinateWidth = 100 + abscissaHeight = 60 + maxScale = Chart.maxScale chart + in ( renderOrdinates (Chart.mkView { x = p1.x, y = p1.y } { x = p1.x + ordinateWidth, y = p2.y - abscissaHeight }) formatOrdinate maxScale + ++ renderAbscissas (Chart.mkView { x = p1.x + ordinateWidth, y = p2.y - abscissaHeight } { x = p2.x, y = p2.y }) keys scaleColor + ++ renderSeries (Chart.mkView { x = p1.x + ordinateWidth, y = p1.y } { x = p2.x, y = p2.y - abscissaHeight }) series maxScale scaleColor + ) + +renderOrdinates : View -> (Float -> String) -> Float -> List (Svg msg) +renderOrdinates view formatOrdinate maxScale = + ordinates + |> List.map (\l -> + text_ + [ x << toString <| view.fx 0.5 + , y << toString <| view.fy l + , textAnchor "middle" + , dominantBaseline "middle" + ] + [ text << formatOrdinate <| (1 - l) * maxScale ] + ) + + +renderAbscissas : View -> List String -> String -> List (Svg msg) +renderAbscissas view keys scaleColor = + let count = List.length keys + in ( abscissasXPositions keys + |> List.map (\(xPos, key) -> + [ text_ + [ x << toString <| view.fx xPos + , y << toString <| view.fy 0.5 + , textAnchor "middle" + , dominantBaseline "middle" + ] + [ text key ] + , line + [ x1 << toString <| view.fx xPos + , y1 << toString <| view.fy 0 + , x2 << toString <| view.fx xPos + , y2 << toString <| view.fy 0.2 + , stroke scaleColor + ] + [] + ] + ) + |> List.concat + ) + +renderSeries : View -> List Serie -> Float -> String -> List (Svg msg) +renderSeries view series maxScale scaleColor = + ( renderHorizontalLines view series scaleColor + ++ renderPoints view series maxScale + ) + +renderHorizontalLines : View -> List Serie -> String -> List (Svg msg) +renderHorizontalLines view series scaleColor = + ordinates + |> List.map (\l -> + line + [ x1 << toString <| view.fx 0 + , y1 << toString <| view.fy l + , x2 << toString <| view.fx 1 + , y2 << toString <| view.fy l + , stroke scaleColor + ] + [] + ) + +renderPoints : View -> List Serie -> Float -> List (Svg msg) +renderPoints view series maxScale = + series + |> List.map (\serie -> + let points = + abscissasXPositions serie.values + |> List.map (\(xPos, value) -> { x = xPos, y = 1 - value / maxScale }) + in [ renderLines view serie.color points + , List.map (renderPoint view serie.color) points + ] + |> List.concat + ) + |> List.concat + +renderLines : View -> String -> List Vec2 -> List (Svg msg) +renderLines view color points = + List.links points + |> List.map (\(p1, p2) -> + line + [ x1 << toString <| view.fx p1.x + , y1 << toString <| view.fy p1.y + , x2 << toString <| view.fx p2.x + , y2 << toString <| view.fy p2.y + , stroke color + ] + [] + ) + +renderPoint : View -> String -> Vec2 -> Svg msg +renderPoint view color pos = + circle + [ cx << toString <| view.fx pos.x + , cy << toString <| view.fy pos.y + , r "4" + , fill color + ] + [] + +abscissasXPositions : List a -> List (Float, a) +abscissasXPositions xs = + let count = List.length xs + in xs + |> List.zip (List.range 1 (count + 1)) + |> List.map (\(i, x) -> (toFloat i / (toFloat count + 1), x)) + +ordinates : List Float +ordinates = + let count = 10 + in List.range 0 (count - 1) + |> List.map (\l -> toFloat l / (toFloat count - 1)) + +renderCaptions : View -> List Serie -> List (Svg msg) +renderCaptions view series = + let count = List.length series + in series + |> List.zip (List.range 1 (List.length series)) + |> List.map (\(i, serie) -> + renderCaption { x = view.fx (toFloat i / (toFloat count + 1)), y = view.fy 0.5 } serie + ) + |> List.concat + +renderCaption : Vec2 -> Serie -> List (Svg msg) +renderCaption point { label, color } = + [ text_ + [ x << toString <| point.x + , y << toString <| point.y + , textAnchor "middle" + , dominantBaseline "middle" + , fill color + , fontSize "18" + ] + [ text label ] + ] diff --git a/src/client/Dialog/AddPayment/Model.elm b/src/client/Dialog/AddPayment/Model.elm index 8a94bc7..07e7cbb 100644 --- a/src/client/Dialog/AddPayment/Model.elm +++ b/src/client/Dialog/AddPayment/Model.elm @@ -21,8 +21,6 @@ import Model.Payment as Payment exposing (Payment, PaymentId) import Model.Frequency exposing (Frequency) import Model.Translations exposing (Translations) -import Utils.Maybe as Maybe - type alias Model = { id : Maybe PaymentId , name : String diff --git a/src/client/LoggedData.elm b/src/client/LoggedData.elm index 9bb0a7f..e048247 100644 --- a/src/client/LoggedData.elm +++ b/src/client/LoggedData.elm @@ -30,11 +30,11 @@ type alias LoggedData = , paymentCategories : PaymentCategories } -build : Model -> LoggedInModel.Model -> LoggedData -build model loggedIn = - { currentTime = model.currentTime - , translations = model.translations - , conf = model.conf +build : Time -> Translations -> Conf -> LoggedInModel.Model -> LoggedData +build currentTime translations conf loggedIn = + { currentTime = currentTime + , translations = translations + , conf = conf , users = loggedIn.users , me = loggedIn.me , payments = loggedIn.payments 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") ] ] diff --git a/src/client/Main.elm b/src/client/Main.elm index 9674b66..7981a1c 100644 --- a/src/client/Main.elm +++ b/src/client/Main.elm @@ -19,7 +19,7 @@ main = , update = update , subscriptions = (\model -> Sub.batch - [ Time.every 1000 Msg.UpdateTime + [ Time.every 60000 Msg.UpdateTime , Sub.map Msg.Tooltip Tooltip.subscription ] ) diff --git a/src/client/Model.elm b/src/client/Model.elm index 5167e42..7f62416 100644 --- a/src/client/Model.elm +++ b/src/client/Model.elm @@ -27,8 +27,6 @@ import Dialog.Msg as DialogMsg import Tooltip -import Utils.Maybe exposing (isJust) - type alias Model = { view : View , currentTime : Time @@ -50,7 +48,7 @@ init payload location = InitEmpty -> SignInView (SignInModel.init Nothing) InitSuccess init -> - LoggedInView (LoggedInModel.init init) + LoggedInView (LoggedInModel.init time init) InitError error -> SignInView (SignInModel.init (Just error)) , currentTime = time diff --git a/src/client/Model/Income.elm b/src/client/Model/Income.elm index 34578c6..aa5f05f 100644 --- a/src/client/Model/Income.elm +++ b/src/client/Model/Income.elm @@ -9,17 +9,16 @@ module Model.Income exposing , cumulativeIncomesSince ) +import Dict exposing (Dict) import Json.Decode as Decode exposing (Decoder) -import Utils.Json as Json -import Time exposing (Time, hour) import List exposing (..) -import Dict exposing (Dict) +import Maybe.Extra as Maybe +import Time exposing (Time, hour) +import Utils.Json as Json import Model.Date exposing (timeDecoder) import Model.User exposing (UserId, userIdDecoder) -import Utils.Maybe as Maybe - type alias Incomes = Dict IncomeId Income type alias IncomeId = Int @@ -46,7 +45,7 @@ incomeDefinedForAll userIds incomes = let userIncomes = List.map (\userId -> List.filter ((==) userId << .userId) << Dict.values <| incomes) userIds firstIncomes = map (head << sortBy .time) userIncomes in if all Maybe.isJust firstIncomes - then head << reverse << List.sort << map .time << Maybe.cat <| firstIncomes + then head << reverse << List.sort << map .time << Maybe.values <| firstIncomes else Nothing userCumulativeIncomeSince : Time -> Time -> Incomes -> UserId -> Int diff --git a/src/client/Model/Payer.elm b/src/client/Model/Payer.elm index 1663273..4d9190e 100644 --- a/src/client/Model/Payer.elm +++ b/src/client/Model/Payer.elm @@ -17,7 +17,6 @@ import Model.User exposing (Users, UserId, userIdDecoder) import Model.Income exposing (..) import Utils.Dict exposing (mapValues) -import Utils.Maybe exposing (isJust) type alias Payers = Dict UserId Payer diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm index 2412ab9..204f9f5 100644 --- a/src/client/Model/Payment.elm +++ b/src/client/Model/Payment.elm @@ -20,10 +20,11 @@ import Date.Extra.Core exposing (monthToInt, intToMonth) import Json.Decode as Decode exposing (Decoder) import Json.Decode.Extra as Decode import List +import List.Extra as List import Form.Validate as Validate exposing (Validation) -import Model.Frequency as Frequency exposing (Frequency(..)) import Model.Date exposing (dateDecoder) +import Model.Frequency as Frequency exposing (Frequency(..)) import Model.User exposing (UserId, userIdDecoder) import Utils.List as List import Utils.Search as Search @@ -63,8 +64,7 @@ paymentIdDecoder = Decode.int find : PaymentId -> Payments -> Maybe Payment find paymentId payments = payments - |> List.filter (\p -> p.id == paymentId) - |> List.head + |> List.find (\p -> p.id == paymentId) edit : Payment -> Payments -> Payments edit payment payments = payment :: delete payment.id payments @@ -94,7 +94,6 @@ groupAndSortByMonth payments = |> List.groupBy (\payment -> (Date.year payment.date, monthToInt << Date.month <| payment.date)) |> List.sortBy Tuple.first |> List.map (\((year, month), payments) -> ((intToMonth month, year), payments)) - |> List.reverse search : String -> Frequency -> Payments -> Payments search name frequency payments = diff --git a/src/client/Model/PaymentCategory.elm b/src/client/Model/PaymentCategory.elm index bb6c152..a4fceb1 100644 --- a/src/client/Model/PaymentCategory.elm +++ b/src/client/Model/PaymentCategory.elm @@ -2,15 +2,20 @@ module Model.PaymentCategory exposing ( PaymentCategories , paymentCategoriesDecoder , search + , groupPaymentsByCategory , isCategoryUnused , save ) import Dict exposing (Dict) import Json.Decode as Decode exposing (Decoder) +import List.Extra as List +import Maybe.Extra as Maybe import Model.Category exposing (CategoryId, categoryIdDecoder) +import Model.Payment exposing (Payments) import Utils.Json as Json +import Utils.List as List import Utils.Search as Search type alias PaymentCategories = List PaymentCategory @@ -26,18 +31,30 @@ paymentCategoriesDecoder = (Decode.field "name" Decode.string) (Decode.field "category" categoryIdDecoder) +groupPaymentsByCategory : PaymentCategories -> Payments -> List (CategoryId, Payments) +groupPaymentsByCategory paymentCategories payments = + payments + |> List.groupBy (\payment -> + search payment.name paymentCategories + |> Maybe.withDefault -1 + ) + |> List.filterMap (\(category, payments) -> + case category of + -1 -> Nothing + _ -> Just (category, payments) + ) + search : String -> PaymentCategories -> Maybe CategoryId search paymentName paymentCategories = paymentCategories - |> List.filter (\pc -> Search.format pc.name == Search.format paymentName) - |> List.head + |> List.find (\pc -> Search.format pc.name == Search.format paymentName) |> Maybe.map .category isCategoryUnused : CategoryId -> PaymentCategories -> Bool isCategoryUnused category paymentCategories = paymentCategories - |> List.filter ((==) category << .category) - |> List.isEmpty + |> List.find ((==) category << .category) + |> Maybe.isNothing save : String -> CategoryId -> PaymentCategories -> PaymentCategories save name category paymentCategories = diff --git a/src/client/Update.elm b/src/client/Update.elm index 7006d5a..4284b65 100644 --- a/src/client/Update.elm +++ b/src/client/Update.elm @@ -2,35 +2,28 @@ module Update exposing ( update ) -import Task -import Platform.Cmd exposing (Cmd) import Navigation exposing (Location) +import Platform.Cmd exposing (Cmd) +import Task -import Page exposing (Page) - -import Server - -import Msg exposing (..) - +import Dialog +import Dialog.Update as DialogUpdate +import LoggedIn.Model as LoggedIn +import LoggedIn.Msg as LoggedIn +import LoggedIn.Stat.Msg as Stat +import LoggedIn.Update as LoggedIn import Model exposing (Model) import Model.Translations exposing (getMessage) import Model.View as V - -import LoggedIn.Model as LoggedInModel -import LoggedIn.Msg as LoggedInMsg -import LoggedIn.Update as LoggedInUpdate - +import Msg exposing (..) +import Page exposing (Page(..)) +import Server import SignIn.Model as SignInModel import SignIn.Msg as SignInMsg import SignIn.Update as SignInUpdate - -import Dialog -import Dialog.Update as DialogUpdate - import Tooltip - -import Utils.Http exposing (errorKey) import Utils.Cmd exposing ((:>)) +import Utils.Http exposing (errorKey) update : Msg -> Model -> (Model, Cmd Msg) update msg model = @@ -40,7 +33,14 @@ update msg model = (model, Cmd.none) UpdatePage page -> - ({ model | page = page }, Cmd.none) + ( { model | page = page } + , if page == Statistics + then + let msg = UpdateLoggedIn <| LoggedIn.StatMsg <| Stat.UpdateChart + in Task.perform (\_ -> msg) (Task.succeed ()) + else + Cmd.none + ) SignIn email -> ( applySignIn model (SignInMsg.WaitingServer) @@ -51,7 +51,7 @@ update msg model = ) GoLoggedInView init -> - ( { model | view = V.LoggedInView (LoggedInModel.init init) } + ( { model | view = V.LoggedInView (LoggedIn.init model.currentTime init) } , Cmd.none ) @@ -92,7 +92,7 @@ update msg model = CreatePayment name cost date category frequency -> ( model , Server.createPayment name cost date category frequency (\result -> case result of - Ok paymentId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreatePayment paymentId name cost date category frequency + Ok paymentId -> UpdateLoggedIn <| LoggedIn.ValidateCreatePayment paymentId name cost date category frequency Err _ -> Error "CreatePaymentError" ) ) @@ -100,7 +100,7 @@ update msg model = EditPayment paymentId name cost date category frequency -> ( model , Server.editPayment paymentId name cost date category frequency (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateEditPayment paymentId name cost date category frequency + Ok _ -> UpdateLoggedIn <| LoggedIn.ValidateEditPayment paymentId name cost date category frequency Err _ -> Error "EditPaymentError" ) ) @@ -108,7 +108,7 @@ update msg model = DeletePayment paymentId -> ( model , Server.deletePayment paymentId (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeletePayment paymentId + Ok _ -> UpdateLoggedIn <| LoggedIn.ValidateDeletePayment paymentId Err _ -> Error "DeletePaymentError" ) ) @@ -116,7 +116,7 @@ update msg model = CreateIncome amount date -> ( model , Server.createIncome amount date (\result -> case result of - Ok incomeId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreateIncome incomeId amount date + Ok incomeId -> UpdateLoggedIn <| LoggedIn.ValidateCreateIncome incomeId amount date Err _ -> Error "CreateIncomeError" ) ) @@ -124,7 +124,7 @@ update msg model = EditIncome incomeId amount date -> ( model , Server.editIncome incomeId amount date (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateEditIncome incomeId amount date + Ok _ -> UpdateLoggedIn <| LoggedIn.ValidateEditIncome incomeId amount date Err _ -> Error "EditIncomeError" ) ) @@ -132,7 +132,7 @@ update msg model = DeleteIncome incomeId -> ( model , Server.deleteIncome incomeId (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeleteIncome incomeId + Ok _ -> UpdateLoggedIn <| LoggedIn.ValidateDeleteIncome incomeId Err _ -> Error "DeleteIncomeError" ) ) @@ -140,7 +140,7 @@ update msg model = CreateCategory name color -> ( model , Server.createCategory name color (\result -> case result of - Ok categoryId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreateCategory categoryId name color + Ok categoryId -> UpdateLoggedIn <| LoggedIn.ValidateCreateCategory categoryId name color Err _ -> Error "CreateCategoryError" ) ) @@ -148,7 +148,7 @@ update msg model = EditCategory categoryId name color -> ( model , Server.editCategory categoryId name color (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateEditCategory categoryId name color + Ok _ -> UpdateLoggedIn <| LoggedIn.ValidateEditCategory categoryId name color Err _ -> Error "EditCategoryError" ) ) @@ -156,7 +156,7 @@ update msg model = DeleteCategory categoryId -> ( model , Server.deleteCategory categoryId (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeleteCategory categoryId + Ok _ -> UpdateLoggedIn <| LoggedIn.ValidateDeleteCategory categoryId Err _ -> Error "DeleteCategoryError" ) ) @@ -170,11 +170,11 @@ applySignIn model signInMsg = _ -> model -applyLoggedIn : Model -> LoggedInMsg.Msg -> (Model, Cmd Msg) +applyLoggedIn : Model -> LoggedIn.Msg -> (Model, Cmd Msg) applyLoggedIn model loggedInMsg = case model.view of V.LoggedInView loggedInView -> - let (view, cmd) = LoggedInUpdate.update model loggedInMsg loggedInView + let (view, cmd) = LoggedIn.update model loggedInMsg loggedInView in ( { model | view = V.LoggedInView view } , Cmd.map UpdateLoggedIn cmd ) diff --git a/src/client/Utils/List.elm b/src/client/Utils/List.elm index cc57d9f..8e26e85 100644 --- a/src/client/Utils/List.elm +++ b/src/client/Utils/List.elm @@ -1,9 +1,11 @@ module Utils.List exposing ( groupBy , mean + , links ) import Dict +import Maybe.Extra as Maybe groupBy : (a -> comparable) -> List a -> List (comparable, List a) groupBy f xs = @@ -15,3 +17,20 @@ groupBy f xs = mean : List Int -> Int mean xs = (List.sum xs) // (List.length xs) + +links : List a -> List (a, a) +links xs = + let reversed = List.reverse xs + in List.foldr + (\x acc -> + case Maybe.map Tuple.first (List.head acc) of + Just y -> + (x, y) :: acc + _ -> + acc + ) + (case reversed of + x :: y :: _ -> [(y, x)] + _ -> [] + ) + (List.reverse << List.drop 2 <| reversed) diff --git a/src/client/Utils/Maybe.elm b/src/client/Utils/Maybe.elm deleted file mode 100644 index 46456e1..0000000 --- a/src/client/Utils/Maybe.elm +++ /dev/null @@ -1,34 +0,0 @@ -module Utils.Maybe exposing - ( isJust - , cat - , toList - , orElse - ) - -isJust : Maybe a -> Bool -isJust maybe = - case maybe of - Just _ -> True - Nothing -> False - -cat : List (Maybe a) -> List a -cat = - List.foldr - (\mb xs -> - case mb of - Just x -> x :: xs - Nothing -> xs - ) - [] - -toList : Maybe a -> List a -toList mb = - case mb of - Just a -> [a] - Nothing -> [] - -orElse : Maybe a -> Maybe a -> Maybe a -orElse mb1 mb2 = - case mb1 of - Just x -> Just x - Nothing -> mb2 diff --git a/src/client/View.elm b/src/client/View.elm index 66c498a..deee272 100644 --- a/src/client/View.elm +++ b/src/client/View.elm @@ -18,8 +18,6 @@ import View.Errors as Errors import SignIn.View as SignInView import LoggedIn.View as LoggedInView -import Utils.Maybe as Maybe - view : Model -> Html Msg view model = div diff --git a/src/client/View/Date.elm b/src/client/View/Date.elm index 35806ba..6df971b 100644 --- a/src/client/View/Date.elm +++ b/src/client/View/Date.elm @@ -1,5 +1,6 @@ module View.Date exposing - ( shortView + ( shortMonthAndYear + , shortView , longView , monthView ) @@ -10,6 +11,14 @@ import String import Model.Translations exposing (..) +shortMonthAndYear : Month -> Int -> Translations -> String +shortMonthAndYear month year translations = + let params = + [ String.pad 2 '0' (toString (Date.monthToInt month)) + , toString year + ] + in getParamMessage params translations "ShortMonthAndYear" + shortView : Date -> Translations -> String shortView date translations = let params = diff --git a/src/client/View/Form.elm b/src/client/View/Form.elm index 7a4965d..977ca0a 100644 --- a/src/client/View/Form.elm +++ b/src/client/View/Form.elm @@ -9,6 +9,7 @@ module View.Form exposing import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) +import Maybe.Extra as Maybe import FontAwesome import View.Color as Color @@ -24,8 +25,6 @@ import LoggedData exposing (LoggedData) import Model.Translations as Translations exposing (Translations) -import Utils.Maybe exposing (isJust) - textInput : Translations -> Form String a -> String -> String -> Html Form.Msg textInput translations form formName fieldName = let field = Form.getFieldAsString fieldName form @@ -33,13 +32,13 @@ textInput translations form formName fieldName = in div [ classList [ ("textInput", True) - , ("error", isJust field.liveError) + , ("error", Maybe.isJust field.liveError) ] ] [ Input.textInput field [ id fieldId - , classList [ ("filled", isJust field.value) ] + , classList [ ("filled", Maybe.isJust field.value) ] , value (Maybe.withDefault "" field.value) ] , label @@ -60,7 +59,7 @@ colorInput translations form formName fieldName = in div [ classList [ ("colorInput", True) - , ("error", isJust field.liveError) + , ("error", Maybe.isJust field.liveError) ] ] [ label @@ -79,7 +78,7 @@ radioInputs translations form formName radioName fieldNames = in div [ classList [ ("radioGroup", True) - , ("error", isJust field.liveError) + , ("error", Maybe.isJust field.liveError) ] ] [ div @@ -115,7 +114,7 @@ selectInput translations form formName selectName options = in div [ classList [ ("selectInput", True) - , ("error", isJust field.liveError) + , ("error", Maybe.isJust field.liveError) ] ] [ label diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index efe8aaa..18f16f0 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -45,6 +45,7 @@ data Key = | December | ShortDate + | ShortMonthAndYear | LongDate -- Search @@ -106,6 +107,7 @@ data Key = | Statistics | ByMonthsAndMean | By + | Total -- Income diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index 90f509a..7d26c3f 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -181,6 +181,11 @@ m l ShortDate = English -> "{3}-{2}-{1}" French -> "{1}/{2}/{3}" +m l ShortMonthAndYear = + case l of + English -> "{2}-{1}" + French -> "{1}/{2}" + m l LongDate = case l of English -> "{2} {1}, {3}" @@ -295,6 +300,56 @@ m l NoPayment = English -> "No payment found from your search criteria." French -> "Aucun paiement ne correspond à vos critères de recherches." +m l PaymentName = + case l of + English -> "Name" + French -> "Nom" + +m l PaymentCost = + case l of + English -> "Cost" + French -> "Coût" + +m l PaymentDate = + case l of + English -> "Date" + French -> "Date" + +m l PaymentCategory = + case l of + English -> "Category" + French -> "Catégorie" + +m l PaymentPunctual = + case l of + English -> "Punctual" + French -> "Ponctuel" + +m l PaymentMonthly = + case l of + English -> "Monthly" + French -> "Mensuel" + +m l ConfirmPaymentDelete = + case l of + English -> "Are you sure to delete this payment ?" + French -> "Voulez-vous vraiment supprimer ce paiement ?" + +m l Edit = + case l of + English -> "Edit" + French -> "Modifier" + +m l Clone = + case l of + English -> "Clone" + French -> "Cloner" + +m l Delete = + case l of + English -> "Delete" + French -> "Supprimer" + -- Categories m l Categories = @@ -361,63 +416,18 @@ m l Statistics = m l ByMonthsAndMean = case l of - English -> "By months ({1} on average)" - French -> "Par mois (en moyenne {1})" + English -> "Payments by category by month months ({1} on average)" + French -> "Paiements par catégorie par mois (en moyenne {1})" m l By = case l of English -> "{1}: {2}" French -> "{1} : {2}" -m l PaymentName = - case l of - English -> "Name" - French -> "Nom" - -m l PaymentCost = - case l of - English -> "Cost" - French -> "Coût" - -m l PaymentDate = - case l of - English -> "Date" - French -> "Date" - -m l PaymentCategory = - case l of - English -> "Category" - French -> "Catégorie" - -m l PaymentPunctual = - case l of - English -> "Punctual" - French -> "Ponctuel" - -m l PaymentMonthly = - case l of - English -> "Monthly" - French -> "Mensuel" - -m l ConfirmPaymentDelete = - case l of - English -> "Are you sure to delete this payment ?" - French -> "Voulez-vous vraiment supprimer ce paiement ?" - -m l Edit = +m l Total = case l of - English -> "Edit" - French -> "Modifier" - -m l Clone = - case l of - English -> "Clone" - French -> "Cloner" - -m l Delete = - case l of - English -> "Delete" - French -> "Supprimer" + English -> "Total" + French -> "Total" -- Income |