From 1e47a7754ca38bd1a6c74765d8378caf68ce4619 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 26 Mar 2017 21:10:42 +0200 Subject: Separate client and server watch --- src/client/Dialog.elm | 165 +++++++++++++++++++ src/client/Dialog/AddCategory/Model.elm | 52 ++++++ src/client/Dialog/AddCategory/View.elm | 72 ++++++++ src/client/Dialog/AddIncome/Model.elm | 53 ++++++ src/client/Dialog/AddIncome/View.elm | 72 ++++++++ src/client/Dialog/AddPayment/Model.elm | 70 ++++++++ src/client/Dialog/AddPayment/View.elm | 95 +++++++++++ src/client/Dialog/Model.elm | 23 +++ src/client/Dialog/Msg.elm | 15 ++ src/client/Dialog/Update.elm | 74 +++++++++ src/client/Init.elm | 30 ++++ src/client/LoggedData.elm | 44 +++++ src/client/LoggedIn/Category/Model.elm | 36 ++++ src/client/LoggedIn/Category/Msg.elm | 9 + src/client/LoggedIn/Category/Table/View.elm | 124 ++++++++++++++ src/client/LoggedIn/Category/Update.elm | 24 +++ src/client/LoggedIn/Category/View.elm | 35 ++++ src/client/LoggedIn/Home/Header/View.elm | 104 ++++++++++++ src/client/LoggedIn/Home/Model.elm | 40 +++++ src/client/LoggedIn/Home/Msg.elm | 12 ++ src/client/LoggedIn/Home/Update.elm | 35 ++++ src/client/LoggedIn/Home/View.elm | 38 +++++ src/client/LoggedIn/Home/View/ExceedingPayers.elm | 45 +++++ src/client/LoggedIn/Home/View/Paging.elm | 109 ++++++++++++ src/client/LoggedIn/Home/View/Table.elm | 166 +++++++++++++++++++ src/client/LoggedIn/Income/Model.elm | 36 ++++ src/client/LoggedIn/Income/Msg.elm | 9 + src/client/LoggedIn/Income/Update.elm | 24 +++ src/client/LoggedIn/Income/View.elm | 108 ++++++++++++ src/client/LoggedIn/Income/View/Table.elm | 129 +++++++++++++++ src/client/LoggedIn/Model.elm | 42 +++++ src/client/LoggedIn/Msg.elm | 28 ++++ src/client/LoggedIn/Stat/View.elm | 62 +++++++ src/client/LoggedIn/Update.elm | 151 +++++++++++++++++ src/client/LoggedIn/View.elm | 33 ++++ src/client/LoggedIn/View/Format.elm | 37 +++++ src/client/Main.elm | 26 +++ src/client/Model.elm | 74 +++++++++ src/client/Model/Category.elm | 35 ++++ src/client/Model/Conf.elm | 13 ++ src/client/Model/Date.elm | 15 ++ src/client/Model/Income.elm | 102 ++++++++++++ src/client/Model/Init.elm | 31 ++++ src/client/Model/InitResult.elm | 28 ++++ src/client/Model/Payer.elm | 138 ++++++++++++++++ src/client/Model/Payment.elm | 143 ++++++++++++++++ src/client/Model/PaymentCategory.elm | 48 ++++++ src/client/Model/Size.elm | 17 ++ src/client/Model/Translations.elm | 68 ++++++++ src/client/Model/User.elm | 44 +++++ src/client/Model/View.elm | 12 ++ src/client/Msg.elm | 48 ++++++ src/client/Page.elm | 43 +++++ src/client/Server.elm | 114 +++++++++++++ src/client/SignIn/Model.elm | 17 ++ src/client/SignIn/Msg.elm | 9 + src/client/SignIn/Update.elm | 31 ++++ src/client/SignIn/View.elm | 63 +++++++ src/client/Tooltip.elm | 113 +++++++++++++ src/client/Update.elm | 182 +++++++++++++++++++++ src/client/Utils/Cmd.elm | 16 ++ src/client/Utils/Dict.elm | 11 ++ src/client/Utils/Either.elm | 9 + src/client/Utils/Form.elm | 13 ++ src/client/Utils/Http.elm | 39 +++++ src/client/Utils/Json.elm | 12 ++ src/client/Utils/List.elm | 17 ++ src/client/Utils/Maybe.elm | 34 ++++ src/client/Utils/Search.elm | 10 ++ src/client/Utils/String.elm | 38 +++++ src/client/Validation.elm | 47 ++++++ src/client/View.elm | 36 ++++ src/client/View/Color.elm | 12 ++ src/client/View/Date.elm | 48 ++++++ src/client/View/Errors.elm | 21 +++ src/client/View/Events.elm | 15 ++ src/client/View/Form.elm | 153 +++++++++++++++++ src/client/View/Header.elm | 60 +++++++ src/client/View/Plural.elm | 11 ++ src/client/elm/Dialog.elm | 165 ------------------- src/client/elm/Dialog/AddCategory/Model.elm | 53 ------ src/client/elm/Dialog/AddCategory/View.elm | 72 -------- src/client/elm/Dialog/AddIncome/Model.elm | 53 ------ src/client/elm/Dialog/AddIncome/View.elm | 72 -------- src/client/elm/Dialog/AddPayment/Model.elm | 70 -------- src/client/elm/Dialog/AddPayment/View.elm | 95 ----------- src/client/elm/Dialog/Model.elm | 32 ---- src/client/elm/Dialog/Msg.elm | 15 -- src/client/elm/Dialog/Update.elm | 74 --------- src/client/elm/Init.elm | 30 ---- src/client/elm/LoggedData.elm | 44 ----- src/client/elm/LoggedIn/Category/Model.elm | 36 ---- src/client/elm/LoggedIn/Category/Msg.elm | 9 - src/client/elm/LoggedIn/Category/Table/View.elm | 124 -------------- src/client/elm/LoggedIn/Category/Update.elm | 24 --- src/client/elm/LoggedIn/Category/View.elm | 35 ---- src/client/elm/LoggedIn/Home/Header/View.elm | 104 ------------ src/client/elm/LoggedIn/Home/Model.elm | 40 ----- src/client/elm/LoggedIn/Home/Msg.elm | 12 -- src/client/elm/LoggedIn/Home/Update.elm | 35 ---- src/client/elm/LoggedIn/Home/View.elm | 38 ----- .../elm/LoggedIn/Home/View/ExceedingPayers.elm | 45 ----- src/client/elm/LoggedIn/Home/View/Paging.elm | 109 ------------ src/client/elm/LoggedIn/Home/View/Table.elm | 166 ------------------- src/client/elm/LoggedIn/Income/Model.elm | 36 ---- src/client/elm/LoggedIn/Income/Msg.elm | 9 - src/client/elm/LoggedIn/Income/Update.elm | 24 --- src/client/elm/LoggedIn/Income/View.elm | 108 ------------ src/client/elm/LoggedIn/Income/View/Table.elm | 129 --------------- src/client/elm/LoggedIn/Model.elm | 42 ----- src/client/elm/LoggedIn/Msg.elm | 28 ---- src/client/elm/LoggedIn/Stat/View.elm | 62 ------- src/client/elm/LoggedIn/Update.elm | 151 ----------------- src/client/elm/LoggedIn/View.elm | 33 ---- src/client/elm/LoggedIn/View/Format.elm | 37 ----- src/client/elm/Main.elm | 26 --- src/client/elm/Model.elm | 74 --------- src/client/elm/Model/Category.elm | 35 ---- src/client/elm/Model/Conf.elm | 13 -- src/client/elm/Model/Date.elm | 15 -- src/client/elm/Model/Income.elm | 102 ------------ src/client/elm/Model/Init.elm | 31 ---- src/client/elm/Model/InitResult.elm | 28 ---- src/client/elm/Model/Payer.elm | 138 ---------------- src/client/elm/Model/Payment.elm | 143 ---------------- src/client/elm/Model/PaymentCategory.elm | 48 ------ src/client/elm/Model/Size.elm | 17 -- src/client/elm/Model/Translations.elm | 68 -------- src/client/elm/Model/User.elm | 44 ----- src/client/elm/Model/View.elm | 12 -- src/client/elm/Msg.elm | 48 ------ src/client/elm/Page.elm | 43 ----- src/client/elm/Server.elm | 114 ------------- src/client/elm/SignIn/Model.elm | 17 -- src/client/elm/SignIn/Msg.elm | 9 - src/client/elm/SignIn/Update.elm | 31 ---- src/client/elm/SignIn/View.elm | 63 ------- src/client/elm/Tooltip.elm | 113 ------------- src/client/elm/Update.elm | 182 --------------------- src/client/elm/Utils/Cmd.elm | 16 -- src/client/elm/Utils/Dict.elm | 11 -- src/client/elm/Utils/Either.elm | 9 - src/client/elm/Utils/Form.elm | 13 -- src/client/elm/Utils/Http.elm | 39 ----- src/client/elm/Utils/Json.elm | 12 -- src/client/elm/Utils/List.elm | 17 -- src/client/elm/Utils/Maybe.elm | 34 ---- src/client/elm/Utils/Search.elm | 10 -- src/client/elm/Utils/String.elm | 38 ----- src/client/elm/Validation.elm | 38 ----- src/client/elm/View.elm | 36 ---- src/client/elm/View/Color.elm | 12 -- src/client/elm/View/Date.elm | 48 ------ src/client/elm/View/Errors.elm | 21 --- src/client/elm/View/Events.elm | 15 -- src/client/elm/View/Form.elm | 153 ----------------- src/client/elm/View/Header.elm | 60 ------- src/client/elm/View/Plural.elm | 11 -- src/client/js/main.js | 17 -- src/server/Main.hs | 19 +-- src/server/Model/Message/Key.hs | 1 + src/server/Model/Message/Translations.hs | 5 + 162 files changed, 4230 insertions(+), 4247 deletions(-) create mode 100644 src/client/Dialog.elm create mode 100644 src/client/Dialog/AddCategory/Model.elm create mode 100644 src/client/Dialog/AddCategory/View.elm create mode 100644 src/client/Dialog/AddIncome/Model.elm create mode 100644 src/client/Dialog/AddIncome/View.elm create mode 100644 src/client/Dialog/AddPayment/Model.elm create mode 100644 src/client/Dialog/AddPayment/View.elm create mode 100644 src/client/Dialog/Model.elm create mode 100644 src/client/Dialog/Msg.elm create mode 100644 src/client/Dialog/Update.elm create mode 100644 src/client/Init.elm create mode 100644 src/client/LoggedData.elm create mode 100644 src/client/LoggedIn/Category/Model.elm create mode 100644 src/client/LoggedIn/Category/Msg.elm create mode 100644 src/client/LoggedIn/Category/Table/View.elm create mode 100644 src/client/LoggedIn/Category/Update.elm create mode 100644 src/client/LoggedIn/Category/View.elm create mode 100644 src/client/LoggedIn/Home/Header/View.elm create mode 100644 src/client/LoggedIn/Home/Model.elm create mode 100644 src/client/LoggedIn/Home/Msg.elm create mode 100644 src/client/LoggedIn/Home/Update.elm create mode 100644 src/client/LoggedIn/Home/View.elm create mode 100644 src/client/LoggedIn/Home/View/ExceedingPayers.elm create mode 100644 src/client/LoggedIn/Home/View/Paging.elm create mode 100644 src/client/LoggedIn/Home/View/Table.elm create mode 100644 src/client/LoggedIn/Income/Model.elm create mode 100644 src/client/LoggedIn/Income/Msg.elm create mode 100644 src/client/LoggedIn/Income/Update.elm create mode 100644 src/client/LoggedIn/Income/View.elm create mode 100644 src/client/LoggedIn/Income/View/Table.elm create mode 100644 src/client/LoggedIn/Model.elm create mode 100644 src/client/LoggedIn/Msg.elm create mode 100644 src/client/LoggedIn/Stat/View.elm create mode 100644 src/client/LoggedIn/Update.elm create mode 100644 src/client/LoggedIn/View.elm create mode 100644 src/client/LoggedIn/View/Format.elm create mode 100644 src/client/Main.elm create mode 100644 src/client/Model.elm create mode 100644 src/client/Model/Category.elm create mode 100644 src/client/Model/Conf.elm create mode 100644 src/client/Model/Date.elm create mode 100644 src/client/Model/Income.elm create mode 100644 src/client/Model/Init.elm create mode 100644 src/client/Model/InitResult.elm create mode 100644 src/client/Model/Payer.elm create mode 100644 src/client/Model/Payment.elm create mode 100644 src/client/Model/PaymentCategory.elm create mode 100644 src/client/Model/Size.elm create mode 100644 src/client/Model/Translations.elm create mode 100644 src/client/Model/User.elm create mode 100644 src/client/Model/View.elm create mode 100644 src/client/Msg.elm create mode 100644 src/client/Page.elm create mode 100644 src/client/Server.elm create mode 100644 src/client/SignIn/Model.elm create mode 100644 src/client/SignIn/Msg.elm create mode 100644 src/client/SignIn/Update.elm create mode 100644 src/client/SignIn/View.elm create mode 100644 src/client/Tooltip.elm create mode 100644 src/client/Update.elm create mode 100644 src/client/Utils/Cmd.elm create mode 100644 src/client/Utils/Dict.elm create mode 100644 src/client/Utils/Either.elm create mode 100644 src/client/Utils/Form.elm create mode 100644 src/client/Utils/Http.elm create mode 100644 src/client/Utils/Json.elm create mode 100644 src/client/Utils/List.elm create mode 100644 src/client/Utils/Maybe.elm create mode 100644 src/client/Utils/Search.elm create mode 100644 src/client/Utils/String.elm create mode 100644 src/client/Validation.elm create mode 100644 src/client/View.elm create mode 100644 src/client/View/Color.elm create mode 100644 src/client/View/Date.elm create mode 100644 src/client/View/Errors.elm create mode 100644 src/client/View/Events.elm create mode 100644 src/client/View/Form.elm create mode 100644 src/client/View/Header.elm create mode 100644 src/client/View/Plural.elm delete mode 100644 src/client/elm/Dialog.elm delete mode 100644 src/client/elm/Dialog/AddCategory/Model.elm delete mode 100644 src/client/elm/Dialog/AddCategory/View.elm delete mode 100644 src/client/elm/Dialog/AddIncome/Model.elm delete mode 100644 src/client/elm/Dialog/AddIncome/View.elm delete mode 100644 src/client/elm/Dialog/AddPayment/Model.elm delete mode 100644 src/client/elm/Dialog/AddPayment/View.elm delete mode 100644 src/client/elm/Dialog/Model.elm delete mode 100644 src/client/elm/Dialog/Msg.elm delete mode 100644 src/client/elm/Dialog/Update.elm delete mode 100644 src/client/elm/Init.elm delete mode 100644 src/client/elm/LoggedData.elm delete mode 100644 src/client/elm/LoggedIn/Category/Model.elm delete mode 100644 src/client/elm/LoggedIn/Category/Msg.elm delete mode 100644 src/client/elm/LoggedIn/Category/Table/View.elm delete mode 100644 src/client/elm/LoggedIn/Category/Update.elm delete mode 100644 src/client/elm/LoggedIn/Category/View.elm delete mode 100644 src/client/elm/LoggedIn/Home/Header/View.elm delete mode 100644 src/client/elm/LoggedIn/Home/Model.elm delete mode 100644 src/client/elm/LoggedIn/Home/Msg.elm delete mode 100644 src/client/elm/LoggedIn/Home/Update.elm delete mode 100644 src/client/elm/LoggedIn/Home/View.elm delete mode 100644 src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm delete mode 100644 src/client/elm/LoggedIn/Home/View/Paging.elm delete mode 100644 src/client/elm/LoggedIn/Home/View/Table.elm delete mode 100644 src/client/elm/LoggedIn/Income/Model.elm delete mode 100644 src/client/elm/LoggedIn/Income/Msg.elm delete mode 100644 src/client/elm/LoggedIn/Income/Update.elm delete mode 100644 src/client/elm/LoggedIn/Income/View.elm delete mode 100644 src/client/elm/LoggedIn/Income/View/Table.elm delete mode 100644 src/client/elm/LoggedIn/Model.elm delete mode 100644 src/client/elm/LoggedIn/Msg.elm delete mode 100644 src/client/elm/LoggedIn/Stat/View.elm delete mode 100644 src/client/elm/LoggedIn/Update.elm delete mode 100644 src/client/elm/LoggedIn/View.elm delete mode 100644 src/client/elm/LoggedIn/View/Format.elm delete mode 100644 src/client/elm/Main.elm delete mode 100644 src/client/elm/Model.elm delete mode 100644 src/client/elm/Model/Category.elm delete mode 100644 src/client/elm/Model/Conf.elm delete mode 100644 src/client/elm/Model/Date.elm delete mode 100644 src/client/elm/Model/Income.elm delete mode 100644 src/client/elm/Model/Init.elm delete mode 100644 src/client/elm/Model/InitResult.elm delete mode 100644 src/client/elm/Model/Payer.elm delete mode 100644 src/client/elm/Model/Payment.elm delete mode 100644 src/client/elm/Model/PaymentCategory.elm delete mode 100644 src/client/elm/Model/Size.elm delete mode 100644 src/client/elm/Model/Translations.elm delete mode 100644 src/client/elm/Model/User.elm delete mode 100644 src/client/elm/Model/View.elm delete mode 100644 src/client/elm/Msg.elm delete mode 100644 src/client/elm/Page.elm delete mode 100644 src/client/elm/Server.elm delete mode 100644 src/client/elm/SignIn/Model.elm delete mode 100644 src/client/elm/SignIn/Msg.elm delete mode 100644 src/client/elm/SignIn/Update.elm delete mode 100644 src/client/elm/SignIn/View.elm delete mode 100644 src/client/elm/Tooltip.elm delete mode 100644 src/client/elm/Update.elm delete mode 100644 src/client/elm/Utils/Cmd.elm delete mode 100644 src/client/elm/Utils/Dict.elm delete mode 100644 src/client/elm/Utils/Either.elm delete mode 100644 src/client/elm/Utils/Form.elm delete mode 100644 src/client/elm/Utils/Http.elm delete mode 100644 src/client/elm/Utils/Json.elm delete mode 100644 src/client/elm/Utils/List.elm delete mode 100644 src/client/elm/Utils/Maybe.elm delete mode 100644 src/client/elm/Utils/Search.elm delete mode 100644 src/client/elm/Utils/String.elm delete mode 100644 src/client/elm/Validation.elm delete mode 100644 src/client/elm/View.elm delete mode 100644 src/client/elm/View/Color.elm delete mode 100644 src/client/elm/View/Date.elm delete mode 100644 src/client/elm/View/Errors.elm delete mode 100644 src/client/elm/View/Events.elm delete mode 100644 src/client/elm/View/Form.elm delete mode 100644 src/client/elm/View/Header.elm delete mode 100644 src/client/elm/View/Plural.elm delete mode 100644 src/client/js/main.js (limited to 'src') diff --git a/src/client/Dialog.elm b/src/client/Dialog.elm new file mode 100644 index 0000000..a7e059a --- /dev/null +++ b/src/client/Dialog.elm @@ -0,0 +1,165 @@ +module Dialog exposing + ( Msg(..) + , Model + , Config + , init + , update + , view + ) + +import Platform.Cmd exposing (Cmd) +import Task exposing (Task) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +-- Model + +type alias Model model modelMsg msg = + { config : Maybe (Config model msg) + , mapMsg : Msg model modelMsg msg -> msg + , model : model + } + +type alias Config model msg = + { className : String + , title : String + , body : model -> Html msg + , confirm : String + , confirmMsg : model -> msg + , undo : String + } + +init : model -> (Msg model modelMsg msg -> msg) -> Model model modelMsg msg +init model mapMsg = + { config = Nothing + , mapMsg = mapMsg + , model = model + } + +-- Update + +type Msg model modelMsg msg = + NoOp + | Update modelMsg + | UpdateAndClose msg + | OpenWithUpdate (Config model msg) modelMsg + | Open (Config model msg) + | Close + +update : (modelMsg -> model -> (model, Cmd modelMsg)) -> Msg model modelMsg msg -> model -> Model model modelMsg msg -> (Model model modelMsg msg, Cmd msg) +update updateModel msg baseModel model = + case msg of + NoOp -> + ( model + , Cmd.none + ) + + Update modelMsg -> + case updateModel modelMsg baseModel of + (newModel, effects) -> + ( { model | model = newModel } + , Cmd.map (model.mapMsg << Update) effects + ) + + UpdateAndClose msg -> + ( { model | config = Nothing } + , Task.perform (always msg) (Task.succeed msg) + ) + + OpenWithUpdate config modelMsg -> + case updateModel modelMsg baseModel of + (newModel, effects) -> + ( { model + | model = newModel + , config = Just config + } + , Cmd.map (model.mapMsg << Update) effects + ) + + Open config -> + ( { model | config = Just config } + , Cmd.none + ) + + Close -> + ( { model | config = Nothing } + , Cmd.none + ) + +-- View + +view : Model model modelMsg msg -> Html msg +view { mapMsg, config, model } = + let isVisible = + case config of + Just _ -> True + Nothing -> False + in div + [ class "dialog" ] + [ curtain mapMsg isVisible + , case config of + Nothing -> + text "" + Just c -> + dialog model mapMsg c + ] + +curtain : (Msg model modelMsg msg -> msg) -> Bool -> Html msg +curtain mapMsg isVisible = + div + [ class "curtain" + , style + [ ("position", "fixed") + , ("top", "0") + , ("left", "0") + , ("width", "100%") + , ("height", "100%") + , ("background-color", "rgba(0, 0, 0, 0.5)") + , ("z-index", if isVisible then "1000" else "-1") + , ("opacity", if isVisible then "1" else "0") + , ("transition", "all 0.2s ease") + ] + , onClick (mapMsg Close) + ] + [] + +dialog : model -> (Msg model modelMsg msg -> msg) -> Config model msg -> Html msg +dialog model mapMsg { className, title, body, confirm, confirmMsg, undo } = + div + [ class ("content " ++ className) + , style + [ ("position", "fixed") + , ("top", "25%") + , ("left", "50%") + , ("transform", "translate(-50%, -25%)") + , ("z-index", "1000") + , ("background-color", "white") + , ("padding", "20px") + , ("border-radius", "5px") + , ("box-shadow", "0px 0px 15px rgba(0, 0, 0, 0.5)") + ] + ] + [ h1 [] [ text title ] + , body model + , div + [ style + [ ("float", "right") + ] + ] + [ button + [ class "confirm" + , onClick (confirmMsg model) + , style + [ ("margin-right", "15px") + ] + ] + [ text confirm ] + , button + [ class "undo" + , onClick (mapMsg Close) + ] + [ text undo ] + ] + ] diff --git a/src/client/Dialog/AddCategory/Model.elm b/src/client/Dialog/AddCategory/Model.elm new file mode 100644 index 0000000..7496c2b --- /dev/null +++ b/src/client/Dialog/AddCategory/Model.elm @@ -0,0 +1,52 @@ +module Dialog.AddCategory.Model exposing + ( Model + , init + , initialAdd + , initialClone + , initialEdit + , validation + ) + +import Date exposing (Date) +import View.Date as Date + +import Form exposing (Form) +import Form.Field as Field exposing (Field) +import Form.Validate as Validate exposing (Validation) + +import Model.Translations exposing (Translations) +import Model.Category exposing (Category, CategoryId) + +type alias Model = + { id : Maybe CategoryId + , name : String + , color : String + } + +init : Form String Model +init = Form.initial [] validation + +initialAdd : Translations -> List (String, Field) +initialAdd translations = + [ ("color", Field.string "#000000") + ] + +initialClone : Translations -> Category -> List (String, Field) +initialClone translations category = + [ ("name", Field.string category.name) + , ("color", Field.string category.color) + ] + +initialEdit : Translations -> CategoryId -> Category -> List (String, Field) +initialEdit translations categoryId category = + [ ("id", Field.string (toString categoryId)) + , ("name", Field.string category.name) + , ("color", Field.string category.color) + ] + +validation : Validation String Model +validation = + Validate.map3 Model + (Validate.field "id" (Validate.maybe Validate.int)) + (Validate.field "name" (Validate.string |> Validate.andThen Validate.nonEmpty)) + (Validate.field "color" (Validate.string |> Validate.andThen Validate.nonEmpty)) diff --git a/src/client/Dialog/AddCategory/View.elm b/src/client/Dialog/AddCategory/View.elm new file mode 100644 index 0000000..6c02351 --- /dev/null +++ b/src/client/Dialog/AddCategory/View.elm @@ -0,0 +1,72 @@ +module Dialog.AddCategory.View exposing + ( button + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Task + +import Form exposing (Form) +import Form.Field as Field exposing (Field) +import Utils.Form as Form + +import Dialog +import Dialog.AddCategory.Model as AddCategory +import Dialog.Msg as DialogMsg + +import Tooltip + +import View.Form as Form +import View.Events exposing (onSubmitPrevDefault) + +import Msg exposing (Msg) +import LoggedIn.Msg as LoggedInMsg +import LoggedIn.Home.Msg as HomeMsg + +import Model.Translations exposing (getMessage) +import Model.View exposing (View(LoggedInView)) + +import LoggedData exposing (LoggedData) +import LoggedIn.Home.Model as HomeModel + +button : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg +button loggedData initialForm title buttonContent tooltip = + let dialogConfig = + { className = "categoryDialog" + , title = getMessage loggedData.translations title + , body = \model -> addCategoryForm loggedData model.addCategory + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = submitForm << .addCategory + , undo = getMessage loggedData.translations "Undo" + } + in Html.button + ( ( case tooltip of + Just message -> Tooltip.show Msg.Tooltip message + Nothing -> [] + ) + ++ [ onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.Init "categoryname" (DialogMsg.AddCategoryMsg <| Form.Reset initialForm))) ] + ) + [ buttonContent ] + +addCategoryForm : LoggedData -> Form String AddCategory.Model -> Html Msg +addCategoryForm loggedData addCategory = + let htmlMap = Html.map (Msg.Dialog << Dialog.Update << DialogMsg.AddCategoryMsg) + in Html.form + [ onSubmitPrevDefault Msg.NoOp ] + [ htmlMap <| Form.textInput loggedData.translations addCategory "category" "name" + , htmlMap <| Form.colorInput loggedData.translations addCategory "category" "color" + , Form.hiddenSubmit (submitForm addCategory) + ] + +submitForm : Form String AddCategory.Model -> Msg +submitForm addCategory = + case Form.getOutput addCategory of + Just data -> + case data.id of + Just categoryId -> + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.EditCategory categoryId data.name data.color + Nothing -> + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.CreateCategory data.name data.color + Nothing -> + Msg.Dialog <| Dialog.Update <| DialogMsg.AddCategoryMsg <| Form.Submit diff --git a/src/client/Dialog/AddIncome/Model.elm b/src/client/Dialog/AddIncome/Model.elm new file mode 100644 index 0000000..ad7b25a --- /dev/null +++ b/src/client/Dialog/AddIncome/Model.elm @@ -0,0 +1,53 @@ +module Dialog.AddIncome.Model exposing + ( Model + , init + , initialAdd + , initialClone + , initialEdit + , validation + ) + +import Date exposing (Date) +import View.Date as Date + +import Form exposing (Form) +import Form.Field as Field exposing (Field) +import Form.Validate as Validate exposing (Validation) +import Validation + +import Model.Translations exposing (Translations) +import Model.Income exposing (Income, IncomeId) + +type alias Model = + { id : Maybe IncomeId + , amount : Int + , date : Date + } + +init : Form String Model +init = Form.initial [] validation + +initialAdd : Translations -> Date -> List (String, Field) +initialAdd translations date = + [ ("date", Field.string (Date.shortView date translations)) + ] + +initialClone : Translations -> Date -> Income -> List (String, Field) +initialClone translations date income = + [ ("amount", Field.string (toString income.amount)) + , ("date", Field.string (Date.shortView date translations)) + ] + +initialEdit : Translations -> IncomeId -> Income -> List (String, Field) +initialEdit translations incomeId income = + [ ("id", Field.string (toString incomeId)) + , ("amount", Field.string (toString income.amount)) + , ("date", Field.string (Date.shortView (Date.fromTime income.time) translations)) + ] + +validation : Validation String Model +validation = + Validate.map3 Model + (Validate.field "id" (Validate.maybe Validate.int)) + (Validate.field "amount" (Validate.int |> Validate.andThen (Validate.minInt 1))) + (Validate.field "date" Validation.date) diff --git a/src/client/Dialog/AddIncome/View.elm b/src/client/Dialog/AddIncome/View.elm new file mode 100644 index 0000000..b413308 --- /dev/null +++ b/src/client/Dialog/AddIncome/View.elm @@ -0,0 +1,72 @@ +module Dialog.AddIncome.View exposing + ( button + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Task + +import Form exposing (Form) +import Form.Field as Field exposing (Field) +import Utils.Form as Form + +import Dialog +import Dialog.AddIncome.Model as AddIncome +import Dialog.Msg as DialogMsg + +import Tooltip + +import View.Form as Form +import View.Events exposing (onSubmitPrevDefault) + +import Msg exposing (Msg) +import LoggedIn.Msg as LoggedInMsg +import LoggedIn.Home.Msg as HomeMsg + +import Model.Translations exposing (getMessage) +import Model.View exposing (View(LoggedInView)) + +import LoggedData exposing (LoggedData) +import LoggedIn.Home.Model as HomeModel + +button : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg +button loggedData initialForm title buttonContent tooltip = + let dialogConfig = + { className = "incomeDialog" + , title = getMessage loggedData.translations title + , body = \model -> addIncomeForm loggedData model.addIncome + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = submitForm << .addIncome + , undo = getMessage loggedData.translations "Undo" + } + in Html.button + ( ( case tooltip of + Just message -> Tooltip.show Msg.Tooltip message + Nothing -> [] + ) + ++ [ onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.Init "incomeamount" (DialogMsg.AddIncomeMsg <| Form.Reset initialForm))) ] + ) + [ buttonContent ] + +addIncomeForm : LoggedData -> Form String AddIncome.Model -> Html Msg +addIncomeForm loggedData addIncome = + let htmlMap = Html.map (Msg.Dialog << Dialog.Update << DialogMsg.AddIncomeMsg) + in Html.form + [ onSubmitPrevDefault Msg.NoOp ] + [ htmlMap <| Form.textInput loggedData.translations addIncome "income" "amount" + , htmlMap <| Form.textInput loggedData.translations addIncome "income" "date" + , Form.hiddenSubmit (submitForm addIncome) + ] + +submitForm : Form String AddIncome.Model -> Msg +submitForm addIncome = + case Form.getOutput addIncome of + Just data -> + case data.id of + Just incomeId -> + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.EditIncome incomeId data.amount data.date + Nothing -> + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.CreateIncome data.amount data.date + Nothing -> + Msg.Dialog <| Dialog.Update <| DialogMsg.AddIncomeMsg <| Form.Submit diff --git a/src/client/Dialog/AddPayment/Model.elm b/src/client/Dialog/AddPayment/Model.elm new file mode 100644 index 0000000..11d59b1 --- /dev/null +++ b/src/client/Dialog/AddPayment/Model.elm @@ -0,0 +1,70 @@ +module Dialog.AddPayment.Model exposing + ( Model + , init + , initialAdd + , initialClone + , initialEdit + , validation + ) + +import Date exposing (Date) +import View.Date as Date + +import Form exposing (Form) +import Form.Field as Field exposing (Field) +import Form.Validate as Validate exposing (Validation) +import Validation + +import Model.Payment as Payment exposing (Payment, Frequency, PaymentId) +import Model.Translations exposing (Translations) +import Model.Category as Category exposing (Categories, CategoryId) + +import Utils.Maybe as Maybe + +type alias Model = + { id : Maybe PaymentId + , name : String + , cost : Int + , date : Date + , category : CategoryId + , frequency : Frequency + } + +init : Form String Model +init = Form.initial [] (validation Category.empty) + +initialAdd : Translations -> Date -> Frequency -> List (String, Field) +initialAdd translations date frequency = + [ ("date", Field.string (Date.shortView date translations)) + , ("frequency", Field.string (toString frequency)) + , ("category", Field.string "") + ] + +initialClone : Translations -> Date -> Maybe CategoryId -> Payment -> List (String, Field) +initialClone translations date category payment = + [ ("name", Field.string payment.name) + , ("cost", Field.string (toString payment.cost)) + , ("date", Field.string (Date.shortView date translations)) + , ("frequency", Field.string (toString payment.frequency)) + , ("category", Field.string (Maybe.map toString category |> Maybe.withDefault "")) + ] + +initialEdit : Translations -> Maybe CategoryId -> Payment -> List (String, Field) +initialEdit translations category payment = + [ ("id", Field.string (toString payment.id)) + , ("name", Field.string payment.name) + , ("cost", Field.string (toString payment.cost)) + , ("date", Field.string (Date.shortView payment.date translations)) + , ("frequency", Field.string (toString payment.frequency)) + , ("category", Field.string (Maybe.map toString category |> Maybe.withDefault "")) + ] + +validation : Categories -> Validation String Model +validation categories = + Validate.map6 Model + (Validate.field "id" (Validate.maybe Validate.int)) + (Validate.field "name" (Validate.string |> Validate.andThen Validate.nonEmpty)) + (Validate.field "cost" Validation.cost) + (Validate.field "date" Validation.date) + (Validate.field "category" (Validation.category categories)) + (Validate.field "frequency" Payment.validateFrequency) diff --git a/src/client/Dialog/AddPayment/View.elm b/src/client/Dialog/AddPayment/View.elm new file mode 100644 index 0000000..078d5b7 --- /dev/null +++ b/src/client/Dialog/AddPayment/View.elm @@ -0,0 +1,95 @@ +module Dialog.AddPayment.View exposing + ( button + ) + +import Dict +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Task + +import Form exposing (Form) +import Form.Field as Field exposing (Field) +import Utils.Form as Form + +import Dialog +import Dialog.AddPayment.Model as AddPayment +import Dialog.Msg as DialogMsg + +import Tooltip + +import View.Events exposing (onSubmitPrevDefault) +import View.Form as Form + +import LoggedIn.Home.Msg as HomeMsg +import LoggedIn.Msg as LoggedInMsg +import Msg exposing (Msg) + +import Model.Category exposing (Categories) +import Model.Payment as Payment exposing (Frequency(..)) +import Model.PaymentCategory exposing (PaymentCategories) +import Model.Translations exposing (getMessage) +import Model.View exposing (View(LoggedInView)) + +import LoggedData exposing (LoggedData) +import LoggedIn.Home.Model as HomeModel + +button : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg +button loggedData initialForm title buttonContent tooltip = + let dialogConfig = + { className = "paymentDialog" + , title = getMessage loggedData.translations title + , body = \model -> addPaymentForm loggedData model.addPayment + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = submitForm loggedData.categories loggedData.paymentCategories << .addPayment + , undo = getMessage loggedData.translations "Undo" + } + in Html.button + ( ( case tooltip of + Just message -> Tooltip.show Msg.Tooltip message + Nothing -> [] + ) + ++ [ class "addPayment" + , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.Init "paymentname" (DialogMsg.AddPaymentMsg loggedData.categories loggedData.paymentCategories <| Form.Reset initialForm))) + ] + ) + [ buttonContent ] + +addPaymentForm : LoggedData -> Form String AddPayment.Model -> Html Msg +addPaymentForm loggedData addPayment = + let htmlMap = Html.map (Msg.Dialog << Dialog.Update << DialogMsg.AddPaymentMsg loggedData.categories loggedData.paymentCategories) + categoryOptions = + loggedData.categories + |> Dict.toList + |> List.sortBy (.name << Tuple.second) + |> List.map (\(id, category) -> (toString id, category.name)) + in Html.form + [ class "addPayment" + , onSubmitPrevDefault Msg.NoOp + ] + [ htmlMap <| Form.textInput loggedData.translations addPayment "payment" "name" + , htmlMap <| Form.textInput loggedData.translations addPayment "payment" "cost" + , if (Form.getFieldAsString "frequency" addPayment).value == Just (toString Punctual) + then htmlMap <| Form.textInput loggedData.translations addPayment "payment" "date" + else text "" + , htmlMap <| Form.selectInput loggedData.translations addPayment "payment" "category" categoryOptions + + , htmlMap <| Form.radioInputs loggedData.translations addPayment "payment" "frequency" [ toString Punctual, toString Monthly ] + , Form.hiddenSubmit (submitForm loggedData.categories loggedData.paymentCategories addPayment) + ] + +submitForm : Categories -> PaymentCategories -> Form String AddPayment.Model -> Msg +submitForm categories paymentCategories addPayment = + case Form.getOutput addPayment of + Just data -> + case data.id of + Just paymentId -> + Msg.Dialog + <| Dialog.UpdateAndClose + <| Msg.EditPayment paymentId data.name data.cost data.date data.category data.frequency + Nothing -> + Msg.Dialog + <| Dialog.UpdateAndClose + <| Msg.CreatePayment data.name data.cost data.date data.category data.frequency + Nothing -> + Msg.Dialog <| Dialog.Update <| DialogMsg.AddPaymentMsg categories paymentCategories <| Form.Submit diff --git a/src/client/Dialog/Model.elm b/src/client/Dialog/Model.elm new file mode 100644 index 0000000..ff8bc57 --- /dev/null +++ b/src/client/Dialog/Model.elm @@ -0,0 +1,23 @@ +module Dialog.Model exposing + ( Model + , init + ) + +import Form exposing (Form) + +import Dialog.AddPayment.Model as AddPayment +import Dialog.AddIncome.Model as AddIncome +import Dialog.AddCategory.Model as AddCategory + +type alias Model = + { addPayment : Form String AddPayment.Model + , addIncome : Form String AddIncome.Model + , addCategory : Form String AddCategory.Model + } + +init : Model +init = + { addPayment = AddPayment.init + , addIncome = AddIncome.init + , addCategory = AddCategory.init + } diff --git a/src/client/Dialog/Msg.elm b/src/client/Dialog/Msg.elm new file mode 100644 index 0000000..68ed146 --- /dev/null +++ b/src/client/Dialog/Msg.elm @@ -0,0 +1,15 @@ +module Dialog.Msg exposing + ( Msg(..) + ) + +import Form exposing (Form) + +import Model.Category exposing (Categories) +import Model.PaymentCategory exposing (PaymentCategories) + +type Msg = + NoOp + | Init String Msg + | AddPaymentMsg Categories PaymentCategories Form.Msg + | AddIncomeMsg Form.Msg + | AddCategoryMsg Form.Msg diff --git a/src/client/Dialog/Update.elm b/src/client/Dialog/Update.elm new file mode 100644 index 0000000..3915548 --- /dev/null +++ b/src/client/Dialog/Update.elm @@ -0,0 +1,74 @@ +module Dialog.Update exposing + ( update + ) + +import Dom exposing (Id) +import Form exposing (Form) +import Form.Field as Field +import Task + +import Dialog.AddCategory.Model as AddCategory +import Dialog.AddIncome.Model as AddIncome +import Dialog.AddPayment.Model as AddPayment +import Dialog.Model as Dialog +import Dialog.Msg as Dialog + +import Model.Category exposing (Categories) +import Model.PaymentCategory as PaymentCategory exposing (PaymentCategories) + +update : Dialog.Msg -> Dialog.Model -> (Dialog.Model, Cmd Dialog.Msg) +update msg model = + case msg of + + Dialog.NoOp -> + ( model + , Cmd.none + ) + + Dialog.Init inputId dialogMsg -> + update dialogMsg model + |> Tuple.mapSecond (\cmd -> Cmd.batch [cmd, inputFocus inputId]) + + Dialog.AddPaymentMsg categories paymentCategories formMsg -> + ( { model + | addPayment = + Form.update (AddPayment.validation categories) formMsg model.addPayment + |> updateCategory categories paymentCategories formMsg + } + , Cmd.none + ) + + Dialog.AddIncomeMsg formMsg -> + ( { model + | addIncome = Form.update AddIncome.validation formMsg model.addIncome + } + , Cmd.none + ) + + Dialog.AddCategoryMsg formMsg -> + ( { model + | addCategory = Form.update AddCategory.validation formMsg model.addCategory + } + , Cmd.none + ) + +inputFocus : Id -> Cmd Dialog.Msg +inputFocus id = + Dom.focus id + |> Task.map (always Dialog.NoOp) + |> Task.onError (\_ -> Task.succeed Dialog.NoOp) + |> Task.perform (always Dialog.NoOp) + +updateCategory : Categories -> PaymentCategories -> Form.Msg -> (Form String AddPayment.Model -> Form String AddPayment.Model) +updateCategory categories paymentCategories formMsg = + case formMsg of + Form.Input "name" Form.Text (Field.String paymentName) -> + case PaymentCategory.search paymentName paymentCategories of + Just category -> + Form.update + (AddPayment.validation categories) + (Form.Input "category" Form.Text (Field.String <| toString category)) + Nothing -> + identity + _ -> + identity diff --git a/src/client/Init.elm b/src/client/Init.elm new file mode 100644 index 0000000..d87e870 --- /dev/null +++ b/src/client/Init.elm @@ -0,0 +1,30 @@ +module Init exposing + ( Init + , decoder + ) + +import Time exposing (..) + +import Json.Decode as Decode exposing (Decoder) + +import Model.Translations exposing (..) +import Model.Conf exposing (..) +import Model.InitResult exposing (..) +import Model.Size exposing (..) + +type alias Init = + { time : Time + , translations : Translations + , conf : Conf + , result : InitResult + , windowSize : Size + } + +decoder : Decoder Init +decoder = + Decode.map5 Init + (Decode.field "time" Decode.float) + (Decode.field "translations" translationsDecoder) + (Decode.field "conf" confDecoder) + (Decode.field "result" initResultDecoder) + (Decode.field "windowSize" sizeDecoder) diff --git a/src/client/LoggedData.elm b/src/client/LoggedData.elm new file mode 100644 index 0000000..9bb0a7f --- /dev/null +++ b/src/client/LoggedData.elm @@ -0,0 +1,44 @@ +module LoggedData exposing + ( LoggedData + , build + ) + +import Time exposing (Time) + +import Msg exposing (Msg) + +import Model exposing (Model) +import Model.Translations exposing (..) +import Model.Conf 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.Model as LoggedInModel + +type alias LoggedData = + { currentTime : Time + , translations : Translations + , conf : Conf + , users : Users + , me : UserId + , payments : Payments + , incomes : Incomes + , categories : Categories + , paymentCategories : PaymentCategories + } + +build : Model -> LoggedInModel.Model -> LoggedData +build model loggedIn = + { currentTime = model.currentTime + , translations = model.translations + , conf = model.conf + , users = loggedIn.users + , me = loggedIn.me + , payments = loggedIn.payments + , incomes = loggedIn.incomes + , categories = loggedIn.categories + , paymentCategories = loggedIn.paymentCategories + } diff --git a/src/client/LoggedIn/Category/Model.elm b/src/client/LoggedIn/Category/Model.elm new file mode 100644 index 0000000..7092fc4 --- /dev/null +++ b/src/client/LoggedIn/Category/Model.elm @@ -0,0 +1,36 @@ +module LoggedIn.Category.Model exposing + ( Model + , AddCategory + , init + , initForm + , validation + ) + +import Date exposing (Date) + +import Form exposing (Form) +import Form.Validate as Validate exposing (Validation) +import Validation + +type alias Model = + { addCategory : Form String AddCategory + } + +type alias AddCategory = + { amount : Int + , date : Date + } + +init : Model +init = + { addCategory = initForm + } + +initForm : Form String AddCategory +initForm = Form.initial [] validation + +validation : Validation String AddCategory +validation = + Validate.map2 AddCategory + (Validate.field "amount" (Validate.int |> Validate.andThen (Validate.minInt 1))) + (Validate.field "date" Validation.date) diff --git a/src/client/LoggedIn/Category/Msg.elm b/src/client/LoggedIn/Category/Msg.elm new file mode 100644 index 0000000..3184297 --- /dev/null +++ b/src/client/LoggedIn/Category/Msg.elm @@ -0,0 +1,9 @@ +module LoggedIn.Category.Msg exposing + ( Msg(..) + ) + +import Form exposing (Form) + +type Msg = + NoOp + | AddCategoryMsg Form.Msg diff --git a/src/client/LoggedIn/Category/Table/View.elm b/src/client/LoggedIn/Category/Table/View.elm new file mode 100644 index 0000000..fa7a7b1 --- /dev/null +++ b/src/client/LoggedIn/Category/Table/View.elm @@ -0,0 +1,124 @@ +module LoggedIn.Category.Table.View exposing + ( view + ) + +import Dict exposing (..) +import Date exposing (Date) +import String exposing (append) + +import FontAwesome +import View.Color as Color + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Dialog +import Dialog.AddCategory.Model as AddCategory +import Dialog.AddCategory.View as AddCategory + +import Tooltip + +import Msg exposing (Msg) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Msg as LoggedInMsg + +import LoggedIn.Category.Model as Category +import View.Date as Date +import LoggedIn.View.Format as Format + +import Model.User exposing (getUserName) +import Model.Category as Category exposing (CategoryId, Category) +import Model.PaymentCategory as PaymentCategory +import Model.Translations exposing (getMessage) + +view : LoggedData -> Category.Model -> Html Msg +view loggedData categoryModel = + let categories = + loggedData.categories + |> Dict.toList + |> List.sortBy (.name << Tuple.second) + in div + [ class "table" ] + [ div + [ class "lines" ] + ( headerLine loggedData :: List.map (paymentLine loggedData categoryModel) categories) + , if List.isEmpty (Dict.toList loggedData.categories) + then + div + [ class "emptyTableMsg" ] + [ text <| getMessage loggedData.translations "NoCategories" ] + else + text "" + ] + +headerLine : LoggedData -> Html Msg +headerLine loggedData = + div + [ class "header" ] + [ div [ class "cell name" ] [ text <| getMessage loggedData.translations "Name" ] + , div [ class "cell category" ] [ text <| getMessage loggedData.translations "Color" ] + , div [ class "cell" ] [] + , div [ class "cell" ] [] + , div [ class "cell" ] [] + ] + +paymentLine : LoggedData -> Category.Model -> (CategoryId, Category) -> Html Msg +paymentLine loggedData categoryModel (categoryId, category) = + div + [ class "row" ] + [ div + [ class "cell category" ] + [ text category.name ] + , div + [ class "cell category" ] + [ span + [ class "tag" + , style [("background-color", category.color)] + ] + [ text category.color ] + ] + , div + [ class "cell button" ] + [ let currentDate = Date.fromTime loggedData.currentTime + in AddCategory.button + loggedData + (AddCategory.initialClone loggedData.translations category) + "CloneCategory" + (FontAwesome.clone Color.chestnutRose 18) + (Just (getMessage loggedData.translations "Clone")) + ] + , div + [ class "cell button" ] + [ AddCategory.button + loggedData + (AddCategory.initialEdit loggedData.translations categoryId category) + "EditCategory" + (FontAwesome.pencil Color.chestnutRose 18) + (Just (getMessage loggedData.translations "Edit")) + ] + , div + [ class "cell button" ] + [ if PaymentCategory.isCategoryUnused categoryId loggedData.paymentCategories + then + let dialogConfig = + { className = "deleteCategoryDialog" + , title = getMessage loggedData.translations "ConfirmCategoryDelete" + , body = always <| text "" + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeleteCategory categoryId + , undo = getMessage loggedData.translations "Undo" + } + in button + ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") + ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] + ) + [ FontAwesome.trash Color.chestnutRose 18 ] + else + span + ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "UsedCategory") ) + [ FontAwesome.trash Color.silver 18 ] + ] + ] diff --git a/src/client/LoggedIn/Category/Update.elm b/src/client/LoggedIn/Category/Update.elm new file mode 100644 index 0000000..1072ef0 --- /dev/null +++ b/src/client/LoggedIn/Category/Update.elm @@ -0,0 +1,24 @@ +module LoggedIn.Category.Update exposing + ( update + ) + +import Form exposing (Form) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Category.Model as Category +import LoggedIn.Category.Msg as Category + +update : LoggedData -> Category.Msg -> Category.Model -> (Category.Model, Cmd Category.Msg) +update loggedData msg model = + case msg of + + Category.NoOp -> + ( model + , Cmd.none + ) + + Category.AddCategoryMsg formMsg -> + ( { model | addCategory = Form.update Category.validation formMsg model.addCategory } + , Cmd.none + ) diff --git a/src/client/LoggedIn/Category/View.elm b/src/client/LoggedIn/Category/View.elm new file mode 100644 index 0000000..4e04fa2 --- /dev/null +++ b/src/client/LoggedIn/Category/View.elm @@ -0,0 +1,35 @@ +module LoggedIn.Category.View exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) + +import LoggedData exposing (LoggedData) + +import Msg exposing (Msg) + +import Dialog.AddCategory.Model as AddCategory +import Dialog.AddCategory.View as AddCategory + +import LoggedIn.Category.Model as Category +import LoggedIn.Category.Table.View as Table + +import Model.Translations exposing (getMessage, getParamMessage) + +view : LoggedData -> Category.Model -> Html Msg +view loggedData categoryModel = + div + [ class "categories" ] + [ div + [ class "titleButton withMargin" ] + [ h1 [] [ text <| getMessage loggedData.translations "Categories" ] + , AddCategory.button + loggedData + (AddCategory.initialAdd loggedData.translations) + "AddCategory" + (text (getMessage loggedData.translations "AddCategory")) + Nothing + ] + , Table.view loggedData categoryModel + ] diff --git a/src/client/LoggedIn/Home/Header/View.elm b/src/client/LoggedIn/Home/Header/View.elm new file mode 100644 index 0000000..3f8a320 --- /dev/null +++ b/src/client/LoggedIn/Home/Header/View.elm @@ -0,0 +1,104 @@ +module LoggedIn.Home.Header.View exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import String +import Dict +import Date + +import Form exposing (Form) +import View.Form as Form +import View.Events exposing (onSubmitPrevDefault) + +import Msg exposing (Msg) +import LoggedIn.Msg as LoggedInMsg +import LoggedIn.Home.Msg as HomeMsg + +import LoggedData exposing (LoggedData) +import LoggedIn.Home.Model as Home +import Model.Translations exposing (getParamMessage) +import Model.Conf exposing (Conf) +import Model.Payment as Payment exposing (Payments, Frequency(..)) +import Model.Translations exposing (getMessage) + +import Dialog.AddPayment.Model as AddPayment +import Dialog.AddPayment.View as AddPayment + +import LoggedIn.Home.View.ExceedingPayers as ExceedingPayers +import LoggedIn.View.Format as Format +import View.Plural exposing (plural) + +view : LoggedData -> Home.Model -> Payments -> Frequency -> Html Msg +view loggedData { search } payments frequency = + let currentDate = Date.fromTime loggedData.currentTime + in Html.div + [ class "header" ] + [ div + [ class "payerAndAdd" ] + [ ExceedingPayers.view loggedData + , AddPayment.button + loggedData + (AddPayment.initialAdd loggedData.translations currentDate frequency) + "AddPayment" + (text (getMessage loggedData.translations "AddPayment")) + Nothing + ] + , Html.div + [ class "searchLine" ] + [ searchForm loggedData search ] + , infos loggedData payments + ] + +searchForm : LoggedData -> Form String Home.Search -> Html Msg +searchForm loggedData search = + Html.map (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.SearchMsg) <| + Html.form + [ onSubmitPrevDefault Form.NoOp ] + [ Form.textInput loggedData.translations search "search" "name" + , if List.isEmpty (Payment.monthly loggedData.payments) + then text "" + else Form.radioInputs loggedData.translations search "search" "frequency" [ toString Punctual, toString Monthly ] + ] + +infos : LoggedData -> Payments -> Html Msg +infos loggedData payments = + let paymentsCount = List.length payments + in if paymentsCount == 0 + then text "" + else + let count = plural loggedData.translations (List.length payments) "Payment" "Payments" + sum = paymentsSum loggedData.conf payments + in div + [ class "infos" ] + [ span + [ class "total" ] + [ text <| getParamMessage [ count, sum ] loggedData.translations "Worth" ] + , span + [ class "partition" ] + [ text <| paymentsPartition loggedData payments ] + ] + +paymentsPartition : LoggedData -> Payments -> String +paymentsPartition loggedData payments = + String.join + ", " + ( loggedData.users + |> Dict.toList + |> List.map (Tuple.mapFirst (\userId -> Payment.totalPayments (always True) userId payments)) + |> List.filter (\(sum, _) -> sum > 0) + |> List.sortBy Tuple.first + |> List.reverse + |> List.map (\(sum, user) -> + getParamMessage [ user.name, Format.price loggedData.conf sum ] loggedData.translations "By" + ) + ) + +paymentsSum : Conf -> Payments -> String +paymentsSum conf payments = + payments + |> List.map .cost + |> List.sum + |> Format.price conf diff --git a/src/client/LoggedIn/Home/Model.elm b/src/client/LoggedIn/Home/Model.elm new file mode 100644 index 0000000..ace1593 --- /dev/null +++ b/src/client/LoggedIn/Home/Model.elm @@ -0,0 +1,40 @@ +module LoggedIn.Home.Model exposing + ( Model + , Search + , init + , searchInitial + , validation + ) + +import Form exposing (Form) +import Form.Validate as Validate exposing (Validation) +import Form.Field as Field exposing (Field) + +import Model.User exposing (Users, UserId) +import Model.Payment as Payment exposing (PaymentId, Payments, Frequency(..)) +import Model.Payer exposing (Payers) + +type alias Model = + { currentPage : Int + , search : Form String Search + } + +type alias Search = + { name : Maybe String + , frequency : Frequency + } + +init : Model +init = + { currentPage = 1 + , search = Form.initial (searchInitial Punctual) validation + } + +searchInitial : Frequency -> List (String, Field) +searchInitial frequency = [ ("frequency", Field.string (toString frequency)) ] + +validation : Validation String Search +validation = + Validate.map2 Search + (Validate.field "name" (Validate.maybe Validate.string)) + (Validate.field "frequency" Payment.validateFrequency) diff --git a/src/client/LoggedIn/Home/Msg.elm b/src/client/LoggedIn/Home/Msg.elm new file mode 100644 index 0000000..b5f2566 --- /dev/null +++ b/src/client/LoggedIn/Home/Msg.elm @@ -0,0 +1,12 @@ +module LoggedIn.Home.Msg exposing + ( Msg(..) + ) + +import Form exposing (Form) + +import Model.Payment exposing (PaymentId) + +type Msg = + NoOp + | UpdatePage Int + | SearchMsg Form.Msg diff --git a/src/client/LoggedIn/Home/Update.elm b/src/client/LoggedIn/Home/Update.elm new file mode 100644 index 0000000..b0ce256 --- /dev/null +++ b/src/client/LoggedIn/Home/Update.elm @@ -0,0 +1,35 @@ +module LoggedIn.Home.Update exposing + ( update + ) + +import Form exposing (Form) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Home.Msg as Home +import LoggedIn.Home.Model as Home + +update : LoggedData -> Home.Msg -> Home.Model -> (Home.Model, Cmd Home.Msg) +update loggedData msg model = + case msg of + + Home.NoOp -> + ( model + , Cmd.none + ) + + Home.UpdatePage page -> + ( { model | currentPage = page } + , Cmd.none + ) + + Home.SearchMsg formMsg -> + ( { model + | search = Form.update Home.validation formMsg model.search + , currentPage = + case formMsg of + Form.Input "name" _ _ -> 1 + _ -> model.currentPage + } + , Cmd.none + ) diff --git a/src/client/LoggedIn/Home/View.elm b/src/client/LoggedIn/Home/View.elm new file mode 100644 index 0000000..0b90e67 --- /dev/null +++ b/src/client/LoggedIn/Home/View.elm @@ -0,0 +1,38 @@ +module LoggedIn.Home.View exposing + ( view + ) + +import Date +import Html exposing (..) +import Html.Attributes exposing (..) + +import Form +import Utils.Form as Form + +import LoggedData exposing (LoggedData) +import LoggedIn.Home.Header.View as Header +import LoggedIn.Home.Model as Home +import LoggedIn.Home.Msg as HomeMsg +import LoggedIn.Home.View.Paging as Paging +import LoggedIn.Home.View.Table as Table +import LoggedIn.Msg as LoggedInMsg +import Model.Payment as Payment exposing (Frequency(..)) +import Msg exposing (Msg) + +view : LoggedData -> Home.Model -> Html Msg +view loggedData home = + let (name, frequency) = + case Form.getOutput home.search of + Just data -> (Maybe.withDefault "" data.name, data.frequency) + Nothing -> ("", Punctual) + payments = Payment.search name frequency loggedData.payments + in div + [ class "home" ] + [ Header.view loggedData home payments frequency + , Table.view loggedData home payments frequency + , Paging.view + home.currentPage + (List.length payments) + Msg.NoOp + (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage) + ] diff --git a/src/client/LoggedIn/Home/View/ExceedingPayers.elm b/src/client/LoggedIn/Home/View/ExceedingPayers.elm new file mode 100644 index 0000000..6f2439c --- /dev/null +++ b/src/client/LoggedIn/Home/View/ExceedingPayers.elm @@ -0,0 +1,45 @@ +module LoggedIn.Home.View.ExceedingPayers exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) + +import Msg exposing (Msg) + +import LoggedData exposing (LoggedData) + +import LoggedIn.View.Format as Format + +import Model exposing (Model) +import Model.User exposing (getUserName) +import Model.Payment as Payment +import Model.Payer exposing (..) +import Model.Translations exposing (getMessage) + +view : LoggedData -> Html Msg +view loggedData = + let payments = Payment.punctual loggedData.payments + exceedingPayers = getOrderedExceedingPayers loggedData.currentTime loggedData.users loggedData.incomes payments + in div + [ class "exceedingPayers" ] + ( if List.isEmpty exceedingPayers + then [ text <| getMessage loggedData.translations "PaymentsAreBalanced" ] + else (List.map (exceedingPayer loggedData) exceedingPayers) + ) + +exceedingPayer : LoggedData -> ExceedingPayer -> Html Msg +exceedingPayer loggedData payer = + span + [ class "exceedingPayer" ] + [ span + [ class "userName" ] + [ payer.userId + |> getUserName loggedData.users + |> Maybe.withDefault "−" + |> text + ] + , span + [ class "amount" ] + [ text ("+ " ++ (Format.price loggedData.conf payer.amount)) ] + ] diff --git a/src/client/LoggedIn/Home/View/Paging.elm b/src/client/LoggedIn/Home/View/Paging.elm new file mode 100644 index 0000000..dffe061 --- /dev/null +++ b/src/client/LoggedIn/Home/View/Paging.elm @@ -0,0 +1,109 @@ +module LoggedIn.Home.View.Paging exposing + ( view + ) + +import Color exposing (Color) + +import FontAwesome + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedData exposing (LoggedData) +import Model.Payment as Payment exposing (Payments, perPage) + +showedPages : Int +showedPages = 5 + +view : Int -> Int -> msg -> (Int -> msg) -> Html msg +view currentPage payments noOp pageMsg = + let maxPage = ceiling (toFloat payments / toFloat perPage) + pages = truncatePages currentPage (List.range 1 maxPage) + in if maxPage <= 1 + then + text "" + else + div + [ class "pages" ] + ( [ firstPage currentPage pageMsg + , previousPage currentPage noOp pageMsg + ] + ++ ( List.map (paymentsPage currentPage noOp pageMsg) pages) + ++ [ nextPage currentPage maxPage noOp pageMsg + , lastPage currentPage maxPage pageMsg + ] + ) + +truncatePages : Int -> List Int -> List Int +truncatePages currentPage pages = + let totalPages = List.length pages + showedLeftPages = ceiling ((toFloat showedPages - 1) / 2) + showedRightPages = floor ((toFloat showedPages - 1) / 2) + truncatedPages = + if currentPage <= showedLeftPages then + (List.range 1 showedPages) + else if currentPage > totalPages - showedRightPages then + (List.range (totalPages - showedPages + 1) totalPages) + else + (List.range (currentPage - showedLeftPages) (currentPage + showedRightPages)) + in List.filter (flip List.member pages) truncatedPages + +firstPage : Int -> (Int -> msg) -> Html msg +firstPage currentPage pageMsg = + button + [ classList + [ ("page", True) + , ("disable", currentPage <= 1) + ] + , onClick (pageMsg 1) + ] + [ FontAwesome.fast_backward grey 13 ] + +previousPage : Int -> msg -> (Int -> msg) -> Html msg +previousPage currentPage noOp pageMsg = + button + [ class "page" + , onClick <| + if currentPage > 1 + then (pageMsg <| currentPage - 1) + else noOp + ] + [ FontAwesome.backward grey 13 ] + +nextPage : Int -> Int -> msg -> (Int -> msg) -> Html msg +nextPage currentPage maxPage noOp pageMsg = + button + [ class "page" + , onClick <| + if currentPage < maxPage + then (pageMsg <| currentPage + 1) + else noOp + ] + [ FontAwesome.forward grey 13 ] + +lastPage : Int -> Int -> (Int -> msg) -> Html msg +lastPage currentPage maxPage pageMsg = + button + [ class "page" + , onClick (pageMsg maxPage) + ] + [ FontAwesome.fast_forward grey 13 ] + +paymentsPage : Int -> msg -> (Int -> msg) -> Int -> Html msg +paymentsPage currentPage noOp pageMsg page = + let onCurrentPage = page == currentPage + in button + [ classList + [ ("page", True) + , ("current", onCurrentPage) + ] + , onClick <| + if onCurrentPage + then noOp + else pageMsg page + ] + [ text (toString page) ] + +grey : Color +grey = Color.greyscale 0.35 diff --git a/src/client/LoggedIn/Home/View/Table.elm b/src/client/LoggedIn/Home/View/Table.elm new file mode 100644 index 0000000..8828488 --- /dev/null +++ b/src/client/LoggedIn/Home/View/Table.elm @@ -0,0 +1,166 @@ +module LoggedIn.Home.View.Table exposing + ( view + ) + +import Date exposing (Date) +import Dict exposing (..) +import String exposing (append) + +import FontAwesome +import View.Color as Color + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Dialog +import Dialog.AddPayment.Model as AddPayment +import Dialog.AddPayment.View as AddPayment + +import Tooltip + +import Msg exposing (Msg) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Msg as LoggedInMsg + +import LoggedIn.Home.Model as Home +import LoggedIn.View.Format as Format +import View.Date as Date + +import Model.Payment as Payment exposing (..) +import Model.PaymentCategory as PaymentCategory +import Model.Translations exposing (getMessage) +import Model.User exposing (getUserName) + +view : LoggedData -> Home.Model -> Payments -> Frequency -> Html Msg +view loggedData homeModel payments frequency = + let visiblePayments = + payments + |> List.drop ((homeModel.currentPage - 1) * perPage) + |> List.take perPage + in div + [ class "table" ] + [ div + [ class "lines" ] + ( headerLine loggedData frequency :: List.map (paymentLine loggedData homeModel frequency) visiblePayments ) + , if List.isEmpty visiblePayments + then + div + [ class "emptyTableMsg" ] + [ text <| getMessage loggedData.translations "NoPayment" ] + else + text "" + ] + +headerLine : LoggedData -> Frequency -> Html Msg +headerLine loggedData frequency = + div + [ class "header" ] + [ div [ class "cell category" ] [ text <| getMessage loggedData.translations "Name" ] + , div [ class "cell cost" ] [ text <| getMessage loggedData.translations "Cost" ] + , div [ class "cell user" ] [ text <| getMessage loggedData.translations "Payer" ] + , div [ class "cell user" ] [ text <| getMessage loggedData.translations "PaymentCategory" ] + , case frequency of + Punctual -> div [ class "cell date" ] [ text <| getMessage loggedData.translations "Date" ] + Monthly -> text "" + , div [ class "cell" ] [] + , div [ class "cell" ] [] + , div [ class "cell" ] [] + ] + +paymentLine : LoggedData -> Home.Model -> Frequency -> Payment -> Html Msg +paymentLine loggedData homeModel frequency payment = + div + [ class "row" ] + [ div [ class "cell name" ] [ text payment.name ] + , div + [ classList + [ ("cell cost", True) + , ("refund", payment.cost < 0) + ] + ] + [ text (Format.price loggedData.conf payment.cost) ] + , div + [ class "cell user" ] + [ payment.userId + |> getUserName loggedData.users + |> Maybe.withDefault "−" + |> text + ] + , div + [ class "cell category" ] + ( let mbCategory = + PaymentCategory.search payment.name loggedData.paymentCategories + |> Maybe.andThen (\category -> Dict.get category loggedData.categories) + in case mbCategory of + Just category -> + [ span + [ class "tag" + , style [("background-color", category.color)] + ] + [ text category.name ] + ] + Nothing -> + [] + ) + , case frequency of + Punctual -> + div + [ class "cell date" ] + [ span + [ class "shortDate" ] + [ text (Date.shortView payment.date loggedData.translations) ] + , span + [ class "longDate" ] + [ text (Date.longView payment.date loggedData.translations) ] + ] + Monthly -> + text "" + , div + [ class "cell button" ] + [ let currentDate = Date.fromTime loggedData.currentTime + category = PaymentCategory.search payment.name loggedData.paymentCategories + in AddPayment.button + loggedData + (AddPayment.initialClone loggedData.translations currentDate category payment) + "ClonePayment" + (FontAwesome.clone Color.chestnutRose 18) + (Just (getMessage loggedData.translations "Clone")) + ] + , div + [ class "cell button" ] + [ if loggedData.me /= payment.userId + then + text "" + else + let category = PaymentCategory.search payment.name loggedData.paymentCategories + in AddPayment.button + loggedData + (AddPayment.initialEdit loggedData.translations category payment) + "EditPayment" + (FontAwesome.pencil Color.chestnutRose 18) + (Just (getMessage loggedData.translations "Edit")) + ] + , div + [ class "cell button" ] + [ if loggedData.me /= payment.userId + then + text "" + else + let dialogConfig = + { className = "deletePaymentDialog" + , title = getMessage loggedData.translations "ConfirmPaymentDelete" + , body = always <| text "" + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeletePayment payment.id + , undo = getMessage loggedData.translations "Undo" + } + in button + ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") + ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] + ) + [ FontAwesome.trash Color.chestnutRose 18 ] + ] + ] diff --git a/src/client/LoggedIn/Income/Model.elm b/src/client/LoggedIn/Income/Model.elm new file mode 100644 index 0000000..7d852b9 --- /dev/null +++ b/src/client/LoggedIn/Income/Model.elm @@ -0,0 +1,36 @@ +module LoggedIn.Income.Model exposing + ( Model + , AddIncome + , init + , initForm + , validation + ) + +import Date exposing (Date) + +import Form exposing (Form) +import Form.Validate as Validate exposing (Validation) +import Validation + +type alias Model = + { addIncome : Form String AddIncome + } + +type alias AddIncome = + { amount : Int + , date : Date + } + +init : Model +init = + { addIncome = initForm + } + +initForm : Form String AddIncome +initForm = Form.initial [] validation + +validation : Validation String AddIncome +validation = + Validate.map2 AddIncome + (Validate.field "amount" (Validate.int |> Validate.andThen (Validate.minInt 1))) + (Validate.field "date" Validation.date) diff --git a/src/client/LoggedIn/Income/Msg.elm b/src/client/LoggedIn/Income/Msg.elm new file mode 100644 index 0000000..0a09dad --- /dev/null +++ b/src/client/LoggedIn/Income/Msg.elm @@ -0,0 +1,9 @@ +module LoggedIn.Income.Msg exposing + ( Msg(..) + ) + +import Form exposing (Form) + +type Msg = + NoOp + | AddIncomeMsg Form.Msg diff --git a/src/client/LoggedIn/Income/Update.elm b/src/client/LoggedIn/Income/Update.elm new file mode 100644 index 0000000..0023c76 --- /dev/null +++ b/src/client/LoggedIn/Income/Update.elm @@ -0,0 +1,24 @@ +module LoggedIn.Income.Update exposing + ( update + ) + +import Form exposing (Form) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Income.Model as Income +import LoggedIn.Income.Msg as Income + +update : LoggedData -> Income.Msg -> Income.Model -> (Income.Model, Cmd Income.Msg) +update loggedData msg model = + case msg of + + Income.NoOp -> + ( model + , Cmd.none + ) + + Income.AddIncomeMsg formMsg -> + ( { model | addIncome = Form.update Income.validation formMsg model.addIncome } + , Cmd.none + ) diff --git a/src/client/LoggedIn/Income/View.elm b/src/client/LoggedIn/Income/View.elm new file mode 100644 index 0000000..00a1646 --- /dev/null +++ b/src/client/LoggedIn/Income/View.elm @@ -0,0 +1,108 @@ +module LoggedIn.Income.View exposing + ( view + ) + +import Dict +import Date +import Time exposing (Time) +import Task + +import FontAwesome + +import Html exposing (..) +import Html.Events exposing (..) +import Html.Attributes exposing (..) + +import Form exposing (Form) +import View.Form as Form +import View.Events exposing (onSubmitPrevDefault) + +import Dialog +import Dialog.AddIncome.Model as AddIncome +import Dialog.AddIncome.View as AddIncome + +import Msg exposing (Msg) + +import LoggedData exposing (LoggedData) + +import Model.Income exposing (IncomeId, Income, userCumulativeIncomeSince) +import Model.Translations exposing (getMessage, getParamMessage) +import Model.Payer exposing (useIncomesFrom) +import Model.User exposing (UserId, User) +import Model.View as View +import LoggedIn.Income.Model as Income + +import LoggedIn.Msg as LoggedInMsg +import LoggedIn.Income.Msg as IncomeMsg + +import View.Date as Date +import LoggedIn.View.Format as Format +import View.Color as Color +import LoggedIn.Income.View.Table as Table + +view : LoggedData -> Income.Model -> Html Msg +view loggedData incomeModel = + div + [ class "income" ] + [ div + [ class "withMargin" ] + [ case useIncomesFrom loggedData.users loggedData.incomes loggedData.payments of + Just since -> cumulativeIncomesView loggedData since + Nothing -> text "" + , div + [ class "titleButton" ] + [ h1 [] [ text <| getMessage loggedData.translations "MonthlyNetIncomes" ] + , AddIncome.button + loggedData + (AddIncome.initialAdd loggedData.translations (Date.fromTime loggedData.currentTime)) + "AddIncome" + (text (getMessage loggedData.translations "AddIncome")) + Nothing + ] + ] + , Table.view loggedData incomeModel + ] + +cumulativeIncomesView : LoggedData -> Time -> Html Msg +cumulativeIncomesView loggedData since = + let longDate = Date.longView (Date.fromTime since) loggedData.translations + in div + [] + [ h1 [] [ text <| getParamMessage [longDate] loggedData.translations "CumulativeIncomesSince" ] + , ul + [] + ( Dict.toList loggedData.users + |> List.map (\(userId, user) -> + (user.name, userCumulativeIncomeSince loggedData.currentTime since loggedData.incomes userId) + ) + |> List.sortBy Tuple.second + |> List.map (\(userName, cumulativeIncome) -> + li + [] + [ text userName + , text " − " + , text <| Format.price loggedData.conf cumulativeIncome + ] + ) + ) + ] + +incomeView : LoggedData -> (IncomeId, Income) -> Html Msg +incomeView loggedData (incomeId, income) = + li + [] + [ text <| Date.shortView (Date.fromTime income.time) loggedData.translations + , text " − " + , text <| Format.price loggedData.conf income.amount + , let dialogConfig = + { className = "deleteIncomeDialog" + , title = getMessage loggedData.translations "ConfirmIncomeDelete" + , body = always <| text "" + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeleteIncome incomeId + , undo = getMessage loggedData.translations "Undo" + } + in button + [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] + [ FontAwesome.trash Color.chestnutRose 14 ] + ] diff --git a/src/client/LoggedIn/Income/View/Table.elm b/src/client/LoggedIn/Income/View/Table.elm new file mode 100644 index 0000000..aa5e392 --- /dev/null +++ b/src/client/LoggedIn/Income/View/Table.elm @@ -0,0 +1,129 @@ +module LoggedIn.Income.View.Table exposing + ( view + ) + +import Dict exposing (..) +import Date exposing (Date) +import String exposing (append) + +import FontAwesome +import View.Color as Color + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Dialog +import Dialog.AddIncome.Model as AddIncome +import Dialog.AddIncome.View as AddIncome + +import Tooltip + +import Msg exposing (Msg) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Msg as LoggedInMsg + +import LoggedIn.Income.Model as Income +import View.Date as Date +import LoggedIn.View.Format as Format + +import Model.User exposing (getUserName) +import Model.Income as Income exposing (..) +import Model.Translations exposing (getMessage) + +view : LoggedData -> Income.Model -> Html Msg +view loggedData incomeModel = + let incomes = + loggedData.incomes + |> Dict.toList + |> List.sortBy (.time << Tuple.second) + |> List.reverse + in div + [ class "table" ] + [ div + [ class "lines" ] + ( headerLine loggedData :: List.map (paymentLine loggedData incomeModel) incomes) + , if List.isEmpty (Dict.toList loggedData.incomes) + then + div + [ class "emptyTableMsg" ] + [ text <| getMessage loggedData.translations "NoIncome" ] + else + text "" + ] + +headerLine : LoggedData -> Html Msg +headerLine loggedData = + div + [ class "header" ] + [ div [ class "cell name" ] [ text <| getMessage loggedData.translations "Name" ] + , div [ class "cell income" ] [ text <| getMessage loggedData.translations "Income" ] + , div [ class "cell date" ] [ text <| getMessage loggedData.translations "Date" ] + , div [ class "cell" ] [] + , div [ class "cell" ] [] + , div [ class "cell" ] [] + ] + +paymentLine : LoggedData -> Income.Model -> (IncomeId, Income) -> Html Msg +paymentLine loggedData incomeModel (incomeId, income) = + div + [ class "row" ] + [ div + [ class "cell name" ] + [ income.userId + |> getUserName loggedData.users + |> Maybe.withDefault "−" + |> text + ] + , div + [ class "cell income" ] + [ text (Format.price loggedData.conf income.amount) ] + , div + [ class "cell date" ] + [ text (Date.longView (Date.fromTime income.time) loggedData.translations) ] + , div + [ class "cell button" ] + [ let currentDate = Date.fromTime loggedData.currentTime + in AddIncome.button + loggedData + (AddIncome.initialClone loggedData.translations currentDate income) + "CloneIncome" + (FontAwesome.clone Color.chestnutRose 18) + (Just (getMessage loggedData.translations "Clone")) + ] + , div + [ class "cell button" ] + [ if loggedData.me /= income.userId + then + text "" + else + AddIncome.button + loggedData + (AddIncome.initialEdit loggedData.translations incomeId income) + "EditIncome" + (FontAwesome.pencil Color.chestnutRose 18) + (Just (getMessage loggedData.translations "Edit")) + ] + , div + [ class "cell button" ] + [ if loggedData.me /= income.userId + then + text "" + else + let dialogConfig = + { className = "deleteIncomeDialog" + , title = getMessage loggedData.translations "ConfirmIncomeDelete" + , body = always <| text "" + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeleteIncome incomeId + , undo = getMessage loggedData.translations "Undo" + } + in button + ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") + ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] + ) + [ FontAwesome.trash Color.chestnutRose 18 ] + ] + ] diff --git a/src/client/LoggedIn/Model.elm b/src/client/LoggedIn/Model.elm new file mode 100644 index 0000000..6bcb0b2 --- /dev/null +++ b/src/client/LoggedIn/Model.elm @@ -0,0 +1,42 @@ +module LoggedIn.Model exposing + ( Model + , init + ) + +import Time exposing (Time) + +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 LoggedIn.Income.Model as Income +import LoggedIn.Category.Model as Categories + +type alias Model = + { home : Home.Model + , income : Income.Model + , category : Categories.Model + , users : Users + , me : UserId + , payments : Payments + , incomes : Incomes + , categories : Categories + , paymentCategories : PaymentCategories + } + +init : Init -> Model +init initData = + { home = Home.init + , income = Income.init + , category = Categories.init + , users = initData.users + , me = initData.me + , payments = initData.payments + , incomes = initData.incomes + , categories = initData.categories + , paymentCategories = initData.paymentCategories + } diff --git a/src/client/LoggedIn/Msg.elm b/src/client/LoggedIn/Msg.elm new file mode 100644 index 0000000..a1379a6 --- /dev/null +++ b/src/client/LoggedIn/Msg.elm @@ -0,0 +1,28 @@ +module LoggedIn.Msg exposing + ( Msg(..) + ) + +import Date exposing (Date) + +import Model.Payment exposing (PaymentId, Frequency) +import Model.Income exposing (IncomeId) +import Model.Category exposing (CategoryId) + +import LoggedIn.Home.Msg as Home +import LoggedIn.Income.Msg as Income +import LoggedIn.Category.Msg as Categories + +type Msg = + NoOp + | HomeMsg Home.Msg + | IncomeMsg Income.Msg + | CategoriesMsg Categories.Msg + | ValidateCreatePayment PaymentId String Int Date CategoryId Frequency + | ValidateEditPayment PaymentId String Int Date CategoryId Frequency + | ValidateDeletePayment PaymentId + | ValidateCreateIncome IncomeId Int Date + | ValidateEditIncome IncomeId Int Date + | ValidateDeleteIncome IncomeId + | ValidateCreateCategory CategoryId String String + | ValidateEditCategory CategoryId String String + | ValidateDeleteCategory CategoryId diff --git a/src/client/LoggedIn/Stat/View.elm b/src/client/LoggedIn/Stat/View.elm new file mode 100644 index 0000000..f57316a --- /dev/null +++ b/src/client/LoggedIn/Stat/View.elm @@ -0,0 +1,62 @@ +module LoggedIn.Stat.View exposing + ( view + ) + +import Date exposing (Month) + +import Html exposing (..) +import Html.Attributes exposing (..) + +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.View.Format as Format +import View.Date as Date +import View.Plural exposing (plural) + +import Utils.List as List + +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) + ] + +getMonthPaymentMean : LoggedData -> List ((Month, Int), Payments) -> Int +getMonthPaymentMean loggedData paymentsByMonth = + paymentsByMonth + |> List.filter (\((month, year), _) -> + let currentDate = Date.fromTime loggedData.currentTime + in not (Date.month currentDate == month && Date.year currentDate == year) + ) + |> List.map (List.sum << List.map .cost << 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 new file mode 100644 index 0000000..9e6d6ee --- /dev/null +++ b/src/client/LoggedIn/Update.elm @@ -0,0 +1,151 @@ +module LoggedIn.Update exposing + ( update + ) + +import Dict +import String +import Task + +import Http exposing (Error(..)) +import Date exposing (Date) +import Platform.Cmd exposing (Cmd) + +import Form + +import Model exposing (Model) +import Model.Payment as Payment exposing (Payment, Frequency(..)) +import Model.Income as Income exposing (Income) +import Model.Category exposing (Category) +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 LoggedIn.Income.Update as Income +import LoggedIn.Income.Model as Income + +import LoggedIn.Category.Update as Categories +import LoggedIn.Category.Model as Categories + +import Utils.Cmd exposing ((:>)) + +update : Model -> LoggedInMsg.Msg -> LoggedInModel.Model -> (LoggedInModel.Model, Cmd LoggedInMsg.Msg) +update model msg loggedIn = + let loggedData = LoggedData.build model loggedIn + in case msg of + + LoggedInMsg.NoOp -> + ( loggedIn + , Cmd.none + ) + + LoggedInMsg.HomeMsg homeMsg -> + case Home.update loggedData homeMsg loggedIn.home of + (home, effects) -> + ( { loggedIn | home = home } + , Cmd.map LoggedInMsg.HomeMsg effects + ) + + LoggedInMsg.IncomeMsg incomeMsg -> + case Income.update loggedData incomeMsg loggedIn.income of + (income, cmd) -> + ( { loggedIn | income = income } + , Cmd.map LoggedInMsg.IncomeMsg cmd + ) + + LoggedInMsg.CategoriesMsg categoriesMsg -> + case Categories.update loggedData categoriesMsg loggedIn.category of + (category, cmd) -> + ( { loggedIn | category = category } + , Cmd.map LoggedInMsg.CategoriesMsg cmd + ) + + 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 -> + let newPayment = Payment paymentId name cost date loggedIn.me frequency + in ( { loggedIn + | payments = newPayment :: loggedIn.payments + , paymentCategories = PaymentCategory.set name category loggedIn.paymentCategories + } + , Cmd.none + ) + ) + + LoggedInMsg.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 + | payments = Payment.edit updatedPayment loggedIn.payments + , paymentCategories = + case mbOldPayment of + Just oldPayment -> + PaymentCategory.update oldPayment.name name category loggedIn.paymentCategories + Nothing -> + loggedData.paymentCategories + } + , Cmd.none + ) + + LoggedInMsg.ValidateDeletePayment paymentId -> + let payments = Payment.delete paymentId loggedIn.payments + frequency = + case Form.getOutput loggedIn.home.search of + Just data -> data.frequency + Nothing -> Punctual + switchToPunctual = + ( frequency == Monthly + && List.isEmpty (Payment.monthly payments) + ) + in if switchToPunctual + then + update model (LoggedInMsg.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial Punctual))) loggedIn + :> (\loggedIn -> + ( { loggedIn | payments = payments } + , Cmd.none + ) + ) + else + ( { loggedIn | payments = payments } + , Cmd.none + ) + + LoggedInMsg.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 -> + 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 | incomes = Dict.remove incomeId loggedIn.incomes } + , Cmd.none + ) + + LoggedInMsg.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 -> + let updateCategory _ = Just <| Category name color + in ( { loggedIn | categories = Dict.update categoryId updateCategory loggedIn.categories } , Cmd.none) + + LoggedInMsg.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 new file mode 100644 index 0000000..2e42a73 --- /dev/null +++ b/src/client/LoggedIn/View.elm @@ -0,0 +1,33 @@ +module LoggedIn.View exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) + +import Page + +import Msg exposing (Msg) +import Model exposing (Model) +import Model.Translations exposing (getMessage) +import LoggedData + +import LoggedIn.Model as LoggedInModel + +import LoggedIn.Home.View as Home +import LoggedIn.Income.View as Income +import LoggedIn.Category.View as Categories +import LoggedIn.Stat.View as Stat + +view : Model -> LoggedInModel.Model -> Html Msg +view model loggedIn = + div + [ class "loggedIn" ] + [ let loggedData = LoggedData.build model loggedIn + in case model.page of + Page.Home -> Home.view loggedData loggedIn.home + Page.Income -> Income.view loggedData loggedIn.income + Page.Categories -> Categories.view loggedData loggedIn.category + Page.Statistics -> Stat.view loggedData + Page.NotFound -> div [] [ text (getMessage model.translations "PageNotFound") ] + ] diff --git a/src/client/LoggedIn/View/Format.elm b/src/client/LoggedIn/View/Format.elm new file mode 100644 index 0000000..f41e2cd --- /dev/null +++ b/src/client/LoggedIn/View/Format.elm @@ -0,0 +1,37 @@ +module LoggedIn.View.Format exposing + ( price + ) + +import String exposing (..) + +import Model.Conf exposing (Conf) + +price : Conf -> Int -> String +price conf amount = + ( number amount + ++ " " + ++ conf.currency + ) + +number : Int -> String +number 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) diff --git a/src/client/Main.elm b/src/client/Main.elm new file mode 100644 index 0000000..9674b66 --- /dev/null +++ b/src/client/Main.elm @@ -0,0 +1,26 @@ +module Main exposing + ( main + ) + +import Navigation +import Time +import Msg exposing (Msg(UpdatePage)) + +import Model exposing (init) +import Update exposing (update) +import View exposing (view) +import Page +import Tooltip + +main = + Navigation.programWithFlags (UpdatePage << Page.fromLocation) + { init = init + , view = view + , update = update + , subscriptions = (\model -> + Sub.batch + [ Time.every 1000 Msg.UpdateTime + , Sub.map Msg.Tooltip Tooltip.subscription + ] + ) + } diff --git a/src/client/Model.elm b/src/client/Model.elm new file mode 100644 index 0000000..5167e42 --- /dev/null +++ b/src/client/Model.elm @@ -0,0 +1,74 @@ +module Model exposing + ( Model + , init + ) + +import Time exposing (Time) +import Json.Decode as Decode + +import Navigation exposing (Location) + +import Html as Html + +import Page exposing (Page) +import Init as Init exposing (Init) +import Msg exposing (Msg) + +import Model.View exposing (..) +import Model.Translations exposing (..) +import Model.Conf exposing (..) +import Model.InitResult exposing (..) +import LoggedIn.Model as LoggedInModel +import SignIn.Model as SignInModel + +import Dialog +import Dialog.Model as DialogModel +import Dialog.Msg as DialogMsg + +import Tooltip + +import Utils.Maybe exposing (isJust) + +type alias Model = + { view : View + , currentTime : Time + , translations : Translations + , conf : Conf + , page : Page + , errors : List String + , dialog : Dialog.Model DialogModel.Model DialogMsg.Msg Msg + , tooltip : Tooltip.Model + } + +init : Decode.Value -> Location -> (Model, Cmd Msg) +init payload location = + let model = + case Decode.decodeValue Init.decoder payload of + Ok { time, translations, conf, result, windowSize } -> + { view = + case result of + InitEmpty -> + SignInView (SignInModel.init Nothing) + InitSuccess init -> + LoggedInView (LoggedInModel.init init) + InitError error -> + SignInView (SignInModel.init (Just error)) + , currentTime = time + , translations = translations + , conf = conf + , page = Page.fromLocation location + , errors = [] + , dialog = Dialog.init DialogModel.init Msg.Dialog + , tooltip = Tooltip.init windowSize.width windowSize.height + } + Err error -> + { view = SignInView (SignInModel.init (Just error)) + , currentTime = 0 + , translations = [] + , conf = { currency = "" } + , page = Page.fromLocation location + , errors = [ error ] + , dialog = Dialog.init DialogModel.init Msg.Dialog + , tooltip = Tooltip.init 0 0 + } + in (model, Cmd.none) diff --git a/src/client/Model/Category.elm b/src/client/Model/Category.elm new file mode 100644 index 0000000..8b653a7 --- /dev/null +++ b/src/client/Model/Category.elm @@ -0,0 +1,35 @@ +module Model.Category exposing + ( Categories + , Category + , CategoryId + , categoriesDecoder + , categoryIdDecoder + , empty + ) + +import Json.Decode as Decode exposing (Decoder) +import Utils.Json as Json +import Dict exposing (Dict) + +type alias Categories = Dict CategoryId Category + +type alias CategoryId = Int + +type alias Category = + { name : String + , color : String + } + +categoriesDecoder : Decoder Categories +categoriesDecoder = + Json.dictDecoder (Decode.field "id" categoryIdDecoder) <| + Decode.map2 + Category + (Decode.field "name" Decode.string) + (Decode.field "color" Decode.string) + +categoryIdDecoder : Decoder CategoryId +categoryIdDecoder = Decode.int + +empty : Categories +empty = Dict.empty diff --git a/src/client/Model/Conf.elm b/src/client/Model/Conf.elm new file mode 100644 index 0000000..308fa04 --- /dev/null +++ b/src/client/Model/Conf.elm @@ -0,0 +1,13 @@ +module Model.Conf exposing + ( Conf + , confDecoder + ) + +import Json.Decode as Decode exposing (Decoder) + +type alias Conf = + { currency : String + } + +confDecoder : Decoder Conf +confDecoder = Decode.map Conf (Decode.field "currency" Decode.string) diff --git a/src/client/Model/Date.elm b/src/client/Model/Date.elm new file mode 100644 index 0000000..bfba02f --- /dev/null +++ b/src/client/Model/Date.elm @@ -0,0 +1,15 @@ +module Model.Date exposing + ( timeDecoder + , dateDecoder + ) + +import Date as Date exposing (Date) +import Json.Decode as Decode exposing (Decoder) +import Json.Decode.Extra as Decode +import Time exposing (Time) + +timeDecoder : Decoder Time +timeDecoder = Decode.map Date.toTime dateDecoder + +dateDecoder : Decoder Date +dateDecoder = Decode.string |> Decode.andThen (Date.fromString >> Decode.fromResult) diff --git a/src/client/Model/Income.elm b/src/client/Model/Income.elm new file mode 100644 index 0000000..34578c6 --- /dev/null +++ b/src/client/Model/Income.elm @@ -0,0 +1,102 @@ +module Model.Income exposing + ( Incomes + , Income + , IncomeId + , incomesDecoder + , incomeIdDecoder + , incomeDefinedForAll + , userCumulativeIncomeSince + , cumulativeIncomesSince + ) + +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 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 + +type alias Income = + { userId : UserId + , time : Float + , amount : Int + } + +incomesDecoder : Decoder Incomes +incomesDecoder = + Json.dictDecoder (Decode.field "id" incomeIdDecoder) <| + Decode.map3 Income + (Decode.field "userId" userIdDecoder) + (Decode.field "date" timeDecoder) + (Decode.field "amount" Decode.int) + +incomeIdDecoder : Decoder IncomeId +incomeIdDecoder = Decode.int + +incomeDefinedForAll : List UserId -> Incomes -> Maybe Time +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 + else Nothing + +userCumulativeIncomeSince : Time -> Time -> Incomes -> UserId -> Int +userCumulativeIncomeSince currentTime since incomes userId = + incomes + |> Dict.values + |> List.filter (\income -> income.userId == userId) + |> cumulativeIncomesSince currentTime since + +cumulativeIncomesSince : Time -> Time -> (List Income) -> Int +cumulativeIncomesSince currentTime since incomes = + cumulativeIncome currentTime (getOrderedIncomesSince since incomes) + +getOrderedIncomesSince : Time -> List Income -> List Income +getOrderedIncomesSince time incomes = + let mbStarterIncome = getIncomeAt time incomes + orderedIncomesSince = filter (\income -> income.time >= time) incomes + in (Maybe.toList mbStarterIncome) ++ orderedIncomesSince + +getIncomeAt : Time -> List Income -> Maybe Income +getIncomeAt time incomes = + case incomes of + [x] -> + if x.time < time + then Just { userId = x.userId, time = time, amount = x.amount } + else Nothing + x1 :: x2 :: xs -> + if x1.time < time && x2.time >= time + then Just { userId = x1.userId, time = time, amount = x1.amount } + else getIncomeAt time (x2 :: xs) + [] -> + Nothing + +cumulativeIncome : Time -> List Income -> Int +cumulativeIncome currentTime incomes = + getIncomesWithDuration currentTime (List.sortBy .time incomes) + |> map durationIncome + |> sum + +getIncomesWithDuration : Time -> List Income -> List (Float, Int) +getIncomesWithDuration currentTime incomes = + case incomes of + [] -> + [] + [income] -> + [(currentTime - income.time, income.amount)] + (income1 :: income2 :: xs) -> + (income2.time - income1.time, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs)) + +durationIncome : (Float, Int) -> Int +durationIncome (duration, income) = + duration * toFloat income / (hour * 24 * 365 / 12) + |> truncate diff --git a/src/client/Model/Init.elm b/src/client/Model/Init.elm new file mode 100644 index 0000000..db7069f --- /dev/null +++ b/src/client/Model/Init.elm @@ -0,0 +1,31 @@ +module Model.Init exposing + ( Init + , initDecoder + ) + +import Json.Decode as Decode exposing (Decoder) + +import Model.Payment exposing (Payments, paymentsDecoder) +import Model.User exposing (Users, UserId, usersDecoder, userIdDecoder) +import Model.Income exposing (Incomes, incomesDecoder) +import Model.Category exposing (Categories, categoriesDecoder) +import Model.PaymentCategory exposing (PaymentCategories, paymentCategoriesDecoder) + +type alias Init = + { users : Users + , me : UserId + , payments : Payments + , incomes : Incomes + , categories : Categories + , paymentCategories : PaymentCategories + } + +initDecoder : Decoder Init +initDecoder = + Decode.map6 Init + (Decode.field "users" usersDecoder) + (Decode.field "me" userIdDecoder) + (Decode.field "payments" paymentsDecoder) + (Decode.field "incomes" incomesDecoder) + (Decode.field "categories" categoriesDecoder) + (Decode.field "paymentCategories" paymentCategoriesDecoder) diff --git a/src/client/Model/InitResult.elm b/src/client/Model/InitResult.elm new file mode 100644 index 0000000..7ce0be2 --- /dev/null +++ b/src/client/Model/InitResult.elm @@ -0,0 +1,28 @@ +module Model.InitResult exposing + ( InitResult(..) + , initResultDecoder + ) + +import Json.Decode as Decode exposing (Decoder) + +import Model.Init exposing (Init, initDecoder) + +type InitResult = + InitEmpty + | InitSuccess Init + | InitError String + +initResultDecoder : Decoder InitResult +initResultDecoder = (Decode.field "tag" Decode.string) |> Decode.andThen initResultDecoderWithTag + +initResultDecoderWithTag : String -> Decoder InitResult +initResultDecoderWithTag tag = + case tag of + "InitEmpty" -> + Decode.succeed InitEmpty + "InitSuccess" -> + Decode.map InitSuccess (Decode.field "contents" initDecoder) + "InitError" -> + Decode.map InitError (Decode.field "contents" Decode.string) + _ -> + Decode.fail <| "got " ++ tag ++ " for InitResult" diff --git a/src/client/Model/Payer.elm b/src/client/Model/Payer.elm new file mode 100644 index 0000000..1663273 --- /dev/null +++ b/src/client/Model/Payer.elm @@ -0,0 +1,138 @@ +module Model.Payer exposing + ( Payers + , Payer + , ExceedingPayer + , getOrderedExceedingPayers + , useIncomesFrom + ) + +import Dict exposing (..) +import List +import Maybe +import Time exposing (Time) +import Date + +import Model.Payment exposing (Payments, totalPayments) +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 + +type alias Payer = + { preIncomePaymentSum : Int + , postIncomePaymentSum : Int + , incomes : List Income + } + +type alias PostPaymentPayer = + { preIncomePaymentSum : Int + , cumulativeIncome : Int + , ratio : Float + } + +type alias ExceedingPayer = + { userId : UserId + , amount : Int + } + +getOrderedExceedingPayers : Time -> Users -> Incomes -> Payments -> List ExceedingPayer +getOrderedExceedingPayers currentTime users incomes payments = + let payers = getPayers currentTime users incomes payments + exceedingPayersOnPreIncome = + payers + |> mapValues .preIncomePaymentSum + |> Dict.toList + |> exceedingPayersFromAmounts + mbSince = useIncomesFrom users incomes payments + in case mbSince of + Just since -> + let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers + mbMaxRatio = + postPaymentPayers + |> Dict.toList + |> List.map (.ratio << Tuple.second) + |> List.maximum + in case mbMaxRatio of + Just maxRatio -> + postPaymentPayers + |> mapValues (getFinalDiff maxRatio) + |> Dict.toList + |> exceedingPayersFromAmounts + Nothing -> + exceedingPayersOnPreIncome + _ -> + exceedingPayersOnPreIncome + +useIncomesFrom : Users -> Incomes -> Payments -> Maybe Time +useIncomesFrom users incomes payments = + let firstPaymentTime = + payments + |> List.map (Date.toTime << .date) + |> List.sort + |> List.head + mbIncomeTime = incomeDefinedForAll (Dict.keys users) incomes + in case (firstPaymentTime, mbIncomeTime) of + (Just paymentTime, Just incomeTime) -> + Just (max paymentTime incomeTime) + _ -> + Nothing + +getPayers : Time -> Users -> Incomes -> Payments -> Payers +getPayers currentTime users incomes payments = + let userIds = Dict.keys users + incomesDefined = incomeDefinedForAll userIds incomes + in userIds + |> List.map (\userId -> + ( userId + , { preIncomePaymentSum = + totalPayments + (\p -> (Date.toTime p.date) < (Maybe.withDefault currentTime incomesDefined)) + userId + payments + , postIncomePaymentSum = + totalPayments + (\p -> + case incomesDefined of + Nothing -> False + Just t -> (Date.toTime p.date) >= t + ) + userId + payments + , incomes = List.filter ((==) userId << .userId) (Dict.values incomes) + } + ) + ) + |> Dict.fromList + +exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer +exceedingPayersFromAmounts userAmounts = + let mbMinAmount = List.minimum << List.map Tuple.second <| userAmounts + in case mbMinAmount of + Nothing -> + [] + Just minAmount -> + userAmounts + |> List.map (\userAmount -> + { userId = Tuple.first userAmount + , amount = Tuple.second userAmount - minAmount + } + ) + |> List.filter (\payer -> payer.amount > 0) + +getPostPaymentPayer : Time -> Time -> Payer -> PostPaymentPayer +getPostPaymentPayer currentTime since payer = + let cumulativeIncome = cumulativeIncomesSince currentTime since payer.incomes + in { preIncomePaymentSum = payer.preIncomePaymentSum + , cumulativeIncome = cumulativeIncome + , ratio = toFloat payer.postIncomePaymentSum / toFloat cumulativeIncome + } + +getFinalDiff : Float -> PostPaymentPayer -> Int +getFinalDiff maxRatio payer = + let postIncomeDiff = + -1 * (maxRatio - payer.ratio) * toFloat payer.cumulativeIncome + |> truncate + in postIncomeDiff + payer.preIncomePaymentSum diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm new file mode 100644 index 0000000..f61ded8 --- /dev/null +++ b/src/client/Model/Payment.elm @@ -0,0 +1,143 @@ +module Model.Payment exposing + ( perPage + , Payments + , Payment + , PaymentId + , Frequency(..) + , paymentsDecoder + , paymentIdDecoder + , find + , edit + , delete + , totalPayments + , punctual + , monthly + , groupAndSortByMonth + , search + , validateFrequency + ) + +import Date exposing (..) +import Date.Extra.Core exposing (monthToInt, intToMonth) +import Json.Decode as Decode exposing (Decoder) +import Json.Decode.Extra as Decode +import List + +import Form.Validate as Validate exposing (Validation) +import Model.Date exposing (dateDecoder) +import Model.User exposing (UserId, userIdDecoder) + +import Utils.List as List +import Utils.Search as Search + +perPage : Int +perPage = 7 + +type alias Payments = List Payment + +type alias Payment = + { id : PaymentId + , name : String + , cost : Int + , date : Date + , userId : UserId + , frequency : Frequency + } + +type alias PaymentId = Int + +type Frequency = Punctual | Monthly + +paymentsDecoder : Decoder Payments +paymentsDecoder = Decode.list paymentDecoder + +paymentDecoder : Decoder Payment +paymentDecoder = + Decode.map6 Payment + (Decode.field "id" paymentIdDecoder) + (Decode.field "name" Decode.string) + (Decode.field "cost" Decode.int) + (Decode.field "date" dateDecoder) + (Decode.field "userId" userIdDecoder) + (Decode.field "frequency" frequencyDecoder) + +paymentIdDecoder : Decoder PaymentId +paymentIdDecoder = Decode.int + +frequencyDecoder : Decoder Frequency +frequencyDecoder = + let frequencyResult input = + case input of + "Punctual" -> Ok Punctual + "Monthly" -> Ok Monthly + _ -> Err ("Could not deduce Punctual nor Monthly from " ++ input) + in Decode.string |> Decode.andThen (Decode.fromResult << frequencyResult) + +find : PaymentId -> Payments -> Maybe Payment +find paymentId payments = + payments + |> List.filter (\p -> p.id == paymentId) + |> List.head + +edit : Payment -> Payments -> Payments +edit payment payments = payment :: delete payment.id payments + +delete : PaymentId -> Payments -> Payments +delete paymentId = List.filter (((/=) paymentId) << .id) + +totalPayments : (Payment -> Bool) -> UserId -> Payments -> Int +totalPayments paymentFilter userId payments = + payments + |> List.filter (\payment -> + paymentFilter payment + && payment.userId == userId + ) + |> List.map .cost + |> List.sum + +punctual : Payments -> Payments +punctual = List.filter ((==) Punctual << .frequency) + +monthly : Payments -> Payments +monthly = List.filter ((==) Monthly << .frequency) + +groupAndSortByMonth : Payments -> List ((Month, Int), Payments) +groupAndSortByMonth payments = + 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 = + payments + |> List.filter ((==) frequency << .frequency) + |> paymentSort frequency + |> List.filter (searchSuccess name) + +paymentSort : Frequency -> Payments -> Payments +paymentSort frequency = + case frequency of + Punctual -> List.reverse << List.sortBy (Date.toTime << .date) + Monthly -> List.sortBy (String.toLower << .name) + +searchSuccess : String -> Payment -> Bool +searchSuccess search { name, cost } = + let searchSuccessWord word = + ( String.contains (Search.format word) (Search.format name) + || String.contains word (toString cost) + ) + in List.all searchSuccessWord (String.words search) + +validateFrequency : Validation String Frequency +validateFrequency = + Validate.customValidation Validate.string (\str -> + if str == toString Punctual + then + Ok Punctual + else + if str == toString Monthly + then Ok Monthly + else Err (Validate.customError "InvalidFrequency") + ) diff --git a/src/client/Model/PaymentCategory.elm b/src/client/Model/PaymentCategory.elm new file mode 100644 index 0000000..87678fe --- /dev/null +++ b/src/client/Model/PaymentCategory.elm @@ -0,0 +1,48 @@ +module Model.PaymentCategory exposing + ( PaymentCategories + , paymentCategoriesDecoder + , search + , isCategoryUnused + , set + , update + ) + +import Dict exposing (Dict) +import Json.Decode as Decode exposing (Decoder) + +import Model.Category exposing (CategoryId, categoryIdDecoder) +import Utils.Json as Json +import Utils.Search as Search + +type alias PaymentCategories = List PaymentCategory + +type alias PaymentCategory = + { name : String + , category : CategoryId + } + +paymentCategoriesDecoder : Decoder PaymentCategories +paymentCategoriesDecoder = + Decode.list <| Decode.map2 PaymentCategory + (Decode.field "name" Decode.string) + (Decode.field "category" categoryIdDecoder) + +search : String -> PaymentCategories -> Maybe CategoryId +search paymentName paymentCategories = + paymentCategories + |> List.filter (\pc -> Search.format pc.name == Search.format paymentName) + |> List.head + |> Maybe.map .category + +isCategoryUnused : CategoryId -> PaymentCategories -> Bool +isCategoryUnused category paymentCategories = + paymentCategories + |> List.filter ((==) category << .category) + |> List.isEmpty + +set : String -> CategoryId -> PaymentCategories -> PaymentCategories +set name category paymentCategories = update name name category paymentCategories + +update : String -> String -> CategoryId -> PaymentCategories -> PaymentCategories +update oldName newName category paymentCategories = + { name = newName, category = category } :: List.filter (\pc -> not <| Search.format pc.name == Search.format oldName) paymentCategories diff --git a/src/client/Model/Size.elm b/src/client/Model/Size.elm new file mode 100644 index 0000000..f40fb01 --- /dev/null +++ b/src/client/Model/Size.elm @@ -0,0 +1,17 @@ +module Model.Size exposing + ( Size + , sizeDecoder + ) + +import Json.Decode as Decode exposing (Decoder) + +type alias Size = + { width: Int + , height: Int + } + +sizeDecoder : Decoder Size +sizeDecoder = + Decode.map2 Size + (Decode.field "width" Decode.int) + (Decode.field "height" Decode.int) diff --git a/src/client/Model/Translations.elm b/src/client/Model/Translations.elm new file mode 100644 index 0000000..9b314e1 --- /dev/null +++ b/src/client/Model/Translations.elm @@ -0,0 +1,68 @@ +module Model.Translations exposing + ( translationsDecoder + , Translations + , Translation + , getMessage + , getParamMessage + ) + +import Maybe exposing (withDefault) +import Json.Decode as Decode exposing (Decoder) +import String + +type alias Translations = List Translation + +translationsDecoder : Decoder Translations +translationsDecoder = Decode.list translationDecoder + +type alias Translation = + { key : String + , message : List MessagePart + } + +getTranslation : String -> Translations -> Maybe (List MessagePart) +getTranslation key translations = + translations + |> List.filter (\translation -> String.toLower translation.key == String.toLower key) + |> List.head + |> Maybe.map .message + +translationDecoder : Decoder Translation +translationDecoder = + Decode.map2 Translation + (Decode.field "key" Decode.string) + (Decode.field "message" (Decode.list partDecoder)) + +type MessagePart = + Order Int + | Str String + +partDecoder : Decoder MessagePart +partDecoder = (Decode.field "tag" Decode.string) |> Decode.andThen partDecoderWithTag + +partDecoderWithTag : String -> Decoder MessagePart +partDecoderWithTag tag = + case tag of + "Order" -> Decode.map Order (Decode.field "contents" Decode.int) + _ -> Decode.map Str (Decode.field "contents" Decode.string) + +----- + +getMessage : Translations -> String -> String +getMessage = getParamMessage [] + +getParamMessage : List String -> Translations -> String -> String +getParamMessage values translations key = + getTranslation key translations + |> Maybe.map (\parts -> String.concat (List.map (replacePart values) parts)) + |> withDefault key + +replacePart : List String -> MessagePart -> String +replacePart values part = + case part of + Str str -> str + Order n -> + values + |> List.drop (n - 1) + |> List.head + |> withDefault ("{" ++ (toString n) ++ "}") diff --git a/src/client/Model/User.elm b/src/client/Model/User.elm new file mode 100644 index 0000000..f6e8147 --- /dev/null +++ b/src/client/Model/User.elm @@ -0,0 +1,44 @@ +module Model.User exposing + ( Users + , usersDecoder + , User + , userDecoder + , UserId + , userIdDecoder + , getUserName + ) + +import Json.Decode as Decode exposing (Decoder) +import Dict exposing (Dict) + +type alias Users = Dict UserId User + +type alias UserId = Int + +type alias User = + { name : String + , email : String + } + +usersDecoder : Decoder Users +usersDecoder = Decode.map Dict.fromList (Decode.list userWithIdDecoder) + +userWithIdDecoder : Decode.Decoder (UserId, User) +userWithIdDecoder = + Decode.map2 (,) + (Decode.field "id" userIdDecoder) + userDecoder + +userIdDecoder : Decoder UserId +userIdDecoder = Decode.int + +userDecoder : Decoder User +userDecoder = + Decode.map2 User + (Decode.field "name" Decode.string) + (Decode.field "email" Decode.string) + +getUserName : Users -> UserId -> Maybe String +getUserName users userId = + Dict.get userId users + |> Maybe.map .name diff --git a/src/client/Model/View.elm b/src/client/Model/View.elm new file mode 100644 index 0000000..61d42a7 --- /dev/null +++ b/src/client/Model/View.elm @@ -0,0 +1,12 @@ +module Model.View exposing + ( View(..) + ) + +import Model.Payment exposing (Payments) + +import SignIn.Model as SignInModel +import LoggedIn.Model as LoggedInModel + +type View = + SignInView SignInModel.Model + | LoggedInView LoggedInModel.Model diff --git a/src/client/Msg.elm b/src/client/Msg.elm new file mode 100644 index 0000000..cf592aa --- /dev/null +++ b/src/client/Msg.elm @@ -0,0 +1,48 @@ +module Msg exposing + ( Msg(..) + ) + +import Date exposing (Date) +import Time exposing (Time) + +import Page exposing (Page) + +import Model.Init exposing (Init) +import Model.Payment exposing (PaymentId, Frequency) +import Model.Income exposing (IncomeId) +import Model.Category exposing (CategoryId) + +import Dialog +import Dialog.Model as DialogModel +import Dialog.Msg as DialogMsg + +import Tooltip + +import SignIn.Msg as SignInMsg +import LoggedIn.Msg as LoggedInMsg + +type Msg = + NoOp + | UpdatePage Page + | SignIn String + | UpdateTime Time + | GoLoggedInView Init + | UpdateSignIn SignInMsg.Msg + | UpdateLoggedIn LoggedInMsg.Msg + | GoSignInView + | SignOut + | Error String + | Dialog (Dialog.Msg DialogModel.Model DialogMsg.Msg Msg) + | Tooltip Tooltip.Msg + + | CreatePayment String Int Date CategoryId Frequency + | EditPayment PaymentId String Int Date CategoryId Frequency + | DeletePayment PaymentId + + | CreateIncome Int Date + | EditIncome IncomeId Int Date + | DeleteIncome IncomeId + + | CreateCategory String String + | EditCategory CategoryId String String + | DeleteCategory CategoryId diff --git a/src/client/Page.elm b/src/client/Page.elm new file mode 100644 index 0000000..39232e0 --- /dev/null +++ b/src/client/Page.elm @@ -0,0 +1,43 @@ +module Page exposing + ( Page(..) + , toHash + , fromLocation + ) + +import Navigation exposing (Location) +import UrlParser exposing (Parser, (), s) +import String + +type Page = + Home + | Income + | Categories + | Statistics + | NotFound + +toHash : Page -> String +toHash page = + case page of + Home -> "#" + Income -> "#income" + Categories -> "#categories" + Statistics -> "#statistics" + NotFound -> "#notFound" + +fromLocation : Location -> Page +fromLocation location = + if location.hash == "" + then + Home + else + case UrlParser.parseHash pageParser location of + Just page -> page + Nothing -> NotFound + +pageParser : Parser (Page -> a) a +pageParser = + UrlParser.oneOf + [ UrlParser.map Income (s "income") + , UrlParser.map Categories (s "categories") + , UrlParser.map Statistics (s "statistics") + ] diff --git a/src/client/Server.elm b/src/client/Server.elm new file mode 100644 index 0000000..7f25876 --- /dev/null +++ b/src/client/Server.elm @@ -0,0 +1,114 @@ +module Server exposing + ( signIn + , createPayment + , editPayment + , deletePayment + , createIncome + , editIncome + , deleteIncome + , createCategory + , editCategory + , deleteCategory + , signOut + ) + +import Task as Task exposing (Task) +import Http exposing (Error) +import Date +import Json.Decode as Decode +import Json.Encode as Encode +import Date exposing (Date) + +import Date.Extra.Format as DateFormat + +import Utils.Http as HttpUtils + +import Model.Payment exposing (..) +import Model.Income exposing (incomeIdDecoder, IncomeId) +import Model.Category exposing (categoryIdDecoder, CategoryId) +import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) +import Model.Init exposing (Init) + +signIn : String -> (Result Error String -> msg) -> Cmd msg +signIn email = HttpUtils.request "POST" ("/signIn?email=" ++ email) Http.expectString + +createPayment : String -> Int -> Date -> CategoryId -> Frequency -> (Result Error PaymentId -> msg) -> Cmd msg +createPayment name cost date categoryId frequency handleResult = + let json = + Encode.object + [ ("name", Encode.string name) + , ("cost", Encode.int cost) + , ("date", Encode.string (DateFormat.isoDateString date)) + , ("category", Encode.int categoryId) + , ("frequency", Encode.string (toString frequency)) + ] + expect = Http.expectJson (Decode.field "id" paymentIdDecoder) + in HttpUtils.jsonRequest "POST" "/payment" expect handleResult json + +editPayment : PaymentId -> String -> Int -> Date -> CategoryId -> Frequency -> (Result Error String -> msg) -> Cmd msg +editPayment paymentId name cost date categoryId frequency handleResult = + let json = + Encode.object + [ ("id", Encode.int paymentId) + , ("name", Encode.string name) + , ("cost", Encode.int cost) + , ("date", Encode.string (DateFormat.isoDateString date)) + , ("category", Encode.int categoryId) + , ("frequency", Encode.string (toString frequency)) + ] + in HttpUtils.jsonRequest "PUT" "/payment" Http.expectString handleResult json + +deletePayment : PaymentId -> (Result Error String -> msg) -> Cmd msg +deletePayment paymentId = + HttpUtils.request "DELETE" ("/payment?id=" ++ (toString paymentId)) Http.expectString + +createIncome : Int -> Date -> (Result Error IncomeId -> msg) -> Cmd msg +createIncome amount date handleResult = + let json = + Encode.object + [ ("amount", Encode.int amount) + , ("date", Encode.string (DateFormat.isoDateString date)) + ] + expect = Http.expectJson (Decode.field "id" incomeIdDecoder) + in HttpUtils.jsonRequest "POST" "/income" expect handleResult json + +editIncome : IncomeId -> Int -> Date -> (Result Error String -> msg) -> Cmd msg +editIncome incomeId amount date handleResult = + let json = + Encode.object + [ ("id", Encode.int incomeId) + , ("amount", Encode.int amount) + , ("date", Encode.string (DateFormat.isoDateString date)) + ] + in HttpUtils.jsonRequest "PUT" "/income" Http.expectString handleResult json + +deleteIncome : IncomeId -> (Result Error String -> msg) -> Cmd msg +deleteIncome incomeId = + HttpUtils.request "DELETE" ("/income?id=" ++ (toString incomeId)) Http.expectString + +createCategory : String -> String -> (Result Error CategoryId -> msg) -> Cmd msg +createCategory name color handleResult = + let json = + Encode.object + [ ("name", Encode.string name) + , ("color", Encode.string color) + ] + expect = Http.expectJson (Decode.field "id" categoryIdDecoder) + in HttpUtils.jsonRequest "POST" "/category" expect handleResult json + +editCategory : CategoryId -> String -> String -> (Result Error String -> msg) -> Cmd msg +editCategory categoryId name color handleResult = + let json = + Encode.object + [ ("id", Encode.int categoryId) + , ("name", Encode.string name) + , ("color", Encode.string color) + ] + in HttpUtils.jsonRequest "PUT" "/category" Http.expectString handleResult json + +deleteCategory : CategoryId -> (Result Error String -> msg) -> Cmd msg +deleteCategory categoryId = + HttpUtils.request "DELETE" ("/category?id=" ++ (toString categoryId)) Http.expectString + +signOut : (Result Error String -> msg) -> Cmd msg +signOut = HttpUtils.request "POST" "/signOut" Http.expectString diff --git a/src/client/SignIn/Model.elm b/src/client/SignIn/Model.elm new file mode 100644 index 0000000..19d4305 --- /dev/null +++ b/src/client/SignIn/Model.elm @@ -0,0 +1,17 @@ +module SignIn.Model exposing + ( Model + , init + ) + +type alias Model = + { login : String + , waitingServer : Bool + , result : Maybe (Result String String) + } + +init : Maybe String -> Model +init mbSignInError = + { login = "" + , waitingServer = False + , result = Maybe.map Err mbSignInError + } diff --git a/src/client/SignIn/Msg.elm b/src/client/SignIn/Msg.elm new file mode 100644 index 0000000..f753ebd --- /dev/null +++ b/src/client/SignIn/Msg.elm @@ -0,0 +1,9 @@ +module SignIn.Msg exposing + ( Msg(..) + ) + +type Msg = + UpdateLogin String + | WaitingServer + | ValidLogin + | ErrorLogin String diff --git a/src/client/SignIn/Update.elm b/src/client/SignIn/Update.elm new file mode 100644 index 0000000..98de777 --- /dev/null +++ b/src/client/SignIn/Update.elm @@ -0,0 +1,31 @@ +module SignIn.Update exposing + ( update + ) + +import SignIn.Model exposing (..) +import SignIn.Msg exposing (..) + +import Model.Translations exposing (getMessage, Translations) + +update : Translations -> Msg -> Model -> Model +update translations msg signInView = + case msg of + UpdateLogin login -> + { signInView | + login = login + } + WaitingServer -> + { signInView + | waitingServer = True + } + ValidLogin -> + { signInView + | login = "" + , result = Just (Ok (getMessage translations "SignInEmailSent")) + , waitingServer = False + } + ErrorLogin message -> + { signInView + | result = Just (Err message) + , waitingServer = False + } diff --git a/src/client/SignIn/View.elm b/src/client/SignIn/View.elm new file mode 100644 index 0000000..88f74b0 --- /dev/null +++ b/src/client/SignIn/View.elm @@ -0,0 +1,63 @@ +module SignIn.View exposing + ( view + ) + +import Json.Decode as Decode + +import FontAwesome +import View.Color as Color + +import Html as H exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import SignIn.Msg as SignInMsg +import SignIn.Model as SignInModel + +import Update exposing (..) + +import Model exposing (Model) +import Msg exposing (..) +import Model.Translations exposing (getMessage) + +import View.Events exposing (onSubmitPrevDefault) + +view : Model -> SignInModel.Model -> Html Msg +view model signInModel = + div + [ class "signIn" ] + [ H.form + [ onSubmitPrevDefault (SignIn signInModel.login) ] + [ input + [ value signInModel.login + , on "input" (targetValue |> (Decode.map <| (UpdateSignIn << SignInMsg.UpdateLogin))) + , name "email" + ] + [] + , button + [] + [ if signInModel.waitingServer + then FontAwesome.spinner Color.white 20 + else text (getMessage model.translations "SignIn") + ] + ] + , div + [ class "result" ] + [ signInResult model signInModel ] + ] + +signInResult : Model -> SignInModel.Model -> Html Msg +signInResult model signInModel = + case signInModel.result of + Just result -> + case result of + Ok login -> + div + [ class "success" ] + [ text (getMessage model.translations "SignInEmailSent") ] + Err error -> + div + [ class "error" ] + [ text (getMessage model.translations error) ] + Nothing -> + text "" diff --git a/src/client/Tooltip.elm b/src/client/Tooltip.elm new file mode 100644 index 0000000..4f70cda --- /dev/null +++ b/src/client/Tooltip.elm @@ -0,0 +1,113 @@ +module Tooltip exposing + ( Msg(..) + , Model + , init + , subscription + , update + , view + , show + ) + +import Platform.Cmd + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Mouse exposing (Position) +import Window exposing (Size) + +type Msg = + UpdateMousePosition Position + | UpdateWindowSize Size + | ShowMessage String + | HideMessage + +type alias Model = + { mousePosition : Maybe Position + , windowSize : Size + , message : Maybe String + } + +init : Int -> Int -> Model +init width height = + { mousePosition = Nothing + , windowSize = + { width = width + , height = height + } + , message = Nothing + } + +subscription : Sub Msg +subscription = + Sub.batch + [ Mouse.moves UpdateMousePosition + , Window.resizes UpdateWindowSize + ] + +update : Msg -> Model -> (Model, Cmd Msg) +update msg model = + case msg of + UpdateMousePosition position -> + ( { model | mousePosition = Just position } + , Cmd.none + ) + + UpdateWindowSize size -> + ( { model | windowSize = size } + , Cmd.none + ) + + ShowMessage message -> + ( { model | message = Just message } + , Cmd.none + ) + + HideMessage -> + ( { model | message = Nothing } + , Cmd.none + ) + +view : Model -> Html Msg +view { mousePosition, windowSize, message } = + case (mousePosition, message) of + (Just pos, Just msg) -> + div + [ class "tooltip" + , style + [ ("position", "absolute") + , horizontalPosition windowSize pos + , ("top", px <| pos.y + 15) + ] + ] + [ text msg ] + _ -> + text "" + +horizontalPosition : Size -> Position -> (String, String) +horizontalPosition size position = + if isLeft size position + then ("left", px <| position.x + 5) + else ("right", px <| size.width - position.x) + +verticalPosition : Size -> Position -> (String, String) +verticalPosition size position = + if isTop size position + then ("top", px <| position.y + 20) + else ("bottom", px <| size.height - position.y + 15) + +px : Int -> String +px n = (toString n) ++ "px" + +isLeft : Size -> Position -> Bool +isLeft { width } { x } = x < width // 2 + +isTop : Size -> Position -> Bool +isTop { height } { y } = y < height // 2 + +show : (Msg -> msg) -> String -> List (Attribute msg) +show mapMsg message = + [ onMouseEnter <| mapMsg <| ShowMessage message + , onMouseLeave <| mapMsg <| HideMessage + ] diff --git a/src/client/Update.elm b/src/client/Update.elm new file mode 100644 index 0000000..7006d5a --- /dev/null +++ b/src/client/Update.elm @@ -0,0 +1,182 @@ +module Update exposing + ( update + ) + +import Task +import Platform.Cmd exposing (Cmd) +import Navigation exposing (Location) + +import Page exposing (Page) + +import Server + +import Msg exposing (..) + +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 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 ((:>)) + +update : Msg -> Model -> (Model, Cmd Msg) +update msg model = + case msg of + + NoOp -> + (model, Cmd.none) + + UpdatePage page -> + ({ model | page = page }, Cmd.none) + + SignIn email -> + ( applySignIn model (SignInMsg.WaitingServer) + , Server.signIn email (\result -> case result of + Ok _ -> UpdateSignIn SignInMsg.ValidLogin + Err error -> UpdateSignIn (SignInMsg.ErrorLogin (errorKey error)) + ) + ) + + GoLoggedInView init -> + ( { model | view = V.LoggedInView (LoggedInModel.init init) } + , Cmd.none + ) + + UpdateTime time -> + ({ model | currentTime = time }, Cmd.none) + + GoSignInView -> + ({ model | view = V.SignInView (SignInModel.init Nothing) }, Cmd.none) + + UpdateSignIn signInMsg -> + (applySignIn model signInMsg, Cmd.none) + + UpdateLoggedIn loggedInMsg -> + applyLoggedIn model loggedInMsg + + SignOut -> + ( model + , Server.signOut (\result -> case result of + Ok _ -> GoSignInView + Err _ -> Error "SignOutError" + ) + ) + + Error error -> + ({ model | errors = model.errors ++ [ error ] }, Cmd.none) + + Dialog dialogMsg -> + Dialog.update DialogUpdate.update dialogMsg model.dialog.model model.dialog + |> Tuple.mapFirst (\dialog -> { model | dialog = dialog }) + :> update (Tooltip Tooltip.HideMessage) + + Tooltip tooltipMsg -> + let (newTooltip, command) = Tooltip.update tooltipMsg model.tooltip + in ( { model | tooltip = newTooltip } + , Cmd.map Tooltip command + ) + + 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 + Err _ -> Error "CreatePaymentError" + ) + ) + + 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 + Err _ -> Error "EditPaymentError" + ) + ) + + DeletePayment paymentId -> + ( model + , Server.deletePayment paymentId (\result -> case result of + Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeletePayment paymentId + Err _ -> Error "DeletePaymentError" + ) + ) + + CreateIncome amount date -> + ( model + , Server.createIncome amount date (\result -> case result of + Ok incomeId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreateIncome incomeId amount date + Err _ -> Error "CreateIncomeError" + ) + ) + + EditIncome incomeId amount date -> + ( model + , Server.editIncome incomeId amount date (\result -> case result of + Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateEditIncome incomeId amount date + Err _ -> Error "EditIncomeError" + ) + ) + + DeleteIncome incomeId -> + ( model + , Server.deleteIncome incomeId (\result -> case result of + Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeleteIncome incomeId + Err _ -> Error "DeleteIncomeError" + ) + ) + + CreateCategory name color -> + ( model + , Server.createCategory name color (\result -> case result of + Ok categoryId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreateCategory categoryId name color + Err _ -> Error "CreateCategoryError" + ) + ) + + EditCategory categoryId name color -> + ( model + , Server.editCategory categoryId name color (\result -> case result of + Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateEditCategory categoryId name color + Err _ -> Error "EditCategoryError" + ) + ) + + DeleteCategory categoryId -> + ( model + , Server.deleteCategory categoryId (\result -> case result of + Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeleteCategory categoryId + Err _ -> Error "DeleteCategoryError" + ) + ) + + +applySignIn : Model -> SignInMsg.Msg -> Model +applySignIn model signInMsg = + case model.view of + V.SignInView signInView -> + { model | view = V.SignInView (SignInUpdate.update model.translations signInMsg signInView) } + _ -> + model + +applyLoggedIn : Model -> LoggedInMsg.Msg -> (Model, Cmd Msg) +applyLoggedIn model loggedInMsg = + case model.view of + V.LoggedInView loggedInView -> + let (view, cmd) = LoggedInUpdate.update model loggedInMsg loggedInView + in ( { model | view = V.LoggedInView view } + , Cmd.map UpdateLoggedIn cmd + ) + _ -> + (model, Cmd.none) diff --git a/src/client/Utils/Cmd.elm b/src/client/Utils/Cmd.elm new file mode 100644 index 0000000..5f41cbe --- /dev/null +++ b/src/client/Utils/Cmd.elm @@ -0,0 +1,16 @@ +module Utils.Cmd exposing + ( pipeUpdate + , (:>) + ) + +import Platform.Cmd as Cmd + +pipeUpdate : (model, Cmd msg) -> (model -> (model, Cmd msg)) -> (model, Cmd msg) +pipeUpdate (model, cmd) f = + let (newModel, newCmd) = f model + in (newModel, Cmd.batch [ cmd, newCmd ]) + +(:>) : (m, Cmd a) -> (m -> (m, Cmd a)) -> (m, Cmd a) +(:>) = pipeUpdate + +infixl 0 :> diff --git a/src/client/Utils/Dict.elm b/src/client/Utils/Dict.elm new file mode 100644 index 0000000..7d708e2 --- /dev/null +++ b/src/client/Utils/Dict.elm @@ -0,0 +1,11 @@ +module Utils.Dict exposing + ( mapValues + ) + +import Dict as Dict exposing (..) + +mapValues : (a -> b) -> Dict comparable a -> Dict comparable b +mapValues f = Dict.fromList << List.map (onSecond f) << Dict.toList + +onSecond : (a -> b) -> (comparable, a) -> (comparable, b) +onSecond f tuple = case tuple of (x, y) -> (x, f y) diff --git a/src/client/Utils/Either.elm b/src/client/Utils/Either.elm new file mode 100644 index 0000000..275fc8c --- /dev/null +++ b/src/client/Utils/Either.elm @@ -0,0 +1,9 @@ +module Utils.Either exposing + ( toMaybeError + ) + +toMaybeError : Result a b -> Maybe a +toMaybeError result = + case result of + Ok _ -> Nothing + Err x -> Just x diff --git a/src/client/Utils/Form.elm b/src/client/Utils/Form.elm new file mode 100644 index 0000000..8d75a32 --- /dev/null +++ b/src/client/Utils/Form.elm @@ -0,0 +1,13 @@ +module Utils.Form exposing + ( fieldAsText + ) + +import Form exposing (Form) + +import Model.Payment exposing (Frequency(..)) + +fieldAsText : Form a b -> String -> String +fieldAsText form field = + Form.getFieldAsString field form + |> .value + |> Maybe.withDefault "" diff --git a/src/client/Utils/Http.elm b/src/client/Utils/Http.elm new file mode 100644 index 0000000..dd3870a --- /dev/null +++ b/src/client/Utils/Http.elm @@ -0,0 +1,39 @@ +module Utils.Http exposing + ( jsonRequest + , request + , errorKey + ) + +import Http exposing (..) +import Task exposing (..) +import Json.Decode as Decode exposing (Decoder, Value) +import Json.Encode as Encode + +jsonRequest : String -> String -> Expect a -> (Result Error a -> msg) -> Encode.Value -> Cmd msg +jsonRequest method url expect handleResult value = + requestWithBody method url (jsonBody value) expect handleResult + +request : String -> String -> Expect a -> (Result Error a -> msg) -> Cmd msg +request method url = requestWithBody method url emptyBody + +requestWithBody : String -> String -> Body -> Expect a -> (Result Error a -> msg) -> Cmd msg +requestWithBody method url body expect handleResult = + let req = Http.request + { method = method + , headers = [] + , url = url + , body = body + , expect = expect + , timeout = Nothing + , withCredentials = False + } + in send handleResult req + +errorKey : Error -> String +errorKey error = + case error of + BadUrl _ -> "BadUrl" + Timeout -> "Timeout" + NetworkError -> "NetworkError" + BadPayload _ _ -> "BadPayload" + BadStatus response -> response.body diff --git a/src/client/Utils/Json.elm b/src/client/Utils/Json.elm new file mode 100644 index 0000000..29e815b --- /dev/null +++ b/src/client/Utils/Json.elm @@ -0,0 +1,12 @@ +module Utils.Json exposing + ( dictDecoder + ) + +import Json.Decode as Decode exposing (Decoder) +import Dict exposing (Dict) + +dictDecoder : Decoder comparable -> Decoder a -> Decoder (Dict comparable a) +dictDecoder keyDecoder valueDecoder = + Decode.map2 (,) keyDecoder valueDecoder + |> Decode.list + |> Decode.map Dict.fromList diff --git a/src/client/Utils/List.elm b/src/client/Utils/List.elm new file mode 100644 index 0000000..cc57d9f --- /dev/null +++ b/src/client/Utils/List.elm @@ -0,0 +1,17 @@ +module Utils.List exposing + ( groupBy + , mean + ) + +import Dict + +groupBy : (a -> comparable) -> List a -> List (comparable, List a) +groupBy f xs = + let addItem item dict = + let groupItems = Dict.get (f item) dict |> Maybe.withDefault [] + in Dict.insert (f item) (item :: groupItems) dict + in List.foldr addItem Dict.empty xs + |> Dict.toList + +mean : List Int -> Int +mean xs = (List.sum xs) // (List.length xs) diff --git a/src/client/Utils/Maybe.elm b/src/client/Utils/Maybe.elm new file mode 100644 index 0000000..46456e1 --- /dev/null +++ b/src/client/Utils/Maybe.elm @@ -0,0 +1,34 @@ +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/Utils/Search.elm b/src/client/Utils/Search.elm new file mode 100644 index 0000000..1b70387 --- /dev/null +++ b/src/client/Utils/Search.elm @@ -0,0 +1,10 @@ +module Utils.Search exposing + ( format + ) + +import String + +import Utils.String as String + +format : String -> String +format = String.unaccent << String.toLower diff --git a/src/client/Utils/String.elm b/src/client/Utils/String.elm new file mode 100644 index 0000000..90fe68e --- /dev/null +++ b/src/client/Utils/String.elm @@ -0,0 +1,38 @@ +module Utils.String exposing + ( unaccent + ) + +unaccent : String -> String +unaccent = String.map unaccentChar + +unaccentChar : Char -> Char +unaccentChar c = case c of + 'à' -> 'a' + 'á' -> 'a' + 'â' -> 'a' + 'ã' -> 'a' + 'ä' -> 'a' + 'ç' -> 'c' + 'è' -> 'e' + 'é' -> 'e' + 'ê' -> 'e' + 'ë' -> 'e' + 'ì' -> 'i' + 'í' -> 'i' + 'î' -> 'i' + 'ï' -> 'i' + 'ñ' -> 'n' + 'ò' -> 'o' + 'ó' -> 'o' + 'ô' -> 'o' + 'õ' -> 'o' + 'ö' -> 'o' + 'š' -> 's' + 'ù' -> 'u' + 'ú' -> 'u' + 'û' -> 'u' + 'ü' -> 'u' + 'ý' -> 'y' + 'ÿ' -> 'y' + 'ž' -> 'z' + _ -> c diff --git a/src/client/Validation.elm b/src/client/Validation.elm new file mode 100644 index 0000000..4781c3d --- /dev/null +++ b/src/client/Validation.elm @@ -0,0 +1,47 @@ +module Validation exposing + ( cost + , date + , category + ) + +import Date exposing (Date) +import Date.Extra.Core exposing (intToMonth) +import Date.Extra.Create exposing (dateFromFields) +import Dict +import String exposing (toInt, split) + +import Form.Validate as Validate exposing (Validation) + +import Model.Category exposing (Categories, CategoryId) + +cost : Validation String Int +cost = + Validate.customValidation Validate.int (\n -> + if n == 0 + then Err (Validate.customError "CostMustNotBeNull") + else Ok n + ) + +date : Validation String Date +date = + Validate.customValidation Validate.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 (intToMonth monthNum) dayNum 0 0 0 0) + _ -> Err (Validate.customError "InvalidDate") + _ -> Err (Validate.customError "InvalidDate") + ) + +category : Categories -> Validation String CategoryId +category categories = + Validate.customValidation Validate.string (\str -> + case toInt str of + Ok category -> + if List.member category (Dict.keys categories) + then Ok category + else Err (Validate.customError "InvalidCategory") + Err _ -> + Err (Validate.customError "InvalidCategory") + ) diff --git a/src/client/View.elm b/src/client/View.elm new file mode 100644 index 0000000..66c498a --- /dev/null +++ b/src/client/View.elm @@ -0,0 +1,36 @@ +module View exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) + +import Model exposing (Model) +import Msg exposing (Msg) +import Model.View exposing (..) +import LoggedData +import Dialog +import Tooltip + +import View.Header as Header +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 + [] + [ Header.view model + , case model.view of + SignInView signIn -> + SignInView.view model signIn + LoggedInView loggedIn -> + LoggedInView.view model loggedIn + , Errors.view model.translations model.errors + , Dialog.view model.dialog + , Html.map Msg.Tooltip <| Tooltip.view model.tooltip + ] diff --git a/src/client/View/Color.elm b/src/client/View/Color.elm new file mode 100644 index 0000000..a2a20c7 --- /dev/null +++ b/src/client/View/Color.elm @@ -0,0 +1,12 @@ +module View.Color exposing (..) + +import Color exposing (Color) + +chestnutRose : Color +chestnutRose = Color.rgb 207 92 86 + +white : Color +white = Color.white + +silver : Color +silver = Color.rgb 200 200 200 diff --git a/src/client/View/Date.elm b/src/client/View/Date.elm new file mode 100644 index 0000000..35806ba --- /dev/null +++ b/src/client/View/Date.elm @@ -0,0 +1,48 @@ +module View.Date exposing + ( shortView + , longView + , monthView + ) + +import Date exposing (..) +import Date.Extra.Core as Date +import String + +import Model.Translations exposing (..) + +shortView : Date -> Translations -> String +shortView date translations = + let params = + [ String.pad 2 '0' (toString (Date.day date)) + , String.pad 2 '0' (toString (Date.monthToInt (Date.month date))) + , toString (Date.year date) + ] + in getParamMessage params translations "ShortDate" + +longView : Date -> Translations -> String +longView date translations = + let params = + [ toString (Date.day date) + , (getMessage translations (getMonthKey (Date.month date))) + , toString (Date.year date) + ] + in getParamMessage params translations "LongDate" + +monthView : Translations -> Month -> String +monthView translations month = getMessage translations (getMonthKey month) + +getMonthKey : Month -> String +getMonthKey month = + case month of + Jan -> "January" + Feb -> "February" + Mar -> "March" + Apr -> "April" + May -> "May" + Jun -> "June" + Jul -> "July" + Aug -> "August" + Sep -> "September" + Oct -> "October" + Nov -> "November" + Dec -> "December" diff --git a/src/client/View/Errors.elm b/src/client/View/Errors.elm new file mode 100644 index 0000000..3e25c99 --- /dev/null +++ b/src/client/View/Errors.elm @@ -0,0 +1,21 @@ +module View.Errors exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Model.Translations exposing (Translations, getMessage) + +view : Translations -> List String -> Html msg +view translations errors = + ul + [ class "errors" ] + ( List.map (errorView translations) errors) + +errorView : Translations -> String -> Html msg +errorView translations error = + li + [ class "error" ] + [ text <| getMessage translations error ] diff --git a/src/client/View/Events.elm b/src/client/View/Events.elm new file mode 100644 index 0000000..d71d67d --- /dev/null +++ b/src/client/View/Events.elm @@ -0,0 +1,15 @@ +module View.Events exposing + ( onSubmitPrevDefault + ) + +import Json.Decode as Decode +import Html exposing (..) +import Html.Events exposing (..) +import Html.Attributes exposing (..) + +onSubmitPrevDefault : msg -> Attribute msg +onSubmitPrevDefault value = + onWithOptions + "submit" + { defaultOptions | preventDefault = True } + (Decode.succeed value) diff --git a/src/client/View/Form.elm b/src/client/View/Form.elm new file mode 100644 index 0000000..7a4965d --- /dev/null +++ b/src/client/View/Form.elm @@ -0,0 +1,153 @@ +module View.Form exposing + ( textInput + , colorInput + , selectInput + , radioInputs + , hiddenSubmit + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import FontAwesome +import View.Color as Color + +import Form exposing (Form, FieldState) +import Form.Input as Input +import Form.Error as FormError exposing (ErrorValue(..)) +import Form.Field as Field + +import Msg exposing (Msg) + +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 + fieldId = formName ++ fieldName + in div + [ classList + [ ("textInput", True) + , ("error", isJust field.liveError) + ] + ] + [ Input.textInput + field + [ id fieldId + , classList [ ("filled", isJust field.value) ] + , value (Maybe.withDefault "" field.value) + ] + , label + [ for fieldId ] + [ text (Translations.getMessage translations fieldId) ] + , button + [ type_ "button" + , onClick (Form.Input fieldName Form.Text Field.EmptyField) + , tabindex -1 + ] + [ FontAwesome.times Color.silver 15 ] + , formError translations field + ] + +colorInput : Translations -> Form String a -> String -> String -> Html Form.Msg +colorInput translations form formName fieldName = + let field = Form.getFieldAsString fieldName form + in div + [ classList + [ ("colorInput", True) + , ("error", isJust field.liveError) + ] + ] + [ label + [ for (formName ++ fieldName) ] + [ text (Translations.getMessage translations (formName ++ fieldName)) ] + , Input.textInput + field + [ id (formName ++ fieldName) + , type_ "color" + ] + ] + +radioInputs : Translations -> Form String a -> String -> String -> List String -> Html Form.Msg +radioInputs translations form formName radioName fieldNames = + let field = Form.getFieldAsString radioName form + in div + [ classList + [ ("radioGroup", True) + , ("error", isJust field.liveError) + ] + ] + [ div + [ class "title" ] + [ text (Translations.getMessage translations (formName ++ radioName) ) ] + , div + [ class "radioInputs" ] + (List.map (radioInput translations field formName) fieldNames) + , formError translations field + ] + +radioInput : Translations -> FieldState String String -> String -> String -> Html Form.Msg +radioInput translations field formName fieldName = + div + [ class "radioInput" ] + [ Input.radioInput + field.path + field + [ id (formName ++ fieldName) + , value fieldName + , checked (field.value == Just fieldName) + ] + , label + [ for (formName ++ fieldName) ] + [ text (Translations.getMessage translations (formName ++ fieldName)) + ] + ] + +selectInput : Translations -> Form String a -> String -> String -> List (String, String) -> Html Form.Msg +selectInput translations form formName selectName options = + let field = Form.getFieldAsString selectName form + fieldId = formName ++ selectName + in div + [ classList + [ ("selectInput", True) + , ("error", isJust field.liveError) + ] + ] + [ label + [ for fieldId ] + [ text (Translations.getMessage translations fieldId) ] + , Input.selectInput + (("", "") :: options) + field + [ id fieldId ] + , formError translations field + ] + +formError : Translations -> FieldState String a -> Html msg +formError translations field = + case field.liveError of + Just error -> + let errorElement error params = + div + [ class "errorMessage" ] + [ text (Translations.getParamMessage params translations error) ] + in case error of + CustomError key -> errorElement key [] + SmallerIntThan n -> errorElement "SmallerIntThan" [toString n] + GreaterIntThan n -> errorElement "GreaterIntThan" [toString n] + error -> errorElement (toString error) [] + Nothing -> + text "" + +hiddenSubmit : msg -> Html msg +hiddenSubmit msg = + button + [ style [ ("display", "none") ] + , onClick msg + ] + [] diff --git a/src/client/View/Header.elm b/src/client/View/Header.elm new file mode 100644 index 0000000..12fb87c --- /dev/null +++ b/src/client/View/Header.elm @@ -0,0 +1,60 @@ +module View.Header exposing + ( view + ) + +import Dict + +import FontAwesome +import View.Color as Color + +import Page exposing (..) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Model exposing (Model) +import Model.Translations exposing (getMessage) +import Msg exposing (..) +import Model.View exposing (..) + +view : Model -> Html Msg +view model = + header + [] + ( [ div [ class "title" ] [ text (getMessage model.translations "SharedCost") ] ] + ++ let item page name = + a + [ href (Page.toHash page) + , classList + [ ("item", True) + , ("current", model.page == page) + ] + ] + [ text (getMessage model.translations name) + ] + in case model.view of + LoggedInView { me, users } -> + [ item Home "PaymentsTitle" + , item Income "Income" + , item Categories "Categories" + , item Statistics "Statistics" + , div + [ class "nameSignOut" ] + [ div + [ class "name" ] + [ Dict.get me users + |> Maybe.map .name + |> Maybe.withDefault "" + |> text + ] + , button + [ class "signOut item" + , onClick SignOut + ] + [ FontAwesome.power_off Color.white 30 ] + ] + ] + _ -> + [] + ) diff --git a/src/client/View/Plural.elm b/src/client/View/Plural.elm new file mode 100644 index 0000000..c36eaca --- /dev/null +++ b/src/client/View/Plural.elm @@ -0,0 +1,11 @@ +module View.Plural exposing + ( plural + ) + +import Model.Translations exposing (Translations, getMessage) + +plural : Translations -> Int -> String -> String -> String +plural translations n single multiple = + let singleMessage = getMessage translations single + multipleMessage = getMessage translations multiple + in (toString n) ++ " " ++ if n <= 1 then singleMessage else multipleMessage diff --git a/src/client/elm/Dialog.elm b/src/client/elm/Dialog.elm deleted file mode 100644 index a7e059a..0000000 --- a/src/client/elm/Dialog.elm +++ /dev/null @@ -1,165 +0,0 @@ -module Dialog exposing - ( Msg(..) - , Model - , Config - , init - , update - , view - ) - -import Platform.Cmd exposing (Cmd) -import Task exposing (Task) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - --- Model - -type alias Model model modelMsg msg = - { config : Maybe (Config model msg) - , mapMsg : Msg model modelMsg msg -> msg - , model : model - } - -type alias Config model msg = - { className : String - , title : String - , body : model -> Html msg - , confirm : String - , confirmMsg : model -> msg - , undo : String - } - -init : model -> (Msg model modelMsg msg -> msg) -> Model model modelMsg msg -init model mapMsg = - { config = Nothing - , mapMsg = mapMsg - , model = model - } - --- Update - -type Msg model modelMsg msg = - NoOp - | Update modelMsg - | UpdateAndClose msg - | OpenWithUpdate (Config model msg) modelMsg - | Open (Config model msg) - | Close - -update : (modelMsg -> model -> (model, Cmd modelMsg)) -> Msg model modelMsg msg -> model -> Model model modelMsg msg -> (Model model modelMsg msg, Cmd msg) -update updateModel msg baseModel model = - case msg of - NoOp -> - ( model - , Cmd.none - ) - - Update modelMsg -> - case updateModel modelMsg baseModel of - (newModel, effects) -> - ( { model | model = newModel } - , Cmd.map (model.mapMsg << Update) effects - ) - - UpdateAndClose msg -> - ( { model | config = Nothing } - , Task.perform (always msg) (Task.succeed msg) - ) - - OpenWithUpdate config modelMsg -> - case updateModel modelMsg baseModel of - (newModel, effects) -> - ( { model - | model = newModel - , config = Just config - } - , Cmd.map (model.mapMsg << Update) effects - ) - - Open config -> - ( { model | config = Just config } - , Cmd.none - ) - - Close -> - ( { model | config = Nothing } - , Cmd.none - ) - --- View - -view : Model model modelMsg msg -> Html msg -view { mapMsg, config, model } = - let isVisible = - case config of - Just _ -> True - Nothing -> False - in div - [ class "dialog" ] - [ curtain mapMsg isVisible - , case config of - Nothing -> - text "" - Just c -> - dialog model mapMsg c - ] - -curtain : (Msg model modelMsg msg -> msg) -> Bool -> Html msg -curtain mapMsg isVisible = - div - [ class "curtain" - , style - [ ("position", "fixed") - , ("top", "0") - , ("left", "0") - , ("width", "100%") - , ("height", "100%") - , ("background-color", "rgba(0, 0, 0, 0.5)") - , ("z-index", if isVisible then "1000" else "-1") - , ("opacity", if isVisible then "1" else "0") - , ("transition", "all 0.2s ease") - ] - , onClick (mapMsg Close) - ] - [] - -dialog : model -> (Msg model modelMsg msg -> msg) -> Config model msg -> Html msg -dialog model mapMsg { className, title, body, confirm, confirmMsg, undo } = - div - [ class ("content " ++ className) - , style - [ ("position", "fixed") - , ("top", "25%") - , ("left", "50%") - , ("transform", "translate(-50%, -25%)") - , ("z-index", "1000") - , ("background-color", "white") - , ("padding", "20px") - , ("border-radius", "5px") - , ("box-shadow", "0px 0px 15px rgba(0, 0, 0, 0.5)") - ] - ] - [ h1 [] [ text title ] - , body model - , div - [ style - [ ("float", "right") - ] - ] - [ button - [ class "confirm" - , onClick (confirmMsg model) - , style - [ ("margin-right", "15px") - ] - ] - [ text confirm ] - , button - [ class "undo" - , onClick (mapMsg Close) - ] - [ text undo ] - ] - ] diff --git a/src/client/elm/Dialog/AddCategory/Model.elm b/src/client/elm/Dialog/AddCategory/Model.elm deleted file mode 100644 index 8aeec1a..0000000 --- a/src/client/elm/Dialog/AddCategory/Model.elm +++ /dev/null @@ -1,53 +0,0 @@ -module Dialog.AddCategory.Model exposing - ( Model - , init - , initialAdd - , initialClone - , initialEdit - , validation - ) - -import Date exposing (Date) -import View.Date as Date - -import Form exposing (Form) -import Form.Field as Field exposing (Field) -import Form.Validate as Validate exposing (Validation) -import Validation - -import Model.Translations exposing (Translations) -import Model.Category exposing (Category, CategoryId) - -type alias Model = - { id : Maybe CategoryId - , name : String - , color : String - } - -init : Form String Model -init = Form.initial [] validation - -initialAdd : Translations -> List (String, Field) -initialAdd translations = - [ ("color", Field.string "#000000") - ] - -initialClone : Translations -> Category -> List (String, Field) -initialClone translations category = - [ ("name", Field.string category.name) - , ("color", Field.string category.color) - ] - -initialEdit : Translations -> CategoryId -> Category -> List (String, Field) -initialEdit translations categoryId category = - [ ("id", Field.string (toString categoryId)) - , ("name", Field.string category.name) - , ("color", Field.string category.color) - ] - -validation : Validation String Model -validation = - Validate.map3 Model - (Validate.field "id" (Validate.maybe Validate.int)) - (Validate.field "name" (Validate.string |> Validate.andThen Validate.nonEmpty)) - (Validate.field "color" (Validate.string |> Validate.andThen Validate.nonEmpty)) diff --git a/src/client/elm/Dialog/AddCategory/View.elm b/src/client/elm/Dialog/AddCategory/View.elm deleted file mode 100644 index 6c02351..0000000 --- a/src/client/elm/Dialog/AddCategory/View.elm +++ /dev/null @@ -1,72 +0,0 @@ -module Dialog.AddCategory.View exposing - ( button - ) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Task - -import Form exposing (Form) -import Form.Field as Field exposing (Field) -import Utils.Form as Form - -import Dialog -import Dialog.AddCategory.Model as AddCategory -import Dialog.Msg as DialogMsg - -import Tooltip - -import View.Form as Form -import View.Events exposing (onSubmitPrevDefault) - -import Msg exposing (Msg) -import LoggedIn.Msg as LoggedInMsg -import LoggedIn.Home.Msg as HomeMsg - -import Model.Translations exposing (getMessage) -import Model.View exposing (View(LoggedInView)) - -import LoggedData exposing (LoggedData) -import LoggedIn.Home.Model as HomeModel - -button : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg -button loggedData initialForm title buttonContent tooltip = - let dialogConfig = - { className = "categoryDialog" - , title = getMessage loggedData.translations title - , body = \model -> addCategoryForm loggedData model.addCategory - , confirm = getMessage loggedData.translations "Confirm" - , confirmMsg = submitForm << .addCategory - , undo = getMessage loggedData.translations "Undo" - } - in Html.button - ( ( case tooltip of - Just message -> Tooltip.show Msg.Tooltip message - Nothing -> [] - ) - ++ [ onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.Init "categoryname" (DialogMsg.AddCategoryMsg <| Form.Reset initialForm))) ] - ) - [ buttonContent ] - -addCategoryForm : LoggedData -> Form String AddCategory.Model -> Html Msg -addCategoryForm loggedData addCategory = - let htmlMap = Html.map (Msg.Dialog << Dialog.Update << DialogMsg.AddCategoryMsg) - in Html.form - [ onSubmitPrevDefault Msg.NoOp ] - [ htmlMap <| Form.textInput loggedData.translations addCategory "category" "name" - , htmlMap <| Form.colorInput loggedData.translations addCategory "category" "color" - , Form.hiddenSubmit (submitForm addCategory) - ] - -submitForm : Form String AddCategory.Model -> Msg -submitForm addCategory = - case Form.getOutput addCategory of - Just data -> - case data.id of - Just categoryId -> - Msg.Dialog <| Dialog.UpdateAndClose <| Msg.EditCategory categoryId data.name data.color - Nothing -> - Msg.Dialog <| Dialog.UpdateAndClose <| Msg.CreateCategory data.name data.color - Nothing -> - Msg.Dialog <| Dialog.Update <| DialogMsg.AddCategoryMsg <| Form.Submit diff --git a/src/client/elm/Dialog/AddIncome/Model.elm b/src/client/elm/Dialog/AddIncome/Model.elm deleted file mode 100644 index ad7b25a..0000000 --- a/src/client/elm/Dialog/AddIncome/Model.elm +++ /dev/null @@ -1,53 +0,0 @@ -module Dialog.AddIncome.Model exposing - ( Model - , init - , initialAdd - , initialClone - , initialEdit - , validation - ) - -import Date exposing (Date) -import View.Date as Date - -import Form exposing (Form) -import Form.Field as Field exposing (Field) -import Form.Validate as Validate exposing (Validation) -import Validation - -import Model.Translations exposing (Translations) -import Model.Income exposing (Income, IncomeId) - -type alias Model = - { id : Maybe IncomeId - , amount : Int - , date : Date - } - -init : Form String Model -init = Form.initial [] validation - -initialAdd : Translations -> Date -> List (String, Field) -initialAdd translations date = - [ ("date", Field.string (Date.shortView date translations)) - ] - -initialClone : Translations -> Date -> Income -> List (String, Field) -initialClone translations date income = - [ ("amount", Field.string (toString income.amount)) - , ("date", Field.string (Date.shortView date translations)) - ] - -initialEdit : Translations -> IncomeId -> Income -> List (String, Field) -initialEdit translations incomeId income = - [ ("id", Field.string (toString incomeId)) - , ("amount", Field.string (toString income.amount)) - , ("date", Field.string (Date.shortView (Date.fromTime income.time) translations)) - ] - -validation : Validation String Model -validation = - Validate.map3 Model - (Validate.field "id" (Validate.maybe Validate.int)) - (Validate.field "amount" (Validate.int |> Validate.andThen (Validate.minInt 1))) - (Validate.field "date" Validation.date) diff --git a/src/client/elm/Dialog/AddIncome/View.elm b/src/client/elm/Dialog/AddIncome/View.elm deleted file mode 100644 index b413308..0000000 --- a/src/client/elm/Dialog/AddIncome/View.elm +++ /dev/null @@ -1,72 +0,0 @@ -module Dialog.AddIncome.View exposing - ( button - ) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Task - -import Form exposing (Form) -import Form.Field as Field exposing (Field) -import Utils.Form as Form - -import Dialog -import Dialog.AddIncome.Model as AddIncome -import Dialog.Msg as DialogMsg - -import Tooltip - -import View.Form as Form -import View.Events exposing (onSubmitPrevDefault) - -import Msg exposing (Msg) -import LoggedIn.Msg as LoggedInMsg -import LoggedIn.Home.Msg as HomeMsg - -import Model.Translations exposing (getMessage) -import Model.View exposing (View(LoggedInView)) - -import LoggedData exposing (LoggedData) -import LoggedIn.Home.Model as HomeModel - -button : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg -button loggedData initialForm title buttonContent tooltip = - let dialogConfig = - { className = "incomeDialog" - , title = getMessage loggedData.translations title - , body = \model -> addIncomeForm loggedData model.addIncome - , confirm = getMessage loggedData.translations "Confirm" - , confirmMsg = submitForm << .addIncome - , undo = getMessage loggedData.translations "Undo" - } - in Html.button - ( ( case tooltip of - Just message -> Tooltip.show Msg.Tooltip message - Nothing -> [] - ) - ++ [ onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.Init "incomeamount" (DialogMsg.AddIncomeMsg <| Form.Reset initialForm))) ] - ) - [ buttonContent ] - -addIncomeForm : LoggedData -> Form String AddIncome.Model -> Html Msg -addIncomeForm loggedData addIncome = - let htmlMap = Html.map (Msg.Dialog << Dialog.Update << DialogMsg.AddIncomeMsg) - in Html.form - [ onSubmitPrevDefault Msg.NoOp ] - [ htmlMap <| Form.textInput loggedData.translations addIncome "income" "amount" - , htmlMap <| Form.textInput loggedData.translations addIncome "income" "date" - , Form.hiddenSubmit (submitForm addIncome) - ] - -submitForm : Form String AddIncome.Model -> Msg -submitForm addIncome = - case Form.getOutput addIncome of - Just data -> - case data.id of - Just incomeId -> - Msg.Dialog <| Dialog.UpdateAndClose <| Msg.EditIncome incomeId data.amount data.date - Nothing -> - Msg.Dialog <| Dialog.UpdateAndClose <| Msg.CreateIncome data.amount data.date - Nothing -> - Msg.Dialog <| Dialog.Update <| DialogMsg.AddIncomeMsg <| Form.Submit diff --git a/src/client/elm/Dialog/AddPayment/Model.elm b/src/client/elm/Dialog/AddPayment/Model.elm deleted file mode 100644 index a287d37..0000000 --- a/src/client/elm/Dialog/AddPayment/Model.elm +++ /dev/null @@ -1,70 +0,0 @@ -module Dialog.AddPayment.Model exposing - ( Model - , init - , initialAdd - , initialClone - , initialEdit - , validation - ) - -import Date exposing (Date) -import View.Date as Date - -import Form exposing (Form) -import Form.Field as Field exposing (Field) -import Form.Validate as Validate exposing (Validation) -import Validation - -import Model.Payment as Payment exposing (Payment, Frequency, PaymentId) -import Model.Translations exposing (Translations) -import Model.Category as Category exposing (Categories, CategoryId) - -import Utils.Maybe as Maybe - -type alias Model = - { id : Maybe PaymentId - , name : String - , cost : Int - , date : Date - , category : CategoryId - , frequency : Frequency - } - -init : Form String Model -init = Form.initial [] (validation Category.empty) - -initialAdd : Translations -> Date -> Frequency -> List (String, Field) -initialAdd translations date frequency = - [ ("date", Field.string (Date.shortView date translations)) - , ("frequency", Field.string (toString frequency)) - , ("category", Field.string "") - ] - -initialClone : Translations -> Date -> Maybe CategoryId -> Payment -> List (String, Field) -initialClone translations date category payment = - [ ("name", Field.string payment.name) - , ("cost", Field.string (toString payment.cost)) - , ("date", Field.string (Date.shortView date translations)) - , ("frequency", Field.string (toString payment.frequency)) - , ("category", Field.string (Maybe.map toString category |> Maybe.withDefault "")) - ] - -initialEdit : Translations -> Maybe CategoryId -> Payment -> List (String, Field) -initialEdit translations category payment = - [ ("id", Field.string (toString payment.id)) - , ("name", Field.string payment.name) - , ("cost", Field.string (toString payment.cost)) - , ("date", Field.string (Date.shortView payment.date translations)) - , ("frequency", Field.string (toString payment.frequency)) - , ("category", Field.string (Maybe.map toString category |> Maybe.withDefault "")) - ] - -validation : Categories -> Validation String Model -validation categories = - Validate.map6 Model - (Validate.field "id" (Validate.maybe Validate.int)) - (Validate.field "name" (Validate.string |> Validate.andThen Validate.nonEmpty)) - (Validate.field "cost" (Validate.int |> Validate.andThen (Validate.minInt 1))) - (Validate.field "date" Validation.date) - (Validate.field "category" (Validation.category categories)) - (Validate.field "frequency" Payment.validateFrequency) diff --git a/src/client/elm/Dialog/AddPayment/View.elm b/src/client/elm/Dialog/AddPayment/View.elm deleted file mode 100644 index 078d5b7..0000000 --- a/src/client/elm/Dialog/AddPayment/View.elm +++ /dev/null @@ -1,95 +0,0 @@ -module Dialog.AddPayment.View exposing - ( button - ) - -import Dict -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Task - -import Form exposing (Form) -import Form.Field as Field exposing (Field) -import Utils.Form as Form - -import Dialog -import Dialog.AddPayment.Model as AddPayment -import Dialog.Msg as DialogMsg - -import Tooltip - -import View.Events exposing (onSubmitPrevDefault) -import View.Form as Form - -import LoggedIn.Home.Msg as HomeMsg -import LoggedIn.Msg as LoggedInMsg -import Msg exposing (Msg) - -import Model.Category exposing (Categories) -import Model.Payment as Payment exposing (Frequency(..)) -import Model.PaymentCategory exposing (PaymentCategories) -import Model.Translations exposing (getMessage) -import Model.View exposing (View(LoggedInView)) - -import LoggedData exposing (LoggedData) -import LoggedIn.Home.Model as HomeModel - -button : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg -button loggedData initialForm title buttonContent tooltip = - let dialogConfig = - { className = "paymentDialog" - , title = getMessage loggedData.translations title - , body = \model -> addPaymentForm loggedData model.addPayment - , confirm = getMessage loggedData.translations "Confirm" - , confirmMsg = submitForm loggedData.categories loggedData.paymentCategories << .addPayment - , undo = getMessage loggedData.translations "Undo" - } - in Html.button - ( ( case tooltip of - Just message -> Tooltip.show Msg.Tooltip message - Nothing -> [] - ) - ++ [ class "addPayment" - , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.Init "paymentname" (DialogMsg.AddPaymentMsg loggedData.categories loggedData.paymentCategories <| Form.Reset initialForm))) - ] - ) - [ buttonContent ] - -addPaymentForm : LoggedData -> Form String AddPayment.Model -> Html Msg -addPaymentForm loggedData addPayment = - let htmlMap = Html.map (Msg.Dialog << Dialog.Update << DialogMsg.AddPaymentMsg loggedData.categories loggedData.paymentCategories) - categoryOptions = - loggedData.categories - |> Dict.toList - |> List.sortBy (.name << Tuple.second) - |> List.map (\(id, category) -> (toString id, category.name)) - in Html.form - [ class "addPayment" - , onSubmitPrevDefault Msg.NoOp - ] - [ htmlMap <| Form.textInput loggedData.translations addPayment "payment" "name" - , htmlMap <| Form.textInput loggedData.translations addPayment "payment" "cost" - , if (Form.getFieldAsString "frequency" addPayment).value == Just (toString Punctual) - then htmlMap <| Form.textInput loggedData.translations addPayment "payment" "date" - else text "" - , htmlMap <| Form.selectInput loggedData.translations addPayment "payment" "category" categoryOptions - - , htmlMap <| Form.radioInputs loggedData.translations addPayment "payment" "frequency" [ toString Punctual, toString Monthly ] - , Form.hiddenSubmit (submitForm loggedData.categories loggedData.paymentCategories addPayment) - ] - -submitForm : Categories -> PaymentCategories -> Form String AddPayment.Model -> Msg -submitForm categories paymentCategories addPayment = - case Form.getOutput addPayment of - Just data -> - case data.id of - Just paymentId -> - Msg.Dialog - <| Dialog.UpdateAndClose - <| Msg.EditPayment paymentId data.name data.cost data.date data.category data.frequency - Nothing -> - Msg.Dialog - <| Dialog.UpdateAndClose - <| Msg.CreatePayment data.name data.cost data.date data.category data.frequency - Nothing -> - Msg.Dialog <| Dialog.Update <| DialogMsg.AddPaymentMsg categories paymentCategories <| Form.Submit diff --git a/src/client/elm/Dialog/Model.elm b/src/client/elm/Dialog/Model.elm deleted file mode 100644 index d4fd484..0000000 --- a/src/client/elm/Dialog/Model.elm +++ /dev/null @@ -1,32 +0,0 @@ -module Dialog.Model exposing - ( Model - , init - ) - -import Date exposing (Date) -import View.Date as Date - -import Form exposing (Form) -import Form.Field as Field exposing (Field) -import Form.Validate as Validate exposing (Validation) -import Validation - -import Model.Payment as Payment exposing (Payment, Frequency, PaymentId) -import Model.Translations exposing (Translations) - -import Dialog.AddPayment.Model as AddPayment -import Dialog.AddIncome.Model as AddIncome -import Dialog.AddCategory.Model as AddCategory - -type alias Model = - { addPayment : Form String AddPayment.Model - , addIncome : Form String AddIncome.Model - , addCategory : Form String AddCategory.Model - } - -init : Model -init = - { addPayment = AddPayment.init - , addIncome = AddIncome.init - , addCategory = AddCategory.init - } diff --git a/src/client/elm/Dialog/Msg.elm b/src/client/elm/Dialog/Msg.elm deleted file mode 100644 index 68ed146..0000000 --- a/src/client/elm/Dialog/Msg.elm +++ /dev/null @@ -1,15 +0,0 @@ -module Dialog.Msg exposing - ( Msg(..) - ) - -import Form exposing (Form) - -import Model.Category exposing (Categories) -import Model.PaymentCategory exposing (PaymentCategories) - -type Msg = - NoOp - | Init String Msg - | AddPaymentMsg Categories PaymentCategories Form.Msg - | AddIncomeMsg Form.Msg - | AddCategoryMsg Form.Msg diff --git a/src/client/elm/Dialog/Update.elm b/src/client/elm/Dialog/Update.elm deleted file mode 100644 index 3915548..0000000 --- a/src/client/elm/Dialog/Update.elm +++ /dev/null @@ -1,74 +0,0 @@ -module Dialog.Update exposing - ( update - ) - -import Dom exposing (Id) -import Form exposing (Form) -import Form.Field as Field -import Task - -import Dialog.AddCategory.Model as AddCategory -import Dialog.AddIncome.Model as AddIncome -import Dialog.AddPayment.Model as AddPayment -import Dialog.Model as Dialog -import Dialog.Msg as Dialog - -import Model.Category exposing (Categories) -import Model.PaymentCategory as PaymentCategory exposing (PaymentCategories) - -update : Dialog.Msg -> Dialog.Model -> (Dialog.Model, Cmd Dialog.Msg) -update msg model = - case msg of - - Dialog.NoOp -> - ( model - , Cmd.none - ) - - Dialog.Init inputId dialogMsg -> - update dialogMsg model - |> Tuple.mapSecond (\cmd -> Cmd.batch [cmd, inputFocus inputId]) - - Dialog.AddPaymentMsg categories paymentCategories formMsg -> - ( { model - | addPayment = - Form.update (AddPayment.validation categories) formMsg model.addPayment - |> updateCategory categories paymentCategories formMsg - } - , Cmd.none - ) - - Dialog.AddIncomeMsg formMsg -> - ( { model - | addIncome = Form.update AddIncome.validation formMsg model.addIncome - } - , Cmd.none - ) - - Dialog.AddCategoryMsg formMsg -> - ( { model - | addCategory = Form.update AddCategory.validation formMsg model.addCategory - } - , Cmd.none - ) - -inputFocus : Id -> Cmd Dialog.Msg -inputFocus id = - Dom.focus id - |> Task.map (always Dialog.NoOp) - |> Task.onError (\_ -> Task.succeed Dialog.NoOp) - |> Task.perform (always Dialog.NoOp) - -updateCategory : Categories -> PaymentCategories -> Form.Msg -> (Form String AddPayment.Model -> Form String AddPayment.Model) -updateCategory categories paymentCategories formMsg = - case formMsg of - Form.Input "name" Form.Text (Field.String paymentName) -> - case PaymentCategory.search paymentName paymentCategories of - Just category -> - Form.update - (AddPayment.validation categories) - (Form.Input "category" Form.Text (Field.String <| toString category)) - Nothing -> - identity - _ -> - identity diff --git a/src/client/elm/Init.elm b/src/client/elm/Init.elm deleted file mode 100644 index d87e870..0000000 --- a/src/client/elm/Init.elm +++ /dev/null @@ -1,30 +0,0 @@ -module Init exposing - ( Init - , decoder - ) - -import Time exposing (..) - -import Json.Decode as Decode exposing (Decoder) - -import Model.Translations exposing (..) -import Model.Conf exposing (..) -import Model.InitResult exposing (..) -import Model.Size exposing (..) - -type alias Init = - { time : Time - , translations : Translations - , conf : Conf - , result : InitResult - , windowSize : Size - } - -decoder : Decoder Init -decoder = - Decode.map5 Init - (Decode.field "time" Decode.float) - (Decode.field "translations" translationsDecoder) - (Decode.field "conf" confDecoder) - (Decode.field "result" initResultDecoder) - (Decode.field "windowSize" sizeDecoder) diff --git a/src/client/elm/LoggedData.elm b/src/client/elm/LoggedData.elm deleted file mode 100644 index 9bb0a7f..0000000 --- a/src/client/elm/LoggedData.elm +++ /dev/null @@ -1,44 +0,0 @@ -module LoggedData exposing - ( LoggedData - , build - ) - -import Time exposing (Time) - -import Msg exposing (Msg) - -import Model exposing (Model) -import Model.Translations exposing (..) -import Model.Conf 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.Model as LoggedInModel - -type alias LoggedData = - { currentTime : Time - , translations : Translations - , conf : Conf - , users : Users - , me : UserId - , payments : Payments - , incomes : Incomes - , categories : Categories - , paymentCategories : PaymentCategories - } - -build : Model -> LoggedInModel.Model -> LoggedData -build model loggedIn = - { currentTime = model.currentTime - , translations = model.translations - , conf = model.conf - , users = loggedIn.users - , me = loggedIn.me - , payments = loggedIn.payments - , incomes = loggedIn.incomes - , categories = loggedIn.categories - , paymentCategories = loggedIn.paymentCategories - } diff --git a/src/client/elm/LoggedIn/Category/Model.elm b/src/client/elm/LoggedIn/Category/Model.elm deleted file mode 100644 index 7092fc4..0000000 --- a/src/client/elm/LoggedIn/Category/Model.elm +++ /dev/null @@ -1,36 +0,0 @@ -module LoggedIn.Category.Model exposing - ( Model - , AddCategory - , init - , initForm - , validation - ) - -import Date exposing (Date) - -import Form exposing (Form) -import Form.Validate as Validate exposing (Validation) -import Validation - -type alias Model = - { addCategory : Form String AddCategory - } - -type alias AddCategory = - { amount : Int - , date : Date - } - -init : Model -init = - { addCategory = initForm - } - -initForm : Form String AddCategory -initForm = Form.initial [] validation - -validation : Validation String AddCategory -validation = - Validate.map2 AddCategory - (Validate.field "amount" (Validate.int |> Validate.andThen (Validate.minInt 1))) - (Validate.field "date" Validation.date) diff --git a/src/client/elm/LoggedIn/Category/Msg.elm b/src/client/elm/LoggedIn/Category/Msg.elm deleted file mode 100644 index 3184297..0000000 --- a/src/client/elm/LoggedIn/Category/Msg.elm +++ /dev/null @@ -1,9 +0,0 @@ -module LoggedIn.Category.Msg exposing - ( Msg(..) - ) - -import Form exposing (Form) - -type Msg = - NoOp - | AddCategoryMsg Form.Msg diff --git a/src/client/elm/LoggedIn/Category/Table/View.elm b/src/client/elm/LoggedIn/Category/Table/View.elm deleted file mode 100644 index fa7a7b1..0000000 --- a/src/client/elm/LoggedIn/Category/Table/View.elm +++ /dev/null @@ -1,124 +0,0 @@ -module LoggedIn.Category.Table.View exposing - ( view - ) - -import Dict exposing (..) -import Date exposing (Date) -import String exposing (append) - -import FontAwesome -import View.Color as Color - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import Dialog -import Dialog.AddCategory.Model as AddCategory -import Dialog.AddCategory.View as AddCategory - -import Tooltip - -import Msg exposing (Msg) - -import LoggedData exposing (LoggedData) - -import LoggedIn.Msg as LoggedInMsg - -import LoggedIn.Category.Model as Category -import View.Date as Date -import LoggedIn.View.Format as Format - -import Model.User exposing (getUserName) -import Model.Category as Category exposing (CategoryId, Category) -import Model.PaymentCategory as PaymentCategory -import Model.Translations exposing (getMessage) - -view : LoggedData -> Category.Model -> Html Msg -view loggedData categoryModel = - let categories = - loggedData.categories - |> Dict.toList - |> List.sortBy (.name << Tuple.second) - in div - [ class "table" ] - [ div - [ class "lines" ] - ( headerLine loggedData :: List.map (paymentLine loggedData categoryModel) categories) - , if List.isEmpty (Dict.toList loggedData.categories) - then - div - [ class "emptyTableMsg" ] - [ text <| getMessage loggedData.translations "NoCategories" ] - else - text "" - ] - -headerLine : LoggedData -> Html Msg -headerLine loggedData = - div - [ class "header" ] - [ div [ class "cell name" ] [ text <| getMessage loggedData.translations "Name" ] - , div [ class "cell category" ] [ text <| getMessage loggedData.translations "Color" ] - , div [ class "cell" ] [] - , div [ class "cell" ] [] - , div [ class "cell" ] [] - ] - -paymentLine : LoggedData -> Category.Model -> (CategoryId, Category) -> Html Msg -paymentLine loggedData categoryModel (categoryId, category) = - div - [ class "row" ] - [ div - [ class "cell category" ] - [ text category.name ] - , div - [ class "cell category" ] - [ span - [ class "tag" - , style [("background-color", category.color)] - ] - [ text category.color ] - ] - , div - [ class "cell button" ] - [ let currentDate = Date.fromTime loggedData.currentTime - in AddCategory.button - loggedData - (AddCategory.initialClone loggedData.translations category) - "CloneCategory" - (FontAwesome.clone Color.chestnutRose 18) - (Just (getMessage loggedData.translations "Clone")) - ] - , div - [ class "cell button" ] - [ AddCategory.button - loggedData - (AddCategory.initialEdit loggedData.translations categoryId category) - "EditCategory" - (FontAwesome.pencil Color.chestnutRose 18) - (Just (getMessage loggedData.translations "Edit")) - ] - , div - [ class "cell button" ] - [ if PaymentCategory.isCategoryUnused categoryId loggedData.paymentCategories - then - let dialogConfig = - { className = "deleteCategoryDialog" - , title = getMessage loggedData.translations "ConfirmCategoryDelete" - , body = always <| text "" - , confirm = getMessage loggedData.translations "Confirm" - , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeleteCategory categoryId - , undo = getMessage loggedData.translations "Undo" - } - in button - ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") - ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] - ) - [ FontAwesome.trash Color.chestnutRose 18 ] - else - span - ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "UsedCategory") ) - [ FontAwesome.trash Color.silver 18 ] - ] - ] diff --git a/src/client/elm/LoggedIn/Category/Update.elm b/src/client/elm/LoggedIn/Category/Update.elm deleted file mode 100644 index 1072ef0..0000000 --- a/src/client/elm/LoggedIn/Category/Update.elm +++ /dev/null @@ -1,24 +0,0 @@ -module LoggedIn.Category.Update exposing - ( update - ) - -import Form exposing (Form) - -import LoggedData exposing (LoggedData) - -import LoggedIn.Category.Model as Category -import LoggedIn.Category.Msg as Category - -update : LoggedData -> Category.Msg -> Category.Model -> (Category.Model, Cmd Category.Msg) -update loggedData msg model = - case msg of - - Category.NoOp -> - ( model - , Cmd.none - ) - - Category.AddCategoryMsg formMsg -> - ( { model | addCategory = Form.update Category.validation formMsg model.addCategory } - , Cmd.none - ) diff --git a/src/client/elm/LoggedIn/Category/View.elm b/src/client/elm/LoggedIn/Category/View.elm deleted file mode 100644 index 4e04fa2..0000000 --- a/src/client/elm/LoggedIn/Category/View.elm +++ /dev/null @@ -1,35 +0,0 @@ -module LoggedIn.Category.View exposing - ( view - ) - -import Html exposing (..) -import Html.Attributes exposing (..) - -import LoggedData exposing (LoggedData) - -import Msg exposing (Msg) - -import Dialog.AddCategory.Model as AddCategory -import Dialog.AddCategory.View as AddCategory - -import LoggedIn.Category.Model as Category -import LoggedIn.Category.Table.View as Table - -import Model.Translations exposing (getMessage, getParamMessage) - -view : LoggedData -> Category.Model -> Html Msg -view loggedData categoryModel = - div - [ class "categories" ] - [ div - [ class "titleButton withMargin" ] - [ h1 [] [ text <| getMessage loggedData.translations "Categories" ] - , AddCategory.button - loggedData - (AddCategory.initialAdd loggedData.translations) - "AddCategory" - (text (getMessage loggedData.translations "AddCategory")) - Nothing - ] - , Table.view loggedData categoryModel - ] diff --git a/src/client/elm/LoggedIn/Home/Header/View.elm b/src/client/elm/LoggedIn/Home/Header/View.elm deleted file mode 100644 index 3f8a320..0000000 --- a/src/client/elm/LoggedIn/Home/Header/View.elm +++ /dev/null @@ -1,104 +0,0 @@ -module LoggedIn.Home.Header.View exposing - ( view - ) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import String -import Dict -import Date - -import Form exposing (Form) -import View.Form as Form -import View.Events exposing (onSubmitPrevDefault) - -import Msg exposing (Msg) -import LoggedIn.Msg as LoggedInMsg -import LoggedIn.Home.Msg as HomeMsg - -import LoggedData exposing (LoggedData) -import LoggedIn.Home.Model as Home -import Model.Translations exposing (getParamMessage) -import Model.Conf exposing (Conf) -import Model.Payment as Payment exposing (Payments, Frequency(..)) -import Model.Translations exposing (getMessage) - -import Dialog.AddPayment.Model as AddPayment -import Dialog.AddPayment.View as AddPayment - -import LoggedIn.Home.View.ExceedingPayers as ExceedingPayers -import LoggedIn.View.Format as Format -import View.Plural exposing (plural) - -view : LoggedData -> Home.Model -> Payments -> Frequency -> Html Msg -view loggedData { search } payments frequency = - let currentDate = Date.fromTime loggedData.currentTime - in Html.div - [ class "header" ] - [ div - [ class "payerAndAdd" ] - [ ExceedingPayers.view loggedData - , AddPayment.button - loggedData - (AddPayment.initialAdd loggedData.translations currentDate frequency) - "AddPayment" - (text (getMessage loggedData.translations "AddPayment")) - Nothing - ] - , Html.div - [ class "searchLine" ] - [ searchForm loggedData search ] - , infos loggedData payments - ] - -searchForm : LoggedData -> Form String Home.Search -> Html Msg -searchForm loggedData search = - Html.map (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.SearchMsg) <| - Html.form - [ onSubmitPrevDefault Form.NoOp ] - [ Form.textInput loggedData.translations search "search" "name" - , if List.isEmpty (Payment.monthly loggedData.payments) - then text "" - else Form.radioInputs loggedData.translations search "search" "frequency" [ toString Punctual, toString Monthly ] - ] - -infos : LoggedData -> Payments -> Html Msg -infos loggedData payments = - let paymentsCount = List.length payments - in if paymentsCount == 0 - then text "" - else - let count = plural loggedData.translations (List.length payments) "Payment" "Payments" - sum = paymentsSum loggedData.conf payments - in div - [ class "infos" ] - [ span - [ class "total" ] - [ text <| getParamMessage [ count, sum ] loggedData.translations "Worth" ] - , span - [ class "partition" ] - [ text <| paymentsPartition loggedData payments ] - ] - -paymentsPartition : LoggedData -> Payments -> String -paymentsPartition loggedData payments = - String.join - ", " - ( loggedData.users - |> Dict.toList - |> List.map (Tuple.mapFirst (\userId -> Payment.totalPayments (always True) userId payments)) - |> List.filter (\(sum, _) -> sum > 0) - |> List.sortBy Tuple.first - |> List.reverse - |> List.map (\(sum, user) -> - getParamMessage [ user.name, Format.price loggedData.conf sum ] loggedData.translations "By" - ) - ) - -paymentsSum : Conf -> Payments -> String -paymentsSum conf payments = - payments - |> List.map .cost - |> List.sum - |> Format.price conf diff --git a/src/client/elm/LoggedIn/Home/Model.elm b/src/client/elm/LoggedIn/Home/Model.elm deleted file mode 100644 index ace1593..0000000 --- a/src/client/elm/LoggedIn/Home/Model.elm +++ /dev/null @@ -1,40 +0,0 @@ -module LoggedIn.Home.Model exposing - ( Model - , Search - , init - , searchInitial - , validation - ) - -import Form exposing (Form) -import Form.Validate as Validate exposing (Validation) -import Form.Field as Field exposing (Field) - -import Model.User exposing (Users, UserId) -import Model.Payment as Payment exposing (PaymentId, Payments, Frequency(..)) -import Model.Payer exposing (Payers) - -type alias Model = - { currentPage : Int - , search : Form String Search - } - -type alias Search = - { name : Maybe String - , frequency : Frequency - } - -init : Model -init = - { currentPage = 1 - , search = Form.initial (searchInitial Punctual) validation - } - -searchInitial : Frequency -> List (String, Field) -searchInitial frequency = [ ("frequency", Field.string (toString frequency)) ] - -validation : Validation String Search -validation = - Validate.map2 Search - (Validate.field "name" (Validate.maybe Validate.string)) - (Validate.field "frequency" Payment.validateFrequency) diff --git a/src/client/elm/LoggedIn/Home/Msg.elm b/src/client/elm/LoggedIn/Home/Msg.elm deleted file mode 100644 index b5f2566..0000000 --- a/src/client/elm/LoggedIn/Home/Msg.elm +++ /dev/null @@ -1,12 +0,0 @@ -module LoggedIn.Home.Msg exposing - ( Msg(..) - ) - -import Form exposing (Form) - -import Model.Payment exposing (PaymentId) - -type Msg = - NoOp - | UpdatePage Int - | SearchMsg Form.Msg diff --git a/src/client/elm/LoggedIn/Home/Update.elm b/src/client/elm/LoggedIn/Home/Update.elm deleted file mode 100644 index b0ce256..0000000 --- a/src/client/elm/LoggedIn/Home/Update.elm +++ /dev/null @@ -1,35 +0,0 @@ -module LoggedIn.Home.Update exposing - ( update - ) - -import Form exposing (Form) - -import LoggedData exposing (LoggedData) - -import LoggedIn.Home.Msg as Home -import LoggedIn.Home.Model as Home - -update : LoggedData -> Home.Msg -> Home.Model -> (Home.Model, Cmd Home.Msg) -update loggedData msg model = - case msg of - - Home.NoOp -> - ( model - , Cmd.none - ) - - Home.UpdatePage page -> - ( { model | currentPage = page } - , Cmd.none - ) - - Home.SearchMsg formMsg -> - ( { model - | search = Form.update Home.validation formMsg model.search - , currentPage = - case formMsg of - Form.Input "name" _ _ -> 1 - _ -> model.currentPage - } - , Cmd.none - ) diff --git a/src/client/elm/LoggedIn/Home/View.elm b/src/client/elm/LoggedIn/Home/View.elm deleted file mode 100644 index 0b90e67..0000000 --- a/src/client/elm/LoggedIn/Home/View.elm +++ /dev/null @@ -1,38 +0,0 @@ -module LoggedIn.Home.View exposing - ( view - ) - -import Date -import Html exposing (..) -import Html.Attributes exposing (..) - -import Form -import Utils.Form as Form - -import LoggedData exposing (LoggedData) -import LoggedIn.Home.Header.View as Header -import LoggedIn.Home.Model as Home -import LoggedIn.Home.Msg as HomeMsg -import LoggedIn.Home.View.Paging as Paging -import LoggedIn.Home.View.Table as Table -import LoggedIn.Msg as LoggedInMsg -import Model.Payment as Payment exposing (Frequency(..)) -import Msg exposing (Msg) - -view : LoggedData -> Home.Model -> Html Msg -view loggedData home = - let (name, frequency) = - case Form.getOutput home.search of - Just data -> (Maybe.withDefault "" data.name, data.frequency) - Nothing -> ("", Punctual) - payments = Payment.search name frequency loggedData.payments - in div - [ class "home" ] - [ Header.view loggedData home payments frequency - , Table.view loggedData home payments frequency - , Paging.view - home.currentPage - (List.length payments) - Msg.NoOp - (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage) - ] diff --git a/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm b/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm deleted file mode 100644 index 6f2439c..0000000 --- a/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm +++ /dev/null @@ -1,45 +0,0 @@ -module LoggedIn.Home.View.ExceedingPayers exposing - ( view - ) - -import Html exposing (..) -import Html.Attributes exposing (..) - -import Msg exposing (Msg) - -import LoggedData exposing (LoggedData) - -import LoggedIn.View.Format as Format - -import Model exposing (Model) -import Model.User exposing (getUserName) -import Model.Payment as Payment -import Model.Payer exposing (..) -import Model.Translations exposing (getMessage) - -view : LoggedData -> Html Msg -view loggedData = - let payments = Payment.punctual loggedData.payments - exceedingPayers = getOrderedExceedingPayers loggedData.currentTime loggedData.users loggedData.incomes payments - in div - [ class "exceedingPayers" ] - ( if List.isEmpty exceedingPayers - then [ text <| getMessage loggedData.translations "PaymentsAreBalanced" ] - else (List.map (exceedingPayer loggedData) exceedingPayers) - ) - -exceedingPayer : LoggedData -> ExceedingPayer -> Html Msg -exceedingPayer loggedData payer = - span - [ class "exceedingPayer" ] - [ span - [ class "userName" ] - [ payer.userId - |> getUserName loggedData.users - |> Maybe.withDefault "−" - |> text - ] - , span - [ class "amount" ] - [ text ("+ " ++ (Format.price loggedData.conf payer.amount)) ] - ] diff --git a/src/client/elm/LoggedIn/Home/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm deleted file mode 100644 index dffe061..0000000 --- a/src/client/elm/LoggedIn/Home/View/Paging.elm +++ /dev/null @@ -1,109 +0,0 @@ -module LoggedIn.Home.View.Paging exposing - ( view - ) - -import Color exposing (Color) - -import FontAwesome - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import LoggedData exposing (LoggedData) -import Model.Payment as Payment exposing (Payments, perPage) - -showedPages : Int -showedPages = 5 - -view : Int -> Int -> msg -> (Int -> msg) -> Html msg -view currentPage payments noOp pageMsg = - let maxPage = ceiling (toFloat payments / toFloat perPage) - pages = truncatePages currentPage (List.range 1 maxPage) - in if maxPage <= 1 - then - text "" - else - div - [ class "pages" ] - ( [ firstPage currentPage pageMsg - , previousPage currentPage noOp pageMsg - ] - ++ ( List.map (paymentsPage currentPage noOp pageMsg) pages) - ++ [ nextPage currentPage maxPage noOp pageMsg - , lastPage currentPage maxPage pageMsg - ] - ) - -truncatePages : Int -> List Int -> List Int -truncatePages currentPage pages = - let totalPages = List.length pages - showedLeftPages = ceiling ((toFloat showedPages - 1) / 2) - showedRightPages = floor ((toFloat showedPages - 1) / 2) - truncatedPages = - if currentPage <= showedLeftPages then - (List.range 1 showedPages) - else if currentPage > totalPages - showedRightPages then - (List.range (totalPages - showedPages + 1) totalPages) - else - (List.range (currentPage - showedLeftPages) (currentPage + showedRightPages)) - in List.filter (flip List.member pages) truncatedPages - -firstPage : Int -> (Int -> msg) -> Html msg -firstPage currentPage pageMsg = - button - [ classList - [ ("page", True) - , ("disable", currentPage <= 1) - ] - , onClick (pageMsg 1) - ] - [ FontAwesome.fast_backward grey 13 ] - -previousPage : Int -> msg -> (Int -> msg) -> Html msg -previousPage currentPage noOp pageMsg = - button - [ class "page" - , onClick <| - if currentPage > 1 - then (pageMsg <| currentPage - 1) - else noOp - ] - [ FontAwesome.backward grey 13 ] - -nextPage : Int -> Int -> msg -> (Int -> msg) -> Html msg -nextPage currentPage maxPage noOp pageMsg = - button - [ class "page" - , onClick <| - if currentPage < maxPage - then (pageMsg <| currentPage + 1) - else noOp - ] - [ FontAwesome.forward grey 13 ] - -lastPage : Int -> Int -> (Int -> msg) -> Html msg -lastPage currentPage maxPage pageMsg = - button - [ class "page" - , onClick (pageMsg maxPage) - ] - [ FontAwesome.fast_forward grey 13 ] - -paymentsPage : Int -> msg -> (Int -> msg) -> Int -> Html msg -paymentsPage currentPage noOp pageMsg page = - let onCurrentPage = page == currentPage - in button - [ classList - [ ("page", True) - , ("current", onCurrentPage) - ] - , onClick <| - if onCurrentPage - then noOp - else pageMsg page - ] - [ text (toString page) ] - -grey : Color -grey = Color.greyscale 0.35 diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm deleted file mode 100644 index 8828488..0000000 --- a/src/client/elm/LoggedIn/Home/View/Table.elm +++ /dev/null @@ -1,166 +0,0 @@ -module LoggedIn.Home.View.Table exposing - ( view - ) - -import Date exposing (Date) -import Dict exposing (..) -import String exposing (append) - -import FontAwesome -import View.Color as Color - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import Dialog -import Dialog.AddPayment.Model as AddPayment -import Dialog.AddPayment.View as AddPayment - -import Tooltip - -import Msg exposing (Msg) - -import LoggedData exposing (LoggedData) - -import LoggedIn.Msg as LoggedInMsg - -import LoggedIn.Home.Model as Home -import LoggedIn.View.Format as Format -import View.Date as Date - -import Model.Payment as Payment exposing (..) -import Model.PaymentCategory as PaymentCategory -import Model.Translations exposing (getMessage) -import Model.User exposing (getUserName) - -view : LoggedData -> Home.Model -> Payments -> Frequency -> Html Msg -view loggedData homeModel payments frequency = - let visiblePayments = - payments - |> List.drop ((homeModel.currentPage - 1) * perPage) - |> List.take perPage - in div - [ class "table" ] - [ div - [ class "lines" ] - ( headerLine loggedData frequency :: List.map (paymentLine loggedData homeModel frequency) visiblePayments ) - , if List.isEmpty visiblePayments - then - div - [ class "emptyTableMsg" ] - [ text <| getMessage loggedData.translations "NoPayment" ] - else - text "" - ] - -headerLine : LoggedData -> Frequency -> Html Msg -headerLine loggedData frequency = - div - [ class "header" ] - [ div [ class "cell category" ] [ text <| getMessage loggedData.translations "Name" ] - , div [ class "cell cost" ] [ text <| getMessage loggedData.translations "Cost" ] - , div [ class "cell user" ] [ text <| getMessage loggedData.translations "Payer" ] - , div [ class "cell user" ] [ text <| getMessage loggedData.translations "PaymentCategory" ] - , case frequency of - Punctual -> div [ class "cell date" ] [ text <| getMessage loggedData.translations "Date" ] - Monthly -> text "" - , div [ class "cell" ] [] - , div [ class "cell" ] [] - , div [ class "cell" ] [] - ] - -paymentLine : LoggedData -> Home.Model -> Frequency -> Payment -> Html Msg -paymentLine loggedData homeModel frequency payment = - div - [ class "row" ] - [ div [ class "cell name" ] [ text payment.name ] - , div - [ classList - [ ("cell cost", True) - , ("refund", payment.cost < 0) - ] - ] - [ text (Format.price loggedData.conf payment.cost) ] - , div - [ class "cell user" ] - [ payment.userId - |> getUserName loggedData.users - |> Maybe.withDefault "−" - |> text - ] - , div - [ class "cell category" ] - ( let mbCategory = - PaymentCategory.search payment.name loggedData.paymentCategories - |> Maybe.andThen (\category -> Dict.get category loggedData.categories) - in case mbCategory of - Just category -> - [ span - [ class "tag" - , style [("background-color", category.color)] - ] - [ text category.name ] - ] - Nothing -> - [] - ) - , case frequency of - Punctual -> - div - [ class "cell date" ] - [ span - [ class "shortDate" ] - [ text (Date.shortView payment.date loggedData.translations) ] - , span - [ class "longDate" ] - [ text (Date.longView payment.date loggedData.translations) ] - ] - Monthly -> - text "" - , div - [ class "cell button" ] - [ let currentDate = Date.fromTime loggedData.currentTime - category = PaymentCategory.search payment.name loggedData.paymentCategories - in AddPayment.button - loggedData - (AddPayment.initialClone loggedData.translations currentDate category payment) - "ClonePayment" - (FontAwesome.clone Color.chestnutRose 18) - (Just (getMessage loggedData.translations "Clone")) - ] - , div - [ class "cell button" ] - [ if loggedData.me /= payment.userId - then - text "" - else - let category = PaymentCategory.search payment.name loggedData.paymentCategories - in AddPayment.button - loggedData - (AddPayment.initialEdit loggedData.translations category payment) - "EditPayment" - (FontAwesome.pencil Color.chestnutRose 18) - (Just (getMessage loggedData.translations "Edit")) - ] - , div - [ class "cell button" ] - [ if loggedData.me /= payment.userId - then - text "" - else - let dialogConfig = - { className = "deletePaymentDialog" - , title = getMessage loggedData.translations "ConfirmPaymentDelete" - , body = always <| text "" - , confirm = getMessage loggedData.translations "Confirm" - , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeletePayment payment.id - , undo = getMessage loggedData.translations "Undo" - } - in button - ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") - ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] - ) - [ FontAwesome.trash Color.chestnutRose 18 ] - ] - ] diff --git a/src/client/elm/LoggedIn/Income/Model.elm b/src/client/elm/LoggedIn/Income/Model.elm deleted file mode 100644 index 7d852b9..0000000 --- a/src/client/elm/LoggedIn/Income/Model.elm +++ /dev/null @@ -1,36 +0,0 @@ -module LoggedIn.Income.Model exposing - ( Model - , AddIncome - , init - , initForm - , validation - ) - -import Date exposing (Date) - -import Form exposing (Form) -import Form.Validate as Validate exposing (Validation) -import Validation - -type alias Model = - { addIncome : Form String AddIncome - } - -type alias AddIncome = - { amount : Int - , date : Date - } - -init : Model -init = - { addIncome = initForm - } - -initForm : Form String AddIncome -initForm = Form.initial [] validation - -validation : Validation String AddIncome -validation = - Validate.map2 AddIncome - (Validate.field "amount" (Validate.int |> Validate.andThen (Validate.minInt 1))) - (Validate.field "date" Validation.date) diff --git a/src/client/elm/LoggedIn/Income/Msg.elm b/src/client/elm/LoggedIn/Income/Msg.elm deleted file mode 100644 index 0a09dad..0000000 --- a/src/client/elm/LoggedIn/Income/Msg.elm +++ /dev/null @@ -1,9 +0,0 @@ -module LoggedIn.Income.Msg exposing - ( Msg(..) - ) - -import Form exposing (Form) - -type Msg = - NoOp - | AddIncomeMsg Form.Msg diff --git a/src/client/elm/LoggedIn/Income/Update.elm b/src/client/elm/LoggedIn/Income/Update.elm deleted file mode 100644 index 0023c76..0000000 --- a/src/client/elm/LoggedIn/Income/Update.elm +++ /dev/null @@ -1,24 +0,0 @@ -module LoggedIn.Income.Update exposing - ( update - ) - -import Form exposing (Form) - -import LoggedData exposing (LoggedData) - -import LoggedIn.Income.Model as Income -import LoggedIn.Income.Msg as Income - -update : LoggedData -> Income.Msg -> Income.Model -> (Income.Model, Cmd Income.Msg) -update loggedData msg model = - case msg of - - Income.NoOp -> - ( model - , Cmd.none - ) - - Income.AddIncomeMsg formMsg -> - ( { model | addIncome = Form.update Income.validation formMsg model.addIncome } - , Cmd.none - ) diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm deleted file mode 100644 index 00a1646..0000000 --- a/src/client/elm/LoggedIn/Income/View.elm +++ /dev/null @@ -1,108 +0,0 @@ -module LoggedIn.Income.View exposing - ( view - ) - -import Dict -import Date -import Time exposing (Time) -import Task - -import FontAwesome - -import Html exposing (..) -import Html.Events exposing (..) -import Html.Attributes exposing (..) - -import Form exposing (Form) -import View.Form as Form -import View.Events exposing (onSubmitPrevDefault) - -import Dialog -import Dialog.AddIncome.Model as AddIncome -import Dialog.AddIncome.View as AddIncome - -import Msg exposing (Msg) - -import LoggedData exposing (LoggedData) - -import Model.Income exposing (IncomeId, Income, userCumulativeIncomeSince) -import Model.Translations exposing (getMessage, getParamMessage) -import Model.Payer exposing (useIncomesFrom) -import Model.User exposing (UserId, User) -import Model.View as View -import LoggedIn.Income.Model as Income - -import LoggedIn.Msg as LoggedInMsg -import LoggedIn.Income.Msg as IncomeMsg - -import View.Date as Date -import LoggedIn.View.Format as Format -import View.Color as Color -import LoggedIn.Income.View.Table as Table - -view : LoggedData -> Income.Model -> Html Msg -view loggedData incomeModel = - div - [ class "income" ] - [ div - [ class "withMargin" ] - [ case useIncomesFrom loggedData.users loggedData.incomes loggedData.payments of - Just since -> cumulativeIncomesView loggedData since - Nothing -> text "" - , div - [ class "titleButton" ] - [ h1 [] [ text <| getMessage loggedData.translations "MonthlyNetIncomes" ] - , AddIncome.button - loggedData - (AddIncome.initialAdd loggedData.translations (Date.fromTime loggedData.currentTime)) - "AddIncome" - (text (getMessage loggedData.translations "AddIncome")) - Nothing - ] - ] - , Table.view loggedData incomeModel - ] - -cumulativeIncomesView : LoggedData -> Time -> Html Msg -cumulativeIncomesView loggedData since = - let longDate = Date.longView (Date.fromTime since) loggedData.translations - in div - [] - [ h1 [] [ text <| getParamMessage [longDate] loggedData.translations "CumulativeIncomesSince" ] - , ul - [] - ( Dict.toList loggedData.users - |> List.map (\(userId, user) -> - (user.name, userCumulativeIncomeSince loggedData.currentTime since loggedData.incomes userId) - ) - |> List.sortBy Tuple.second - |> List.map (\(userName, cumulativeIncome) -> - li - [] - [ text userName - , text " − " - , text <| Format.price loggedData.conf cumulativeIncome - ] - ) - ) - ] - -incomeView : LoggedData -> (IncomeId, Income) -> Html Msg -incomeView loggedData (incomeId, income) = - li - [] - [ text <| Date.shortView (Date.fromTime income.time) loggedData.translations - , text " − " - , text <| Format.price loggedData.conf income.amount - , let dialogConfig = - { className = "deleteIncomeDialog" - , title = getMessage loggedData.translations "ConfirmIncomeDelete" - , body = always <| text "" - , confirm = getMessage loggedData.translations "Confirm" - , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeleteIncome incomeId - , undo = getMessage loggedData.translations "Undo" - } - in button - [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] - [ FontAwesome.trash Color.chestnutRose 14 ] - ] diff --git a/src/client/elm/LoggedIn/Income/View/Table.elm b/src/client/elm/LoggedIn/Income/View/Table.elm deleted file mode 100644 index aa5e392..0000000 --- a/src/client/elm/LoggedIn/Income/View/Table.elm +++ /dev/null @@ -1,129 +0,0 @@ -module LoggedIn.Income.View.Table exposing - ( view - ) - -import Dict exposing (..) -import Date exposing (Date) -import String exposing (append) - -import FontAwesome -import View.Color as Color - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import Dialog -import Dialog.AddIncome.Model as AddIncome -import Dialog.AddIncome.View as AddIncome - -import Tooltip - -import Msg exposing (Msg) - -import LoggedData exposing (LoggedData) - -import LoggedIn.Msg as LoggedInMsg - -import LoggedIn.Income.Model as Income -import View.Date as Date -import LoggedIn.View.Format as Format - -import Model.User exposing (getUserName) -import Model.Income as Income exposing (..) -import Model.Translations exposing (getMessage) - -view : LoggedData -> Income.Model -> Html Msg -view loggedData incomeModel = - let incomes = - loggedData.incomes - |> Dict.toList - |> List.sortBy (.time << Tuple.second) - |> List.reverse - in div - [ class "table" ] - [ div - [ class "lines" ] - ( headerLine loggedData :: List.map (paymentLine loggedData incomeModel) incomes) - , if List.isEmpty (Dict.toList loggedData.incomes) - then - div - [ class "emptyTableMsg" ] - [ text <| getMessage loggedData.translations "NoIncome" ] - else - text "" - ] - -headerLine : LoggedData -> Html Msg -headerLine loggedData = - div - [ class "header" ] - [ div [ class "cell name" ] [ text <| getMessage loggedData.translations "Name" ] - , div [ class "cell income" ] [ text <| getMessage loggedData.translations "Income" ] - , div [ class "cell date" ] [ text <| getMessage loggedData.translations "Date" ] - , div [ class "cell" ] [] - , div [ class "cell" ] [] - , div [ class "cell" ] [] - ] - -paymentLine : LoggedData -> Income.Model -> (IncomeId, Income) -> Html Msg -paymentLine loggedData incomeModel (incomeId, income) = - div - [ class "row" ] - [ div - [ class "cell name" ] - [ income.userId - |> getUserName loggedData.users - |> Maybe.withDefault "−" - |> text - ] - , div - [ class "cell income" ] - [ text (Format.price loggedData.conf income.amount) ] - , div - [ class "cell date" ] - [ text (Date.longView (Date.fromTime income.time) loggedData.translations) ] - , div - [ class "cell button" ] - [ let currentDate = Date.fromTime loggedData.currentTime - in AddIncome.button - loggedData - (AddIncome.initialClone loggedData.translations currentDate income) - "CloneIncome" - (FontAwesome.clone Color.chestnutRose 18) - (Just (getMessage loggedData.translations "Clone")) - ] - , div - [ class "cell button" ] - [ if loggedData.me /= income.userId - then - text "" - else - AddIncome.button - loggedData - (AddIncome.initialEdit loggedData.translations incomeId income) - "EditIncome" - (FontAwesome.pencil Color.chestnutRose 18) - (Just (getMessage loggedData.translations "Edit")) - ] - , div - [ class "cell button" ] - [ if loggedData.me /= income.userId - then - text "" - else - let dialogConfig = - { className = "deleteIncomeDialog" - , title = getMessage loggedData.translations "ConfirmIncomeDelete" - , body = always <| text "" - , confirm = getMessage loggedData.translations "Confirm" - , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeleteIncome incomeId - , undo = getMessage loggedData.translations "Undo" - } - in button - ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") - ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] - ) - [ FontAwesome.trash Color.chestnutRose 18 ] - ] - ] diff --git a/src/client/elm/LoggedIn/Model.elm b/src/client/elm/LoggedIn/Model.elm deleted file mode 100644 index 6bcb0b2..0000000 --- a/src/client/elm/LoggedIn/Model.elm +++ /dev/null @@ -1,42 +0,0 @@ -module LoggedIn.Model exposing - ( Model - , init - ) - -import Time exposing (Time) - -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 LoggedIn.Income.Model as Income -import LoggedIn.Category.Model as Categories - -type alias Model = - { home : Home.Model - , income : Income.Model - , category : Categories.Model - , users : Users - , me : UserId - , payments : Payments - , incomes : Incomes - , categories : Categories - , paymentCategories : PaymentCategories - } - -init : Init -> Model -init initData = - { home = Home.init - , income = Income.init - , category = Categories.init - , users = initData.users - , me = initData.me - , payments = initData.payments - , incomes = initData.incomes - , categories = initData.categories - , paymentCategories = initData.paymentCategories - } diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm deleted file mode 100644 index a1379a6..0000000 --- a/src/client/elm/LoggedIn/Msg.elm +++ /dev/null @@ -1,28 +0,0 @@ -module LoggedIn.Msg exposing - ( Msg(..) - ) - -import Date exposing (Date) - -import Model.Payment exposing (PaymentId, Frequency) -import Model.Income exposing (IncomeId) -import Model.Category exposing (CategoryId) - -import LoggedIn.Home.Msg as Home -import LoggedIn.Income.Msg as Income -import LoggedIn.Category.Msg as Categories - -type Msg = - NoOp - | HomeMsg Home.Msg - | IncomeMsg Income.Msg - | CategoriesMsg Categories.Msg - | ValidateCreatePayment PaymentId String Int Date CategoryId Frequency - | ValidateEditPayment PaymentId String Int Date CategoryId Frequency - | ValidateDeletePayment PaymentId - | ValidateCreateIncome IncomeId Int Date - | ValidateEditIncome IncomeId Int Date - | ValidateDeleteIncome IncomeId - | ValidateCreateCategory CategoryId String String - | ValidateEditCategory CategoryId String String - | ValidateDeleteCategory CategoryId diff --git a/src/client/elm/LoggedIn/Stat/View.elm b/src/client/elm/LoggedIn/Stat/View.elm deleted file mode 100644 index f57316a..0000000 --- a/src/client/elm/LoggedIn/Stat/View.elm +++ /dev/null @@ -1,62 +0,0 @@ -module LoggedIn.Stat.View exposing - ( view - ) - -import Date exposing (Month) - -import Html exposing (..) -import Html.Attributes exposing (..) - -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.View.Format as Format -import View.Date as Date -import View.Plural exposing (plural) - -import Utils.List as List - -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) - ] - -getMonthPaymentMean : LoggedData -> List ((Month, Int), Payments) -> Int -getMonthPaymentMean loggedData paymentsByMonth = - paymentsByMonth - |> List.filter (\((month, year), _) -> - let currentDate = Date.fromTime loggedData.currentTime - in not (Date.month currentDate == month && Date.year currentDate == year) - ) - |> List.map (List.sum << List.map .cost << 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/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm deleted file mode 100644 index 9e6d6ee..0000000 --- a/src/client/elm/LoggedIn/Update.elm +++ /dev/null @@ -1,151 +0,0 @@ -module LoggedIn.Update exposing - ( update - ) - -import Dict -import String -import Task - -import Http exposing (Error(..)) -import Date exposing (Date) -import Platform.Cmd exposing (Cmd) - -import Form - -import Model exposing (Model) -import Model.Payment as Payment exposing (Payment, Frequency(..)) -import Model.Income as Income exposing (Income) -import Model.Category exposing (Category) -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 LoggedIn.Income.Update as Income -import LoggedIn.Income.Model as Income - -import LoggedIn.Category.Update as Categories -import LoggedIn.Category.Model as Categories - -import Utils.Cmd exposing ((:>)) - -update : Model -> LoggedInMsg.Msg -> LoggedInModel.Model -> (LoggedInModel.Model, Cmd LoggedInMsg.Msg) -update model msg loggedIn = - let loggedData = LoggedData.build model loggedIn - in case msg of - - LoggedInMsg.NoOp -> - ( loggedIn - , Cmd.none - ) - - LoggedInMsg.HomeMsg homeMsg -> - case Home.update loggedData homeMsg loggedIn.home of - (home, effects) -> - ( { loggedIn | home = home } - , Cmd.map LoggedInMsg.HomeMsg effects - ) - - LoggedInMsg.IncomeMsg incomeMsg -> - case Income.update loggedData incomeMsg loggedIn.income of - (income, cmd) -> - ( { loggedIn | income = income } - , Cmd.map LoggedInMsg.IncomeMsg cmd - ) - - LoggedInMsg.CategoriesMsg categoriesMsg -> - case Categories.update loggedData categoriesMsg loggedIn.category of - (category, cmd) -> - ( { loggedIn | category = category } - , Cmd.map LoggedInMsg.CategoriesMsg cmd - ) - - 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 -> - let newPayment = Payment paymentId name cost date loggedIn.me frequency - in ( { loggedIn - | payments = newPayment :: loggedIn.payments - , paymentCategories = PaymentCategory.set name category loggedIn.paymentCategories - } - , Cmd.none - ) - ) - - LoggedInMsg.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 - | payments = Payment.edit updatedPayment loggedIn.payments - , paymentCategories = - case mbOldPayment of - Just oldPayment -> - PaymentCategory.update oldPayment.name name category loggedIn.paymentCategories - Nothing -> - loggedData.paymentCategories - } - , Cmd.none - ) - - LoggedInMsg.ValidateDeletePayment paymentId -> - let payments = Payment.delete paymentId loggedIn.payments - frequency = - case Form.getOutput loggedIn.home.search of - Just data -> data.frequency - Nothing -> Punctual - switchToPunctual = - ( frequency == Monthly - && List.isEmpty (Payment.monthly payments) - ) - in if switchToPunctual - then - update model (LoggedInMsg.HomeMsg <| Home.SearchMsg (Form.Reset (Home.searchInitial Punctual))) loggedIn - :> (\loggedIn -> - ( { loggedIn | payments = payments } - , Cmd.none - ) - ) - else - ( { loggedIn | payments = payments } - , Cmd.none - ) - - LoggedInMsg.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 -> - 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 | incomes = Dict.remove incomeId loggedIn.incomes } - , Cmd.none - ) - - LoggedInMsg.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 -> - let updateCategory _ = Just <| Category name color - in ( { loggedIn | categories = Dict.update categoryId updateCategory loggedIn.categories } , Cmd.none) - - LoggedInMsg.ValidateDeleteCategory categoryId -> - ( { loggedIn | categories = Dict.remove categoryId loggedIn.categories } - , Cmd.none - ) diff --git a/src/client/elm/LoggedIn/View.elm b/src/client/elm/LoggedIn/View.elm deleted file mode 100644 index 2e42a73..0000000 --- a/src/client/elm/LoggedIn/View.elm +++ /dev/null @@ -1,33 +0,0 @@ -module LoggedIn.View exposing - ( view - ) - -import Html exposing (..) -import Html.Attributes exposing (..) - -import Page - -import Msg exposing (Msg) -import Model exposing (Model) -import Model.Translations exposing (getMessage) -import LoggedData - -import LoggedIn.Model as LoggedInModel - -import LoggedIn.Home.View as Home -import LoggedIn.Income.View as Income -import LoggedIn.Category.View as Categories -import LoggedIn.Stat.View as Stat - -view : Model -> LoggedInModel.Model -> Html Msg -view model loggedIn = - div - [ class "loggedIn" ] - [ let loggedData = LoggedData.build model loggedIn - in case model.page of - Page.Home -> Home.view loggedData loggedIn.home - Page.Income -> Income.view loggedData loggedIn.income - Page.Categories -> Categories.view loggedData loggedIn.category - Page.Statistics -> Stat.view loggedData - Page.NotFound -> div [] [ text (getMessage model.translations "PageNotFound") ] - ] diff --git a/src/client/elm/LoggedIn/View/Format.elm b/src/client/elm/LoggedIn/View/Format.elm deleted file mode 100644 index f41e2cd..0000000 --- a/src/client/elm/LoggedIn/View/Format.elm +++ /dev/null @@ -1,37 +0,0 @@ -module LoggedIn.View.Format exposing - ( price - ) - -import String exposing (..) - -import Model.Conf exposing (Conf) - -price : Conf -> Int -> String -price conf amount = - ( number amount - ++ " " - ++ conf.currency - ) - -number : Int -> String -number 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) diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm deleted file mode 100644 index 9674b66..0000000 --- a/src/client/elm/Main.elm +++ /dev/null @@ -1,26 +0,0 @@ -module Main exposing - ( main - ) - -import Navigation -import Time -import Msg exposing (Msg(UpdatePage)) - -import Model exposing (init) -import Update exposing (update) -import View exposing (view) -import Page -import Tooltip - -main = - Navigation.programWithFlags (UpdatePage << Page.fromLocation) - { init = init - , view = view - , update = update - , subscriptions = (\model -> - Sub.batch - [ Time.every 1000 Msg.UpdateTime - , Sub.map Msg.Tooltip Tooltip.subscription - ] - ) - } diff --git a/src/client/elm/Model.elm b/src/client/elm/Model.elm deleted file mode 100644 index 5167e42..0000000 --- a/src/client/elm/Model.elm +++ /dev/null @@ -1,74 +0,0 @@ -module Model exposing - ( Model - , init - ) - -import Time exposing (Time) -import Json.Decode as Decode - -import Navigation exposing (Location) - -import Html as Html - -import Page exposing (Page) -import Init as Init exposing (Init) -import Msg exposing (Msg) - -import Model.View exposing (..) -import Model.Translations exposing (..) -import Model.Conf exposing (..) -import Model.InitResult exposing (..) -import LoggedIn.Model as LoggedInModel -import SignIn.Model as SignInModel - -import Dialog -import Dialog.Model as DialogModel -import Dialog.Msg as DialogMsg - -import Tooltip - -import Utils.Maybe exposing (isJust) - -type alias Model = - { view : View - , currentTime : Time - , translations : Translations - , conf : Conf - , page : Page - , errors : List String - , dialog : Dialog.Model DialogModel.Model DialogMsg.Msg Msg - , tooltip : Tooltip.Model - } - -init : Decode.Value -> Location -> (Model, Cmd Msg) -init payload location = - let model = - case Decode.decodeValue Init.decoder payload of - Ok { time, translations, conf, result, windowSize } -> - { view = - case result of - InitEmpty -> - SignInView (SignInModel.init Nothing) - InitSuccess init -> - LoggedInView (LoggedInModel.init init) - InitError error -> - SignInView (SignInModel.init (Just error)) - , currentTime = time - , translations = translations - , conf = conf - , page = Page.fromLocation location - , errors = [] - , dialog = Dialog.init DialogModel.init Msg.Dialog - , tooltip = Tooltip.init windowSize.width windowSize.height - } - Err error -> - { view = SignInView (SignInModel.init (Just error)) - , currentTime = 0 - , translations = [] - , conf = { currency = "" } - , page = Page.fromLocation location - , errors = [ error ] - , dialog = Dialog.init DialogModel.init Msg.Dialog - , tooltip = Tooltip.init 0 0 - } - in (model, Cmd.none) diff --git a/src/client/elm/Model/Category.elm b/src/client/elm/Model/Category.elm deleted file mode 100644 index 8b653a7..0000000 --- a/src/client/elm/Model/Category.elm +++ /dev/null @@ -1,35 +0,0 @@ -module Model.Category exposing - ( Categories - , Category - , CategoryId - , categoriesDecoder - , categoryIdDecoder - , empty - ) - -import Json.Decode as Decode exposing (Decoder) -import Utils.Json as Json -import Dict exposing (Dict) - -type alias Categories = Dict CategoryId Category - -type alias CategoryId = Int - -type alias Category = - { name : String - , color : String - } - -categoriesDecoder : Decoder Categories -categoriesDecoder = - Json.dictDecoder (Decode.field "id" categoryIdDecoder) <| - Decode.map2 - Category - (Decode.field "name" Decode.string) - (Decode.field "color" Decode.string) - -categoryIdDecoder : Decoder CategoryId -categoryIdDecoder = Decode.int - -empty : Categories -empty = Dict.empty diff --git a/src/client/elm/Model/Conf.elm b/src/client/elm/Model/Conf.elm deleted file mode 100644 index 308fa04..0000000 --- a/src/client/elm/Model/Conf.elm +++ /dev/null @@ -1,13 +0,0 @@ -module Model.Conf exposing - ( Conf - , confDecoder - ) - -import Json.Decode as Decode exposing (Decoder) - -type alias Conf = - { currency : String - } - -confDecoder : Decoder Conf -confDecoder = Decode.map Conf (Decode.field "currency" Decode.string) diff --git a/src/client/elm/Model/Date.elm b/src/client/elm/Model/Date.elm deleted file mode 100644 index bfba02f..0000000 --- a/src/client/elm/Model/Date.elm +++ /dev/null @@ -1,15 +0,0 @@ -module Model.Date exposing - ( timeDecoder - , dateDecoder - ) - -import Date as Date exposing (Date) -import Json.Decode as Decode exposing (Decoder) -import Json.Decode.Extra as Decode -import Time exposing (Time) - -timeDecoder : Decoder Time -timeDecoder = Decode.map Date.toTime dateDecoder - -dateDecoder : Decoder Date -dateDecoder = Decode.string |> Decode.andThen (Date.fromString >> Decode.fromResult) diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm deleted file mode 100644 index 34578c6..0000000 --- a/src/client/elm/Model/Income.elm +++ /dev/null @@ -1,102 +0,0 @@ -module Model.Income exposing - ( Incomes - , Income - , IncomeId - , incomesDecoder - , incomeIdDecoder - , incomeDefinedForAll - , userCumulativeIncomeSince - , cumulativeIncomesSince - ) - -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 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 - -type alias Income = - { userId : UserId - , time : Float - , amount : Int - } - -incomesDecoder : Decoder Incomes -incomesDecoder = - Json.dictDecoder (Decode.field "id" incomeIdDecoder) <| - Decode.map3 Income - (Decode.field "userId" userIdDecoder) - (Decode.field "date" timeDecoder) - (Decode.field "amount" Decode.int) - -incomeIdDecoder : Decoder IncomeId -incomeIdDecoder = Decode.int - -incomeDefinedForAll : List UserId -> Incomes -> Maybe Time -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 - else Nothing - -userCumulativeIncomeSince : Time -> Time -> Incomes -> UserId -> Int -userCumulativeIncomeSince currentTime since incomes userId = - incomes - |> Dict.values - |> List.filter (\income -> income.userId == userId) - |> cumulativeIncomesSince currentTime since - -cumulativeIncomesSince : Time -> Time -> (List Income) -> Int -cumulativeIncomesSince currentTime since incomes = - cumulativeIncome currentTime (getOrderedIncomesSince since incomes) - -getOrderedIncomesSince : Time -> List Income -> List Income -getOrderedIncomesSince time incomes = - let mbStarterIncome = getIncomeAt time incomes - orderedIncomesSince = filter (\income -> income.time >= time) incomes - in (Maybe.toList mbStarterIncome) ++ orderedIncomesSince - -getIncomeAt : Time -> List Income -> Maybe Income -getIncomeAt time incomes = - case incomes of - [x] -> - if x.time < time - then Just { userId = x.userId, time = time, amount = x.amount } - else Nothing - x1 :: x2 :: xs -> - if x1.time < time && x2.time >= time - then Just { userId = x1.userId, time = time, amount = x1.amount } - else getIncomeAt time (x2 :: xs) - [] -> - Nothing - -cumulativeIncome : Time -> List Income -> Int -cumulativeIncome currentTime incomes = - getIncomesWithDuration currentTime (List.sortBy .time incomes) - |> map durationIncome - |> sum - -getIncomesWithDuration : Time -> List Income -> List (Float, Int) -getIncomesWithDuration currentTime incomes = - case incomes of - [] -> - [] - [income] -> - [(currentTime - income.time, income.amount)] - (income1 :: income2 :: xs) -> - (income2.time - income1.time, income1.amount) :: (getIncomesWithDuration currentTime (income2 :: xs)) - -durationIncome : (Float, Int) -> Int -durationIncome (duration, income) = - duration * toFloat income / (hour * 24 * 365 / 12) - |> truncate diff --git a/src/client/elm/Model/Init.elm b/src/client/elm/Model/Init.elm deleted file mode 100644 index db7069f..0000000 --- a/src/client/elm/Model/Init.elm +++ /dev/null @@ -1,31 +0,0 @@ -module Model.Init exposing - ( Init - , initDecoder - ) - -import Json.Decode as Decode exposing (Decoder) - -import Model.Payment exposing (Payments, paymentsDecoder) -import Model.User exposing (Users, UserId, usersDecoder, userIdDecoder) -import Model.Income exposing (Incomes, incomesDecoder) -import Model.Category exposing (Categories, categoriesDecoder) -import Model.PaymentCategory exposing (PaymentCategories, paymentCategoriesDecoder) - -type alias Init = - { users : Users - , me : UserId - , payments : Payments - , incomes : Incomes - , categories : Categories - , paymentCategories : PaymentCategories - } - -initDecoder : Decoder Init -initDecoder = - Decode.map6 Init - (Decode.field "users" usersDecoder) - (Decode.field "me" userIdDecoder) - (Decode.field "payments" paymentsDecoder) - (Decode.field "incomes" incomesDecoder) - (Decode.field "categories" categoriesDecoder) - (Decode.field "paymentCategories" paymentCategoriesDecoder) diff --git a/src/client/elm/Model/InitResult.elm b/src/client/elm/Model/InitResult.elm deleted file mode 100644 index 7ce0be2..0000000 --- a/src/client/elm/Model/InitResult.elm +++ /dev/null @@ -1,28 +0,0 @@ -module Model.InitResult exposing - ( InitResult(..) - , initResultDecoder - ) - -import Json.Decode as Decode exposing (Decoder) - -import Model.Init exposing (Init, initDecoder) - -type InitResult = - InitEmpty - | InitSuccess Init - | InitError String - -initResultDecoder : Decoder InitResult -initResultDecoder = (Decode.field "tag" Decode.string) |> Decode.andThen initResultDecoderWithTag - -initResultDecoderWithTag : String -> Decoder InitResult -initResultDecoderWithTag tag = - case tag of - "InitEmpty" -> - Decode.succeed InitEmpty - "InitSuccess" -> - Decode.map InitSuccess (Decode.field "contents" initDecoder) - "InitError" -> - Decode.map InitError (Decode.field "contents" Decode.string) - _ -> - Decode.fail <| "got " ++ tag ++ " for InitResult" diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm deleted file mode 100644 index 1663273..0000000 --- a/src/client/elm/Model/Payer.elm +++ /dev/null @@ -1,138 +0,0 @@ -module Model.Payer exposing - ( Payers - , Payer - , ExceedingPayer - , getOrderedExceedingPayers - , useIncomesFrom - ) - -import Dict exposing (..) -import List -import Maybe -import Time exposing (Time) -import Date - -import Model.Payment exposing (Payments, totalPayments) -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 - -type alias Payer = - { preIncomePaymentSum : Int - , postIncomePaymentSum : Int - , incomes : List Income - } - -type alias PostPaymentPayer = - { preIncomePaymentSum : Int - , cumulativeIncome : Int - , ratio : Float - } - -type alias ExceedingPayer = - { userId : UserId - , amount : Int - } - -getOrderedExceedingPayers : Time -> Users -> Incomes -> Payments -> List ExceedingPayer -getOrderedExceedingPayers currentTime users incomes payments = - let payers = getPayers currentTime users incomes payments - exceedingPayersOnPreIncome = - payers - |> mapValues .preIncomePaymentSum - |> Dict.toList - |> exceedingPayersFromAmounts - mbSince = useIncomesFrom users incomes payments - in case mbSince of - Just since -> - let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers - mbMaxRatio = - postPaymentPayers - |> Dict.toList - |> List.map (.ratio << Tuple.second) - |> List.maximum - in case mbMaxRatio of - Just maxRatio -> - postPaymentPayers - |> mapValues (getFinalDiff maxRatio) - |> Dict.toList - |> exceedingPayersFromAmounts - Nothing -> - exceedingPayersOnPreIncome - _ -> - exceedingPayersOnPreIncome - -useIncomesFrom : Users -> Incomes -> Payments -> Maybe Time -useIncomesFrom users incomes payments = - let firstPaymentTime = - payments - |> List.map (Date.toTime << .date) - |> List.sort - |> List.head - mbIncomeTime = incomeDefinedForAll (Dict.keys users) incomes - in case (firstPaymentTime, mbIncomeTime) of - (Just paymentTime, Just incomeTime) -> - Just (max paymentTime incomeTime) - _ -> - Nothing - -getPayers : Time -> Users -> Incomes -> Payments -> Payers -getPayers currentTime users incomes payments = - let userIds = Dict.keys users - incomesDefined = incomeDefinedForAll userIds incomes - in userIds - |> List.map (\userId -> - ( userId - , { preIncomePaymentSum = - totalPayments - (\p -> (Date.toTime p.date) < (Maybe.withDefault currentTime incomesDefined)) - userId - payments - , postIncomePaymentSum = - totalPayments - (\p -> - case incomesDefined of - Nothing -> False - Just t -> (Date.toTime p.date) >= t - ) - userId - payments - , incomes = List.filter ((==) userId << .userId) (Dict.values incomes) - } - ) - ) - |> Dict.fromList - -exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer -exceedingPayersFromAmounts userAmounts = - let mbMinAmount = List.minimum << List.map Tuple.second <| userAmounts - in case mbMinAmount of - Nothing -> - [] - Just minAmount -> - userAmounts - |> List.map (\userAmount -> - { userId = Tuple.first userAmount - , amount = Tuple.second userAmount - minAmount - } - ) - |> List.filter (\payer -> payer.amount > 0) - -getPostPaymentPayer : Time -> Time -> Payer -> PostPaymentPayer -getPostPaymentPayer currentTime since payer = - let cumulativeIncome = cumulativeIncomesSince currentTime since payer.incomes - in { preIncomePaymentSum = payer.preIncomePaymentSum - , cumulativeIncome = cumulativeIncome - , ratio = toFloat payer.postIncomePaymentSum / toFloat cumulativeIncome - } - -getFinalDiff : Float -> PostPaymentPayer -> Int -getFinalDiff maxRatio payer = - let postIncomeDiff = - -1 * (maxRatio - payer.ratio) * toFloat payer.cumulativeIncome - |> truncate - in postIncomeDiff + payer.preIncomePaymentSum diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm deleted file mode 100644 index f61ded8..0000000 --- a/src/client/elm/Model/Payment.elm +++ /dev/null @@ -1,143 +0,0 @@ -module Model.Payment exposing - ( perPage - , Payments - , Payment - , PaymentId - , Frequency(..) - , paymentsDecoder - , paymentIdDecoder - , find - , edit - , delete - , totalPayments - , punctual - , monthly - , groupAndSortByMonth - , search - , validateFrequency - ) - -import Date exposing (..) -import Date.Extra.Core exposing (monthToInt, intToMonth) -import Json.Decode as Decode exposing (Decoder) -import Json.Decode.Extra as Decode -import List - -import Form.Validate as Validate exposing (Validation) -import Model.Date exposing (dateDecoder) -import Model.User exposing (UserId, userIdDecoder) - -import Utils.List as List -import Utils.Search as Search - -perPage : Int -perPage = 7 - -type alias Payments = List Payment - -type alias Payment = - { id : PaymentId - , name : String - , cost : Int - , date : Date - , userId : UserId - , frequency : Frequency - } - -type alias PaymentId = Int - -type Frequency = Punctual | Monthly - -paymentsDecoder : Decoder Payments -paymentsDecoder = Decode.list paymentDecoder - -paymentDecoder : Decoder Payment -paymentDecoder = - Decode.map6 Payment - (Decode.field "id" paymentIdDecoder) - (Decode.field "name" Decode.string) - (Decode.field "cost" Decode.int) - (Decode.field "date" dateDecoder) - (Decode.field "userId" userIdDecoder) - (Decode.field "frequency" frequencyDecoder) - -paymentIdDecoder : Decoder PaymentId -paymentIdDecoder = Decode.int - -frequencyDecoder : Decoder Frequency -frequencyDecoder = - let frequencyResult input = - case input of - "Punctual" -> Ok Punctual - "Monthly" -> Ok Monthly - _ -> Err ("Could not deduce Punctual nor Monthly from " ++ input) - in Decode.string |> Decode.andThen (Decode.fromResult << frequencyResult) - -find : PaymentId -> Payments -> Maybe Payment -find paymentId payments = - payments - |> List.filter (\p -> p.id == paymentId) - |> List.head - -edit : Payment -> Payments -> Payments -edit payment payments = payment :: delete payment.id payments - -delete : PaymentId -> Payments -> Payments -delete paymentId = List.filter (((/=) paymentId) << .id) - -totalPayments : (Payment -> Bool) -> UserId -> Payments -> Int -totalPayments paymentFilter userId payments = - payments - |> List.filter (\payment -> - paymentFilter payment - && payment.userId == userId - ) - |> List.map .cost - |> List.sum - -punctual : Payments -> Payments -punctual = List.filter ((==) Punctual << .frequency) - -monthly : Payments -> Payments -monthly = List.filter ((==) Monthly << .frequency) - -groupAndSortByMonth : Payments -> List ((Month, Int), Payments) -groupAndSortByMonth payments = - 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 = - payments - |> List.filter ((==) frequency << .frequency) - |> paymentSort frequency - |> List.filter (searchSuccess name) - -paymentSort : Frequency -> Payments -> Payments -paymentSort frequency = - case frequency of - Punctual -> List.reverse << List.sortBy (Date.toTime << .date) - Monthly -> List.sortBy (String.toLower << .name) - -searchSuccess : String -> Payment -> Bool -searchSuccess search { name, cost } = - let searchSuccessWord word = - ( String.contains (Search.format word) (Search.format name) - || String.contains word (toString cost) - ) - in List.all searchSuccessWord (String.words search) - -validateFrequency : Validation String Frequency -validateFrequency = - Validate.customValidation Validate.string (\str -> - if str == toString Punctual - then - Ok Punctual - else - if str == toString Monthly - then Ok Monthly - else Err (Validate.customError "InvalidFrequency") - ) diff --git a/src/client/elm/Model/PaymentCategory.elm b/src/client/elm/Model/PaymentCategory.elm deleted file mode 100644 index 87678fe..0000000 --- a/src/client/elm/Model/PaymentCategory.elm +++ /dev/null @@ -1,48 +0,0 @@ -module Model.PaymentCategory exposing - ( PaymentCategories - , paymentCategoriesDecoder - , search - , isCategoryUnused - , set - , update - ) - -import Dict exposing (Dict) -import Json.Decode as Decode exposing (Decoder) - -import Model.Category exposing (CategoryId, categoryIdDecoder) -import Utils.Json as Json -import Utils.Search as Search - -type alias PaymentCategories = List PaymentCategory - -type alias PaymentCategory = - { name : String - , category : CategoryId - } - -paymentCategoriesDecoder : Decoder PaymentCategories -paymentCategoriesDecoder = - Decode.list <| Decode.map2 PaymentCategory - (Decode.field "name" Decode.string) - (Decode.field "category" categoryIdDecoder) - -search : String -> PaymentCategories -> Maybe CategoryId -search paymentName paymentCategories = - paymentCategories - |> List.filter (\pc -> Search.format pc.name == Search.format paymentName) - |> List.head - |> Maybe.map .category - -isCategoryUnused : CategoryId -> PaymentCategories -> Bool -isCategoryUnused category paymentCategories = - paymentCategories - |> List.filter ((==) category << .category) - |> List.isEmpty - -set : String -> CategoryId -> PaymentCategories -> PaymentCategories -set name category paymentCategories = update name name category paymentCategories - -update : String -> String -> CategoryId -> PaymentCategories -> PaymentCategories -update oldName newName category paymentCategories = - { name = newName, category = category } :: List.filter (\pc -> not <| Search.format pc.name == Search.format oldName) paymentCategories diff --git a/src/client/elm/Model/Size.elm b/src/client/elm/Model/Size.elm deleted file mode 100644 index f40fb01..0000000 --- a/src/client/elm/Model/Size.elm +++ /dev/null @@ -1,17 +0,0 @@ -module Model.Size exposing - ( Size - , sizeDecoder - ) - -import Json.Decode as Decode exposing (Decoder) - -type alias Size = - { width: Int - , height: Int - } - -sizeDecoder : Decoder Size -sizeDecoder = - Decode.map2 Size - (Decode.field "width" Decode.int) - (Decode.field "height" Decode.int) diff --git a/src/client/elm/Model/Translations.elm b/src/client/elm/Model/Translations.elm deleted file mode 100644 index 9b314e1..0000000 --- a/src/client/elm/Model/Translations.elm +++ /dev/null @@ -1,68 +0,0 @@ -module Model.Translations exposing - ( translationsDecoder - , Translations - , Translation - , getMessage - , getParamMessage - ) - -import Maybe exposing (withDefault) -import Json.Decode as Decode exposing (Decoder) -import String - -type alias Translations = List Translation - -translationsDecoder : Decoder Translations -translationsDecoder = Decode.list translationDecoder - -type alias Translation = - { key : String - , message : List MessagePart - } - -getTranslation : String -> Translations -> Maybe (List MessagePart) -getTranslation key translations = - translations - |> List.filter (\translation -> String.toLower translation.key == String.toLower key) - |> List.head - |> Maybe.map .message - -translationDecoder : Decoder Translation -translationDecoder = - Decode.map2 Translation - (Decode.field "key" Decode.string) - (Decode.field "message" (Decode.list partDecoder)) - -type MessagePart = - Order Int - | Str String - -partDecoder : Decoder MessagePart -partDecoder = (Decode.field "tag" Decode.string) |> Decode.andThen partDecoderWithTag - -partDecoderWithTag : String -> Decoder MessagePart -partDecoderWithTag tag = - case tag of - "Order" -> Decode.map Order (Decode.field "contents" Decode.int) - _ -> Decode.map Str (Decode.field "contents" Decode.string) - ------ - -getMessage : Translations -> String -> String -getMessage = getParamMessage [] - -getParamMessage : List String -> Translations -> String -> String -getParamMessage values translations key = - getTranslation key translations - |> Maybe.map (\parts -> String.concat (List.map (replacePart values) parts)) - |> withDefault key - -replacePart : List String -> MessagePart -> String -replacePart values part = - case part of - Str str -> str - Order n -> - values - |> List.drop (n - 1) - |> List.head - |> withDefault ("{" ++ (toString n) ++ "}") diff --git a/src/client/elm/Model/User.elm b/src/client/elm/Model/User.elm deleted file mode 100644 index f6e8147..0000000 --- a/src/client/elm/Model/User.elm +++ /dev/null @@ -1,44 +0,0 @@ -module Model.User exposing - ( Users - , usersDecoder - , User - , userDecoder - , UserId - , userIdDecoder - , getUserName - ) - -import Json.Decode as Decode exposing (Decoder) -import Dict exposing (Dict) - -type alias Users = Dict UserId User - -type alias UserId = Int - -type alias User = - { name : String - , email : String - } - -usersDecoder : Decoder Users -usersDecoder = Decode.map Dict.fromList (Decode.list userWithIdDecoder) - -userWithIdDecoder : Decode.Decoder (UserId, User) -userWithIdDecoder = - Decode.map2 (,) - (Decode.field "id" userIdDecoder) - userDecoder - -userIdDecoder : Decoder UserId -userIdDecoder = Decode.int - -userDecoder : Decoder User -userDecoder = - Decode.map2 User - (Decode.field "name" Decode.string) - (Decode.field "email" Decode.string) - -getUserName : Users -> UserId -> Maybe String -getUserName users userId = - Dict.get userId users - |> Maybe.map .name diff --git a/src/client/elm/Model/View.elm b/src/client/elm/Model/View.elm deleted file mode 100644 index 61d42a7..0000000 --- a/src/client/elm/Model/View.elm +++ /dev/null @@ -1,12 +0,0 @@ -module Model.View exposing - ( View(..) - ) - -import Model.Payment exposing (Payments) - -import SignIn.Model as SignInModel -import LoggedIn.Model as LoggedInModel - -type View = - SignInView SignInModel.Model - | LoggedInView LoggedInModel.Model diff --git a/src/client/elm/Msg.elm b/src/client/elm/Msg.elm deleted file mode 100644 index cf592aa..0000000 --- a/src/client/elm/Msg.elm +++ /dev/null @@ -1,48 +0,0 @@ -module Msg exposing - ( Msg(..) - ) - -import Date exposing (Date) -import Time exposing (Time) - -import Page exposing (Page) - -import Model.Init exposing (Init) -import Model.Payment exposing (PaymentId, Frequency) -import Model.Income exposing (IncomeId) -import Model.Category exposing (CategoryId) - -import Dialog -import Dialog.Model as DialogModel -import Dialog.Msg as DialogMsg - -import Tooltip - -import SignIn.Msg as SignInMsg -import LoggedIn.Msg as LoggedInMsg - -type Msg = - NoOp - | UpdatePage Page - | SignIn String - | UpdateTime Time - | GoLoggedInView Init - | UpdateSignIn SignInMsg.Msg - | UpdateLoggedIn LoggedInMsg.Msg - | GoSignInView - | SignOut - | Error String - | Dialog (Dialog.Msg DialogModel.Model DialogMsg.Msg Msg) - | Tooltip Tooltip.Msg - - | CreatePayment String Int Date CategoryId Frequency - | EditPayment PaymentId String Int Date CategoryId Frequency - | DeletePayment PaymentId - - | CreateIncome Int Date - | EditIncome IncomeId Int Date - | DeleteIncome IncomeId - - | CreateCategory String String - | EditCategory CategoryId String String - | DeleteCategory CategoryId diff --git a/src/client/elm/Page.elm b/src/client/elm/Page.elm deleted file mode 100644 index 39232e0..0000000 --- a/src/client/elm/Page.elm +++ /dev/null @@ -1,43 +0,0 @@ -module Page exposing - ( Page(..) - , toHash - , fromLocation - ) - -import Navigation exposing (Location) -import UrlParser exposing (Parser, (), s) -import String - -type Page = - Home - | Income - | Categories - | Statistics - | NotFound - -toHash : Page -> String -toHash page = - case page of - Home -> "#" - Income -> "#income" - Categories -> "#categories" - Statistics -> "#statistics" - NotFound -> "#notFound" - -fromLocation : Location -> Page -fromLocation location = - if location.hash == "" - then - Home - else - case UrlParser.parseHash pageParser location of - Just page -> page - Nothing -> NotFound - -pageParser : Parser (Page -> a) a -pageParser = - UrlParser.oneOf - [ UrlParser.map Income (s "income") - , UrlParser.map Categories (s "categories") - , UrlParser.map Statistics (s "statistics") - ] diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm deleted file mode 100644 index 7f25876..0000000 --- a/src/client/elm/Server.elm +++ /dev/null @@ -1,114 +0,0 @@ -module Server exposing - ( signIn - , createPayment - , editPayment - , deletePayment - , createIncome - , editIncome - , deleteIncome - , createCategory - , editCategory - , deleteCategory - , signOut - ) - -import Task as Task exposing (Task) -import Http exposing (Error) -import Date -import Json.Decode as Decode -import Json.Encode as Encode -import Date exposing (Date) - -import Date.Extra.Format as DateFormat - -import Utils.Http as HttpUtils - -import Model.Payment exposing (..) -import Model.Income exposing (incomeIdDecoder, IncomeId) -import Model.Category exposing (categoryIdDecoder, CategoryId) -import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) -import Model.Init exposing (Init) - -signIn : String -> (Result Error String -> msg) -> Cmd msg -signIn email = HttpUtils.request "POST" ("/signIn?email=" ++ email) Http.expectString - -createPayment : String -> Int -> Date -> CategoryId -> Frequency -> (Result Error PaymentId -> msg) -> Cmd msg -createPayment name cost date categoryId frequency handleResult = - let json = - Encode.object - [ ("name", Encode.string name) - , ("cost", Encode.int cost) - , ("date", Encode.string (DateFormat.isoDateString date)) - , ("category", Encode.int categoryId) - , ("frequency", Encode.string (toString frequency)) - ] - expect = Http.expectJson (Decode.field "id" paymentIdDecoder) - in HttpUtils.jsonRequest "POST" "/payment" expect handleResult json - -editPayment : PaymentId -> String -> Int -> Date -> CategoryId -> Frequency -> (Result Error String -> msg) -> Cmd msg -editPayment paymentId name cost date categoryId frequency handleResult = - let json = - Encode.object - [ ("id", Encode.int paymentId) - , ("name", Encode.string name) - , ("cost", Encode.int cost) - , ("date", Encode.string (DateFormat.isoDateString date)) - , ("category", Encode.int categoryId) - , ("frequency", Encode.string (toString frequency)) - ] - in HttpUtils.jsonRequest "PUT" "/payment" Http.expectString handleResult json - -deletePayment : PaymentId -> (Result Error String -> msg) -> Cmd msg -deletePayment paymentId = - HttpUtils.request "DELETE" ("/payment?id=" ++ (toString paymentId)) Http.expectString - -createIncome : Int -> Date -> (Result Error IncomeId -> msg) -> Cmd msg -createIncome amount date handleResult = - let json = - Encode.object - [ ("amount", Encode.int amount) - , ("date", Encode.string (DateFormat.isoDateString date)) - ] - expect = Http.expectJson (Decode.field "id" incomeIdDecoder) - in HttpUtils.jsonRequest "POST" "/income" expect handleResult json - -editIncome : IncomeId -> Int -> Date -> (Result Error String -> msg) -> Cmd msg -editIncome incomeId amount date handleResult = - let json = - Encode.object - [ ("id", Encode.int incomeId) - , ("amount", Encode.int amount) - , ("date", Encode.string (DateFormat.isoDateString date)) - ] - in HttpUtils.jsonRequest "PUT" "/income" Http.expectString handleResult json - -deleteIncome : IncomeId -> (Result Error String -> msg) -> Cmd msg -deleteIncome incomeId = - HttpUtils.request "DELETE" ("/income?id=" ++ (toString incomeId)) Http.expectString - -createCategory : String -> String -> (Result Error CategoryId -> msg) -> Cmd msg -createCategory name color handleResult = - let json = - Encode.object - [ ("name", Encode.string name) - , ("color", Encode.string color) - ] - expect = Http.expectJson (Decode.field "id" categoryIdDecoder) - in HttpUtils.jsonRequest "POST" "/category" expect handleResult json - -editCategory : CategoryId -> String -> String -> (Result Error String -> msg) -> Cmd msg -editCategory categoryId name color handleResult = - let json = - Encode.object - [ ("id", Encode.int categoryId) - , ("name", Encode.string name) - , ("color", Encode.string color) - ] - in HttpUtils.jsonRequest "PUT" "/category" Http.expectString handleResult json - -deleteCategory : CategoryId -> (Result Error String -> msg) -> Cmd msg -deleteCategory categoryId = - HttpUtils.request "DELETE" ("/category?id=" ++ (toString categoryId)) Http.expectString - -signOut : (Result Error String -> msg) -> Cmd msg -signOut = HttpUtils.request "POST" "/signOut" Http.expectString diff --git a/src/client/elm/SignIn/Model.elm b/src/client/elm/SignIn/Model.elm deleted file mode 100644 index 19d4305..0000000 --- a/src/client/elm/SignIn/Model.elm +++ /dev/null @@ -1,17 +0,0 @@ -module SignIn.Model exposing - ( Model - , init - ) - -type alias Model = - { login : String - , waitingServer : Bool - , result : Maybe (Result String String) - } - -init : Maybe String -> Model -init mbSignInError = - { login = "" - , waitingServer = False - , result = Maybe.map Err mbSignInError - } diff --git a/src/client/elm/SignIn/Msg.elm b/src/client/elm/SignIn/Msg.elm deleted file mode 100644 index f753ebd..0000000 --- a/src/client/elm/SignIn/Msg.elm +++ /dev/null @@ -1,9 +0,0 @@ -module SignIn.Msg exposing - ( Msg(..) - ) - -type Msg = - UpdateLogin String - | WaitingServer - | ValidLogin - | ErrorLogin String diff --git a/src/client/elm/SignIn/Update.elm b/src/client/elm/SignIn/Update.elm deleted file mode 100644 index 98de777..0000000 --- a/src/client/elm/SignIn/Update.elm +++ /dev/null @@ -1,31 +0,0 @@ -module SignIn.Update exposing - ( update - ) - -import SignIn.Model exposing (..) -import SignIn.Msg exposing (..) - -import Model.Translations exposing (getMessage, Translations) - -update : Translations -> Msg -> Model -> Model -update translations msg signInView = - case msg of - UpdateLogin login -> - { signInView | - login = login - } - WaitingServer -> - { signInView - | waitingServer = True - } - ValidLogin -> - { signInView - | login = "" - , result = Just (Ok (getMessage translations "SignInEmailSent")) - , waitingServer = False - } - ErrorLogin message -> - { signInView - | result = Just (Err message) - , waitingServer = False - } diff --git a/src/client/elm/SignIn/View.elm b/src/client/elm/SignIn/View.elm deleted file mode 100644 index 88f74b0..0000000 --- a/src/client/elm/SignIn/View.elm +++ /dev/null @@ -1,63 +0,0 @@ -module SignIn.View exposing - ( view - ) - -import Json.Decode as Decode - -import FontAwesome -import View.Color as Color - -import Html as H exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import SignIn.Msg as SignInMsg -import SignIn.Model as SignInModel - -import Update exposing (..) - -import Model exposing (Model) -import Msg exposing (..) -import Model.Translations exposing (getMessage) - -import View.Events exposing (onSubmitPrevDefault) - -view : Model -> SignInModel.Model -> Html Msg -view model signInModel = - div - [ class "signIn" ] - [ H.form - [ onSubmitPrevDefault (SignIn signInModel.login) ] - [ input - [ value signInModel.login - , on "input" (targetValue |> (Decode.map <| (UpdateSignIn << SignInMsg.UpdateLogin))) - , name "email" - ] - [] - , button - [] - [ if signInModel.waitingServer - then FontAwesome.spinner Color.white 20 - else text (getMessage model.translations "SignIn") - ] - ] - , div - [ class "result" ] - [ signInResult model signInModel ] - ] - -signInResult : Model -> SignInModel.Model -> Html Msg -signInResult model signInModel = - case signInModel.result of - Just result -> - case result of - Ok login -> - div - [ class "success" ] - [ text (getMessage model.translations "SignInEmailSent") ] - Err error -> - div - [ class "error" ] - [ text (getMessage model.translations error) ] - Nothing -> - text "" diff --git a/src/client/elm/Tooltip.elm b/src/client/elm/Tooltip.elm deleted file mode 100644 index 4f70cda..0000000 --- a/src/client/elm/Tooltip.elm +++ /dev/null @@ -1,113 +0,0 @@ -module Tooltip exposing - ( Msg(..) - , Model - , init - , subscription - , update - , view - , show - ) - -import Platform.Cmd - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import Mouse exposing (Position) -import Window exposing (Size) - -type Msg = - UpdateMousePosition Position - | UpdateWindowSize Size - | ShowMessage String - | HideMessage - -type alias Model = - { mousePosition : Maybe Position - , windowSize : Size - , message : Maybe String - } - -init : Int -> Int -> Model -init width height = - { mousePosition = Nothing - , windowSize = - { width = width - , height = height - } - , message = Nothing - } - -subscription : Sub Msg -subscription = - Sub.batch - [ Mouse.moves UpdateMousePosition - , Window.resizes UpdateWindowSize - ] - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - UpdateMousePosition position -> - ( { model | mousePosition = Just position } - , Cmd.none - ) - - UpdateWindowSize size -> - ( { model | windowSize = size } - , Cmd.none - ) - - ShowMessage message -> - ( { model | message = Just message } - , Cmd.none - ) - - HideMessage -> - ( { model | message = Nothing } - , Cmd.none - ) - -view : Model -> Html Msg -view { mousePosition, windowSize, message } = - case (mousePosition, message) of - (Just pos, Just msg) -> - div - [ class "tooltip" - , style - [ ("position", "absolute") - , horizontalPosition windowSize pos - , ("top", px <| pos.y + 15) - ] - ] - [ text msg ] - _ -> - text "" - -horizontalPosition : Size -> Position -> (String, String) -horizontalPosition size position = - if isLeft size position - then ("left", px <| position.x + 5) - else ("right", px <| size.width - position.x) - -verticalPosition : Size -> Position -> (String, String) -verticalPosition size position = - if isTop size position - then ("top", px <| position.y + 20) - else ("bottom", px <| size.height - position.y + 15) - -px : Int -> String -px n = (toString n) ++ "px" - -isLeft : Size -> Position -> Bool -isLeft { width } { x } = x < width // 2 - -isTop : Size -> Position -> Bool -isTop { height } { y } = y < height // 2 - -show : (Msg -> msg) -> String -> List (Attribute msg) -show mapMsg message = - [ onMouseEnter <| mapMsg <| ShowMessage message - , onMouseLeave <| mapMsg <| HideMessage - ] diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm deleted file mode 100644 index 7006d5a..0000000 --- a/src/client/elm/Update.elm +++ /dev/null @@ -1,182 +0,0 @@ -module Update exposing - ( update - ) - -import Task -import Platform.Cmd exposing (Cmd) -import Navigation exposing (Location) - -import Page exposing (Page) - -import Server - -import Msg exposing (..) - -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 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 ((:>)) - -update : Msg -> Model -> (Model, Cmd Msg) -update msg model = - case msg of - - NoOp -> - (model, Cmd.none) - - UpdatePage page -> - ({ model | page = page }, Cmd.none) - - SignIn email -> - ( applySignIn model (SignInMsg.WaitingServer) - , Server.signIn email (\result -> case result of - Ok _ -> UpdateSignIn SignInMsg.ValidLogin - Err error -> UpdateSignIn (SignInMsg.ErrorLogin (errorKey error)) - ) - ) - - GoLoggedInView init -> - ( { model | view = V.LoggedInView (LoggedInModel.init init) } - , Cmd.none - ) - - UpdateTime time -> - ({ model | currentTime = time }, Cmd.none) - - GoSignInView -> - ({ model | view = V.SignInView (SignInModel.init Nothing) }, Cmd.none) - - UpdateSignIn signInMsg -> - (applySignIn model signInMsg, Cmd.none) - - UpdateLoggedIn loggedInMsg -> - applyLoggedIn model loggedInMsg - - SignOut -> - ( model - , Server.signOut (\result -> case result of - Ok _ -> GoSignInView - Err _ -> Error "SignOutError" - ) - ) - - Error error -> - ({ model | errors = model.errors ++ [ error ] }, Cmd.none) - - Dialog dialogMsg -> - Dialog.update DialogUpdate.update dialogMsg model.dialog.model model.dialog - |> Tuple.mapFirst (\dialog -> { model | dialog = dialog }) - :> update (Tooltip Tooltip.HideMessage) - - Tooltip tooltipMsg -> - let (newTooltip, command) = Tooltip.update tooltipMsg model.tooltip - in ( { model | tooltip = newTooltip } - , Cmd.map Tooltip command - ) - - 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 - Err _ -> Error "CreatePaymentError" - ) - ) - - 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 - Err _ -> Error "EditPaymentError" - ) - ) - - DeletePayment paymentId -> - ( model - , Server.deletePayment paymentId (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeletePayment paymentId - Err _ -> Error "DeletePaymentError" - ) - ) - - CreateIncome amount date -> - ( model - , Server.createIncome amount date (\result -> case result of - Ok incomeId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreateIncome incomeId amount date - Err _ -> Error "CreateIncomeError" - ) - ) - - EditIncome incomeId amount date -> - ( model - , Server.editIncome incomeId amount date (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateEditIncome incomeId amount date - Err _ -> Error "EditIncomeError" - ) - ) - - DeleteIncome incomeId -> - ( model - , Server.deleteIncome incomeId (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeleteIncome incomeId - Err _ -> Error "DeleteIncomeError" - ) - ) - - CreateCategory name color -> - ( model - , Server.createCategory name color (\result -> case result of - Ok categoryId -> UpdateLoggedIn <| LoggedInMsg.ValidateCreateCategory categoryId name color - Err _ -> Error "CreateCategoryError" - ) - ) - - EditCategory categoryId name color -> - ( model - , Server.editCategory categoryId name color (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateEditCategory categoryId name color - Err _ -> Error "EditCategoryError" - ) - ) - - DeleteCategory categoryId -> - ( model - , Server.deleteCategory categoryId (\result -> case result of - Ok _ -> UpdateLoggedIn <| LoggedInMsg.ValidateDeleteCategory categoryId - Err _ -> Error "DeleteCategoryError" - ) - ) - - -applySignIn : Model -> SignInMsg.Msg -> Model -applySignIn model signInMsg = - case model.view of - V.SignInView signInView -> - { model | view = V.SignInView (SignInUpdate.update model.translations signInMsg signInView) } - _ -> - model - -applyLoggedIn : Model -> LoggedInMsg.Msg -> (Model, Cmd Msg) -applyLoggedIn model loggedInMsg = - case model.view of - V.LoggedInView loggedInView -> - let (view, cmd) = LoggedInUpdate.update model loggedInMsg loggedInView - in ( { model | view = V.LoggedInView view } - , Cmd.map UpdateLoggedIn cmd - ) - _ -> - (model, Cmd.none) diff --git a/src/client/elm/Utils/Cmd.elm b/src/client/elm/Utils/Cmd.elm deleted file mode 100644 index 5f41cbe..0000000 --- a/src/client/elm/Utils/Cmd.elm +++ /dev/null @@ -1,16 +0,0 @@ -module Utils.Cmd exposing - ( pipeUpdate - , (:>) - ) - -import Platform.Cmd as Cmd - -pipeUpdate : (model, Cmd msg) -> (model -> (model, Cmd msg)) -> (model, Cmd msg) -pipeUpdate (model, cmd) f = - let (newModel, newCmd) = f model - in (newModel, Cmd.batch [ cmd, newCmd ]) - -(:>) : (m, Cmd a) -> (m -> (m, Cmd a)) -> (m, Cmd a) -(:>) = pipeUpdate - -infixl 0 :> diff --git a/src/client/elm/Utils/Dict.elm b/src/client/elm/Utils/Dict.elm deleted file mode 100644 index 7d708e2..0000000 --- a/src/client/elm/Utils/Dict.elm +++ /dev/null @@ -1,11 +0,0 @@ -module Utils.Dict exposing - ( mapValues - ) - -import Dict as Dict exposing (..) - -mapValues : (a -> b) -> Dict comparable a -> Dict comparable b -mapValues f = Dict.fromList << List.map (onSecond f) << Dict.toList - -onSecond : (a -> b) -> (comparable, a) -> (comparable, b) -onSecond f tuple = case tuple of (x, y) -> (x, f y) diff --git a/src/client/elm/Utils/Either.elm b/src/client/elm/Utils/Either.elm deleted file mode 100644 index 275fc8c..0000000 --- a/src/client/elm/Utils/Either.elm +++ /dev/null @@ -1,9 +0,0 @@ -module Utils.Either exposing - ( toMaybeError - ) - -toMaybeError : Result a b -> Maybe a -toMaybeError result = - case result of - Ok _ -> Nothing - Err x -> Just x diff --git a/src/client/elm/Utils/Form.elm b/src/client/elm/Utils/Form.elm deleted file mode 100644 index 8d75a32..0000000 --- a/src/client/elm/Utils/Form.elm +++ /dev/null @@ -1,13 +0,0 @@ -module Utils.Form exposing - ( fieldAsText - ) - -import Form exposing (Form) - -import Model.Payment exposing (Frequency(..)) - -fieldAsText : Form a b -> String -> String -fieldAsText form field = - Form.getFieldAsString field form - |> .value - |> Maybe.withDefault "" diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm deleted file mode 100644 index dd3870a..0000000 --- a/src/client/elm/Utils/Http.elm +++ /dev/null @@ -1,39 +0,0 @@ -module Utils.Http exposing - ( jsonRequest - , request - , errorKey - ) - -import Http exposing (..) -import Task exposing (..) -import Json.Decode as Decode exposing (Decoder, Value) -import Json.Encode as Encode - -jsonRequest : String -> String -> Expect a -> (Result Error a -> msg) -> Encode.Value -> Cmd msg -jsonRequest method url expect handleResult value = - requestWithBody method url (jsonBody value) expect handleResult - -request : String -> String -> Expect a -> (Result Error a -> msg) -> Cmd msg -request method url = requestWithBody method url emptyBody - -requestWithBody : String -> String -> Body -> Expect a -> (Result Error a -> msg) -> Cmd msg -requestWithBody method url body expect handleResult = - let req = Http.request - { method = method - , headers = [] - , url = url - , body = body - , expect = expect - , timeout = Nothing - , withCredentials = False - } - in send handleResult req - -errorKey : Error -> String -errorKey error = - case error of - BadUrl _ -> "BadUrl" - Timeout -> "Timeout" - NetworkError -> "NetworkError" - BadPayload _ _ -> "BadPayload" - BadStatus response -> response.body diff --git a/src/client/elm/Utils/Json.elm b/src/client/elm/Utils/Json.elm deleted file mode 100644 index 29e815b..0000000 --- a/src/client/elm/Utils/Json.elm +++ /dev/null @@ -1,12 +0,0 @@ -module Utils.Json exposing - ( dictDecoder - ) - -import Json.Decode as Decode exposing (Decoder) -import Dict exposing (Dict) - -dictDecoder : Decoder comparable -> Decoder a -> Decoder (Dict comparable a) -dictDecoder keyDecoder valueDecoder = - Decode.map2 (,) keyDecoder valueDecoder - |> Decode.list - |> Decode.map Dict.fromList diff --git a/src/client/elm/Utils/List.elm b/src/client/elm/Utils/List.elm deleted file mode 100644 index cc57d9f..0000000 --- a/src/client/elm/Utils/List.elm +++ /dev/null @@ -1,17 +0,0 @@ -module Utils.List exposing - ( groupBy - , mean - ) - -import Dict - -groupBy : (a -> comparable) -> List a -> List (comparable, List a) -groupBy f xs = - let addItem item dict = - let groupItems = Dict.get (f item) dict |> Maybe.withDefault [] - in Dict.insert (f item) (item :: groupItems) dict - in List.foldr addItem Dict.empty xs - |> Dict.toList - -mean : List Int -> Int -mean xs = (List.sum xs) // (List.length xs) diff --git a/src/client/elm/Utils/Maybe.elm b/src/client/elm/Utils/Maybe.elm deleted file mode 100644 index 46456e1..0000000 --- a/src/client/elm/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/elm/Utils/Search.elm b/src/client/elm/Utils/Search.elm deleted file mode 100644 index 1b70387..0000000 --- a/src/client/elm/Utils/Search.elm +++ /dev/null @@ -1,10 +0,0 @@ -module Utils.Search exposing - ( format - ) - -import String - -import Utils.String as String - -format : String -> String -format = String.unaccent << String.toLower diff --git a/src/client/elm/Utils/String.elm b/src/client/elm/Utils/String.elm deleted file mode 100644 index 90fe68e..0000000 --- a/src/client/elm/Utils/String.elm +++ /dev/null @@ -1,38 +0,0 @@ -module Utils.String exposing - ( unaccent - ) - -unaccent : String -> String -unaccent = String.map unaccentChar - -unaccentChar : Char -> Char -unaccentChar c = case c of - 'à' -> 'a' - 'á' -> 'a' - 'â' -> 'a' - 'ã' -> 'a' - 'ä' -> 'a' - 'ç' -> 'c' - 'è' -> 'e' - 'é' -> 'e' - 'ê' -> 'e' - 'ë' -> 'e' - 'ì' -> 'i' - 'í' -> 'i' - 'î' -> 'i' - 'ï' -> 'i' - 'ñ' -> 'n' - 'ò' -> 'o' - 'ó' -> 'o' - 'ô' -> 'o' - 'õ' -> 'o' - 'ö' -> 'o' - 'š' -> 's' - 'ù' -> 'u' - 'ú' -> 'u' - 'û' -> 'u' - 'ü' -> 'u' - 'ý' -> 'y' - 'ÿ' -> 'y' - 'ž' -> 'z' - _ -> c diff --git a/src/client/elm/Validation.elm b/src/client/elm/Validation.elm deleted file mode 100644 index 18b3934..0000000 --- a/src/client/elm/Validation.elm +++ /dev/null @@ -1,38 +0,0 @@ -module Validation exposing - ( date - , category - ) - -import Date exposing (Date) -import Date.Extra.Core exposing (intToMonth) -import Date.Extra.Create exposing (dateFromFields) -import Dict -import String exposing (toInt, split) - -import Form.Validate as Validate exposing (..) - -import Model.Category exposing (Categories, CategoryId) - -date : Validation String Date -date = - 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 (intToMonth monthNum) dayNum 0 0 0 0) - _ -> Err (customError "InvalidDate") - _ -> Err (customError "InvalidDate") - ) - -category : Categories -> Validation String CategoryId -category categories = - customValidation string (\str -> - case toInt str of - Ok category -> - if List.member category (Dict.keys categories) - then Ok category - else Err (customError "InvalidCategory") - Err _ -> - Err (customError "InvalidCategory") - ) diff --git a/src/client/elm/View.elm b/src/client/elm/View.elm deleted file mode 100644 index 66c498a..0000000 --- a/src/client/elm/View.elm +++ /dev/null @@ -1,36 +0,0 @@ -module View exposing - ( view - ) - -import Html exposing (..) -import Html.Attributes exposing (..) - -import Model exposing (Model) -import Msg exposing (Msg) -import Model.View exposing (..) -import LoggedData -import Dialog -import Tooltip - -import View.Header as Header -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 - [] - [ Header.view model - , case model.view of - SignInView signIn -> - SignInView.view model signIn - LoggedInView loggedIn -> - LoggedInView.view model loggedIn - , Errors.view model.translations model.errors - , Dialog.view model.dialog - , Html.map Msg.Tooltip <| Tooltip.view model.tooltip - ] diff --git a/src/client/elm/View/Color.elm b/src/client/elm/View/Color.elm deleted file mode 100644 index a2a20c7..0000000 --- a/src/client/elm/View/Color.elm +++ /dev/null @@ -1,12 +0,0 @@ -module View.Color exposing (..) - -import Color exposing (Color) - -chestnutRose : Color -chestnutRose = Color.rgb 207 92 86 - -white : Color -white = Color.white - -silver : Color -silver = Color.rgb 200 200 200 diff --git a/src/client/elm/View/Date.elm b/src/client/elm/View/Date.elm deleted file mode 100644 index 35806ba..0000000 --- a/src/client/elm/View/Date.elm +++ /dev/null @@ -1,48 +0,0 @@ -module View.Date exposing - ( shortView - , longView - , monthView - ) - -import Date exposing (..) -import Date.Extra.Core as Date -import String - -import Model.Translations exposing (..) - -shortView : Date -> Translations -> String -shortView date translations = - let params = - [ String.pad 2 '0' (toString (Date.day date)) - , String.pad 2 '0' (toString (Date.monthToInt (Date.month date))) - , toString (Date.year date) - ] - in getParamMessage params translations "ShortDate" - -longView : Date -> Translations -> String -longView date translations = - let params = - [ toString (Date.day date) - , (getMessage translations (getMonthKey (Date.month date))) - , toString (Date.year date) - ] - in getParamMessage params translations "LongDate" - -monthView : Translations -> Month -> String -monthView translations month = getMessage translations (getMonthKey month) - -getMonthKey : Month -> String -getMonthKey month = - case month of - Jan -> "January" - Feb -> "February" - Mar -> "March" - Apr -> "April" - May -> "May" - Jun -> "June" - Jul -> "July" - Aug -> "August" - Sep -> "September" - Oct -> "October" - Nov -> "November" - Dec -> "December" diff --git a/src/client/elm/View/Errors.elm b/src/client/elm/View/Errors.elm deleted file mode 100644 index 3e25c99..0000000 --- a/src/client/elm/View/Errors.elm +++ /dev/null @@ -1,21 +0,0 @@ -module View.Errors exposing - ( view - ) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import Model.Translations exposing (Translations, getMessage) - -view : Translations -> List String -> Html msg -view translations errors = - ul - [ class "errors" ] - ( List.map (errorView translations) errors) - -errorView : Translations -> String -> Html msg -errorView translations error = - li - [ class "error" ] - [ text <| getMessage translations error ] diff --git a/src/client/elm/View/Events.elm b/src/client/elm/View/Events.elm deleted file mode 100644 index d71d67d..0000000 --- a/src/client/elm/View/Events.elm +++ /dev/null @@ -1,15 +0,0 @@ -module View.Events exposing - ( onSubmitPrevDefault - ) - -import Json.Decode as Decode -import Html exposing (..) -import Html.Events exposing (..) -import Html.Attributes exposing (..) - -onSubmitPrevDefault : msg -> Attribute msg -onSubmitPrevDefault value = - onWithOptions - "submit" - { defaultOptions | preventDefault = True } - (Decode.succeed value) diff --git a/src/client/elm/View/Form.elm b/src/client/elm/View/Form.elm deleted file mode 100644 index 7a4965d..0000000 --- a/src/client/elm/View/Form.elm +++ /dev/null @@ -1,153 +0,0 @@ -module View.Form exposing - ( textInput - , colorInput - , selectInput - , radioInputs - , hiddenSubmit - ) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import FontAwesome -import View.Color as Color - -import Form exposing (Form, FieldState) -import Form.Input as Input -import Form.Error as FormError exposing (ErrorValue(..)) -import Form.Field as Field - -import Msg exposing (Msg) - -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 - fieldId = formName ++ fieldName - in div - [ classList - [ ("textInput", True) - , ("error", isJust field.liveError) - ] - ] - [ Input.textInput - field - [ id fieldId - , classList [ ("filled", isJust field.value) ] - , value (Maybe.withDefault "" field.value) - ] - , label - [ for fieldId ] - [ text (Translations.getMessage translations fieldId) ] - , button - [ type_ "button" - , onClick (Form.Input fieldName Form.Text Field.EmptyField) - , tabindex -1 - ] - [ FontAwesome.times Color.silver 15 ] - , formError translations field - ] - -colorInput : Translations -> Form String a -> String -> String -> Html Form.Msg -colorInput translations form formName fieldName = - let field = Form.getFieldAsString fieldName form - in div - [ classList - [ ("colorInput", True) - , ("error", isJust field.liveError) - ] - ] - [ label - [ for (formName ++ fieldName) ] - [ text (Translations.getMessage translations (formName ++ fieldName)) ] - , Input.textInput - field - [ id (formName ++ fieldName) - , type_ "color" - ] - ] - -radioInputs : Translations -> Form String a -> String -> String -> List String -> Html Form.Msg -radioInputs translations form formName radioName fieldNames = - let field = Form.getFieldAsString radioName form - in div - [ classList - [ ("radioGroup", True) - , ("error", isJust field.liveError) - ] - ] - [ div - [ class "title" ] - [ text (Translations.getMessage translations (formName ++ radioName) ) ] - , div - [ class "radioInputs" ] - (List.map (radioInput translations field formName) fieldNames) - , formError translations field - ] - -radioInput : Translations -> FieldState String String -> String -> String -> Html Form.Msg -radioInput translations field formName fieldName = - div - [ class "radioInput" ] - [ Input.radioInput - field.path - field - [ id (formName ++ fieldName) - , value fieldName - , checked (field.value == Just fieldName) - ] - , label - [ for (formName ++ fieldName) ] - [ text (Translations.getMessage translations (formName ++ fieldName)) - ] - ] - -selectInput : Translations -> Form String a -> String -> String -> List (String, String) -> Html Form.Msg -selectInput translations form formName selectName options = - let field = Form.getFieldAsString selectName form - fieldId = formName ++ selectName - in div - [ classList - [ ("selectInput", True) - , ("error", isJust field.liveError) - ] - ] - [ label - [ for fieldId ] - [ text (Translations.getMessage translations fieldId) ] - , Input.selectInput - (("", "") :: options) - field - [ id fieldId ] - , formError translations field - ] - -formError : Translations -> FieldState String a -> Html msg -formError translations field = - case field.liveError of - Just error -> - let errorElement error params = - div - [ class "errorMessage" ] - [ text (Translations.getParamMessage params translations error) ] - in case error of - CustomError key -> errorElement key [] - SmallerIntThan n -> errorElement "SmallerIntThan" [toString n] - GreaterIntThan n -> errorElement "GreaterIntThan" [toString n] - error -> errorElement (toString error) [] - Nothing -> - text "" - -hiddenSubmit : msg -> Html msg -hiddenSubmit msg = - button - [ style [ ("display", "none") ] - , onClick msg - ] - [] diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm deleted file mode 100644 index 12fb87c..0000000 --- a/src/client/elm/View/Header.elm +++ /dev/null @@ -1,60 +0,0 @@ -module View.Header exposing - ( view - ) - -import Dict - -import FontAwesome -import View.Color as Color - -import Page exposing (..) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import Model exposing (Model) -import Model.Translations exposing (getMessage) -import Msg exposing (..) -import Model.View exposing (..) - -view : Model -> Html Msg -view model = - header - [] - ( [ div [ class "title" ] [ text (getMessage model.translations "SharedCost") ] ] - ++ let item page name = - a - [ href (Page.toHash page) - , classList - [ ("item", True) - , ("current", model.page == page) - ] - ] - [ text (getMessage model.translations name) - ] - in case model.view of - LoggedInView { me, users } -> - [ item Home "PaymentsTitle" - , item Income "Income" - , item Categories "Categories" - , item Statistics "Statistics" - , div - [ class "nameSignOut" ] - [ div - [ class "name" ] - [ Dict.get me users - |> Maybe.map .name - |> Maybe.withDefault "" - |> text - ] - , button - [ class "signOut item" - , onClick SignOut - ] - [ FontAwesome.power_off Color.white 30 ] - ] - ] - _ -> - [] - ) diff --git a/src/client/elm/View/Plural.elm b/src/client/elm/View/Plural.elm deleted file mode 100644 index c36eaca..0000000 --- a/src/client/elm/View/Plural.elm +++ /dev/null @@ -1,11 +0,0 @@ -module View.Plural exposing - ( plural - ) - -import Model.Translations exposing (Translations, getMessage) - -plural : Translations -> Int -> String -> String -> String -plural translations n single multiple = - let singleMessage = getMessage translations single - multipleMessage = getMessage translations multiple - in (toString n) ++ " " ++ if n <= 1 then singleMessage else multipleMessage diff --git a/src/client/js/main.js b/src/client/js/main.js deleted file mode 100644 index 3c3d797..0000000 --- a/src/client/js/main.js +++ /dev/null @@ -1,17 +0,0 @@ -// Remove search query -window.history.pushState( - { - html: document.documentElement.innerHTML, - pageTitle: document.title - }, - '', - document.location.pathname + document.location.hash -); - -var app = Elm.Main.fullscreen({ - time: new Date().getTime(), - translations: JSON.parse(document.getElementById('translations').innerHTML), - conf: JSON.parse(document.getElementById('conf').innerHTML), - result: JSON.parse(document.getElementById('result').innerHTML), - windowSize: { width: window.innerWidth, height: window.innerHeight } -}); diff --git a/src/server/Main.hs b/src/server/Main.hs index b7764c9..7ae8c1c 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -1,22 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} -import Web.Scotty - import Network.Wai.Middleware.Static - -import Job.Daemon (runDaemons) - import qualified Data.Text.Lazy as LT +import Web.Scotty -import qualified Controller.Index as Index -import qualified Controller.SignIn as SignIn -import qualified Controller.Payment as Payment -import qualified Controller.Income as Income -import qualified Controller.Category as Category - +import Job.Daemon (runDaemons) import Model.Database (runMigrations) - import qualified Conf +import qualified Controller.Category as Category +import qualified Controller.Income as Income +import qualified Controller.Index as Index +import qualified Controller.Payment as Payment +import qualified Controller.SignIn as SignIn main :: IO () main = do diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index 36b3ba0..79ccf39 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -127,6 +127,7 @@ data Key = | Empty | InvalidString | InvalidDate + | CostMustNotBeNull | InvalidInt | InvalidCategory | SmallerIntThan diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index 6565344..16fc3fd 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -498,6 +498,11 @@ m l InvalidDate = English -> "day/month/year required" French -> "jour/mois/année requis" +m l CostMustNotBeNull = + case l of + English -> "Cost must not be zero" + French -> "Le coût ne doît pas être nul" + m l InvalidInt = case l of English -> "Integer required" -- cgit v1.2.3