aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoris2016-06-26 12:31:24 +0200
committerJoris2016-06-26 12:31:24 +0200
commit9ec84e3a20c767f6525639f58cd22715e302b88d (patch)
treea080552859180707472c1a289080857c0a54fc06
parent5cb36652ccf07c9e0995ebc421a837ad7d258469 (diff)
downloadbudget-9ec84e3a20c767f6525639f58cd22715e302b88d.tar.gz
budget-9ec84e3a20c767f6525639f58cd22715e302b88d.tar.bz2
budget-9ec84e3a20c767f6525639f58cd22715e302b88d.zip
Add an editable date field for punctual payment creation
-rw-r--r--src/client/elm/Dialog/AddPayment/View.elm10
-rw-r--r--src/client/elm/Dialog/Model.elm16
-rw-r--r--src/client/elm/LoggedIn/Home/View/Table.elm6
-rw-r--r--src/client/elm/LoggedIn/Income/Model.elm25
-rw-r--r--src/client/elm/LoggedIn/Income/View.elm13
-rw-r--r--src/client/elm/LoggedIn/Msg.elm10
-rw-r--r--src/client/elm/LoggedIn/Stat/View.elm4
-rw-r--r--src/client/elm/LoggedIn/Update.elm20
-rw-r--r--src/client/elm/Model/Income.elm2
-rw-r--r--src/client/elm/Model/Payer.elm6
-rw-r--r--src/client/elm/Model/Payment.elm8
-rw-r--r--src/client/elm/Server.elm28
-rw-r--r--src/client/elm/Utils/Form.elm10
-rw-r--r--src/client/elm/Validation.elm22
-rw-r--r--src/client/elm/View/Date.elm (renamed from src/client/elm/LoggedIn/View/Date.elm)20
-rw-r--r--src/server/Controller/Income.hs10
-rw-r--r--src/server/Controller/Payment.hs34
-rw-r--r--src/server/Main.hs30
-rw-r--r--src/server/Model/Database.hs3
-rw-r--r--src/server/Model/Income.hs8
-rw-r--r--src/server/Model/Init.hs4
-rw-r--r--src/server/Model/Json/CreateIncome.hs (renamed from src/server/Model/Json/AddIncome.hs)10
-rw-r--r--src/server/Model/Json/CreatePayment.hs22
-rw-r--r--src/server/Model/Json/Income.hs2
-rw-r--r--src/server/Model/Json/Payment.hs4
-rw-r--r--src/server/Model/Message/Key.hs5
-rw-r--r--src/server/Model/Message/Translations.hs11
-rw-r--r--src/server/Model/Payment.hs31
-rw-r--r--src/server/MonthlyPaymentJob.hs9
-rw-r--r--src/server/Utils/Time.hs23
30 files changed, 228 insertions, 178 deletions
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/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/LoggedIn/View/Date.elm b/src/client/elm/View/Date.elm
index 8e4e872..21bbfc4 100644
--- a/src/client/elm/LoggedIn/View/Date.elm
+++ b/src/client/elm/View/Date.elm
@@ -1,7 +1,7 @@
-module LoggedIn.View.Date exposing
- ( renderShortDate
- , renderLongDate
- , renderMonth
+module View.Date exposing
+ ( shortView
+ , longView
+ , monthView
)
import Date exposing (..)
@@ -10,8 +10,8 @@ import String
import Model.Translations exposing (..)
-renderShortDate : Date -> Translations -> String
-renderShortDate date translations =
+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)))
@@ -19,8 +19,8 @@ renderShortDate date translations =
]
in getParamMessage params "ShortDate" translations
-renderLongDate : Date -> Translations -> String
-renderLongDate date translations =
+longView : Date -> Translations -> String
+longView date translations =
let params =
[ toString (Date.day date)
, (getMessage (getMonthKey (Date.month date)) translations)
@@ -28,8 +28,8 @@ renderLongDate date translations =
]
in getParamMessage params "LongDate" translations
-renderMonth : Translations -> Month -> String
-renderMonth translations month = getMessage (getMonthKey month) translations
+monthView : Translations -> Month -> String
+monthView translations month = getMessage (getMonthKey month) translations
getMonthKey : Month -> String
getMonthKey month =
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/CreateIncome.hs
index 6570ba9..cf9b1c3 100644
--- a/src/server/Model/Json/AddIncome.hs
+++ b/src/server/Model/Json/CreateIncome.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE DeriveGeneric #-}
-module Model.Json.AddIncome
- ( AddIncome(..)
+module Model.Json.CreateIncome
+ ( CreateIncome(..)
) where
import GHC.Generics
@@ -9,9 +9,9 @@ import GHC.Generics
import Data.Aeson
import Data.Time.Calendar (Day)
-data AddIncome = AddIncome
- { day :: Day
+data CreateIncome = CreateIncome
+ { date :: Day
, amount :: Int
} deriving (Show, Generic)
-instance FromJSON AddIncome
+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