From 9ec84e3a20c767f6525639f58cd22715e302b88d Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 26 Jun 2016 12:31:24 +0200 Subject: Add an editable date field for punctual payment creation --- src/client/elm/Dialog/AddPayment/View.elm | 10 ++++-- src/client/elm/Dialog/Model.elm | 16 ++++++++-- src/client/elm/LoggedIn/Home/View/Table.elm | 6 ++-- src/client/elm/LoggedIn/Income/Model.elm | 25 +++------------ src/client/elm/LoggedIn/Income/View.elm | 13 ++++---- src/client/elm/LoggedIn/Msg.elm | 10 +++--- src/client/elm/LoggedIn/Stat/View.elm | 4 +-- src/client/elm/LoggedIn/Update.elm | 20 ++++++------ src/client/elm/LoggedIn/View/Date.elm | 48 ----------------------------- src/client/elm/Model/Income.elm | 2 +- src/client/elm/Model/Payer.elm | 6 ++-- src/client/elm/Model/Payment.elm | 8 ++--- src/client/elm/Server.elm | 28 +++++++++++------ src/client/elm/Utils/Form.elm | 10 ++++++ src/client/elm/Validation.elm | 22 +++++++++++++ src/client/elm/View/Date.elm | 48 +++++++++++++++++++++++++++++ src/server/Controller/Income.hs | 10 +++--- src/server/Controller/Payment.hs | 34 ++++++++++---------- src/server/Main.hs | 30 +++++------------- src/server/Model/Database.hs | 3 +- src/server/Model/Income.hs | 8 ++--- src/server/Model/Init.hs | 4 +-- src/server/Model/Json/AddIncome.hs | 17 ---------- src/server/Model/Json/CreateIncome.hs | 17 ++++++++++ src/server/Model/Json/CreatePayment.hs | 22 +++++++++++++ src/server/Model/Json/Income.hs | 2 +- src/server/Model/Json/Payment.hs | 4 +-- src/server/Model/Message/Key.hs | 5 +-- src/server/Model/Message/Translations.hs | 11 +++++-- src/server/Model/Payment.hs | 31 ++++++++++--------- src/server/MonthlyPaymentJob.hs | 9 +++--- src/server/Utils/Time.hs | 23 ++++++-------- 32 files changed, 278 insertions(+), 228 deletions(-) delete mode 100644 src/client/elm/LoggedIn/View/Date.elm create mode 100644 src/client/elm/Validation.elm create mode 100644 src/client/elm/View/Date.elm delete mode 100644 src/server/Model/Json/AddIncome.hs create mode 100644 src/server/Model/Json/CreateIncome.hs create mode 100644 src/server/Model/Json/CreatePayment.hs diff --git a/src/client/elm/Dialog/AddPayment/View.elm b/src/client/elm/Dialog/AddPayment/View.elm index 79381dd..96686b8 100644 --- a/src/client/elm/Dialog/AddPayment/View.elm +++ b/src/client/elm/Dialog/AddPayment/View.elm @@ -7,8 +7,10 @@ import Html.Attributes exposing (..) import Html.Events exposing (..) import Html.App as Html import Task +import Date import Form exposing (Form) +import Utils.Form as Form import Dialog @@ -39,15 +41,16 @@ view loggedData frequency = , confirmMsg = \model -> ( case Form.getOutput model.addPayment of Just data -> - Ok (Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.frequency) + Ok (Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.date data.frequency) Nothing -> Err (Msg.Dialog <| Dialog.UpdateModel <| DialogMsg.AddPaymentMsg <| Form.Submit) ) , undo = getMessage "Undo" loggedData.translations } + currentDate = Date.fromTime loggedData.currentTime in button [ class "addPayment" - , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.AddPaymentMsg <| Form.Reset (DialogModel.addPaymentInitial frequency))) + , onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.AddPaymentMsg <| Form.Reset (DialogModel.addPaymentInitial loggedData.translations currentDate frequency))) ] [ text (getMessage "AddPayment" loggedData.translations) ] @@ -60,5 +63,8 @@ addPaymentForm loggedData addPayment = ] [ Form.textInput loggedData.translations addPayment "payment" "name" , Form.textInput loggedData.translations addPayment "payment" "cost" + , if Form.frequency addPayment == Punctual + then Form.textInput loggedData.translations addPayment "payment" "date" + else text "" , Form.radioInputs loggedData.translations addPayment "payment" "frequency" [ toString Punctual, toString Monthly ] ] diff --git a/src/client/elm/Dialog/Model.elm b/src/client/elm/Dialog/Model.elm index 9bd6a09..2ac4591 100644 --- a/src/client/elm/Dialog/Model.elm +++ b/src/client/elm/Dialog/Model.elm @@ -5,11 +5,16 @@ module Dialog.Model exposing , addPaymentInitial ) +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 +import Model.Translations exposing (Translations) type alias Model = { addPayment : Form String AddPayment @@ -18,6 +23,7 @@ type alias Model = type alias AddPayment = { name : String , cost : Int + , date : Date , frequency : Payment.Frequency } @@ -26,12 +32,16 @@ init = { addPayment = Form.initial [] addPaymentValidation } -addPaymentInitial : Payment.Frequency -> List (String, Field) -addPaymentInitial frequency = [ ("frequency", Field.Radio (toString frequency)) ] +addPaymentInitial : Translations -> Date -> Payment.Frequency -> List (String, Field) +addPaymentInitial translations date frequency = + [ ("date", Field.Text (Date.shortView date translations)) + , ("frequency", Field.Radio (toString frequency)) + ] addPaymentValidation : Validation String AddPayment addPaymentValidation = - Validate.form3 AddPayment + Validate.form4 AddPayment (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/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm index 323a45d..fa0a93d 100644 --- a/src/client/elm/LoggedIn/Home/View/Table.elm +++ b/src/client/elm/LoggedIn/Home/View/Table.elm @@ -21,7 +21,7 @@ import LoggedIn.Msg as LoggedInMsg import LoggedIn.Home.Msg as HomeMsg import LoggedIn.Home.Model as HomeModel -import LoggedIn.View.Date exposing (..) +import View.Date as Date import LoggedIn.View.Format as Format import Model.User exposing (getUserName) @@ -91,10 +91,10 @@ paymentLine loggedData homeModel frequency payment = [ class "cell date" ] [ span [ class "shortDate" ] - [ text (renderShortDate payment.creation loggedData.translations) ] + [ text (Date.shortView payment.date loggedData.translations) ] , span [ class "longDate" ] - [ text (renderLongDate payment.creation loggedData.translations) ] + [ text (Date.longView payment.date loggedData.translations) ] ] Monthly -> text "" diff --git a/src/client/elm/LoggedIn/Income/Model.elm b/src/client/elm/LoggedIn/Income/Model.elm index e56e290..d6e5e7a 100644 --- a/src/client/elm/LoggedIn/Income/Model.elm +++ b/src/client/elm/LoggedIn/Income/Model.elm @@ -5,14 +5,11 @@ module LoggedIn.Income.Model exposing , initForm ) -import String exposing (toInt, split) -import Date -import Time exposing (Time) -import Date.Extra.Create exposing (dateFromFields) -import Date.Extra.Core exposing (intToMonth) +import Date exposing (Date) import Form exposing (Form) import Form.Validate as Validate exposing (..) +import Validation type alias Model = { addIncome : Form String AddIncome @@ -20,8 +17,8 @@ type alias Model = } type alias AddIncome = - { time : Time - , amount : Int + { amount : Int + , date : Date } init : Model @@ -36,17 +33,5 @@ initForm = Form.initial [] validate validate : Validation String AddIncome validate = form2 AddIncome - (get "creation" timeValidation) (get "amount" (int `andThen` (minInt 1))) - -timeValidation : Validation String Time -timeValidation = - customValidation string (\str -> - case split "/" str of - [day, month, year] -> - case (toInt day, toInt month, toInt year) of - (Ok dayNum, Ok monthNum, Ok yearNum) -> - Ok (Date.toTime (dateFromFields yearNum (intToMonth monthNum) dayNum 0 0 0 0)) - _ -> Err (customError "InvalidDate") - _ -> Err (customError "InvalidDate") - ) + (get "date" Validation.date) diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm index 3019fea..02e4467 100644 --- a/src/client/elm/LoggedIn/Income/View.elm +++ b/src/client/elm/LoggedIn/Income/View.elm @@ -34,10 +34,9 @@ import LoggedIn.Income.Model as IncomeModel import LoggedIn.Msg as LoggedInMsg import LoggedIn.Income.Msg as IncomeMsg -import LoggedIn.View.Date exposing (renderShortDate) +import View.Date as Date import LoggedIn.View.Format as Format -import LoggedIn.View.Date exposing (renderLongDate) import View.Color as Color view : LoggedData -> IncomeModel.Model -> Html Msg @@ -54,7 +53,7 @@ view loggedData incomeModel = cumulativeIncomesView : LoggedData -> Time -> Html Msg cumulativeIncomesView loggedData since = - let longDate = renderLongDate (Date.fromTime since) loggedData.translations + let longDate = Date.longView (Date.fromTime since) loggedData.translations in div [] [ h1 [] [ text <| getParamMessage [longDate] "CumulativeIncomesSince" loggedData.translations ] @@ -81,13 +80,13 @@ 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" "creation" - , htmlMap <| Form.textInput loggedData.translations addIncome "income" "amount" + [ 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.AddIncome data.time data.amount) + onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.amount data.date) Nothing -> onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit) ] @@ -110,7 +109,7 @@ incomeView : LoggedData -> (IncomeId, Income) -> Html Msg incomeView loggedData (incomeId, income) = li [] - [ text <| renderShortDate (Date.fromTime income.time) loggedData.translations + [ text <| Date.shortView (Date.fromTime income.time) loggedData.translations , text " − " , text <| Format.price loggedData.conf income.amount , let dialogConfig = diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm index c09655f..cbae67f 100644 --- a/src/client/elm/LoggedIn/Msg.elm +++ b/src/client/elm/LoggedIn/Msg.elm @@ -2,7 +2,7 @@ module LoggedIn.Msg exposing ( Msg(..) ) -import Time exposing (Time) +import Date exposing (Date) import Model.Payment exposing (Payment, PaymentId, Frequency) import Model.Income exposing (IncomeId) @@ -15,14 +15,14 @@ type Msg = | HomeMsg HomeMsg.Msg | IncomeMsg IncomeMsg.Msg - | AddPayment String Int Frequency - | ValidateAddPayment PaymentId String Int Frequency + | AddPayment String Int Date Frequency + | ValidateAddPayment PaymentId String Int Date Frequency | DeletePayment PaymentId | ValidateDeletePayment PaymentId - | AddIncome Time Int - | ValidateAddIncome IncomeId Time Int + | AddIncome Int Date + | ValidateAddIncome 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 72e1f34..636312d 100644 --- a/src/client/elm/LoggedIn/Stat/View.elm +++ b/src/client/elm/LoggedIn/Stat/View.elm @@ -16,7 +16,7 @@ import Model.Conf exposing (Conf) import Model.Translations exposing (getMessage, getParamMessage) import LoggedIn.View.Format as Format -import LoggedIn.View.Date as Date +import View.Date as Date import View.Plural exposing (plural) import Utils.List as List @@ -47,7 +47,7 @@ monthDetail : LoggedData -> ((Month, Int), Payments) -> Html Msg monthDetail loggedData ((month, year), payments) = li [] - [ text (Date.renderMonth loggedData.translations month) + [ text (Date.monthView loggedData.translations month) , text " " , text (toString year) , text " − " diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm index 48d87f7..1f09271 100644 --- a/src/client/elm/LoggedIn/Update.elm +++ b/src/client/elm/LoggedIn/Update.elm @@ -58,9 +58,9 @@ update model msg loggedIn = , Cmd.map LoggedInMsg.IncomeMsg cmd ) - LoggedInMsg.AddPayment name cost frequency -> + LoggedInMsg.AddPayment name cost date frequency -> ( loggedIn - , Server.addPayment name cost frequency + , Server.createPayment name cost date frequency |> Task.perform (\err -> case err of @@ -69,15 +69,15 @@ update model msg loggedIn = _ -> LoggedInMsg.NoOp ) - (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost frequency) + (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost date frequency) ) - LoggedInMsg.ValidateAddPayment paymentId name cost frequency -> + LoggedInMsg.ValidateAddPayment paymentId name cost date frequency -> 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 + let newPayment = Payment paymentId name cost date loggedIn.me frequency in ( { loggedIn | payments = newPayment :: loggedIn.payments } , Cmd.none ) @@ -115,16 +115,16 @@ update model msg loggedIn = , Cmd.none ) - LoggedInMsg.AddIncome time amount -> + LoggedInMsg.AddIncome amount date -> ( loggedIn - , Server.addIncome time amount + , Server.createIncome amount date |> Task.perform (always LoggedInMsg.NoOp) - (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId time amount)) + (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId amount date)) ) - LoggedInMsg.ValidateAddIncome incomeId time amount -> - let newIncome = { userId = loggedIn.me, time = time, amount = amount } + LoggedInMsg.ValidateAddIncome incomeId amount date -> + let newIncome = { userId = loggedIn.me, amount = amount, time = Date.toTime date } loggedInIncome = loggedIn.income in ( { loggedIn | incomes = Dict.insert incomeId newIncome loggedIn.incomes diff --git a/src/client/elm/LoggedIn/View/Date.elm b/src/client/elm/LoggedIn/View/Date.elm deleted file mode 100644 index 8e4e872..0000000 --- a/src/client/elm/LoggedIn/View/Date.elm +++ /dev/null @@ -1,48 +0,0 @@ -module LoggedIn.View.Date exposing - ( renderShortDate - , renderLongDate - , renderMonth - ) - -import Date exposing (..) -import Date.Extra.Core as Date -import String - -import Model.Translations exposing (..) - -renderShortDate : Date -> Translations -> String -renderShortDate date translations = - let params = - [ String.pad 2 '0' (toString (Date.day date)) - , String.pad 2 '0' (toString (Date.monthToInt (Date.month date))) - , toString (Date.year date) - ] - in getParamMessage params "ShortDate" translations - -renderLongDate : Date -> Translations -> String -renderLongDate date translations = - let params = - [ toString (Date.day date) - , (getMessage (getMonthKey (Date.month date)) translations) - , toString (Date.year date) - ] - in getParamMessage params "LongDate" translations - -renderMonth : Translations -> Month -> String -renderMonth translations month = getMessage (getMonthKey month) translations - -getMonthKey : Month -> String -getMonthKey month = - case month of - Jan -> "January" - Feb -> "February" - Mar -> "March" - Apr -> "April" - May -> "May" - Jun -> "June" - Jul -> "July" - Aug -> "August" - Sep -> "September" - Oct -> "October" - Nov -> "November" - Dec -> "December" diff --git a/src/client/elm/Model/Income.elm b/src/client/elm/Model/Income.elm index 7eaa77f..06ba772 100644 --- a/src/client/elm/Model/Income.elm +++ b/src/client/elm/Model/Income.elm @@ -45,7 +45,7 @@ incomeDecoder : Json.Decoder Income incomeDecoder = Json.object3 Income ("userId" := userIdDecoder) - ("day" := timeDecoder) + ("date" := timeDecoder) ("amount" := Json.int) incomeDefinedForAll : List UserId -> Incomes -> Maybe Time diff --git a/src/client/elm/Model/Payer.elm b/src/client/elm/Model/Payer.elm index fb9940a..e5a4b65 100644 --- a/src/client/elm/Model/Payer.elm +++ b/src/client/elm/Model/Payer.elm @@ -71,7 +71,7 @@ useIncomesFrom : Users -> Incomes -> Payments -> Maybe Time useIncomesFrom users incomes payments = let firstPaymentTime = payments - |> List.map (Date.toTime << .creation) + |> List.map (Date.toTime << .date) |> List.sort |> List.head mbIncomeTime = incomeDefinedForAll (Dict.keys users) incomes @@ -90,7 +90,7 @@ getPayers currentTime users incomes payments = ( userId , { preIncomePaymentSum = totalPayments - (\p -> (Date.toTime p.creation) < (Maybe.withDefault currentTime incomesDefined)) + (\p -> (Date.toTime p.date) < (Maybe.withDefault currentTime incomesDefined)) userId payments , postIncomePaymentSum = @@ -98,7 +98,7 @@ getPayers currentTime users incomes payments = (\p -> case incomesDefined of Nothing -> False - Just t -> (Date.toTime p.creation) >= t + Just t -> (Date.toTime p.date) >= t ) userId payments diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm index ab3cbb7..c89e709 100644 --- a/src/client/elm/Model/Payment.elm +++ b/src/client/elm/Model/Payment.elm @@ -33,9 +33,9 @@ type alias Payments = List Payment type alias Payment = { id : PaymentId - , creation : Date , name : String , cost : Int + , date : Date , userId : UserId , frequency : Frequency } @@ -51,9 +51,9 @@ paymentDecoder : Json.Decoder Payment paymentDecoder = Json.object6 Payment ("id" := paymentIdDecoder) - ("creation" := dateDecoder) ("name" := Json.string) ("cost" := Json.int) + ("date" := dateDecoder) ("userId" := userIdDecoder) ("frequency" := frequencyDecoder) @@ -92,7 +92,7 @@ monthly = List.filter ((==) Monthly << .frequency) groupAndSortByMonth : Payments -> List ((Month, Int), Payments) groupAndSortByMonth payments = payments - |> List.groupBy (\payment -> (Date.year payment.creation, monthToInt << Date.month <| payment.creation)) + |> List.groupBy (\payment -> (Date.year payment.date, monthToInt << Date.month <| payment.date)) |> List.sortBy fst |> List.map (\((year, month), payments) -> ((intToMonth month, year), payments)) |> List.reverse @@ -101,7 +101,7 @@ search : String -> Frequency -> Payments -> Payments search name frequency payments = payments |> List.filter ((==) frequency << .frequency) - |> List.sortBy (Date.toTime << .creation) + |> List.sortBy (Date.toTime << .date) |> List.filter (searchSuccess name) |> List.reverse diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm index f3ed949..9522d17 100644 --- a/src/client/elm/Server.elm +++ b/src/client/elm/Server.elm @@ -1,8 +1,8 @@ module Server exposing ( signIn - , addPayment + , createPayment , deletePayment - , addIncome + , createIncome , deleteIncome , signOut ) @@ -12,7 +12,7 @@ import Http import Date import Json.Decode exposing ((:=)) import Json.Encode as Json -import Time exposing (Time) +import Date exposing (Date) import Date.Extra.Format as DateFormat @@ -28,9 +28,17 @@ signIn email = post ("/signIn?email=" ++ email) |> Task.map (always ()) -addPayment : String -> Int -> Frequency -> Task Http.Error PaymentId -addPayment name cost frequency = - post ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)) +createPayment : String -> Int -> Date -> Frequency -> Task Http.Error PaymentId +createPayment name cost date frequency = + Json.object + [ ("name", Json.string name) + , ("cost", Json.int cost) + , ("date", Json.string (DateFormat.isoDateString date)) + , ("frequency", Json.string (toString frequency)) + ] + |> Json.encode 0 + |> Http.string + |> postWithBody "/payment" |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder) deletePayment : PaymentId -> Task Http.Error () @@ -38,11 +46,11 @@ deletePayment paymentId = delete ("/payment?id=" ++ (toString paymentId)) |> Task.map (always ()) -addIncome : Time -> Int -> Task Http.Error IncomeId -addIncome time amount = +createIncome : Int -> Date -> Task Http.Error IncomeId +createIncome amount date = Json.object - [ ("day", Json.string (DateFormat.isoDateString (Date.fromTime time))) - , ("amount", Json.int amount) + [ ("amount", Json.int amount) + , ("date", Json.string (DateFormat.isoDateString date)) ] |> Json.encode 0 |> Http.string diff --git a/src/client/elm/Utils/Form.elm b/src/client/elm/Utils/Form.elm index 6793222..482db5f 100644 --- a/src/client/elm/Utils/Form.elm +++ b/src/client/elm/Utils/Form.elm @@ -1,11 +1,21 @@ module Utils.Form exposing ( fieldAsText + , frequency ) import Form exposing (Form) +import Model.Payment exposing (Frequency(..)) + fieldAsText : Form a b -> String -> String fieldAsText form field = Form.getFieldAsString field form |> .value |> Maybe.withDefault "" + +frequency : Form a b -> Frequency +frequency form = + let field = Form.getFieldAsString "frequency" form + in if field.value == Just (toString Monthly) + then Monthly + else Punctual diff --git a/src/client/elm/Validation.elm b/src/client/elm/Validation.elm new file mode 100644 index 0000000..1729daa --- /dev/null +++ b/src/client/elm/Validation.elm @@ -0,0 +1,22 @@ +module Validation exposing + ( date + ) + +import String exposing (toInt, split) +import Date exposing (Date) +import Date.Extra.Create exposing (dateFromFields) +import Date.Extra.Core exposing (intToMonth) + +import Form.Validate as Validate exposing (..) + +date : Validation String Date +date = + customValidation string (\str -> + case split "/" str of + [day, month, year] -> + case (toInt day, toInt month, toInt year) of + (Ok dayNum, Ok monthNum, Ok yearNum) -> + Ok (dateFromFields yearNum (intToMonth monthNum) dayNum 0 0 0 0) + _ -> Err (customError "InvalidDate") + _ -> Err (customError "InvalidDate") + ) diff --git a/src/client/elm/View/Date.elm b/src/client/elm/View/Date.elm new file mode 100644 index 0000000..21bbfc4 --- /dev/null +++ b/src/client/elm/View/Date.elm @@ -0,0 +1,48 @@ +module View.Date exposing + ( shortView + , longView + , monthView + ) + +import Date exposing (..) +import Date.Extra.Core as Date +import String + +import Model.Translations exposing (..) + +shortView : Date -> Translations -> String +shortView date translations = + let params = + [ String.pad 2 '0' (toString (Date.day date)) + , String.pad 2 '0' (toString (Date.monthToInt (Date.month date))) + , toString (Date.year date) + ] + in getParamMessage params "ShortDate" translations + +longView : Date -> Translations -> String +longView date translations = + let params = + [ toString (Date.day date) + , (getMessage (getMonthKey (Date.month date)) translations) + , toString (Date.year date) + ] + in getParamMessage params "LongDate" translations + +monthView : Translations -> Month -> String +monthView translations month = getMessage (getMonthKey month) translations + +getMonthKey : Month -> String +getMonthKey month = + case month of + Jan -> "January" + Feb -> "February" + Mar -> "March" + Apr -> "April" + May -> "May" + Jun -> "June" + Jul -> "July" + Aug -> "August" + Sep -> "September" + Oct -> "October" + Nov -> "November" + Dec -> "December" diff --git a/src/server/Controller/Income.hs b/src/server/Controller/Income.hs index 70e40ce..fa575c5 100644 --- a/src/server/Controller/Income.hs +++ b/src/server/Controller/Income.hs @@ -2,7 +2,7 @@ module Controller.Income ( getIncomes - , addIncome + , createIncome , deleteOwnIncome ) where @@ -24,7 +24,7 @@ import Json (jsonId) import Model.Database import qualified Model.Income as Income import qualified Model.Message.Key as Key -import qualified Model.Json.AddIncome as Json +import qualified Model.Json.CreateIncome as Json getIncomes :: ActionM () getIncomes = @@ -32,10 +32,10 @@ getIncomes = (liftIO $ map Income.getJsonIncome <$> runDb Income.getIncomes) >>= json ) -addIncome :: Json.AddIncome -> ActionM () -addIncome (Json.AddIncome date amount) = +createIncome :: Json.CreateIncome -> ActionM () +createIncome (Json.CreateIncome date amount) = Secure.loggedAction (\user -> - (liftIO . runDb $ Income.addIncome (entityKey user) date amount) >>= jsonId + (liftIO . runDb $ Income.createIncome (entityKey user) date amount) >>= jsonId ) deleteOwnIncome :: Text -> ActionM () diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index 294e4c4..55edea5 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module Controller.Payment - ( getPayments - , createPayment - , deleteOwnPayment + ( list + , create + , deleteOwn ) where import Web.Scotty @@ -16,34 +16,32 @@ import Control.Monad.IO.Class (liftIO) import Data.Text (Text) import qualified Data.Text.Lazy as TL -import qualified Data.Aeson.Types as Json import qualified Secure -import Json (jsonObject) +import Json (jsonId) import Model.Database -import qualified Model.Payment as P -import Model.Frequency +import qualified Model.Payment as Payment import Model.Message.Key (Key(PaymentNotDeleted)) +import qualified Model.Json.CreatePayment as Json -getPayments :: ActionM () -getPayments = +list :: ActionM () +list = Secure.loggedAction (\_ -> do - (liftIO $ runDb P.getPayments) >>= json + (liftIO $ runDb Payment.list) >>= json ) -createPayment :: Text -> Int -> Frequency -> ActionM () -createPayment name cost frequency = - Secure.loggedAction (\user -> do - paymentId <- liftIO . runDb $ P.createPayment (entityKey user) name cost frequency - jsonObject [("id", Json.Number . fromIntegral . keyToInt64 $ paymentId)] +create :: Json.CreatePayment -> ActionM () +create (Json.CreatePayment date name cost frequency) = + Secure.loggedAction (\user -> + (liftIO . runDb $ Payment.create (entityKey user) date name cost frequency) >>= jsonId ) -deleteOwnPayment :: Text -> ActionM () -deleteOwnPayment paymentId = +deleteOwn :: Text -> ActionM () +deleteOwn paymentId = Secure.loggedAction (\user -> do - deleted <- liftIO . runDb $ P.deleteOwnPayment user (textToKey paymentId) + deleted <- liftIO . runDb $ Payment.deleteOwn user (textToKey paymentId) if deleted then status ok200 diff --git a/src/server/Main.hs b/src/server/Main.hs index d04a3ac..72e8675 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -14,12 +14,10 @@ import qualified Data.Text.IO as T import Controller.Index import Controller.SignIn -import Controller.Payment -import Controller.User +import Controller.Payment as Payment import Controller.Income import Model.Database (runMigrations) -import Model.Frequency import qualified Conf @@ -52,32 +50,18 @@ main = do post "/signOut" (signOut conf) - -- Users + -- Payments - get "/users" getUsers + post "/payment" $ jsonData >>= Payment.create - get "/whoAmI" whoAmI + delete "/payment" $ do + paymentId <- param "id" :: ActionM Text + Payment.deleteOwn paymentId -- Incomes - get "/incomes" getIncomes - - post "/income" $ jsonData >>= addIncome + post "/income" $ jsonData >>= createIncome delete "/income" $ do incomeId <- param "id" :: ActionM Text deleteOwnIncome incomeId - - -- Payments - - get "/payments" getPayments - - post "/payment/add" $ do - name <- param "name" :: ActionM Text - cost <- param "cost" :: ActionM Int - frequency <- param "frequency" :: ActionM Frequency - createPayment name cost frequency - - delete "/payment" $ do - paymentId <- param "id" :: ActionM Text - deleteOwnPayment paymentId diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs index 5df925a..7e67f9a 100644 --- a/src/server/Model/Database.hs +++ b/src/server/Model/Database.hs @@ -35,9 +35,10 @@ User deriving Show Payment userId UserId - creation UTCTime + date Day name Text cost Int + createdAt UTCTime deletedAt UTCTime Maybe frequency Frequency deriving Show diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs index 119a44f..62ab0ed 100644 --- a/src/server/Model/Income.hs +++ b/src/server/Model/Income.hs @@ -1,7 +1,7 @@ module Model.Income ( getJsonIncome , getIncomes - , addIncome + , createIncome , deleteOwnIncome ) where @@ -23,10 +23,10 @@ getJsonIncome incomeEntity = getIncomes :: Persist [Entity Income] getIncomes = selectList [IncomeDeletedAt ==. Nothing] [] -addIncome :: UserId -> Day -> Int -> Persist IncomeId -addIncome userId day amount = do +createIncome :: UserId -> Day -> Int -> Persist IncomeId +createIncome userId date amount = do now <- liftIO getCurrentTime - insert (Income userId day amount now Nothing) + insert (Income userId date amount now Nothing) deleteOwnIncome :: Entity User -> IncomeId -> Persist Bool deleteOwnIncome user incomeId = do diff --git a/src/server/Model/Init.hs b/src/server/Model/Init.hs index 167eead..09ac627 100644 --- a/src/server/Model/Init.hs +++ b/src/server/Model/Init.hs @@ -11,7 +11,7 @@ import Database.Persist import Model.Database import Model.Json.Init (Init, Init(Init)) -import Model.Payment (getPayments) +import qualified Model.Payment as Payment import Model.User (getUsers, getJsonUser) import Model.Income (getIncomes, getJsonIncome) @@ -21,7 +21,7 @@ getInit :: Entity User -> Persist Init getInit user = liftIO . runDb $ do users <- getUsers - payments <- getPayments + payments <- Payment.list incomes <- getIncomes return $ Init { Init.users = map getJsonUser users diff --git a/src/server/Model/Json/AddIncome.hs b/src/server/Model/Json/AddIncome.hs deleted file mode 100644 index 6570ba9..0000000 --- a/src/server/Model/Json/AddIncome.hs +++ /dev/null @@ -1,17 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Json.AddIncome - ( AddIncome(..) - ) where - -import GHC.Generics - -import Data.Aeson -import Data.Time.Calendar (Day) - -data AddIncome = AddIncome - { day :: Day - , amount :: Int - } deriving (Show, Generic) - -instance FromJSON AddIncome diff --git a/src/server/Model/Json/CreateIncome.hs b/src/server/Model/Json/CreateIncome.hs new file mode 100644 index 0000000..cf9b1c3 --- /dev/null +++ b/src/server/Model/Json/CreateIncome.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Model.Json.CreateIncome + ( CreateIncome(..) + ) where + +import GHC.Generics + +import Data.Aeson +import Data.Time.Calendar (Day) + +data CreateIncome = CreateIncome + { date :: Day + , amount :: Int + } deriving (Show, Generic) + +instance FromJSON CreateIncome diff --git a/src/server/Model/Json/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs new file mode 100644 index 0000000..f117daf --- /dev/null +++ b/src/server/Model/Json/CreatePayment.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Model.Json.CreatePayment + ( CreatePayment(..) + ) where + +import GHC.Generics + +import Data.Aeson +import Data.Time.Calendar (Day) +import Data.Text (Text) + +import Model.Frequency (Frequency) + +data CreatePayment = CreatePayment + { date :: Day + , name :: Text + , cost :: Int + , frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON CreatePayment diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs index e80ab63..bb1ac97 100644 --- a/src/server/Model/Json/Income.hs +++ b/src/server/Model/Json/Income.hs @@ -14,7 +14,7 @@ import Model.Database (IncomeId, UserId) data Income = Income { id :: IncomeId , userId :: UserId - , day :: Day + , date :: Day , amount :: Int } deriving (Show, Generic) diff --git a/src/server/Model/Json/Payment.hs b/src/server/Model/Json/Payment.hs index 7f4de15..04c6de8 100644 --- a/src/server/Model/Json/Payment.hs +++ b/src/server/Model/Json/Payment.hs @@ -6,16 +6,16 @@ module Model.Json.Payment import GHC.Generics -import Data.Time import Data.Text (Text) import Data.Aeson +import Data.Time.Calendar (Day) import Model.Database (PaymentId, UserId) import Model.Frequency data Payment = Payment { id :: PaymentId - , creation :: UTCTime + , date :: Day , name :: Text , cost :: Int , userId :: UserId diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs index 8b957f1..093024b 100644 --- a/src/server/Model/Message/Key.hs +++ b/src/server/Model/Message/Key.hs @@ -75,6 +75,7 @@ data Key = | PaymentName | PaymentCost + | PaymentDate | PaymentPunctual | PaymentMonthly @@ -90,7 +91,7 @@ data Key = | Income | MonthlyNetIncomes | IncomeNotDeleted - | IncomeCreation + | IncomeDate | IncomeAmount | ConfirmDelete @@ -117,4 +118,4 @@ data Key = deriving (Enum, Bounded, Show) instance Json.ToJSON Key where - toJSON = Json.String . T.pack . show + toJSON = Json.String . T.pack . show diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index df3f402..6522d75 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -312,6 +312,11 @@ m l PaymentCost = English -> "Cost" French -> "Coût" +m l PaymentDate = + case l of + English -> "Date" + French -> "Date" + m l PaymentPunctual = case l of English -> "Punctual" @@ -344,10 +349,10 @@ m l IncomeNotDeleted = English -> "The income could not have been deleted." French -> "Le revenu n'a pas pu être supprimé." -m l IncomeCreation = +m l IncomeDate = case l of - English -> "Creation" - French -> "Création" + English -> "Date" + French -> "Date" m l IncomeAmount = case l of diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index 28f1a09..51ca152 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -1,14 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} module Model.Payment - ( getPayments - , getMonthlyPayments - , createPayment - , deleteOwnPayment + ( list + , listMonthly + , create + , deleteOwn ) where import Data.Text (Text) import Data.Time.Clock (getCurrentTime) +import Data.Time.Calendar (Day) import Control.Monad.IO.Class (liftIO) @@ -18,14 +19,14 @@ import Model.Database import Model.Frequency import qualified Model.Json.Payment as P -getPayments :: Persist [P.Payment] -getPayments = +list :: Persist [P.Payment] +list = map getJsonPayment <$> selectList [ PaymentDeletedAt ==. Nothing ] - [ Desc PaymentCreation ] + [] -getMonthlyPayments :: Persist [Entity Payment] -getMonthlyPayments = +listMonthly :: Persist [Entity Payment] +listMonthly = selectList [ PaymentDeletedAt ==. Nothing , PaymentFrequency ==. Monthly @@ -37,20 +38,20 @@ getJsonPayment paymentEntity = let payment = entityVal paymentEntity in P.Payment { P.id = entityKey paymentEntity - , P.creation = paymentCreation payment + , P.date = paymentDate payment , P.name = paymentName payment , P.cost = paymentCost payment , P.userId = paymentUserId payment , P.frequency = paymentFrequency payment } -createPayment :: UserId -> Text -> Int -> Frequency -> Persist PaymentId -createPayment userId name cost frequency = do +create :: UserId -> Day -> Text -> Int -> Frequency -> Persist PaymentId +create userId date name cost frequency = do now <- liftIO getCurrentTime - insert (Payment userId now name cost Nothing frequency) + insert (Payment userId date name cost now Nothing frequency) -deleteOwnPayment :: Entity User -> PaymentId -> Persist Bool -deleteOwnPayment user paymentId = do +deleteOwn :: Entity User -> PaymentId -> Persist Bool +deleteOwn user paymentId = do mbPayment <- get paymentId case mbPayment of Just payment -> diff --git a/src/server/MonthlyPaymentJob.hs b/src/server/MonthlyPaymentJob.hs index f5f6878..c4022c9 100644 --- a/src/server/MonthlyPaymentJob.hs +++ b/src/server/MonthlyPaymentJob.hs @@ -11,11 +11,11 @@ import Database.Persist (entityVal, insert) import Job (jobListener) import Model.Database -import Model.Payment (getMonthlyPayments) +import qualified Model.Payment as Payment import Model.JobKind import Model.Frequency -import Utils.Time (belongToCurrentMonth) +import Utils.Time (belongToCurrentMonth, timeToDay) monthlyPaymentJobListener :: IO () monthlyPaymentJobListener = @@ -26,7 +26,8 @@ monthlyPaymentJobListener = monthlyPaymentJob :: Persist () monthlyPaymentJob = do - monthlyPayments <- map entityVal <$> getMonthlyPayments + monthlyPayments <- map entityVal <$> Payment.listMonthly now <- liftIO $ getCurrentTime - let punctualPayments = map (\p -> p { paymentFrequency = Punctual, paymentCreation = now }) monthlyPayments + actualDay <- liftIO $ timeToDay now + let punctualPayments = map (\p -> p { paymentFrequency = Punctual, paymentDate = actualDay, paymentCreatedAt = now }) monthlyPayments sequence_ $ map insert punctualPayments diff --git a/src/server/Utils/Time.hs b/src/server/Utils/Time.hs index 0d6ed73..e8c7ac1 100644 --- a/src/server/Utils/Time.hs +++ b/src/server/Utils/Time.hs @@ -1,7 +1,6 @@ module Utils.Time ( belongToCurrentMonth - , getLocalDate - , Date(..) + , timeToDay ) where import Data.Time.Clock @@ -10,18 +9,16 @@ import Data.Time.Calendar belongToCurrentMonth :: UTCTime -> IO Bool belongToCurrentMonth time = do - timeMonth <- month <$> getLocalDate time - actualMonth <- month <$> (getCurrentTime >>= getLocalDate) + timeMonth <- dayMonth <$> timeToDay time + actualMonth <- dayMonth <$> (getCurrentTime >>= timeToDay) return (timeMonth == actualMonth) -getLocalDate :: UTCTime -> IO Date -getLocalDate time = do +timeToDay :: UTCTime -> IO Day +timeToDay time = do timeZone <- getCurrentTimeZone - let (y, m, d) = toGregorian . localDay $ utcToLocalTime timeZone time - return (Date y m d) + return . localDay $ utcToLocalTime timeZone time -data Date = Date - { year :: Integer - , month :: Int - , day :: Int - } +dayMonth :: Day -> Int +dayMonth day = + let (_, month, _) = toGregorian day + in month -- cgit v1.2.3