From 70720548c9af024dbb6080638ac8e5470c2213eb Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 25 Jun 2016 15:10:03 +0200 Subject: Use the search to view either punctual or monthly payments --- src/client/elm/Dialog.elm | 62 +++++++---- src/client/elm/Dialog/AddPayment/View.elm | 64 +++++++++++ src/client/elm/Dialog/Model.elm | 37 +++++++ src/client/elm/Dialog/Msg.elm | 9 ++ src/client/elm/Dialog/Update.elm | 24 ++++ src/client/elm/LoggedIn/Home/AddPayment/View.elm | 68 ------------ src/client/elm/LoggedIn/Home/Header/View.elm | 97 ++++++++++++++++ src/client/elm/LoggedIn/Home/Model.elm | 44 ++------ src/client/elm/LoggedIn/Home/Msg.elm | 3 - src/client/elm/LoggedIn/Home/Search/View.elm | 56 ---------- src/client/elm/LoggedIn/Home/Update.elm | 44 +++----- src/client/elm/LoggedIn/Home/View.elm | 28 ++--- .../elm/LoggedIn/Home/View/ExceedingPayers.elm | 45 ++++++++ src/client/elm/LoggedIn/Home/View/Monthly.elm | 93 ---------------- src/client/elm/LoggedIn/Home/View/Paging.elm | 8 +- src/client/elm/LoggedIn/Home/View/Table.elm | 74 ++++++++----- src/client/elm/LoggedIn/Income/View.elm | 7 +- src/client/elm/LoggedIn/Stat/Account/View.elm | 38 ------- src/client/elm/LoggedIn/Stat/View.elm | 87 +++------------ src/client/elm/LoggedIn/Update.elm | 61 ++++++---- src/client/elm/Model.elm | 9 +- src/client/elm/Model/Payment.elm | 30 +++-- src/client/elm/Msg.elm | 5 +- src/client/elm/Update.elm | 5 +- src/client/elm/Utils/Cmd.elm | 6 +- src/client/elm/View.elm | 12 +- src/client/elm/View/Form.elm | 41 +++---- src/client/elm/View/Header.elm | 6 +- src/server/Controller/Payment.hs | 12 +- src/server/Design/Dialog.hs | 13 +++ src/server/Design/Form.hs | 24 ++-- src/server/Design/Global.hs | 2 + src/server/Design/Helper.hs | 18 +-- src/server/Design/LoggedIn.hs | 12 +- src/server/Design/LoggedIn/Home.hs | 8 +- src/server/Design/LoggedIn/Home/Add.hs | 87 --------------- src/server/Design/LoggedIn/Home/Header.hs | 56 ++++++++++ src/server/Design/LoggedIn/Home/Monthly.hs | 23 ---- src/server/Design/LoggedIn/Home/Search.hs | 31 ------ src/server/Design/LoggedIn/Home/Table.hs | 123 +++++++++++---------- src/server/Main.hs | 2 +- src/server/Model/Message/Key.hs | 28 +++-- src/server/Model/Message/Translations.hs | 93 +++++++++------- src/server/Model/Payment.hs | 28 +---- src/server/Validation.hs | 18 +-- 45 files changed, 775 insertions(+), 866 deletions(-) create mode 100644 src/client/elm/Dialog/AddPayment/View.elm create mode 100644 src/client/elm/Dialog/Model.elm create mode 100644 src/client/elm/Dialog/Msg.elm create mode 100644 src/client/elm/Dialog/Update.elm delete mode 100644 src/client/elm/LoggedIn/Home/AddPayment/View.elm create mode 100644 src/client/elm/LoggedIn/Home/Header/View.elm delete mode 100644 src/client/elm/LoggedIn/Home/Search/View.elm create mode 100644 src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm delete mode 100644 src/client/elm/LoggedIn/Home/View/Monthly.elm delete mode 100644 src/client/elm/LoggedIn/Stat/Account/View.elm create mode 100644 src/server/Design/Dialog.hs delete mode 100644 src/server/Design/LoggedIn/Home/Add.hs create mode 100644 src/server/Design/LoggedIn/Home/Header.hs delete mode 100644 src/server/Design/LoggedIn/Home/Monthly.hs delete mode 100644 src/server/Design/LoggedIn/Home/Search.hs (limited to 'src') diff --git a/src/client/elm/Dialog.elm b/src/client/elm/Dialog.elm index 4b5b4cd..21286eb 100644 --- a/src/client/elm/Dialog.elm +++ b/src/client/elm/Dialog.elm @@ -16,41 +16,68 @@ import Html.Events exposing (..) -- Model -type alias Model model msg = +type alias Model model modelMsg msg = { config : Maybe (Config model msg) - , mapMsg : Msg model msg -> msg + , mapMsg : Msg model modelMsg msg -> msg + , model : model } type alias Config model msg = - { title : String + { className : String + , title : String , body : model -> Html msg , confirm : String , confirmMsg : model -> Result msg msg , undo : String } -init : (Msg model msg -> msg) -> Model model msg -init mapMsg = +init : model -> (Msg model modelMsg msg -> msg) -> Model model modelMsg msg +init model mapMsg = { config = Nothing , mapMsg = mapMsg + , model = model } -- Update -type Msg model msg = +type Msg model modelMsg msg = NoOp - | ConfirmMsg (model -> Result msg msg) + | UpdateModel modelMsg + | OpenWithUpdate (Config model msg) modelMsg | Open (Config model msg) + | ConfirmMsg (model -> Result msg msg) | Close -update : Msg model msg -> model -> Model model msg -> (Model model msg, Cmd msg) -update msg baseModel model = +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 ) + UpdateModel modelMsg -> + case updateModel modelMsg baseModel of + (newModel, effects) -> + ( { model | model = newModel } + , Cmd.map (model.mapMsg << UpdateModel) effects + ) + + OpenWithUpdate config modelMsg -> + case updateModel modelMsg baseModel of + (newModel, effects) -> + ( { model + | model = newModel + , config = Just config + } + , Cmd.map (model.mapMsg << UpdateModel) effects + ) + + Open config -> + ( { model | config = Just config } + , Cmd.none + ) + ConfirmMsg confirmMsg -> case confirmMsg baseModel of Ok msg -> @@ -62,11 +89,6 @@ update msg baseModel model = , Task.perform (always msg) (always msg) (Task.succeed NoOp) ) - Open config -> - ( { model | config = Just config } - , Cmd.none - ) - Close -> ( { model | config = Nothing } , Cmd.none @@ -74,8 +96,8 @@ update msg baseModel model = -- View -view : model -> Model model msg -> Html msg -view model { mapMsg, config } = +view : Model model modelMsg msg -> Html msg +view { mapMsg, config, model } = let isVisible = case config of Just _ -> True @@ -90,7 +112,7 @@ view model { mapMsg, config } = dialog model mapMsg c ] -curtain : (Msg model msg -> msg) -> Bool -> Html msg +curtain : (Msg model modelMsg msg -> msg) -> Bool -> Html msg curtain mapMsg isVisible = div [ class "curtain" @@ -109,10 +131,10 @@ curtain mapMsg isVisible = ] [] -dialog : model -> (Msg model msg -> msg) -> Config model msg -> Html msg -dialog model mapMsg { title, body, confirm, confirmMsg, undo } = +dialog : model -> (Msg model modelMsg msg -> msg) -> Config model msg -> Html msg +dialog model mapMsg { className, title, body, confirm, confirmMsg, undo } = div - [ class "content" + [ class ("content " ++ className) , style [ ("position", "fixed") , ("top", "25%") diff --git a/src/client/elm/Dialog/AddPayment/View.elm b/src/client/elm/Dialog/AddPayment/View.elm new file mode 100644 index 0000000..8915b1d --- /dev/null +++ b/src/client/elm/Dialog/AddPayment/View.elm @@ -0,0 +1,64 @@ +module Dialog.AddPayment.View exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Html.App as Html +import Task + +import Form exposing (Form) + +import Dialog + +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.Payment as Payment exposing (Frequency(..)) +import Model.View exposing (View(LoggedInView)) + +import Dialog.Model as DialogModel +import Dialog.Msg as DialogMsg + +import LoggedData exposing (LoggedData) +import LoggedIn.Home.Model as HomeModel + +view : LoggedData -> Frequency -> Html Msg +view loggedData frequency = + let dialogConfig = + { className = "paymentDialog" + , title = getMessage "AddPayment" loggedData.translations + , body = \model -> addPaymentForm loggedData model.addPayment + , confirm = getMessage "Confirm" loggedData.translations + , confirmMsg = \model -> ( + case Form.getOutput model.addPayment of + Just data -> + Ok (Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.frequency) + Nothing -> + Err (Msg.Dialog <| Dialog.UpdateModel <| DialogMsg.AddPaymentMsg <| Form.Submit) + ) + , undo = getMessage "Undo" loggedData.translations + } + in button + [ class "addPayment" + , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.AddPaymentMsg <| Form.Reset (DialogModel.addPaymentInitial frequency))) + ] + [ text (getMessage "AddPayment" loggedData.translations) ] + +addPaymentForm : LoggedData -> Form String DialogModel.AddPayment -> Html Msg +addPaymentForm loggedData addPayment = + let htmlMap = Html.map (Msg.Dialog << Dialog.UpdateModel << DialogMsg.AddPaymentMsg) + in Html.form + [ class "addPayment" + , onSubmitPrevDefault Msg.NoOp + ] + [ Form.textInput loggedData.translations addPayment htmlMap "payment" "name" + , Form.textInput loggedData.translations addPayment htmlMap "payment" "cost" + , Form.radioInputs loggedData.translations addPayment htmlMap "payment" "frequency" [ toString Punctual, toString Monthly ] + ] diff --git a/src/client/elm/Dialog/Model.elm b/src/client/elm/Dialog/Model.elm new file mode 100644 index 0000000..9bd6a09 --- /dev/null +++ b/src/client/elm/Dialog/Model.elm @@ -0,0 +1,37 @@ +module Dialog.Model exposing + ( Model + , AddPayment + , init + , addPaymentInitial + ) + +import Form exposing (Form) +import Form.Field as Field exposing (Field) +import Form.Validate as Validate exposing (Validation) + +import Model.Payment as Payment + +type alias Model = + { addPayment : Form String AddPayment + } + +type alias AddPayment = + { name : String + , cost : Int + , frequency : Payment.Frequency + } + +init : Model +init = + { addPayment = Form.initial [] addPaymentValidation + } + +addPaymentInitial : Payment.Frequency -> List (String, Field) +addPaymentInitial frequency = [ ("frequency", Field.Radio (toString frequency)) ] + +addPaymentValidation : Validation String AddPayment +addPaymentValidation = + Validate.form3 AddPayment + (Validate.get "name" (Validate.string `Validate.andThen` (Validate.nonEmpty))) + (Validate.get "cost" (Validate.int `Validate.andThen` (Validate.minInt 1))) + (Validate.get "frequency" Payment.validateFrequency) diff --git a/src/client/elm/Dialog/Msg.elm b/src/client/elm/Dialog/Msg.elm new file mode 100644 index 0000000..c9e1596 --- /dev/null +++ b/src/client/elm/Dialog/Msg.elm @@ -0,0 +1,9 @@ +module Dialog.Msg exposing + ( Msg(..) + ) + +import Form exposing (Form) + +type Msg = + NoOp + | AddPaymentMsg Form.Msg diff --git a/src/client/elm/Dialog/Update.elm b/src/client/elm/Dialog/Update.elm new file mode 100644 index 0000000..e1e2dba --- /dev/null +++ b/src/client/elm/Dialog/Update.elm @@ -0,0 +1,24 @@ +module Dialog.Update exposing + ( update + ) + +import Form exposing (Form) + +import Dialog.Msg as Dialog +import Dialog.Model as Dialog + +update : Dialog.Msg -> Dialog.Model -> (Dialog.Model, Cmd Dialog.Msg) +update msg model = + case msg of + + Dialog.NoOp -> + ( model + , Cmd.none + ) + + Dialog.AddPaymentMsg formMsg -> + ( { model + | addPayment = Form.update formMsg model.addPayment + } + , Cmd.none + ) diff --git a/src/client/elm/LoggedIn/Home/AddPayment/View.elm b/src/client/elm/LoggedIn/Home/AddPayment/View.elm deleted file mode 100644 index 5ccdb35..0000000 --- a/src/client/elm/LoggedIn/Home/AddPayment/View.elm +++ /dev/null @@ -1,68 +0,0 @@ -module LoggedIn.Home.AddPayment.View exposing - ( view - ) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Html.App as Html -import Task - -import Form exposing (Form) - -import Dialog - -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.Payment as Payment -import Model.View exposing (View(LoggedInView)) - -import LoggedData exposing (LoggedData) -import LoggedIn.Home.Model as HomeModel - -view : LoggedData -> Html Msg -view loggedData = - let dialogConfig = - { title = getMessage "AddPayment" loggedData.translations - , body = \view -> ( - case view of - LoggedInView loggedIn -> addPaymentForm loggedData loggedIn.home - _ -> text "" - ) - , confirm = getMessage "Confirm" loggedData.translations - , confirmMsg = \view -> ( - case view of - LoggedInView loggedIn -> - case Form.getOutput loggedIn.home.addPayment of - Just data -> - Ok (Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.frequency) - Nothing -> - Err (Msg.UpdateLoggedIn <| LoggedInMsg.HomeMsg <| HomeMsg.AddPaymentMsg <| Form.Submit) - _ -> - Err (Msg.UpdateLoggedIn LoggedInMsg.NoOp) - ) - , undo = getMessage "Undo" loggedData.translations - } - in button - [ class "addPayment" - , onClick (Msg.Dialog <| Dialog.Open dialogConfig) - ] - [ text (getMessage "AddPayment" loggedData.translations) ] - -addPaymentForm : LoggedData -> HomeModel.Model -> Html Msg -addPaymentForm loggedData { addPayment } = - let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.AddPaymentMsg) - in Html.form - [ class "addPayment" - , onSubmitPrevDefault Msg.NoOp - ] - [ Form.textInput loggedData.translations addPayment htmlMap "name" - , Form.textInput loggedData.translations addPayment htmlMap "cost" - , Form.radioInputs loggedData.translations addPayment htmlMap "frequency" [ toString Payment.Punctual, toString Payment.Monthly ] - ] diff --git a/src/client/elm/LoggedIn/Home/Header/View.elm b/src/client/elm/LoggedIn/Home/Header/View.elm new file mode 100644 index 0000000..f9fbb6a --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Header/View.elm @@ -0,0 +1,97 @@ +module LoggedIn.Home.Header.View exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import Html.App as Html +import String +import Dict + +import Form exposing (Form) +import View.Form as Form + +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.View as AddPayment + +import LoggedIn.Home.View.ExceedingPayers as ExceedingPayers +import LoggedIn.View.Format as Format +import View.Plural exposing (plural) + +import Utils.Tuple as Tuple + +view : LoggedData -> Home.Model -> Payments -> Frequency -> Html Msg +view loggedData { search } payments frequency = + Html.div + [ class "header" ] + [ ExceedingPayers.view loggedData + , searchLine loggedData search frequency + , infos loggedData payments + ] + +searchLine : LoggedData -> Form String Home.Search -> Frequency -> Html Msg +searchLine loggedData search frequency = + Html.div + [ class "searchLine" ] + [ searchForm loggedData search + , AddPayment.view loggedData frequency + ] + +searchForm : LoggedData -> Form String Home.Search -> Html Msg +searchForm loggedData search = + let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.SearchMsg) + in Html.form + [] + [ Form.textInput loggedData.translations search htmlMap "search" "name" + , if List.isEmpty (Payment.monthly loggedData.payments) + then text "" + else Form.radioInputs loggedData.translations search htmlMap "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" ] + [ text <| getParamMessage [ count, sum ] "Worth" loggedData.translations + , span + [ class "partition" ] + [ text <| paymentsPartition loggedData payments ] + ] + +paymentsPartition : LoggedData -> Payments -> String +paymentsPartition loggedData payments = + String.join + ", " + ( loggedData.users + |> Dict.toList + |> List.map (Tuple.mapFst (\userId -> Payment.totalPayments (always True) userId payments)) + |> List.sortBy fst + |> List.reverse + |> List.map (\(sum, user) -> + getParamMessage [ user.name, Format.price loggedData.conf sum ] "By" loggedData.translations + ) + ) + +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 index e802828..be32fb7 100644 --- a/src/client/elm/LoggedIn/Home/Model.elm +++ b/src/client/elm/LoggedIn/Home/Model.elm @@ -2,7 +2,7 @@ module LoggedIn.Home.Model exposing ( Model , Search , init - , addPaymentInitial + , searchInitial ) import Form exposing (Form) @@ -10,24 +10,17 @@ import Form.Validate as Validate exposing (Validation) import Form.Field as Field exposing (Field) import Model.User exposing (Users, UserId) -import Model.Payment exposing (PaymentId, Payments, Frequency(..)) +import Model.Payment as Payment exposing (PaymentId, Payments, Frequency(..)) import Model.Payer exposing (Payers) type alias Model = { paymentEdition : Maybe PaymentId , currentPage : Int - , monthlyDetail : Bool , search : Form String Search - , addPayment : Form String AddPayment } type alias Search = - { searchText : Maybe String - } - -type alias AddPayment = - { name : String - , cost : Int + { name : Maybe String , frequency : Frequency } @@ -35,31 +28,14 @@ init : Model init = { paymentEdition = Nothing , currentPage = 1 - , monthlyDetail = False - , search = Form.initial [] searchValidation - , addPayment = Form.initial addPaymentInitial addPaymentValidation + , search = Form.initial (searchInitial Punctual) searchValidation } +searchInitial : Frequency -> List (String, Field) +searchInitial frequency = [ ("frequency", Field.Radio (toString frequency)) ] + searchValidation : Validation String Search searchValidation = - Validate.form1 Search - (Validate.get "searchText" (Validate.maybe Validate.string)) - -addPaymentInitial : List (String, Field) -addPaymentInitial = [ ("frequency", Field.Radio (toString Punctual)) ] - -addPaymentValidation : Validation String AddPayment -addPaymentValidation = - Validate.form3 AddPayment - (Validate.get "name" (Validate.string `Validate.andThen` (Validate.nonEmpty))) - (Validate.get "cost" (Validate.int `Validate.andThen` (Validate.minInt 1))) - (Validate.get "frequency" validateFrequency) - -validateFrequency : Validation String Frequency -validateFrequency = - Validate.customValidation Validate.string (\str -> - case str of - "Punctual" -> Ok Punctual - "Monthly" -> Ok Monthly - _ -> Err (Validate.customError "InvalidFrequency") - ) + Validate.form2 Search + (Validate.get "name" (Validate.maybe Validate.string)) + (Validate.get "frequency" Payment.validateFrequency) diff --git a/src/client/elm/LoggedIn/Home/Msg.elm b/src/client/elm/LoggedIn/Home/Msg.elm index bb6f77d..73b8980 100644 --- a/src/client/elm/LoggedIn/Home/Msg.elm +++ b/src/client/elm/LoggedIn/Home/Msg.elm @@ -10,7 +10,4 @@ type Msg = NoOp | ToggleEdit PaymentId | UpdatePage Int - | ShowMonthlyDetail - | ToggleMonthlyDetail | SearchMsg Form.Msg - | AddPaymentMsg Form.Msg diff --git a/src/client/elm/LoggedIn/Home/Search/View.elm b/src/client/elm/LoggedIn/Home/Search/View.elm deleted file mode 100644 index 99eec95..0000000 --- a/src/client/elm/LoggedIn/Home/Search/View.elm +++ /dev/null @@ -1,56 +0,0 @@ -module LoggedIn.Home.Search.View exposing - ( view - ) - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) -import Html.App as Html - -import Form exposing (Form) -import View.Form as Form - -import Msg exposing (Msg) -import LoggedIn.Msg as LoggedInMsg -import LoggedIn.Home.Msg as HomeMsg - -import LoggedData exposing (LoggedData) -import LoggedIn.Home.Model as HomeModel -import Model.Translations exposing (getParamMessage) -import Model.Conf exposing (Conf) -import Model.Payment exposing (Payments) -import Model.Translations exposing (getMessage) - -import LoggedIn.Home.AddPayment.View as AddPayment - -import LoggedIn.View.Format as Format -import View.Plural exposing (plural) - -view : LoggedData -> HomeModel.Model -> Payments -> Html Msg -view loggedData { search } payments = - Html.div - [ class "search" ] - [ searchForm loggedData search - , paymentsStat loggedData payments - , AddPayment.view loggedData - ] - -searchForm : LoggedData -> Form String HomeModel.Search -> Html Msg -searchForm loggedData search = - let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.SearchMsg) - in Form.textInput loggedData.translations search htmlMap "searchText" - -paymentsStat : LoggedData -> Payments -> Html Msg -paymentsStat loggedData payments = - let count = plural loggedData.translations (List.length payments) "Payment" "Payments" - sum = paymentsSum loggedData.conf payments - in span - [ class "stat" ] - [ text <| getParamMessage [ count, sum ] "Worth" loggedData.translations ] - -paymentsSum : Conf -> Payments -> String -paymentsSum conf payments = - payments - |> List.map .cost - |> List.sum - |> Format.price conf diff --git a/src/client/elm/LoggedIn/Home/Update.elm b/src/client/elm/LoggedIn/Home/Update.elm index 562cd20..160e279 100644 --- a/src/client/elm/LoggedIn/Home/Update.elm +++ b/src/client/elm/LoggedIn/Home/Update.elm @@ -6,49 +6,35 @@ import Form exposing (Form) import LoggedData exposing (LoggedData) -import LoggedIn.Home.Msg as HomeMsg -import LoggedIn.Home.Model as HomeModel +import LoggedIn.Home.Msg as Home +import LoggedIn.Home.Model as Home -update : LoggedData -> HomeMsg.Msg -> HomeModel.Model -> (HomeModel.Model, Cmd HomeMsg.Msg) -update loggedData msg homeModel = +update : LoggedData -> Home.Msg -> Home.Model -> (Home.Model, Cmd Home.Msg) +update loggedData msg model = case msg of - HomeMsg.NoOp -> (homeModel, Cmd.none) - - HomeMsg.ToggleEdit id -> - ( { homeModel | paymentEdition = if homeModel.paymentEdition == Just id then Nothing else Just id } - , Cmd.none - ) - - HomeMsg.UpdatePage page -> - ( { homeModel | currentPage = page } + Home.NoOp -> + ( model , Cmd.none ) - HomeMsg.ShowMonthlyDetail -> - ( { homeModel | monthlyDetail = True } + Home.ToggleEdit id -> + ( { model | paymentEdition = if model.paymentEdition == Just id then Nothing else Just id } , Cmd.none ) - HomeMsg.ToggleMonthlyDetail -> - ( { homeModel | monthlyDetail = not homeModel.monthlyDetail } + Home.UpdatePage page -> + ( { model | currentPage = page } , Cmd.none ) - HomeMsg.SearchMsg formMsg -> - ( { homeModel - | search = Form.update formMsg homeModel.search + Home.SearchMsg formMsg -> + ( { model + | search = Form.update formMsg model.search , currentPage = case formMsg of - Form.Input "searchText" _ -> 1 - _ -> homeModel.currentPage - } - , Cmd.none - ) - - HomeMsg.AddPaymentMsg formMsg -> - ( { homeModel - | addPayment = Form.update formMsg homeModel.addPayment + 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 index 8076673..0def64e 100644 --- a/src/client/elm/LoggedIn/Home/View.elm +++ b/src/client/elm/LoggedIn/Home/View.elm @@ -12,22 +12,24 @@ import Utils.Form as Form import Msg exposing (Msg) import LoggedData exposing (LoggedData) -import Model.Payment as Payment +import Model.Payment as Payment exposing (Frequency(..)) -import LoggedIn.Home.Model as LoggedInModel -import LoggedIn.Home.Search.View as SearchView -import LoggedIn.Home.View.Monthly as MonthlyView +import LoggedIn.Home.Model as Home +import LoggedIn.Home.Header.View as Header -import LoggedIn.Home.View.Table exposing (paymentsTable) -import LoggedIn.Home.View.Paging exposing (paymentsPaging) +import LoggedIn.Home.View.Table as Table +import LoggedIn.Home.View.Paging as Paging -view : LoggedData -> LoggedInModel.Model -> Html Msg -view loggedData loggedIn = - let punctualPayments = Payment.sortedFiltredPunctual (Form.fieldAsText loggedIn.search "searchText") loggedData.payments +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" ] - [ SearchView.view loggedData loggedIn punctualPayments - , MonthlyView.view loggedData loggedIn - , paymentsTable loggedData loggedIn punctualPayments - , paymentsPaging loggedIn punctualPayments + [ Header.view loggedData home payments frequency + , Table.view loggedData home payments frequency + , Paging.view home payments ] diff --git a/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm b/src/client/elm/LoggedIn/Home/View/ExceedingPayers.elm new file mode 100644 index 0000000..15f5cf5 --- /dev/null +++ b/src/client/elm/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 "PaymentsAreBalanced" loggedData.translations ] + 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/Monthly.elm b/src/client/elm/LoggedIn/Home/View/Monthly.elm deleted file mode 100644 index 20dda19..0000000 --- a/src/client/elm/LoggedIn/Home/View/Monthly.elm +++ /dev/null @@ -1,93 +0,0 @@ -module LoggedIn.Home.View.Monthly exposing - ( view - ) - -import String -import Color - -import FontAwesome - -import Html exposing (..) -import Html.Attributes exposing (..) -import Html.Events exposing (..) - -import Msg exposing (Msg) - -import LoggedIn.Msg as LoggedInMsg - -import LoggedIn.Home.Msg as HomeMsg -import LoggedIn.Home.Model as HomeModel -import LoggedIn.View.Format as Format -import LoggedIn.Home.View.Expand exposing (..) - -import Model.Payment as Payment exposing (Payments, Payment, monthly) -import Model.Translations exposing (getMessage, getParamMessage) -import LoggedData exposing (LoggedData) - -view : LoggedData -> HomeModel.Model -> Html Msg -view loggedData homeModel = - let monthlyPayments = Payment.monthly loggedData.me loggedData.payments - in if List.length monthlyPayments == 0 - then - text "" - else - div - [ classList - [ ("monthly", True) - , ("detail", homeModel.monthlyDetail) - ] - ] - [ monthlyCount loggedData monthlyPayments homeModel - , if homeModel.monthlyDetail - then paymentsTable loggedData monthlyPayments homeModel - else text "" - ] - -monthlyCount : LoggedData -> Payments -> HomeModel.Model -> Html Msg -monthlyCount loggedData monthlyPayments homeModel = - let count = List.length monthlyPayments - total = List.sum << List.map .cost <| monthlyPayments - key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount" - in button - [ class "header" - , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg <| HomeMsg.ToggleMonthlyDetail) - ] - [ text (getParamMessage [toString count, Format.price loggedData.conf total] key loggedData.translations) - , expand ExpandDown homeModel.monthlyDetail - ] - -paymentsTable : LoggedData -> Payments -> HomeModel.Model -> Html Msg -paymentsTable loggedData monthlyPayments homeModel = - div - [ class "table" ] - ( monthlyPayments - |> List.sortBy (String.toLower << .name) - |> List.map (paymentLine loggedData homeModel) - ) - -paymentLine : LoggedData -> HomeModel.Model -> Payment -> Html Msg -paymentLine loggedData homeModel payment = - a - [ classList - [ ("row", True) - , ("edition", homeModel.paymentEdition == Just payment.id) - ] - , onClick (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg <| HomeMsg.ToggleEdit payment.id) - ] - [ div [ class "cell category" ] [ text (payment.name) ] - , div - [ classList - [ ("cell cost", True) - , ("refund", payment.cost < 0) - ] - ] - [ text (Format.price loggedData.conf payment.cost) ] - , div - [ class "cell delete" - , onClick (Msg.UpdateLoggedIn <| LoggedInMsg.DeletePayment payment.id) - ] - [ button - [] - [ FontAwesome.times Color.white 20 ] - ] - ] diff --git a/src/client/elm/LoggedIn/Home/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm index da69232..90ae522 100644 --- a/src/client/elm/LoggedIn/Home/View/Paging.elm +++ b/src/client/elm/LoggedIn/Home/View/Paging.elm @@ -1,5 +1,5 @@ module LoggedIn.Home.View.Paging exposing - ( paymentsPaging + ( view ) import Color exposing (Color) @@ -22,11 +22,11 @@ import Model.Payment as Payment exposing (Payments, perPage) showedPages : Int showedPages = 5 -paymentsPaging : HomeModel.Model -> Payments -> Html Msg -paymentsPaging homeModel payments = +view : HomeModel.Model -> Payments -> Html Msg +view homeModel payments = let maxPage = ceiling (toFloat (List.length payments) / toFloat perPage) pages = truncatePages homeModel.currentPage [1..maxPage] - in if maxPage == 1 + in if maxPage <= 1 then text "" else diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm index a03faa2..9cd43a7 100644 --- a/src/client/elm/LoggedIn/Home/View/Table.elm +++ b/src/client/elm/LoggedIn/Home/View/Table.elm @@ -1,5 +1,5 @@ module LoggedIn.Home.View.Table exposing - ( paymentsTable + ( view ) import Dict exposing (..) @@ -26,33 +26,43 @@ import LoggedIn.View.Format as Format import Model.User exposing (getUserName) import Model.Payment as Payment exposing (..) +import Model.Translations exposing (getMessage) -paymentsTable : LoggedData -> HomeModel.Model -> Payments -> Html Msg -paymentsTable loggedData homeModel punctualPayments = - div - [ class "table" ] - ( headerLine loggedData :: paymentLines loggedData homeModel punctualPayments) +view : LoggedData -> HomeModel.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 "noPayment" ] + [ text <| getMessage "NoPayment" loggedData.translations ] + else + text "" + ] -headerLine : LoggedData -> Html Msg -headerLine loggedData = +headerLine : LoggedData -> Frequency -> Html Msg +headerLine loggedData frequency = div [ class "header" ] - [ div [ class "cell category" ] [ FontAwesome.shopping_cart Color.white 28 ] - , div [ class "cell cost" ] [ text loggedData.conf.currency ] - , div [ class "cell user" ] [ FontAwesome.user Color.white 28 ] - , div [ class "cell date" ] [ FontAwesome.calendar Color.white 28 ] + [ div [ class "cell category" ] [ text <| getMessage "Name" loggedData.translations ] + , div [ class "cell cost" ] [ text <| getMessage "Cost" loggedData.translations ] + , div [ class "cell user" ] [ text <| getMessage "Payer" loggedData.translations ] + , case frequency of + Punctual -> div [ class "cell date" ] [ text <| getMessage "Date" loggedData.translations ] + Monthly -> text "" , div [ class "cell" ] [] ] -paymentLines : LoggedData -> HomeModel.Model -> Payments -> List (Html Msg) -paymentLines loggedData homeModel punctualPayments = - punctualPayments - |> List.drop ((homeModel.currentPage - 1) * perPage) - |> List.take perPage - |> List.map (paymentLine loggedData homeModel) - -paymentLine : LoggedData -> HomeModel.Model -> Payment -> Html Msg -paymentLine loggedData homeModel payment = +paymentLine : LoggedData -> HomeModel.Model -> Frequency -> Payment -> Html Msg +paymentLine loggedData homeModel frequency payment = a [ classList [ ("row", True) @@ -75,15 +85,19 @@ paymentLine loggedData homeModel payment = |> Maybe.withDefault "−" |> text ] - , div - [ class "cell date" ] - [ span - [ class "shortDate" ] - [ text (renderShortDate payment.creation loggedData.translations) ] - , span - [ class "longDate" ] - [ text (renderLongDate payment.creation loggedData.translations) ] - ] + , case frequency of + Punctual -> + div + [ class "cell date" ] + [ span + [ class "shortDate" ] + [ text (renderShortDate payment.creation loggedData.translations) ] + , span + [ class "longDate" ] + [ text (renderLongDate payment.creation loggedData.translations) ] + ] + Monthly -> + text "" , if loggedData.me == payment.userId then div diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm index 25cb5a6..be15c6b 100644 --- a/src/client/elm/LoggedIn/Income/View.elm +++ b/src/client/elm/LoggedIn/Income/View.elm @@ -80,8 +80,8 @@ addIncomeView loggedData addIncome = let htmlMap = Html.map (Msg.UpdateLoggedIn << LoggedInMsg.IncomeMsg << IncomeMsg.AddIncomeMsg) in Html.form [ onSubmitPrevDefault Msg.NoOp ] - [ Form.textInput loggedData.translations addIncome htmlMap "creation" - , Form.textInput loggedData.translations addIncome htmlMap "amount" + [ Form.textInput loggedData.translations addIncome htmlMap "income" "creation" + , Form.textInput loggedData.translations addIncome htmlMap "income" "amount" , button [ case Form.getOutput addIncome of Just data -> @@ -112,7 +112,8 @@ incomeView loggedData (incomeId, income) = , text " − " , text <| Format.price loggedData.conf income.amount , let dialogConfig = - { title = getMessage "ConfirmDelete" loggedData.translations + { className = "incomeDialog" + , title = getMessage "ConfirmDelete" loggedData.translations , body = always <| text "" , confirm = getMessage "Confirm" loggedData.translations , confirmMsg = always <| Ok <| Msg.UpdateLoggedIn <| LoggedInMsg.DeleteIncome incomeId diff --git a/src/client/elm/LoggedIn/Stat/Account/View.elm b/src/client/elm/LoggedIn/Stat/Account/View.elm deleted file mode 100644 index 3eb5ef4..0000000 --- a/src/client/elm/LoggedIn/Stat/Account/View.elm +++ /dev/null @@ -1,38 +0,0 @@ -module LoggedIn.Stat.Account.View 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.Payer exposing (..) - -view : LoggedData -> Html Msg -view loggedData = - ul - [ class "exceedingPayers" ] - (List.map (exceedingPayer loggedData) (getOrderedExceedingPayers loggedData.currentTime loggedData.users loggedData.incomes loggedData.payments)) - -exceedingPayer : LoggedData -> ExceedingPayer -> Html Msg -exceedingPayer loggedData payer = - li - [] - [ 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/Stat/View.elm b/src/client/elm/LoggedIn/Stat/View.elm index f99ef0e..72e1f34 100644 --- a/src/client/elm/LoggedIn/Stat/View.elm +++ b/src/client/elm/LoggedIn/Stat/View.elm @@ -3,8 +3,6 @@ module LoggedIn.Stat.View exposing ) import Date exposing (Month) -import Dict -import String import Html exposing (..) import Html.Attributes exposing (..) @@ -21,85 +19,30 @@ import LoggedIn.View.Format as Format import LoggedIn.View.Date as Date import View.Plural exposing (plural) -import LoggedIn.Stat.Account.View as AccountView - -import Utils.Tuple as Tuple import Utils.List as List view : LoggedData -> Html Msg view loggedData = - div - [ class "stat" ] - [ h1 [] [ text (getMessage "Balance" loggedData.translations) ] - , AccountView.view loggedData - , h1 [] [ text (getMessage "Overall" loggedData.translations) ] - , paymentsDetail loggedData (Payment.punctual loggedData.payments) - , h1 [] [ text (getMessage "ByMonths" loggedData.translations) ] - , monthsDetail loggedData - ] - -paymentsDetail : LoggedData -> Payments -> Html Msg -paymentsDetail loggedData payments = - ul - [] - [ li - [] - [ text <| plural loggedData.translations (List.length payments) "Payment" "Payments" ] - , li - [] - [ text (paymentsSum loggedData.conf payments) - , text " − " - , text <| totalPayments loggedData - ] - ] - -totalPayments : LoggedData -> String -totalPayments loggedData = - String.join - ", " - ( loggedData.users - |> Dict.toList - |> List.map (Tuple.mapFst (\userId -> Payment.totalPayments (always True) userId loggedData.payments)) - |> List.sortBy fst - |> List.map (\(sum, user) -> - String.concat - [ Format.price loggedData.conf sum - , " " - , getMessage "By" loggedData.translations - , " " - , user.name - ] - ) - ) - -monthsDetail : LoggedData -> Html Msg -monthsDetail loggedData = - let paymentsByMonth = - loggedData.payments - |> Payment.punctual - |> Payment.groupAndSortByMonth - monthPaymentMean = - 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 << snd) - |> List.mean + let paymentsByMonth = Payment.groupAndSortByMonth (Payment.punctual loggedData.payments) + monthPaymentMean = getMonthPaymentMean loggedData paymentsByMonth in div - [] - [ div - [ class "mean" ] - [ text (getParamMessage [ Format.price loggedData.conf monthPaymentMean ] "Mean" loggedData.translations) - ] + [ class "stat" ] + [ h1 [] [ text (getParamMessage [ Format.price loggedData.conf monthPaymentMean ] "ByMonthsAndMean" loggedData.translations) ] , ul [] - ( Payment.punctual loggedData.payments - |> Payment.groupAndSortByMonth - |> List.map (monthDetail loggedData) - ) + ( 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 << snd) + |> List.mean + monthDetail : LoggedData -> ((Month, Int), Payments) -> Html Msg monthDetail loggedData ((month, year), payments) = li diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm index 4fddc2c..48d87f7 100644 --- a/src/client/elm/LoggedIn/Update.elm +++ b/src/client/elm/LoggedIn/Update.elm @@ -14,7 +14,7 @@ import Form import Model exposing (Model) import Model.Translations exposing (getMessage) -import Model.Payment exposing (Payment, Frequency(..), deletePayment) +import Model.Payment as Payment exposing (Payment, Frequency(..), deletePayment) import Server import LoggedData @@ -59,27 +59,23 @@ update model msg loggedIn = ) LoggedInMsg.AddPayment name cost frequency -> - Server.addPayment name cost frequency - |> Task.perform - (\err -> - case err of - BadResponse 400 jsonErr -> - LoggedInMsg.NoOp - _ -> - LoggedInMsg.NoOp - ) - (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost frequency) - |> \cmd -> (loggedIn, cmd) + ( loggedIn + , Server.addPayment name cost frequency + |> Task.perform + (\err -> + case err of + BadResponse 400 jsonErr -> + LoggedInMsg.NoOp + _ -> + LoggedInMsg.NoOp + ) + (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost frequency) + ) LoggedInMsg.ValidateAddPayment paymentId name cost frequency -> - update model (LoggedInMsg.HomeMsg <| HomeMsg.AddPaymentMsg (Form.Reset HomeModel.addPaymentInitial)) loggedIn - :> (\loggedIn -> - case frequency of - Punctual -> - update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1) loggedIn - Monthly -> - update model (LoggedInMsg.HomeMsg <| HomeMsg.ShowMonthlyDetail) loggedIn - ) + update model (LoggedInMsg.HomeMsg <| HomeMsg.SearchMsg (Form.Reset (HomeModel.searchInitial frequency))) loggedIn + :> update model (LoggedInMsg.HomeMsg <| HomeMsg.SearchMsg Form.Submit) + :> update model (LoggedInMsg.HomeMsg <| HomeMsg.UpdatePage 1) :> (\loggedIn -> let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedIn.me frequency in ( { loggedIn | payments = newPayment :: loggedIn.payments } @@ -96,9 +92,28 @@ update model msg loggedIn = ) LoggedInMsg.ValidateDeletePayment paymentId -> - ( { loggedIn | payments = deletePayment paymentId loggedIn.payments } - , Cmd.none - ) + let payments = deletePayment 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 <| HomeMsg.SearchMsg (Form.Reset (HomeModel.searchInitial Punctual))) loggedIn + :> update model (LoggedInMsg.HomeMsg <| HomeMsg.SearchMsg Form.Submit) + :> (\loggedIn -> + ( { loggedIn | payments = payments } + , Cmd.none + ) + ) + else + ( { loggedIn | payments = payments } + , Cmd.none + ) LoggedInMsg.AddIncome time amount -> ( loggedIn diff --git a/src/client/elm/Model.elm b/src/client/elm/Model.elm index 3eec89d..0cd714f 100644 --- a/src/client/elm/Model.elm +++ b/src/client/elm/Model.elm @@ -20,6 +20,9 @@ import LoggedIn.Model as LoggedInModel import SignIn.Model as SignInModel import Dialog +import Dialog.Model as DialogModel +import Dialog.Msg as DialogMsg + import Utils.Maybe exposing (isJust) type alias Model = @@ -28,7 +31,7 @@ type alias Model = , translations : Translations , conf : Conf , page : Page - , dialog : Dialog.Model View Msg + , dialog : Dialog.Model DialogModel.Model DialogMsg.Msg Msg } init : Json.Value -> Result String Page -> (Model, Cmd Msg) @@ -52,7 +55,7 @@ init payload result = , translations = translations , conf = conf , page = page - , dialog = Dialog.init Msg.Dialog + , dialog = Dialog.init DialogModel.init Msg.Dialog } Err error -> { view = SignInView (SignInModel.init (Just error)) @@ -60,6 +63,6 @@ init payload result = , translations = [] , conf = { currency = "" } , page = page - , dialog = Dialog.init Msg.Dialog + , dialog = Dialog.init DialogModel.init Msg.Dialog } in (model, Cmd.none) diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm index 7a6c630..ab3cbb7 100644 --- a/src/client/elm/Model/Payment.elm +++ b/src/client/elm/Model/Payment.elm @@ -11,7 +11,8 @@ module Model.Payment exposing , punctual , monthly , groupAndSortByMonth - , sortedFiltredPunctual + , search + , validateFrequency ) import Date exposing (..) @@ -19,6 +20,7 @@ import Date.Extra.Core exposing (monthToInt, intToMonth) import Json.Decode as Json exposing ((:=)) import String +import Form.Validate as Validate exposing (Validation) import Model.User exposing (UserId, userIdDecoder) import Model.Date exposing (dateDecoder) @@ -77,7 +79,6 @@ totalPayments paymentFilter userId payments = |> List.filter (\payment -> paymentFilter payment && payment.userId == userId - && payment.frequency == Punctual ) |> List.map .cost |> List.sum @@ -85,8 +86,8 @@ totalPayments paymentFilter userId payments = punctual : Payments -> Payments punctual = List.filter ((==) Punctual << .frequency) -monthly : UserId -> Payments -> Payments -monthly userId = List.filter (\p -> p.frequency == Monthly && p.userId == userId) +monthly : Payments -> Payments +monthly = List.filter ((==) Monthly << .frequency) groupAndSortByMonth : Payments -> List ((Month, Int), Payments) groupAndSortByMonth payments = @@ -96,12 +97,25 @@ groupAndSortByMonth payments = |> List.map (\((year, month), payments) -> ((intToMonth month, year), payments)) |> List.reverse -sortedFiltredPunctual : String -> Payments -> Payments -sortedFiltredPunctual search payments = - punctual payments +search : String -> Frequency -> Payments -> Payments +search name frequency payments = + payments + |> List.filter ((==) frequency << .frequency) |> List.sortBy (Date.toTime << .creation) - |> List.filter (searchSuccess search) + |> List.filter (searchSuccess name) |> List.reverse searchSuccess : String -> Payment -> Bool searchSuccess text { name } = (String.toLower text) `String.contains` (String.toLower name) + +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/Msg.elm b/src/client/elm/Msg.elm index 2ed15e4..a1da7e6 100644 --- a/src/client/elm/Msg.elm +++ b/src/client/elm/Msg.elm @@ -10,7 +10,8 @@ import Model.Init exposing (Init) import Dialog -import Model.View exposing (View) +import Dialog.Model as DialogModel +import Dialog.Msg as DialogMsg import SignIn.Msg as SignInMsg import LoggedIn.Msg as LoggedInMsg @@ -24,4 +25,4 @@ type Msg = | UpdateLoggedIn LoggedInMsg.Msg | GoSignInView | SignOut - | Dialog (Dialog.Msg View Msg) + | Dialog (Dialog.Msg DialogModel.Model DialogMsg.Msg Msg) diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm index d3e82de..23e0789 100644 --- a/src/client/elm/Update.elm +++ b/src/client/elm/Update.elm @@ -26,6 +26,7 @@ import SignIn.Msg as SignInMsg import SignIn.Update as SignInUpdate import Dialog +import Dialog.Update as DialogUpdate import Utils.Http exposing (errorKey) @@ -68,7 +69,7 @@ update msg model = ) Dialog dialogMsg -> - let (newDialog, command) = Dialog.update dialogMsg model.view model.dialog + let (newDialog, command) = Dialog.update DialogUpdate.update dialogMsg model.dialog.model model.dialog in ( { model | dialog = newDialog } , command ) @@ -94,7 +95,7 @@ applyLoggedIn model loggedInMsg = urlUpdate : Result String Page -> Model -> (Model, Cmd Msg) urlUpdate result model = - case Debug.log "urlUpdate" result of + case result of Err _ -> (model, Navigation.modifyUrl (Page.toHash model.page)) Ok page -> diff --git a/src/client/elm/Utils/Cmd.elm b/src/client/elm/Utils/Cmd.elm index 1eee6f3..8b79446 100644 --- a/src/client/elm/Utils/Cmd.elm +++ b/src/client/elm/Utils/Cmd.elm @@ -7,10 +7,8 @@ import Platform.Cmd as Cmd pipeUpdate : (model, Cmd msg) -> (model -> (model, Cmd msg)) -> (model, Cmd msg) pipeUpdate (model, cmd) f = - let - (model', cmd') = f model - in - (model', Cmd.batch [ cmd, cmd' ]) + let (model', cmd') = f model + in (model', Cmd.batch [ cmd, cmd' ]) (:>) : (m, Cmd a) -> (m -> (m, Cmd a)) -> (m, Cmd a) (:>) = pipeUpdate diff --git a/src/client/elm/View.elm b/src/client/elm/View.elm index 4e97472..6953816 100644 --- a/src/client/elm/View.elm +++ b/src/client/elm/View.elm @@ -12,7 +12,7 @@ import Model.View exposing (..) import LoggedData import Dialog -import View.Header exposing (renderHeader) +import View.Header as Header import SignIn.View as SignInView import LoggedIn.View as LoggedInView @@ -23,13 +23,13 @@ view : Model -> Html Msg view model = div [] - [ renderHeader model - , renderMain model - , Dialog.view model.view model.dialog + [ Header.view model + , mainView model + , Dialog.view model.dialog ] -renderMain : Model -> Html Msg -renderMain model = +mainView : Model -> Html Msg +mainView model = case model.view of SignInView signIn -> SignInView.view model signIn diff --git a/src/client/elm/View/Form.elm b/src/client/elm/View/Form.elm index 5471e7d..b123db9 100644 --- a/src/client/elm/View/Form.elm +++ b/src/client/elm/View/Form.elm @@ -18,8 +18,8 @@ import Model.Translations as Translations exposing (Translations) import Utils.Maybe exposing (isJust) -textInput : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> Html msg -textInput translations form htmlMap fieldName = +textInput : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> String -> Html msg +textInput translations form htmlMap formName fieldName = let field = Form.getFieldAsString fieldName form in div [ classList @@ -30,19 +30,19 @@ textInput translations form htmlMap fieldName = [ htmlMap <| Input.textInput field - [ id fieldName + [ id (formName ++ fieldName) , classList [ ("filled", isJust field.value) ] ] , label - [ for fieldName ] - [ text (Translations.getMessage fieldName translations) ] + [ for (formName ++ fieldName) ] + [ text (Translations.getMessage (formName ++ fieldName) translations) ] , case field.liveError of Just error -> formError translations error Nothing -> text "" ] -radioInputs : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> List String -> Html msg -radioInputs translations form htmlMap radioName fieldNames = +radioInputs : Translations -> Form String a -> (Html Form.Msg -> Html msg) -> String -> String -> List String -> Html msg +radioInputs translations form htmlMap formName radioName fieldNames = let field = Form.getFieldAsString radioName form in div [ classList @@ -52,29 +52,32 @@ radioInputs translations form htmlMap radioName fieldNames = ] [ div [ class "title" ] - [ text (Translations.getMessage radioName translations) ] + [ text (Translations.getMessage (formName ++ radioName) translations) ] , div - [ class "radioElems" ] - (List.map (radioInput translations field htmlMap) fieldNames) + [ class "radioInputs" ] + (List.map (radioInput translations field htmlMap formName) fieldNames) , case field.liveError of Just error -> formError translations error Nothing -> text "" ] -radioInput : Translations -> FieldState String String -> (Html Form.Msg -> Html msg) -> String -> Html msg -radioInput translations field htmlMap fieldName = - label - [ for fieldName ] - [ htmlMap <| - Input.radioInput +radioInput : Translations -> FieldState String String -> (Html Form.Msg -> Html msg) -> String -> String -> Html msg +radioInput translations field htmlMap formName fieldName = + htmlMap <| + div + [ class "radioInput" ] + [ Input.radioInput field.path field - [ id fieldName + [ id (formName ++ fieldName) , value fieldName , checked (field.value == Just fieldName) ] - , text (Translations.getMessage fieldName translations) - ] + , label + [ for (formName ++ fieldName) ] + [ text (Translations.getMessage (formName ++ fieldName) translations) + ] + ] formError : Translations -> FormError.Error String -> Html msg formError translations error = diff --git a/src/client/elm/View/Header.elm b/src/client/elm/View/Header.elm index 5f38c31..00f55d5 100644 --- a/src/client/elm/View/Header.elm +++ b/src/client/elm/View/Header.elm @@ -1,5 +1,5 @@ module View.Header exposing - ( renderHeader + ( view ) import Dict @@ -18,8 +18,8 @@ import Model.Translations exposing (getMessage) import Msg exposing (..) import Model.View exposing (..) -renderHeader : Model -> Html Msg -renderHeader model = +view : Model -> Html Msg +view model = header [] ( [ div [ class "title" ] [ text (getMessage "SharedCost" model.translations) ] ] diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index 7e8d0a3..294e4c4 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -15,7 +15,6 @@ import Database.Persist import Control.Monad.IO.Class (liftIO) import Data.Text (Text) -import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Aeson.Types as Json @@ -34,16 +33,11 @@ getPayments = (liftIO $ runDb P.getPayments) >>= json ) -createPayment :: Text -> Text -> Frequency -> ActionM () +createPayment :: Text -> Int -> Frequency -> ActionM () createPayment name cost frequency = Secure.loggedAction (\user -> do - creationResult <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency - case creationResult of - Left errors -> do - status badRequest400 - jsonObject . map (\(a, b) -> (a, Json.String . T.pack . show $ b)) $ errors - Right paymentId -> - jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)] + paymentId <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency + jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)] ) deleteOwnPayment :: Text -> ActionM () diff --git a/src/server/Design/Dialog.hs b/src/server/Design/Dialog.hs new file mode 100644 index 0000000..f0b8009 --- /dev/null +++ b/src/server/Design/Dialog.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Design.Dialog + ( design + ) where + +import Clay + +design :: Css +design = do + + ".paymentDialog" ? do + ".radioGroup" ? ".title" ? display none diff --git a/src/server/Design/Form.hs b/src/server/Design/Form.hs index 4bd1ad6..c2537f1 100644 --- a/src/server/Design/Form.hs +++ b/src/server/Design/Form.hs @@ -66,14 +66,18 @@ design = do color Color.silver marginBottom (em 0.8) - ".radioElems" ? do + ".radioInputs" ? do display flex - "justify-content" -: "space-around" - - label ? do - marginBottom (px 5) - display block - cursor pointer - input ? do - margin (px 0) (px 8) (px (-1)) (px 0) - cursor pointer + "justify-content" -: "center" + + ".radioInput:not(:last-child)::after" ? do + content (stringContent "/") + marginLeft (px 10) + marginRight (px 10) + + input ? display none + label ? cursor pointer + + "input:checked + label" ? do + color Color.chestnutRose + fontWeight bold diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs index 7d4a1bb..149769c 100644 --- a/src/server/Design/Global.hs +++ b/src/server/Design/Global.hs @@ -12,6 +12,7 @@ import qualified Design.Header as Header import qualified Design.SignIn as SignIn import qualified Design.LoggedIn as LoggedIn import qualified Design.Form as Form +import qualified Design.Dialog as Dialog import Design.Animation.Keyframes @@ -28,6 +29,7 @@ global = do header ? Header.design ".signIn" ? SignIn.design ".loggedIn" ? LoggedIn.design + ".dialog" ? Dialog.design Form.design allKeyframes diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs index deb0aab..c8b3070 100644 --- a/src/server/Design/Helper.hs +++ b/src/server/Design/Helper.hs @@ -3,10 +3,9 @@ module Design.Helper ( clearFix , defaultButton - , iconButton , defaultInput + , iconButton , centeredWithMargin - , expandBlock , verticalCentering ) where @@ -69,21 +68,6 @@ centeredWithMargin = do marginLeft auto marginRight auto -expandBlock :: Color -> Color -> Size Abs -> Css -expandBlock headerBackground headerColor headerHeight = do - marginBottom blockMarginBottom - marginLeft (pct blockPercentMargin) - marginRight (pct blockPercentMargin) - ".header" ? do - defaultButton headerBackground headerColor headerHeight focusLighten - width (pct 100) - fontSize (px 18) - borderRadius radius radius radius radius - textAlign (alignSide sideLeft) - position relative - paddingLeft blockPadding - paddingRight (px 55) - verticalCentering :: Css verticalCentering = do position absolute diff --git a/src/server/Design/LoggedIn.hs b/src/server/Design/LoggedIn.hs index 63ff413..5a3297a 100644 --- a/src/server/Design/LoggedIn.hs +++ b/src/server/Design/LoggedIn.hs @@ -8,15 +8,15 @@ import Data.Monoid ((<>)) import Clay -import qualified Design.LoggedIn.Home as HomeDesign -import qualified Design.LoggedIn.Income as IncomeDesign -import qualified Design.LoggedIn.Stat as StatDesign +import qualified Design.LoggedIn.Home as Home +import qualified Design.LoggedIn.Income as Income +import qualified Design.LoggedIn.Stat as Stat design :: Css design = do - ".home" ? HomeDesign.design - ".income" ? IncomeDesign.design - ".stat" ? StatDesign.design + ".home" ? Home.design + ".income" ? Income.design + ".stat" ? Stat.design (".income" <> ".stat") ? do "margin" -: "0 2vw" diff --git a/src/server/Design/LoggedIn/Home.hs b/src/server/Design/LoggedIn/Home.hs index 47bfc84..7845434 100644 --- a/src/server/Design/LoggedIn/Home.hs +++ b/src/server/Design/LoggedIn/Home.hs @@ -6,16 +6,12 @@ module Design.LoggedIn.Home import Clay -import qualified Design.LoggedIn.Home.Add as Add -import qualified Design.LoggedIn.Home.Monthly as Monthly -import qualified Design.LoggedIn.Home.Search as Search +import qualified Design.LoggedIn.Home.Header as Header import qualified Design.LoggedIn.Home.Table as Table import qualified Design.LoggedIn.Home.Pages as Pages design :: Css design = do - form # ".addPayment" ? Add.design - ".monthly" ? Monthly.design - ".search" ? Search.design + ".header" ? Header.design ".table" ? Table.design ".pages" ? Pages.design diff --git a/src/server/Design/LoggedIn/Home/Add.hs b/src/server/Design/LoggedIn/Home/Add.hs deleted file mode 100644 index ce64077..0000000 --- a/src/server/Design/LoggedIn/Home/Add.hs +++ /dev/null @@ -1,87 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.LoggedIn.Home.Add - ( design - ) where - -import Data.Monoid ((<>)) - -import Clay - -import Design.Color as Color -import Design.Helper -import Design.Constants - -design :: Css -design = do - centeredWithMargin - display flex - "justify-content" -: "center" - - ".name" <> ".cost" ? do - position relative - display flex - marginRight (pct blockPercentMargin) - label ? do - fontWeight bold - display inlineBlock - width (px 50) - textAlign (alignSide sideCenter) - backgroundColor Color.dustyGray - color Color.white - height (px inputHeight) - lineHeight (px inputHeight) - fontSize (px 22) - verticalAlign middle - cursor cursorText - borderRadius (px 0) radius radius (px 0) - input ? do - defaultInput inputHeight - borderRadius radius (px 0) (px 0) radius - "width" -: "calc(100% - 40px)" - input # focus |+ label ? - backgroundColor Color.silver - hover & do - input ? borderColor Color.silver - label ? backgroundColor Color.silver - - ".name" ? minWidth (px 150) - - button # ".frequency" ? do - fontSize (pct 90) - marginRight (pct blockPercentMargin) - - (".punctual" <> ".monthly") ? do - defaultButton Color.wildSand Color.dustyGray (px $ inputHeight `Prelude.div` 2) focusLighten - paddingLeft (px 15) - paddingRight (px 15) - ".selected" & do - backgroundColor Color.gothic - color Color.white - - hover & (".punctual" <> ".monthly") ? - ".selected" & backgroundColor (focusLighten Color.gothic) - - focus & (".punctual" <> ".monthly") ? - ".selected" & backgroundColor (focusLighten Color.gothic) - - ".punctual" ? borderRadius radius radius 0 0 - ".monthly" ? borderRadius 0 0 radius radius - - button # ".add" ? do - defaultButton Color.chestnutRose Color.white (px inputHeight) focusLighten - paddingLeft (px 15) - paddingRight (px 15) - i ? marginLeft (px 10) - ".waitingServer" & ("cursor" -: "not-allowed") - - ".name.error" <> ".cost.error" ? do - input ? borderColor Color.chestnutRose - label ? backgroundColor Color.chestnutRose - "input:focus + label" ? backgroundColor Color.chestnutRose - - ".errorMessage" ? do - position absolute - color Color.chestnutRose - top (px (inputHeight + 10)) - left (px 0) diff --git a/src/server/Design/LoggedIn/Home/Header.hs b/src/server/Design/LoggedIn/Home/Header.hs new file mode 100644 index 0000000..9008a95 --- /dev/null +++ b/src/server/Design/LoggedIn/Home/Header.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Design.LoggedIn.Home.Header + ( design + ) where + +import Clay + +import Design.Constants + +import qualified Design.Helper as Helper +import qualified Design.Color as Color +import qualified Design.Constants as Constants + +design :: Css +design = do + marginBottom blockMarginBottom + marginLeft (pct blockPercentMargin) + marginRight (pct blockPercentMargin) + + ".exceedingPayers" ? do + backgroundColor Color.mossGreen + padding (px 10) (px 10) (px 10) (px 10) + borderRadius (px 5) (px 5) (px 5) (px 5) + color Color.white + marginBottom (em 1) + + ".exceedingPayer:not(:last-child)::after" ? content (stringContent ", ") + + ".userName" ? marginRight (px 5) + + ".searchLine" ? do + marginBottom (em 1) + form ? do + display inlineBlock + + ".textInput" ? do + display inlineBlock + marginRight (px 30) + marginBottom (px 0) + + ".radioGroup" ? do + display inlineBlock + marginBottom (px 0) + ".title" ? display none + + ".addPayment" ? do + Helper.defaultButton Color.chestnutRose Color.white (px 47) Constants.focusLighten + float floatRight + + ".infos" ? do + lineHeight (px Constants.inputHeight) + + ".partition" ? do + color Color.dustyGray + marginLeft (px 15) diff --git a/src/server/Design/LoggedIn/Home/Monthly.hs b/src/server/Design/LoggedIn/Home/Monthly.hs deleted file mode 100644 index 5e976ef..0000000 --- a/src/server/Design/LoggedIn/Home/Monthly.hs +++ /dev/null @@ -1,23 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.LoggedIn.Home.Monthly - ( design - ) where - -import Clay - -import Design.Color as Color -import Design.Helper -import Design.Constants - -design :: Css -design = do - - expandBlock Color.gothic Color.white (px inputHeight) - - ".expand" ? do - position absolute - right blockPadding - bottom (px 0) - - ".detail" |> ".header" ? borderRadius radius radius 0 0 diff --git a/src/server/Design/LoggedIn/Home/Search.hs b/src/server/Design/LoggedIn/Home/Search.hs deleted file mode 100644 index 726b4cf..0000000 --- a/src/server/Design/LoggedIn/Home/Search.hs +++ /dev/null @@ -1,31 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Design.LoggedIn.Home.Search - ( design - ) where - -import Clay - -import Design.Constants - -import qualified Design.Helper as Helper -import qualified Design.Color as Color -import qualified Design.Constants as Constants - -design :: Css -design = do - marginBottom blockMarginBottom - marginLeft (pct blockPercentMargin) - marginRight (pct blockPercentMargin) - - ".textInput" ? do - display inlineBlock - marginRight (px 30) - marginBottom (px 0) - - ".stat" ? do - lineHeight (pct 100) - - ".addPayment" ? do - Helper.defaultButton Color.chestnutRose Color.white (px Constants.inputHeight) Constants.focusLighten - float floatRight diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs index 538bc6d..a229132 100644 --- a/src/server/Design/LoggedIn/Home/Table.hs +++ b/src/server/Design/LoggedIn/Home/Table.hs @@ -16,70 +16,75 @@ import Design.Helper design :: Css design = do - display D.table - width (pct 100) - textAlign (alignSide (sideCenter)) + ".noPayment" ? do + margin (em 2) (em 2) (em 2) (em 2) + textAlign (alignSide sideCenter) - ".header" <> ".row" ? display tableRow - let headerHeight = (px 70) + ".lines" ? do + display D.table + width (pct 100) + textAlign (alignSide (sideCenter)) - ".header" ? do - fontWeight bold - backgroundColor Color.gothic - color Color.white - fontSize iconFontSize - height headerHeight + ".header" <> ".row" ? display tableRow + let headerHeight = (px 70) - ".row" ? do - fontSize (px 18) - height (px rowHeightPx) - ".cell:first-child::before" ? do - display block - content (stringContent "") - position absolute - top (px 0) - left (px 0) - width (px 0) + ".header" ? do + fontWeight bold + backgroundColor Color.gothic + color Color.white + fontSize (px 18) + height headerHeight + + ".row" ? do + fontSize (px 18) height (px rowHeightPx) - backgroundColor Color.mossGreen - transition "width" (sec 0.3) ease (sec 0) - opacity (0.8) + ".cell:first-child::before" ? do + display block + content (stringContent "") + position absolute + top (px 0) + left (px 0) + width (px 0) + height (px rowHeightPx) + backgroundColor Color.mossGreen + transition "width" (sec 0.3) ease (sec 0) + opacity (0.8) - hover & do - ".cell:first-child::before" ? width (px 5) + hover & do + ".cell:first-child::before" ? width (px 5) - nthChild "odd" & do - backgroundColor Color.wildSand - ".edition" & do - backgroundColor Color.negroni - ".delete" |> button ? visibility visible + nthChild "odd" & do + backgroundColor Color.wildSand + ".edition" & do + backgroundColor Color.negroni + ".delete" |> button ? visibility visible - ".cell" ? do - display tableCell - position relative - verticalAlign middle - ".category" & width (pct 40) - ".cost" & do - width (pct 17) - ".refund" & color Color.mossGreen - ".user" & width (pct 20) - ".date" & do - width (pct 20) - Media.mobileTablet $ do - ".shortDate" ? display inline - ".longDate" ? display none - Media.desktop $ do - ".shortDate" ? display none - ".longDate" ? display inline - ".delete" & do + ".cell" ? do + display tableCell position relative - width (pct 3) - textAlign (alignSide sideCenter) - button ? do - defaultButton Color.chestnutRose Color.white (px rowHeightPx) focusLighten - borderRadius (px 0) (px 0) (px 0) (px 0) - position absolute - top (px 0) - right (px 0) - width (pct 100) - visibility hidden + verticalAlign middle + ".category" & width (pct 40) + ".cost" & do + width (pct 17) + ".refund" & color Color.mossGreen + ".user" & width (pct 20) + ".date" & do + width (pct 20) + Media.mobileTablet $ do + ".shortDate" ? display inline + ".longDate" ? display none + Media.desktop $ do + ".shortDate" ? display none + ".longDate" ? display inline + ".delete" & do + position relative + width (pct 3) + textAlign (alignSide sideCenter) + button ? do + defaultButton Color.chestnutRose Color.white (px rowHeightPx) focusLighten + borderRadius (px 0) (px 0) (px 0) (px 0) + position absolute + top (px 0) + right (px 0) + width (pct 100) + visibility hidden diff --git a/src/server/Main.hs b/src/server/Main.hs index 9946961..d04a3ac 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -74,7 +74,7 @@ main = do post "/payment/add" $ do name <- param "name" :: ActionM Text - cost <- param "cost" :: ActionM Text + cost <- param "cost" :: ActionM Int frequency <- param "frequency" :: ActionM Frequency createPayment name cost frequency diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index c87a2c1..8b957f1 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -47,15 +47,19 @@ data Key = | ShortDate | LongDate - -- Validation + -- Search - | CategoryRequired - | CostRequired + | SearchName + | SearchPunctual + | SearchMonthly -- Payments + | PaymentsAreBalanced | Name | Cost + | Payer + | Date | Frequency | InvalidFrequency | AddPayment @@ -63,22 +67,22 @@ data Key = | Punctual | Monthly - | SingularMonthlyCount - | PluralMonthlyCount | PaymentsTitle | Payment | Payments - | SearchText | Worth + | NoPayment + + | PaymentName + | PaymentCost + | PaymentPunctual + | PaymentMonthly -- Statistics | Statistics - | Balance - | Overall - | ByMonths + | ByMonthsAndMean | By - | Mean -- Income @@ -86,8 +90,8 @@ data Key = | Income | MonthlyNetIncomes | IncomeNotDeleted - | Creation - | Amount + | IncomeCreation + | IncomeAmount | ConfirmDelete -- Form diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index f4087a4..df3f402 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -186,20 +186,30 @@ m l LongDate = English -> "{2} {1}, {3}" French -> "{1} {2} {3}" --- Validation +-- Search -m l CategoryRequired = +m l SearchName = case l of - English -> "Type a category." - French -> "Entre une catégorie." + English -> "Search" + French -> "Recherche" + +m l SearchPunctual = + case l of + English -> "Punctual" + French -> "Ponctuel" -m l CostRequired = +m l SearchMonthly = case l of - English -> "Type a positive cost." - French -> "Entre un coût positif." + English -> "Monthly" + French -> "Mensuel" -- Payments +m l PaymentsAreBalanced = + case l of + English -> "Payments are balanced." + French -> "Les paiements sont équilibrés." + m l Name = case l of English -> "Name" @@ -210,6 +220,16 @@ m l Cost = English -> "Cost" French -> "Coût" +m l Payer = + case l of + English -> "Payer" + French -> "Payeur" + +m l Date = + case l of + English -> "Date" + French -> "Date" + m l Frequency = case l of English -> "Frequency" @@ -240,16 +260,6 @@ m l Monthly = English -> "Monthly" French -> "Mensuelle" -m l SingularMonthlyCount = - case l of - English -> "{1} monthly payment of {2}" - French -> "{1} paiement mensuel de {2}" - -m l PluralMonthlyCount = - case l of - English -> "{1} monthly payments worth {2}" - French -> "{1} paiements mensuels comptabilisant {2}" - m l PaymentsTitle = case l of English -> "Payments" @@ -265,16 +275,16 @@ m l Payments = English -> "payments" French -> "paiements" -m l SearchText = - case l of - English -> "Search" - French -> "Recherche" - m l Worth = case l of English -> "{1} worth {2}" French -> "{1} comptabilisant {2}" +m l NoPayment = + case l of + English -> "No payment found from your search criteria." + French -> "Aucun paiement ne correspond à vos critères de recherches." + -- Statistics m l Statistics = @@ -282,30 +292,35 @@ m l Statistics = English -> "Statistics" French -> "Statistiques" -m l Balance = +m l ByMonthsAndMean = + case l of + English -> "By months ({1} on average)" + French -> "Par mois (en moyenne {1})" + +m l By = case l of - English -> "Balance" - French -> "Équilibre" + English -> "{1}: {2}" + French -> "{1} : {2}" -m l Overall = +m l PaymentName = case l of - English -> "Overall" - French -> "Global" + English -> "Name" + French -> "Nom" -m l ByMonths = +m l PaymentCost = case l of - English -> "By months" - French -> "Par mois" + English -> "Cost" + French -> "Coût" -m l By = +m l PaymentPunctual = case l of - English -> "by" - French -> "par" + English -> "Punctual" + French -> "Ponctuel" -m l Mean = +m l PaymentMonthly = case l of - English -> "Mean: {1}" - French -> "En moyenne : {1}" + English -> "Monthly" + French -> "Mensuel" -- Income @@ -329,12 +344,12 @@ m l IncomeNotDeleted = English -> "The income could not have been deleted." French -> "Le revenu n'a pas pu être supprimé." -m l Creation = +m l IncomeCreation = case l of English -> "Creation" French -> "Création" -m l Amount = +m l IncomeAmount = case l of English -> "Amount" French -> "Montant" diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index 47397ff..28f1a09 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -9,18 +9,14 @@ module Model.Payment import Data.Text (Text) import Data.Time.Clock (getCurrentTime) -import Data.Either (lefts) import Control.Monad.IO.Class (liftIO) import Database.Persist -import qualified Validation - import Model.Database import Model.Frequency import qualified Model.Json.Payment as P -import qualified Model.Message.Key as K getPayments :: Persist [P.Payment] getPayments = @@ -48,26 +44,10 @@ getJsonPayment paymentEntity = , P.frequency = paymentFrequency payment } -createPayment :: UserId -> Text -> Text -> Frequency -> Persist (Either [(Text, K.Key)] PaymentId) -createPayment userId name cost frequency = - case validatePayment name cost of - Left err -> - return . Left $ err - Right (validatedName, validatedCost) -> do - now <- liftIO getCurrentTime - Right <$> insert (Payment userId now validatedName validatedCost Nothing frequency) - -validatePayment :: Text -> Text -> Either [(Text, K.Key)] (Text, Int) -validatePayment name cost = - let eitherName = Validation.nonEmpty K.CategoryRequired name - eitherCost = Validation.nonEmpty K.CostRequired cost >>= Validation.number K.CostRequired (/= 0) - in case (eitherName, eitherCost) of - (Right validatedName, Right validatedCost) -> - Right (validatedName, validatedCost) - _ -> - let nameErrors = map (\x -> ("name", x)) $ lefts [eitherName] - costErrors = map (\x -> ("cost", x)) $ lefts [eitherCost] - in Left (nameErrors ++ costErrors) +createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId +createPayment userId name cost frequency = do + now <- liftIO getCurrentTime + insert (Payment userId now name cost Nothing frequency) deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool deleteOwnPayment user paymentId = do diff --git a/src/server/Validation.hs b/src/server/Validation.hs index 455ae5b..1f332c9 100644 --- a/src/server/Validation.hs +++ b/src/server/Validation.hs @@ -6,18 +6,18 @@ module Validation import Data.Text (Text) import qualified Data.Text as T -nonEmpty :: a -> Text -> Either a Text -nonEmpty x str = +nonEmpty :: Text -> Maybe Text +nonEmpty str = if T.null str - then Left x - else Right str + then Nothing + else Just str -number :: x -> (Int -> Bool) -> Text -> Either x Int -number x numberForm str = +number :: (Int -> Bool) -> Text -> Maybe Int +number numberForm str = case reads (T.unpack str) :: [(Int, String)] of (num, _) : _ -> if numberForm num - then Right num - else Left x + then Just num + else Nothing _ -> - Left x + Nothing -- cgit v1.2.3