diff options
35 files changed, 631 insertions, 289 deletions
diff --git a/.tmuxinator.yml b/.tmuxinator.yml index 34b8cc4..2be1fda 100644 --- a/.tmuxinator.yml +++ b/.tmuxinator.yml @@ -5,4 +5,4 @@ windows: layout: fff4,119x58,0,0{94x58,0,0,0,24x58,95,0,1} panes: - # Empty - - make install && make build && make watch + - make install && make && make watch @@ -1,16 +1,15 @@ -all: install build +all: build clean: - @echo "Cleaning…" @cabal clean > /dev/null @rm -r elm-stuff >/dev/null 2>&1 || true @rm -r node_modules >/dev/null 2>&1 || true install: - cabal2nix --shell . > sharedCost.nix - nix-shell sharedCost.nix -I ~ --command 'cabal configure' - elm package install - npm install + @cabal2nix --shell . > sharedCost.nix + @nix-shell sharedCost.nix -I ~ --command 'cabal configure' + @elm package install + @npm install # Watch # ----- @@ -18,13 +17,13 @@ install: watch: watch-server watch-elm watch-js watch-server: - ./node_modules/nodemon/bin/nodemon.js -e hs,conf --exec 'make build-and-launch-server --silent' + @./node_modules/nodemon/bin/nodemon.js -e hs,conf --exec 'clear && make build-and-launch-server --silent' & watch-elm: - ./node_modules/nodemon/bin/nodemon.js -e elm --exec 'make build-elm --silent' + @./node_modules/nodemon/bin/nodemon.js -e elm --exec 'clear && make build-elm --silent' & watch-js: - ./node_modules/nodemon/bin/nodemon.js --watch src/client/js --exec 'make build-js --silent' + @./node_modules/nodemon/bin/nodemon.js --watch src/client/js --exec 'make build-js --silent' # Build and launch # ---------------- @@ -32,10 +31,10 @@ watch-js: build-and-launch-server: build-server kill-server launch-server launch-server: - ./dist/build/sharedCost/sharedCost & + @./dist/build/sharedCost/sharedCost & kill-server: - pkill sharedCost || true + @pkill sharedCost || true # Build # ----- @@ -43,10 +42,10 @@ kill-server: build: build-server build-elm build-js build-server: - cabal build + @cabal build || true build-elm: - elm make src/client/elm/Main.elm --output public/javascripts/client.js + @elm make src/client/elm/Main.elm --output public/javascripts/client.js || true build-js: - cp src/client/js/main.js public/javascripts/main.js + @cp src/client/js/main.js public/javascripts/main.js || true @@ -1,8 +1,10 @@ -# Shared Cost +Shared Cost +=========== Share costs with a group of people. -## Getting started +Getting started +--------------- Install nix: @@ -24,13 +26,14 @@ insert into user(creation, email, name) values (datetime('now'), 'john@mail.com' insert into user(creation, email, name) values (datetime('now'), 'lisa@mail.com', 'Lisa'); ``` -## Configuration +Configuration +------------- -[application.conf](application.conf) +See [application.conf](application.conf). -## TODO +TODO +---- -- Income CRUD - Server error message - Dates after today must be forbidden - Weekly notifications about added, modified, deleted payments and incomes diff --git a/package.json b/package.json index 6d7467e..56b0d09 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,7 @@ { "dependencies": { - "nodemon": "1.9.2" + "nodemon": "1.9.2", + "elm": "0.17.1" }, "repository": "guyonvarch/sharedCost", "license": "GPL-3.0" diff --git a/sharedCost.cabal b/sharedCost.cabal index 679bb47..0cf5152 100644 --- a/sharedCost.cabal +++ b/sharedCost.cabal @@ -3,7 +3,7 @@ version: 0.1 license: GPL-3 license-file: LICENSE author: Joris -maintainer: joris.guyonvarch@gmail.com +maintainer: joris@guyonvarch.me category: Web build-type: Simple cabal-version: >=1.10 @@ -12,7 +12,6 @@ with import <nixpkgs> {}; { ]; shellHook = '' tmux kill-session -t sharedCost >/dev/null 2>&1 - firefox http://localhost:3000/ tmuxinator local ''; }; diff --git a/src/client/elm/Dialog/AddIncome/Model.elm b/src/client/elm/Dialog/AddIncome/Model.elm new file mode 100644 index 0000000..664557e --- /dev/null +++ b/src/client/elm/Dialog/AddIncome/Model.elm @@ -0,0 +1,52 @@ +module Dialog.AddIncome.Model exposing + ( Model + , init + , initialAdd + , initialClone + , initialEdit + ) + +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 [] validate + +initialAdd : Translations -> Date -> List (String, Field) +initialAdd translations date = + [ ("date", Field.Text (Date.shortView date translations)) + ] + +initialClone : Translations -> Date -> Income -> List (String, Field) +initialClone translations date income = + [ ("amount", Field.Text (toString income.amount)) + , ("date", Field.Text (Date.shortView (Date.fromTime income.time) translations)) + ] + +initialEdit : Translations -> IncomeId -> Income -> List (String, Field) +initialEdit translations incomeId income = + [ ("id", Field.Text (toString incomeId)) + , ("amount", Field.Text (toString income.amount)) + , ("date", Field.Text (Date.shortView (Date.fromTime income.time) translations)) + ] + +validate : Validation String Model +validate = + Validate.form3 Model + (Validate.get "id" (Validate.maybe Validate.int)) + (Validate.get "amount" (Validate.int `Validate.andThen` (Validate.minInt 1))) + (Validate.get "date" Validation.date) diff --git a/src/client/elm/Dialog/AddIncome/View.elm b/src/client/elm/Dialog/AddIncome/View.elm new file mode 100644 index 0000000..cc1ac13 --- /dev/null +++ b/src/client/elm/Dialog/AddIncome/View.elm @@ -0,0 +1,75 @@ +module Dialog.AddIncome.View exposing + ( button + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Html.App as Html +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 : String -> LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg +button className loggedData initialForm title buttonContent tooltip = + let dialogConfig = + { className = "incomeDialog" + , title = getMessage title loggedData.translations + , body = \model -> addIncomeForm loggedData model.addIncome + , confirm = getMessage "Confirm" loggedData.translations + , confirmMsg = submitForm << .addIncome + , undo = getMessage "Undo" loggedData.translations + } + in Html.button + ( ( case tooltip of + Just message -> Tooltip.show Msg.Tooltip message + Nothing -> [] + ) + ++ [ class className + , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (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.UpdateLoggedIn <| LoggedInMsg.EditIncome incomeId data.amount data.date + Nothing -> + Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.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 new file mode 100644 index 0000000..19326f0 --- /dev/null +++ b/src/client/elm/Dialog/AddPayment/Model.elm @@ -0,0 +1,61 @@ +module Dialog.AddPayment.Model exposing + ( Model + , init + , initialAdd + , initialClone + , initialEdit + ) + +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) + +type alias Model = + { id : Maybe PaymentId + , name : String + , cost : Int + , date : Date + , frequency : Frequency + } + +init : Form String Model +init = Form.initial [] validation + +initialAdd : Translations -> Date -> Frequency -> List (String, Field) +initialAdd translations date frequency = + [ ("date", Field.Text (Date.shortView date translations)) + , ("frequency", Field.Radio (toString frequency)) + ] + +initialClone : Translations -> Date -> Payment -> List (String, Field) +initialClone translations date payment = + [ ("name", Field.Text payment.name) + , ("cost", Field.Text (toString payment.cost)) + , ("date", Field.Text (Date.shortView date translations)) + , ("frequency", Field.Radio (toString payment.frequency)) + ] + +initialEdit : Translations -> Payment -> List (String, Field) +initialEdit translations payment = + [ ("id", Field.Text (toString payment.id)) + , ("name", Field.Text payment.name) + , ("cost", Field.Text (toString payment.cost)) + , ("date", Field.Text (Date.shortView payment.date translations)) + , ("frequency", Field.Radio (toString payment.frequency)) + ] + +validation : Validation String Model +validation = + Validate.form5 Model + (Validate.get "id" (Validate.maybe Validate.int)) + (Validate.get "name" (Validate.string `Validate.andThen` (Validate.nonEmpty))) + (Validate.get "cost" (Validate.int `Validate.andThen` (Validate.minInt 1))) + (Validate.get "date" Validation.date) + (Validate.get "frequency" Payment.validateFrequency) diff --git a/src/client/elm/Dialog/AddPaymentButton/View.elm b/src/client/elm/Dialog/AddPayment/View.elm index 585b1b7..3ffe200 100644 --- a/src/client/elm/Dialog/AddPaymentButton/View.elm +++ b/src/client/elm/Dialog/AddPayment/View.elm @@ -1,5 +1,5 @@ -module Dialog.AddPaymentButton.View exposing - ( view +module Dialog.AddPayment.View exposing + ( button ) import Html exposing (..) @@ -13,7 +13,7 @@ import Form.Field as Field exposing (Field) import Utils.Form as Form import Dialog -import Dialog.Model as DialogModel +import Dialog.AddPayment.Model as AddPayment import Dialog.Msg as DialogMsg import Tooltip @@ -32,8 +32,8 @@ import Model.View exposing (View(LoggedInView)) import LoggedData exposing (LoggedData) import LoggedIn.Home.Model as HomeModel -view : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg -view loggedData initialForm title buttonContent tooltip = +button : LoggedData -> List (String, Field) -> String -> Html Msg -> Maybe String -> Html Msg +button loggedData initialForm title buttonContent tooltip = let dialogConfig = { className = "paymentDialog" , title = getMessage title loggedData.translations @@ -42,7 +42,7 @@ view loggedData initialForm title buttonContent tooltip = , confirmMsg = submitForm << .addPayment , undo = getMessage "Undo" loggedData.translations } - in button + in Html.button ( ( case tooltip of Just message -> Tooltip.show Msg.Tooltip message Nothing -> [] @@ -53,7 +53,7 @@ view loggedData initialForm title buttonContent tooltip = ) [ buttonContent ] -addPaymentForm : LoggedData -> Form String DialogModel.AddPayment -> Html Msg +addPaymentForm : LoggedData -> Form String AddPayment.Model -> Html Msg addPaymentForm loggedData addPayment = let htmlMap = Html.map (Msg.Dialog << Dialog.Update << DialogMsg.AddPaymentMsg) in Html.form @@ -69,7 +69,7 @@ addPaymentForm loggedData addPayment = , Form.hiddenSubmit (submitForm addPayment) ] -submitForm : Form String DialogModel.AddPayment -> Msg +submitForm : Form String AddPayment.Model -> Msg submitForm addPayment = case Form.getOutput addPayment of Just data -> diff --git a/src/client/elm/Dialog/Model.elm b/src/client/elm/Dialog/Model.elm index b49d8f1..a3901f9 100644 --- a/src/client/elm/Dialog/Model.elm +++ b/src/client/elm/Dialog/Model.elm @@ -1,10 +1,6 @@ module Dialog.Model exposing ( Model - , AddPayment , init - , addPaymentInitial - , clonePaymentInitial - , editPaymentInitial ) import Date exposing (Date) @@ -18,51 +14,16 @@ import Validation import Model.Payment as Payment exposing (Payment, Frequency, PaymentId) import Model.Translations exposing (Translations) -type alias Model = - { addPayment : Form String AddPayment - } +import Dialog.AddPayment.Model as AddPayment +import Dialog.AddIncome.Model as AddIncome -type alias AddPayment = - { id : Maybe PaymentId - , name : String - , cost : Int - , date : Date - , frequency : Frequency +type alias Model = + { addPayment : Form String AddPayment.Model + , addIncome : Form String AddIncome.Model } init : Model init = - { addPayment = Form.initial [] addPaymentValidation + { addPayment = AddPayment.init + , addIncome = AddIncome.init } - -addPaymentInitial : Translations -> Date -> Frequency -> List (String, Field) -addPaymentInitial translations date frequency = - [ ("date", Field.Text (Date.shortView date translations)) - , ("frequency", Field.Radio (toString frequency)) - ] - -clonePaymentInitial : Translations -> Date -> Payment -> List (String, Field) -clonePaymentInitial translations date payment = - [ ("name", Field.Text payment.name) - , ("cost", Field.Text (toString payment.cost)) - , ("date", Field.Text (Date.shortView date translations)) - , ("frequency", Field.Radio (toString payment.frequency)) - ] - -editPaymentInitial : Translations -> Payment -> List (String, Field) -editPaymentInitial translations payment = - [ ("id", Field.Text (toString payment.id)) - , ("name", Field.Text payment.name) - , ("cost", Field.Text (toString payment.cost)) - , ("date", Field.Text (Date.shortView payment.date translations)) - , ("frequency", Field.Radio (toString payment.frequency)) - ] - -addPaymentValidation : Validation String AddPayment -addPaymentValidation = - Validate.form5 AddPayment - (Validate.get "id" (Validate.maybe Validate.int)) - (Validate.get "name" (Validate.string `Validate.andThen` (Validate.nonEmpty))) - (Validate.get "cost" (Validate.int `Validate.andThen` (Validate.minInt 1))) - (Validate.get "date" Validation.date) - (Validate.get "frequency" Payment.validateFrequency) diff --git a/src/client/elm/Dialog/Msg.elm b/src/client/elm/Dialog/Msg.elm index c9e1596..d504281 100644 --- a/src/client/elm/Dialog/Msg.elm +++ b/src/client/elm/Dialog/Msg.elm @@ -7,3 +7,4 @@ import Form exposing (Form) type Msg = NoOp | AddPaymentMsg Form.Msg + | AddIncomeMsg Form.Msg diff --git a/src/client/elm/Dialog/Update.elm b/src/client/elm/Dialog/Update.elm index e1e2dba..d69082d 100644 --- a/src/client/elm/Dialog/Update.elm +++ b/src/client/elm/Dialog/Update.elm @@ -22,3 +22,10 @@ update msg model = } , Cmd.none ) + + Dialog.AddIncomeMsg formMsg -> + ( { model + | addIncome = Form.update formMsg model.addIncome + } + , Cmd.none + ) diff --git a/src/client/elm/LoggedIn/Home/Header/View.elm b/src/client/elm/LoggedIn/Home/Header/View.elm index 95cef3c..e6b2444 100644 --- a/src/client/elm/LoggedIn/Home/Header/View.elm +++ b/src/client/elm/LoggedIn/Home/Header/View.elm @@ -25,8 +25,8 @@ import Model.Conf exposing (Conf) import Model.Payment as Payment exposing (Payments, Frequency(..)) import Model.Translations exposing (getMessage) -import Dialog.Model as DialogModel -import Dialog.AddPaymentButton.View as AddPaymentButton +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 @@ -42,9 +42,9 @@ view loggedData { search } payments frequency = [ div [ class "payerAndAdd" ] [ ExceedingPayers.view loggedData - , AddPaymentButton.view + , AddPayment.button loggedData - (DialogModel.addPaymentInitial loggedData.translations currentDate frequency) + (AddPayment.initialAdd loggedData.translations currentDate frequency) "AddPayment" (text (getMessage "AddPayment" loggedData.translations)) Nothing diff --git a/src/client/elm/LoggedIn/Home/View/Expand.elm b/src/client/elm/LoggedIn/Home/View/Expand.elm deleted file mode 100644 index 2bcfec1..0000000 --- a/src/client/elm/LoggedIn/Home/View/Expand.elm +++ /dev/null @@ -1,29 +0,0 @@ -module LoggedIn.Home.View.Expand exposing - ( expand - , ExpandType(..) - ) - -import View.Color as Color - -import FontAwesome - -import Html exposing (..) -import Html.Attributes exposing (..) - -import Msg exposing (Msg) - -type ExpandType = ExpandUp | ExpandDown - -expand : ExpandType -> Bool -> Html Msg -expand expandType isExpanded = - div - [ class "expand" ] - [ (chevronIcon expandType isExpanded) Color.white 15 ] - -chevronIcon : ExpandType -> Bool -> (Color -> Int -> Html msg) -chevronIcon expandType isExpanded = - case (expandType, isExpanded) of - (ExpandUp, True) -> FontAwesome.chevron_down - (ExpandUp, False) -> FontAwesome.chevron_up - (ExpandDown, True) -> FontAwesome.chevron_up - (ExpandDown, False) -> FontAwesome.chevron_down diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm index 429632c..6c12f31 100644 --- a/src/client/elm/LoggedIn/Home/View/Table.elm +++ b/src/client/elm/LoggedIn/Home/View/Table.elm @@ -14,8 +14,8 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Dialog -import Dialog.Model as DialogModel -import Dialog.AddPaymentButton.View as AddPaymentButton +import Dialog.AddPayment.Model as AddPayment +import Dialog.AddPayment.View as AddPayment import Tooltip @@ -25,8 +25,7 @@ import LoggedData exposing (LoggedData) import LoggedIn.Msg as LoggedInMsg -import LoggedIn.Home.Msg as HomeMsg -import LoggedIn.Home.Model as HomeModel +import LoggedIn.Home.Model as Home import View.Date as Date import LoggedIn.View.Format as Format @@ -34,7 +33,7 @@ import Model.User exposing (getUserName) import Model.Payment as Payment exposing (..) import Model.Translations exposing (getMessage) -view : LoggedData -> HomeModel.Model -> Payments -> Frequency -> Html Msg +view : LoggedData -> Home.Model -> Payments -> Frequency -> Html Msg view loggedData homeModel payments frequency = let visiblePayments = payments @@ -48,7 +47,7 @@ view loggedData homeModel payments frequency = , if List.isEmpty visiblePayments then div - [ class "noPayment" ] + [ class "emptyTableMsg" ] [ text <| getMessage "NoPayment" loggedData.translations ] else text "" @@ -69,7 +68,7 @@ headerLine loggedData frequency = , div [ class "cell" ] [] ] -paymentLine : LoggedData -> HomeModel.Model -> Frequency -> Payment -> Html Msg +paymentLine : LoggedData -> Home.Model -> Frequency -> Payment -> Html Msg paymentLine loggedData homeModel frequency payment = div [ class "row" ] @@ -104,9 +103,9 @@ paymentLine loggedData homeModel frequency payment = , div [ class "cell button" ] [ let currentDate = Date.fromTime loggedData.currentTime - in AddPaymentButton.view + in AddPayment.button loggedData - (DialogModel.clonePaymentInitial loggedData.translations currentDate payment) + (AddPayment.initialClone loggedData.translations currentDate payment) "ClonePayment" (FontAwesome.clone Color.chestnutRose 18) (Just (getMessage "Clone" loggedData.translations)) @@ -117,11 +116,11 @@ paymentLine loggedData homeModel frequency payment = then text "" else - AddPaymentButton.view + AddPayment.button loggedData - (DialogModel.editPaymentInitial loggedData.translations payment) + (AddPayment.initialEdit loggedData.translations payment) "EditPayment" - (FontAwesome.edit Color.chestnutRose 18) + (FontAwesome.pencil Color.chestnutRose 18) (Just (getMessage "Edit" loggedData.translations)) ] , div diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm index 2b69806..5a2c18e 100644 --- a/src/client/elm/LoggedIn/Income/View.elm +++ b/src/client/elm/LoggedIn/Income/View.elm @@ -19,6 +19,8 @@ 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) @@ -29,33 +31,42 @@ 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 IncomeModel +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 -> IncomeModel.Model -> Html Msg +view : LoggedData -> Income.Model -> Html Msg view loggedData incomeModel = div [ class "income" ] [ case useIncomesFrom loggedData.users loggedData.incomes loggedData.payments of Just since -> cumulativeIncomesView loggedData since Nothing -> text "" - , h1 [] [ text <| getMessage "MonthlyNetIncomes" loggedData.translations ] - , addIncomeView loggedData incomeModel.addIncome - , incomesView loggedData + , div + [ class "textual monthlyNetIncomes" ] + [ h1 [] [ text <| getMessage "MonthlyNetIncomes" loggedData.translations ] + , AddIncome.button + "addIncome" + loggedData + (AddIncome.initialAdd loggedData.translations (Date.fromTime loggedData.currentTime)) + "AddIncome" + (text (getMessage "AddIncome" loggedData.translations)) + Nothing + ] + , Table.view loggedData incomeModel ] cumulativeIncomesView : LoggedData -> Time -> Html Msg cumulativeIncomesView loggedData since = let longDate = Date.longView (Date.fromTime since) loggedData.translations in div - [] + [ class "textual" ] [ h1 [] [ text <| getParamMessage [longDate] "CumulativeIncomesSince" loggedData.translations ] , ul [] @@ -75,36 +86,6 @@ cumulativeIncomesView loggedData since = ) ] -addIncomeView : LoggedData -> Form String IncomeModel.AddIncome -> Html Msg -addIncomeView loggedData addIncome = - let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.IncomeMsg << IncomeMsg.AddIncomeMsg) - in Html.form - [ onSubmitPrevDefault Msg.NoOp ] - [ htmlMap <| Form.textInput loggedData.translations addIncome "income" "amount" - , htmlMap <| Form.textInput loggedData.translations addIncome "income" "date" - , button - [ class "add" - , case Form.getOutput addIncome of - Just data -> - onClick (Msg.UpdateLoggedIn <| LoggedInMsg.CreateIncome data.amount data.date) - Nothing -> - onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit) - ] - [ text (getMessage "Add" loggedData.translations) ] - ] - -incomesView : LoggedData -> Html Msg -incomesView loggedData = - ul - [ class "incomes" ] - ( loggedData.incomes - |> Dict.toList - |> List.filter ((==) loggedData.me << .userId << snd) - |> List.sortBy (.time << snd) - |> List.reverse - |> List.map (incomeView loggedData) - ) - incomeView : LoggedData -> (IncomeId, Income) -> Html Msg incomeView loggedData (incomeId, income) = li diff --git a/src/client/elm/LoggedIn/Income/View/Table.elm b/src/client/elm/LoggedIn/Income/View/Table.elm new file mode 100644 index 0000000..cf82772 --- /dev/null +++ b/src/client/elm/LoggedIn/Income/View/Table.elm @@ -0,0 +1,131 @@ +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 << snd) + |> 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 "NoPayment" loggedData.translations ] + else + text "" + ] + +headerLine : LoggedData -> Html Msg +headerLine loggedData = + div + [ class "header" ] + [ div [ class "cell name" ] [ text <| getMessage "Name" loggedData.translations ] + , div [ class "cell income" ] [ text <| getMessage "Income" loggedData.translations ] + , div [ class "cell date" ] [ text <| getMessage "Date" loggedData.translations ] + , 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 "Clone" loggedData.translations)) + ] + , 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 "Edit" loggedData.translations)) + ] + , div + [ class "cell button" ] + [ if loggedData.me /= income.userId + then + text "" + else + let dialogConfig = + { className = "deleteIncomeDialog" + , title = getMessage "ConfirmIncomeDelete" loggedData.translations + , body = always <| text "" + , confirm = getMessage "Confirm" loggedData.translations + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId + , undo = getMessage "Undo" loggedData.translations + } + in button + ( Tooltip.show Msg.Tooltip (getMessage "Delete" loggedData.translations) + ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] + ) + [ FontAwesome.trash Color.chestnutRose 18 ] + ] + ] diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm index 77fb0ed..9bb87b9 100644 --- a/src/client/elm/LoggedIn/Msg.elm +++ b/src/client/elm/LoggedIn/Msg.elm @@ -27,5 +27,8 @@ type Msg = | CreateIncome Int Date | ValidateCreateIncome IncomeId Int Date + | EditIncome IncomeId Int Date + | ValidateEditIncome IncomeId Int Date + | DeleteIncome IncomeId | ValidateDeleteIncome IncomeId diff --git a/src/client/elm/LoggedIn/Stat/View.elm b/src/client/elm/LoggedIn/Stat/View.elm index 636312d..a6faf5c 100644 --- a/src/client/elm/LoggedIn/Stat/View.elm +++ b/src/client/elm/LoggedIn/Stat/View.elm @@ -26,7 +26,7 @@ view loggedData = let paymentsByMonth = Payment.groupAndSortByMonth (Payment.punctual loggedData.payments) monthPaymentMean = getMonthPaymentMean loggedData paymentsByMonth in div - [ class "stat" ] + [ class "stat textual" ] [ h1 [] [ text (getParamMessage [ Format.price loggedData.conf monthPaymentMean ] "ByMonthsAndMean" loggedData.translations) ] , ul [] diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm index db851f1..68e840e 100644 --- a/src/client/elm/LoggedIn/Update.elm +++ b/src/client/elm/LoggedIn/Update.elm @@ -15,6 +15,7 @@ import Form import Model exposing (Model) import Model.Translations exposing (getMessage) import Model.Payment as Payment exposing (Payment, Frequency(..)) +import Model.Income as Income exposing (Income) import Server import LoggedData @@ -139,6 +140,24 @@ update model msg loggedIn = , Cmd.none ) + LoggedInMsg.EditIncome incomeId amount date -> + ( loggedIn + , Server.editIncome incomeId amount date + |> Task.perform + (always LoggedInMsg.NoOp) + (always <| LoggedInMsg.ValidateEditIncome incomeId amount date) + ) + + LoggedInMsg.ValidateEditIncome incomeId amount date -> + let updatedIncome = Income loggedIn.me (Date.toTime date) amount + updateIncome mbIncome = + case mbIncome of + Just _ -> Just updatedIncome + Nothing -> Just updatedIncome + in ( { loggedIn | incomes = Dict.update incomeId updateIncome loggedIn.incomes } + , Cmd.none + ) + LoggedInMsg.DeleteIncome incomeId -> ( loggedIn , Server.deleteIncome incomeId diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm index fd32cec..c017548 100644 --- a/src/client/elm/Server.elm +++ b/src/client/elm/Server.elm @@ -4,6 +4,7 @@ module Server exposing , editPayment , deletePayment , createIncome + , editIncome , deleteIncome , signOut ) @@ -66,6 +67,16 @@ createIncome amount date = |> HttpUtils.jsonRequest "POST" "/income" |> flip Task.andThen (HttpUtils.decodeHttpValue <| "id" := incomeIdDecoder) +editIncome : IncomeId -> Int -> Date -> Task Http.Error () +editIncome incomeId amount date = + Json.object + [ ("id", Json.int incomeId) + , ("amount", Json.int amount) + , ("date", Json.string (DateFormat.isoDateString date)) + ] + |> HttpUtils.jsonRequest "PUT" "/income" + |> Task.map (always ()) + deleteIncome : IncomeId -> Task Http.Error () deleteIncome incomeId = HttpUtils.request "DELETE" ("/income?id=" ++ (toString incomeId)) diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs index fa575c5..ff3e75d 100644 --- a/src/server/Controller/Income.hs +++ b/src/server/Controller/Income.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Controller.Income - ( getIncomes - , createIncome - , deleteOwnIncome + ( create + , editOwn + , deleteOwn ) where import Web.Scotty @@ -25,23 +25,27 @@ import Model.Database import qualified Model.Income as Income import qualified Model.Message.Key as Key import qualified Model.Json.CreateIncome as Json +import qualified Model.Json.EditIncome as Json -getIncomes :: ActionM () -getIncomes = - Secure.loggedAction (\_ -> - (liftIO $ map Income.getJsonIncome <$> runDb Income.getIncomes) >>= json +create :: Json.CreateIncome -> ActionM () +create (Json.CreateIncome date amount) = + Secure.loggedAction (\user -> + (liftIO . runDb $ Income.create (entityKey user) date amount) >>= jsonId ) -createIncome :: Json.CreateIncome -> ActionM () -createIncome (Json.CreateIncome date amount) = - Secure.loggedAction (\user -> - (liftIO . runDb $ Income.createIncome (entityKey user) date amount) >>= jsonId +editOwn :: Json.EditIncome -> ActionM () +editOwn (Json.EditIncome incomeId date amount) = + Secure.loggedAction (\user -> do + updated <- liftIO . runDb $ Income.editOwn (entityKey user) incomeId date amount + if updated + then status ok200 + else status badRequest400 ) -deleteOwnIncome :: Text -> ActionM () -deleteOwnIncome incomeId = +deleteOwn :: Text -> ActionM () +deleteOwn incomeId = Secure.loggedAction (\user -> do - deleted <- liftIO . runDb $ Income.deleteOwnIncome user (textToKey incomeId) + deleted <- liftIO . runDb $ Income.deleteOwn user (textToKey incomeId) if deleted then status ok200 diff --git a/src/server/Design/Constants.hs b/src/server/Design/Constants.hs index 7d196cb..a532ac8 100644 --- a/src/server/Design/Constants.hs +++ b/src/server/Design/Constants.hs @@ -17,7 +17,7 @@ blockPercentWidth = 90 blockPercentMargin :: Double blockPercentMargin = (100 - blockPercentWidth) / 2 -inputHeight :: Integer +inputHeight :: Double inputHeight = 40 focusLighten :: Color -> Color diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs index 36cedb0..f25cf05 100644 --- a/src/server/Design/Helper.hs +++ b/src/server/Design/Helper.hs @@ -53,7 +53,7 @@ iconButton backgroundCol textCol h focusOp = do marginLeft (px 15) marginRight (px 20) -input :: Integer -> Css +input :: Double -> Css input h = do height (px h) padding (px 10) (px 10) (px 10) (px 10) diff --git a/src/server/Design/LoggedIn.hs b/src/server/Design/LoggedIn.hs index 5a3297a..2899fa4 100644 --- a/src/server/Design/LoggedIn.hs +++ b/src/server/Design/LoggedIn.hs @@ -4,19 +4,19 @@ module Design.LoggedIn ( design ) where -import Data.Monoid ((<>)) - import Clay import qualified Design.LoggedIn.Home as Home import qualified Design.LoggedIn.Income as Income import qualified Design.LoggedIn.Stat as Stat +import qualified Design.LoggedIn.Table as Table design :: Css design = do ".home" ? Home.design ".income" ? Income.design ".stat" ? Stat.design + Table.design - (".income" <> ".stat") ? do + ".textual" ? do "margin" -: "0 2vw" diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs index 3358f5d..73ced3a 100644 --- a/src/server/Design/LoggedIn/Home/Table.hs +++ b/src/server/Design/LoggedIn/Home/Table.hs @@ -4,101 +4,31 @@ module Design.LoggedIn.Home.Table ( design ) where -import Data.Monoid ((<>)) - import Clay -import qualified Clay.Display as D -import Design.Color as Color import qualified Design.Media as Media design :: Css design = do - ".noPayment" ? do - margin (em 2) (em 2) (em 2) (em 2) - textAlign (alignSide sideCenter) + ".cell" ? do + ".category" & do + Media.tabletDesktop $ width (pct 36) - ".lines" ? do - Media.tabletDesktop $ display D.table - width (pct 100) - textAlign (alignSide (sideCenter)) + ".cost" & do + Media.tabletDesktop $ width (pct 15) - ".header" <> ".row" ? do - Media.tabletDesktop $ display tableRow + ".user" & do + Media.tabletDesktop $ width (pct 20) - ".header" ? do + ".date" & do + Media.tabletDesktop $ width (pct 20) Media.desktop $ do - fontSize (px 18) - height (px 70) - - Media.tabletDesktop $ do - backgroundColor Color.gothic - color Color.white - + ".shortDate" ? display none + ".longDate" ? display inline Media.tablet $ do - fontSize (px 16) - height (px 60) - + ".shortDate" ? display inline + ".longDate" ? display none Media.mobile $ do - display none - - ".row" ? do - nthChild "even" & backgroundColor Color.wildSand - - Media.desktop $ do - fontSize (px 18) - height (px 60) - - Media.tablet $ do - height (px 50) - - Media.mobile $ do - lineHeight (px 25) - paddingTop (px 10) - paddingBottom (px 10) - - ".cell" ? do - Media.tabletDesktop $ display tableCell - position relative - verticalAlign middle - - ".category" & do - Media.tabletDesktop $ width (pct 36) - Media.mobile $ do - fontSize (px 20) - lineHeight (px 30) - color Color.gothic - - ".cost" & do - Media.tabletDesktop $ width (pct 15) - ".refund" & color Color.mossGreen - - ".user" & do - Media.tabletDesktop $ width (pct 20) - - ".date" & do - Media.tabletDesktop $ width (pct 20) - Media.desktop $ do - ".shortDate" ? display none - ".longDate" ? display inline - Media.tablet $ do - ".shortDate" ? display inline - ".longDate" ? display none - Media.mobile $ do - ".shortDate" ? display none - ".longDate" ? display inline - marginBottom (em 0.5) - - ".cell.button" & do - position relative - textAlign (alignSide sideCenter) - button ? do - padding (px 10) (px 10) (px 10) (px 10) - hover & "svg path" ? do - "fill" -: "rgb(237, 122, 116)" - - Media.tabletDesktop $ width (pct 3) - - Media.mobile $ do - display inlineBlock - button ? display flex + ".shortDate" ? display none + ".longDate" ? display inline + marginBottom (em 0.5) diff --git a/src/server/Design/LoggedIn/Income.hs b/src/server/Design/LoggedIn/Income.hs index 5773e04..c44c67b 100644 --- a/src/server/Design/LoggedIn/Income.hs +++ b/src/server/Design/LoggedIn/Income.hs @@ -9,21 +9,21 @@ import Clay import qualified Design.Helper as Helper import qualified Design.Constants as Constants import qualified Design.Color as Color +import qualified Design.Media as Media design :: Css -design = do +design = + ".monthlyNetIncomes" ? do - h1 ? paddingBottom (px 0) + h1 ? do + Media.tabletDesktop $ float floatLeft - form ? do - display flex - "alignItems" -: "center" - "margin-bottom" -: "4vh" - ".textInput" ? marginRight (px 30) - - button # ".add" ? do + ".addIncome" ? do Helper.button Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten - marginTop (px 3) - - ul # ".incomes" ? button ? - marginLeft (px 12) + Media.tabletDesktop $ do + float floatRight + position relative + top (px (-8)) + Media.mobile $ do + width (pct 100) + marginBottom (px 20) diff --git a/src/server/Design/LoggedIn/Table.hs b/src/server/Design/LoggedIn/Table.hs new file mode 100644 index 0000000..1af5e2b --- /dev/null +++ b/src/server/Design/LoggedIn/Table.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Design.LoggedIn.Table + ( design + ) where + +import Data.Monoid ((<>)) + +import Clay +import qualified Clay.Display as D + +import Design.Color as Color +import qualified Design.Media as Media + +design :: Css +design = do + ".emptyTableMsg" ? do + margin (em 2) (em 2) (em 2) (em 2) + textAlign (alignSide sideCenter) + + ".lines" ? do + Media.tabletDesktop $ display D.table + width (pct 100) + textAlign (alignSide (sideCenter)) + + ".header" <> ".row" ? do + Media.tabletDesktop $ display tableRow + + ".header" ? do + Media.desktop $ do + fontSize (px 18) + height (px 70) + + Media.tabletDesktop $ do + backgroundColor Color.gothic + color Color.white + + Media.tablet $ do + fontSize (px 16) + height (px 60) + + Media.mobile $ do + display none + + ".row" ? do + nthChild "even" & backgroundColor Color.wildSand + + Media.desktop $ do + fontSize (px 18) + height (px 60) + + Media.tablet $ do + height (px 50) + + Media.mobile $ do + lineHeight (px 25) + paddingTop (px 10) + paddingBottom (px 10) + + ".cell" ? do + Media.tabletDesktop $ display tableCell + position relative + verticalAlign middle + + firstChild & do + Media.mobile $ do + fontSize (px 20) + lineHeight (px 30) + color Color.gothic + + ".refund" & color Color.mossGreen + + ".cell.button" & do + position relative + textAlign (alignSide sideCenter) + button ? do + padding (px 10) (px 10) (px 10) (px 10) + hover & "svg path" ? do + "fill" -: "rgb(237, 122, 116)" + + Media.tabletDesktop $ width (pct 3) + + Media.mobile $ do + display inlineBlock + button ? display flex diff --git a/src/server/Main.hs b/src/server/Main.hs index 19d78b3..4636674 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -15,7 +15,7 @@ import qualified Data.Text.IO as T import Controller.Index import Controller.SignIn import Controller.Payment as Payment -import Controller.Income +import Controller.Income as Income import Model.Database (runMigrations) @@ -62,8 +62,10 @@ main = do -- Incomes - post "/income" $ jsonData >>= createIncome + post "/income" $ jsonData >>= Income.create + + put "/income" $ jsonData >>= Income.editOwn delete "/income" $ do incomeId <- param "id" :: ActionM Text - deleteOwnIncome incomeId + Income.deleteOwn incomeId diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs index 4526fc5..6a2fefe 100644 --- a/src/server/Model/Database.hs +++ b/src/server/Model/Database.hs @@ -61,6 +61,7 @@ Income date Day amount Int createdAt UTCTime + editedAt UTCTime Maybe deletedAt UTCTime Maybe deriving Show |] diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs index 62ab0ed..f389661 100644 --- a/src/server/Model/Income.hs +++ b/src/server/Model/Income.hs @@ -1,8 +1,9 @@ module Model.Income ( getJsonIncome , getIncomes - , createIncome - , deleteOwnIncome + , create + , editOwn + , deleteOwn ) where import Data.Time.Clock (getCurrentTime) @@ -23,13 +24,32 @@ getJsonIncome incomeEntity = getIncomes :: Persist [Entity Income] getIncomes = selectList [IncomeDeletedAt ==. Nothing] [] -createIncome :: UserId -> Day -> Int -> Persist IncomeId -createIncome userId date amount = do +create :: UserId -> Day -> Int -> Persist IncomeId +create userId date amount = do now <- liftIO getCurrentTime - insert (Income userId date amount now Nothing) + insert (Income userId date amount now Nothing Nothing) -deleteOwnIncome :: Entity User -> IncomeId -> Persist Bool -deleteOwnIncome user incomeId = do +editOwn :: UserId -> IncomeId -> Day -> Int -> Persist Bool +editOwn userId incomeId date amount = do + mbIncome <- get incomeId + case mbIncome of + Just income -> + if incomeUserId income == userId + then do + now <- liftIO getCurrentTime + update incomeId + [ IncomeEditedAt =. Just now + , IncomeDate =. date + , IncomeAmount =. amount + ] + return True + else + return False + Nothing -> + return False + +deleteOwn :: Entity User -> IncomeId -> Persist Bool +deleteOwn user incomeId = do mbIncome <- get incomeId case mbIncome of Just income -> diff --git a/src/server/Model/Json/EditIncome.hs b/src/server/Model/Json/EditIncome.hs new file mode 100644 index 0000000..be3c7dc --- /dev/null +++ b/src/server/Model/Json/EditIncome.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Model.Json.EditIncome + ( EditIncome(..) + ) where + +import GHC.Generics + +import Data.Aeson +import Data.Time.Calendar (Day) + +import Model.Database (IncomeId) + +data EditIncome = EditIncome + { id :: IncomeId + , date :: Day + , amount :: Int + } deriving (Show, Generic) + +instance FromJSON EditIncome diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index 2723dd5..4ffc890 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -97,6 +97,7 @@ data Key = | CumulativeIncomesSince | Income | MonthlyNetIncomes + | AddIncome | IncomeNotDeleted | IncomeDate | IncomeAmount diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index 5dcf428..32b58fc 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -374,6 +374,11 @@ m l MonthlyNetIncomes = English -> "Monthly incomes" French -> "Revenus mensuels nets" +m l AddIncome = + case l of + English -> "Add an income" + French -> "Ajouter un revenu" + m l IncomeNotDeleted = case l of English -> "The income could not have been deleted." |