aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.md8
-rw-r--r--elm-package.json2
-rw-r--r--src/client/elm/Dialog/AddPaymentButton/View.elm16
-rw-r--r--src/client/elm/Dialog/Model.elm18
-rw-r--r--src/client/elm/LoggedIn/Home/Header/View.elm1
-rw-r--r--src/client/elm/LoggedIn/Home/View/Table.elm14
-rw-r--r--src/client/elm/LoggedIn/Income/View.elm2
-rw-r--r--src/client/elm/LoggedIn/Msg.elm11
-rw-r--r--src/client/elm/LoggedIn/Update.elm40
-rw-r--r--src/client/elm/Model/Payment.elm10
-rw-r--r--src/client/elm/Server.elm35
-rw-r--r--src/client/elm/Utils/Form.elm8
-rw-r--r--src/client/elm/Utils/Http.elm30
-rw-r--r--src/server/Controller/Payment.hs26
-rw-r--r--src/server/Design/Form.hs2
-rw-r--r--src/server/Design/LoggedIn/Home/Table.hs6
-rw-r--r--src/server/Main.hs2
-rw-r--r--src/server/Model/Database.hs5
-rw-r--r--src/server/Model/Json/CreatePayment.hs4
-rw-r--r--src/server/Model/Json/EditPayment.hs24
-rw-r--r--src/server/Model/Message/Key.hs2
-rw-r--r--src/server/Model/Message/Translations.hs10
-rw-r--r--src/server/Model/Payment.hs34
23 files changed, 217 insertions, 93 deletions
diff --git a/README.md b/README.md
index 7c78b0e..d54538e 100644
--- a/README.md
+++ b/README.md
@@ -19,3 +19,11 @@ npm install
elm package install
npm start
```
+
+## TODO
+
+- Tooltips on table icons
+- Server error message
+- Dates after today most be forbidden
+- Income CRUD
+- Responsive design
diff --git a/elm-package.json b/elm-package.json
index 060cc80..8e2a73d 100644
--- a/elm-package.json
+++ b/elm-package.json
@@ -12,7 +12,7 @@
"elm-lang/navigation": "1.0.0 <= v < 2.0.0",
"evancz/elm-http": "3.0.1 <= v < 4.0.0",
"evancz/url-parser": "1.0.0 <= v < 2.0.0",
- "etaque/elm-simple-form": "3.0.0 <= v < 4.0.0",
+ "etaque/elm-simple-form": "3.0.1 <= v < 4.0.0",
"rluiten/elm-date-extra": "6.0.1 <= v < 7.0.0",
"jystic/elm-font-awesome": "2.0.0 <= v < 3.0.0"
}
diff --git a/src/client/elm/Dialog/AddPaymentButton/View.elm b/src/client/elm/Dialog/AddPaymentButton/View.elm
index 8014571..5da380c 100644
--- a/src/client/elm/Dialog/AddPaymentButton/View.elm
+++ b/src/client/elm/Dialog/AddPaymentButton/View.elm
@@ -31,11 +31,11 @@ import Dialog.Msg as DialogMsg
import LoggedData exposing (LoggedData)
import LoggedIn.Home.Model as HomeModel
-view : LoggedData -> List (String, Field) -> Html Msg -> Html Msg
-view loggedData initialForm content =
+view : LoggedData -> List (String, Field) -> String -> Html Msg -> Html Msg
+view loggedData initialForm title buttonContent =
let dialogConfig =
{ className = "paymentDialog"
- , title = getMessage "AddPayment" loggedData.translations
+ , title = getMessage title loggedData.translations
, body = \model -> addPaymentForm loggedData model.addPayment
, confirm = getMessage "Confirm" loggedData.translations
, confirmMsg = submitForm << .addPayment
@@ -45,7 +45,7 @@ view loggedData initialForm content =
[ class "addPayment"
, onClick (Msg.Dialog <| Dialog.OpenWithUpdate dialogConfig (DialogMsg.AddPaymentMsg <| Form.Reset initialForm))
]
- [ content ]
+ [ buttonContent ]
addPaymentForm : LoggedData -> Form String DialogModel.AddPayment -> Html Msg
addPaymentForm loggedData addPayment =
@@ -56,7 +56,7 @@ addPaymentForm loggedData addPayment =
]
[ htmlMap <| Form.textInput loggedData.translations addPayment "payment" "name"
, htmlMap <| Form.textInput loggedData.translations addPayment "payment" "cost"
- , if Form.frequency addPayment == Punctual
+ , if (Maybe.map .frequency <| Form.getOutput addPayment) == Just Punctual
then htmlMap <| Form.textInput loggedData.translations addPayment "payment" "date"
else text ""
, htmlMap <| Form.radioInputs loggedData.translations addPayment "payment" "frequency" [ toString Punctual, toString Monthly ]
@@ -67,6 +67,10 @@ submitForm : Form String DialogModel.AddPayment -> Msg
submitForm addPayment =
case Form.getOutput addPayment of
Just data ->
- Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.AddPayment data.name data.cost data.date data.frequency
+ case data.id of
+ Just paymentId ->
+ Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.EditPayment paymentId data.name data.cost data.date data.frequency
+ Nothing ->
+ Msg.Dialog <| Dialog.UpdateAndClose <| Msg.UpdateLoggedIn <| LoggedInMsg.CreatePayment data.name data.cost data.date data.frequency
Nothing ->
Msg.Dialog <| Dialog.Update <| DialogMsg.AddPaymentMsg <| Form.Submit
diff --git a/src/client/elm/Dialog/Model.elm b/src/client/elm/Dialog/Model.elm
index 6256fea..b49d8f1 100644
--- a/src/client/elm/Dialog/Model.elm
+++ b/src/client/elm/Dialog/Model.elm
@@ -4,6 +4,7 @@ module Dialog.Model exposing
, init
, addPaymentInitial
, clonePaymentInitial
+ , editPaymentInitial
)
import Date exposing (Date)
@@ -14,7 +15,7 @@ import Form.Field as Field exposing (Field)
import Form.Validate as Validate exposing (Validation)
import Validation
-import Model.Payment as Payment exposing (Payment, Frequency)
+import Model.Payment as Payment exposing (Payment, Frequency, PaymentId)
import Model.Translations exposing (Translations)
type alias Model =
@@ -22,7 +23,8 @@ type alias Model =
}
type alias AddPayment =
- { name : String
+ { id : Maybe PaymentId
+ , name : String
, cost : Int
, date : Date
, frequency : Frequency
@@ -47,9 +49,19 @@ clonePaymentInitial translations date payment =
, ("frequency", Field.Radio (toString payment.frequency))
]
+editPaymentInitial : Translations -> Payment -> List (String, Field)
+editPaymentInitial translations payment =
+ [ ("id", Field.Text (toString payment.id))
+ , ("name", Field.Text payment.name)
+ , ("cost", Field.Text (toString payment.cost))
+ , ("date", Field.Text (Date.shortView payment.date translations))
+ , ("frequency", Field.Radio (toString payment.frequency))
+ ]
+
addPaymentValidation : Validation String AddPayment
addPaymentValidation =
- Validate.form4 AddPayment
+ Validate.form5 AddPayment
+ (Validate.get "id" (Validate.maybe Validate.int))
(Validate.get "name" (Validate.string `Validate.andThen` (Validate.nonEmpty)))
(Validate.get "cost" (Validate.int `Validate.andThen` (Validate.minInt 1)))
(Validate.get "date" Validation.date)
diff --git a/src/client/elm/LoggedIn/Home/Header/View.elm b/src/client/elm/LoggedIn/Home/Header/View.elm
index 753a120..b23e6fe 100644
--- a/src/client/elm/LoggedIn/Home/Header/View.elm
+++ b/src/client/elm/LoggedIn/Home/Header/View.elm
@@ -52,6 +52,7 @@ searchLine loggedData search frequency =
, AddPaymentButton.view
loggedData
(DialogModel.addPaymentInitial loggedData.translations currentDate frequency)
+ "AddPayment"
(text (getMessage "AddPayment" loggedData.translations))
]
diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm
index d2087bb..ebffeb9 100644
--- a/src/client/elm/LoggedIn/Home/View/Table.elm
+++ b/src/client/elm/LoggedIn/Home/View/Table.elm
@@ -64,6 +64,7 @@ headerLine loggedData frequency =
Monthly -> text ""
, div [ class "cell" ] []
, div [ class "cell" ] []
+ , div [ class "cell" ] []
]
paymentLine : LoggedData -> HomeModel.Model -> Frequency -> Payment -> Html Msg
@@ -104,6 +105,7 @@ paymentLine loggedData homeModel frequency payment =
in AddPaymentButton.view
loggedData
(DialogModel.clonePaymentInitial loggedData.translations currentDate payment)
+ "ClonePayment"
(FontAwesome.clone Color.chestnutRose 18)
]
, div
@@ -112,6 +114,18 @@ paymentLine loggedData homeModel frequency payment =
then
text ""
else
+ AddPaymentButton.view
+ loggedData
+ (DialogModel.editPaymentInitial loggedData.translations payment)
+ "EditPayment"
+ (FontAwesome.edit Color.chestnutRose 18)
+ ]
+ , div
+ [ class "cell button" ]
+ [ if loggedData.me /= payment.userId
+ then
+ text ""
+ else
let dialogConfig =
{ className = "paymentDialog"
, title = getMessage "ConfirmPaymentDelete" loggedData.translations
diff --git a/src/client/elm/LoggedIn/Income/View.elm b/src/client/elm/LoggedIn/Income/View.elm
index 6466f70..9638ddc 100644
--- a/src/client/elm/LoggedIn/Income/View.elm
+++ b/src/client/elm/LoggedIn/Income/View.elm
@@ -86,7 +86,7 @@ addIncomeView loggedData addIncome =
[ class "add"
, case Form.getOutput addIncome of
Just data ->
- onClick (Msg.UpdateLoggedIn <| LoggedInMsg.AddIncome data.amount data.date)
+ onClick (Msg.UpdateLoggedIn <| LoggedInMsg.CreateIncome data.amount data.date)
Nothing ->
onClick (Msg.UpdateLoggedIn <| LoggedInMsg.IncomeMsg <| IncomeMsg.AddIncomeMsg <| Form.Submit)
]
diff --git a/src/client/elm/LoggedIn/Msg.elm b/src/client/elm/LoggedIn/Msg.elm
index cbae67f..77fb0ed 100644
--- a/src/client/elm/LoggedIn/Msg.elm
+++ b/src/client/elm/LoggedIn/Msg.elm
@@ -15,14 +15,17 @@ type Msg =
| HomeMsg HomeMsg.Msg
| IncomeMsg IncomeMsg.Msg
- | AddPayment String Int Date Frequency
- | ValidateAddPayment PaymentId String Int Date Frequency
+ | CreatePayment String Int Date Frequency
+ | ValidateCreatePayment PaymentId String Int Date Frequency
+
+ | EditPayment PaymentId String Int Date Frequency
+ | ValidateEditPayment PaymentId String Int Date Frequency
| DeletePayment PaymentId
| ValidateDeletePayment PaymentId
- | AddIncome Int Date
- | ValidateAddIncome IncomeId Int Date
+ | CreateIncome Int Date
+ | ValidateCreateIncome IncomeId Int Date
| DeleteIncome IncomeId
| ValidateDeleteIncome IncomeId
diff --git a/src/client/elm/LoggedIn/Update.elm b/src/client/elm/LoggedIn/Update.elm
index 1f09271..db851f1 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 as Payment exposing (Payment, Frequency(..), deletePayment)
+import Model.Payment as Payment exposing (Payment, Frequency(..))
import Server
import LoggedData
@@ -58,23 +58,16 @@ update model msg loggedIn =
, Cmd.map LoggedInMsg.IncomeMsg cmd
)
- LoggedInMsg.AddPayment name cost date frequency ->
+ LoggedInMsg.CreatePayment name cost date frequency ->
( loggedIn
, Server.createPayment name cost date frequency
|> Task.perform
- (\err ->
- case err of
- BadResponse 400 jsonErr ->
- LoggedInMsg.NoOp
- _ ->
- LoggedInMsg.NoOp
- )
- (\paymentId -> LoggedInMsg.ValidateAddPayment paymentId name cost date frequency)
+ (always LoggedInMsg.NoOp)
+ (\paymentId -> LoggedInMsg.ValidateCreatePayment paymentId name cost date frequency)
)
- LoggedInMsg.ValidateAddPayment paymentId name cost date frequency ->
+ LoggedInMsg.ValidateCreatePayment 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 name cost date loggedIn.me frequency
@@ -83,6 +76,20 @@ update model msg loggedIn =
)
)
+ LoggedInMsg.EditPayment paymentId name cost date frequency ->
+ ( loggedIn
+ , Server.editPayment paymentId name cost date frequency
+ |> Task.perform
+ (always LoggedInMsg.NoOp)
+ (always <| LoggedInMsg.ValidateEditPayment paymentId name cost date frequency)
+ )
+
+ LoggedInMsg.ValidateEditPayment paymentId name cost date frequency ->
+ let updatedPayment = Payment paymentId name cost date loggedIn.me frequency
+ in ( { loggedIn | payments = Payment.edit updatedPayment loggedIn.payments }
+ , Cmd.none
+ )
+
LoggedInMsg.DeletePayment paymentId ->
( loggedIn
, Server.deletePayment paymentId
@@ -92,7 +99,7 @@ update model msg loggedIn =
)
LoggedInMsg.ValidateDeletePayment paymentId ->
- let payments = deletePayment paymentId loggedIn.payments
+ let payments = Payment.delete paymentId loggedIn.payments
frequency =
case Form.getOutput loggedIn.home.search of
Just data -> data.frequency
@@ -104,7 +111,6 @@ update model msg loggedIn =
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
@@ -115,15 +121,15 @@ update model msg loggedIn =
, Cmd.none
)
- LoggedInMsg.AddIncome amount date ->
+ LoggedInMsg.CreateIncome amount date ->
( loggedIn
, Server.createIncome amount date
|> Task.perform
(always LoggedInMsg.NoOp)
- (\incomeId -> (LoggedInMsg.ValidateAddIncome incomeId amount date))
+ (\incomeId -> (LoggedInMsg.ValidateCreateIncome incomeId amount date))
)
- LoggedInMsg.ValidateAddIncome incomeId amount date ->
+ LoggedInMsg.ValidateCreateIncome incomeId amount date ->
let newIncome = { userId = loggedIn.me, amount = amount, time = Date.toTime date }
loggedInIncome = loggedIn.income
in ( { loggedIn
diff --git a/src/client/elm/Model/Payment.elm b/src/client/elm/Model/Payment.elm
index 7e5b37d..b08166e 100644
--- a/src/client/elm/Model/Payment.elm
+++ b/src/client/elm/Model/Payment.elm
@@ -6,7 +6,8 @@ module Model.Payment exposing
, Frequency(..)
, paymentsDecoder
, paymentIdDecoder
- , deletePayment
+ , edit
+ , delete
, totalPayments
, punctual
, monthly
@@ -70,8 +71,11 @@ frequencyDecoder =
_ -> Err ("Could not deduce Punctual nor Monthly from " ++ input)
)
-deletePayment : PaymentId -> Payments -> Payments
-deletePayment paymentId = List.filter (((/=) paymentId) << .id)
+edit : Payment -> Payments -> Payments
+edit payment payments = payment :: delete payment.id payments
+
+delete : PaymentId -> Payments -> Payments
+delete paymentId = List.filter (((/=) paymentId) << .id)
totalPayments : (Payment -> Bool) -> UserId -> Payments -> Int
totalPayments paymentFilter userId payments =
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index 9522d17..fd32cec 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -1,6 +1,7 @@
module Server exposing
( signIn
, createPayment
+ , editPayment
, deletePayment
, createIncome
, deleteIncome
@@ -16,7 +17,7 @@ import Date exposing (Date)
import Date.Extra.Format as DateFormat
-import Utils.Http exposing (..)
+import Utils.Http as HttpUtils
import Model.Payment exposing (..)
import Model.Income exposing (incomesDecoder, incomeIdDecoder, IncomeId)
@@ -25,7 +26,7 @@ import Model.Init exposing (Init)
signIn : String -> Task Http.Error ()
signIn email =
- post ("/signIn?email=" ++ email)
+ HttpUtils.request "POST" ("/signIn?email=" ++ email)
|> Task.map (always ())
createPayment : String -> Int -> Date -> Frequency -> Task Http.Error PaymentId
@@ -36,14 +37,24 @@ createPayment name cost date frequency =
, ("date", Json.string (DateFormat.isoDateString date))
, ("frequency", Json.string (toString frequency))
]
- |> Json.encode 0
- |> Http.string
- |> postWithBody "/payment"
- |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
+ |> HttpUtils.jsonRequest "POST" "/payment"
+ |> flip Task.andThen (HttpUtils.decodeHttpValue <| "id" := paymentIdDecoder)
+
+editPayment : PaymentId -> String -> Int -> Date -> Frequency -> Task Http.Error ()
+editPayment paymentId name cost date frequency =
+ Json.object
+ [ ("id", Json.int paymentId)
+ , ("name", Json.string name)
+ , ("cost", Json.int cost)
+ , ("date", Json.string (DateFormat.isoDateString date))
+ , ("frequency", Json.string (toString frequency))
+ ]
+ |> HttpUtils.jsonRequest "PUT" "/payment"
+ |> Task.map (always ())
deletePayment : PaymentId -> Task Http.Error ()
deletePayment paymentId =
- delete ("/payment?id=" ++ (toString paymentId))
+ HttpUtils.request "DELETE" ("/payment?id=" ++ (toString paymentId))
|> Task.map (always ())
createIncome : Int -> Date -> Task Http.Error IncomeId
@@ -52,17 +63,15 @@ createIncome amount date =
[ ("amount", Json.int amount)
, ("date", Json.string (DateFormat.isoDateString date))
]
- |> Json.encode 0
- |> Http.string
- |> postWithBody "/income"
- |> flip Task.andThen (decodeHttpValue <| "id" := incomeIdDecoder)
+ |> HttpUtils.jsonRequest "POST" "/income"
+ |> flip Task.andThen (HttpUtils.decodeHttpValue <| "id" := incomeIdDecoder)
deleteIncome : IncomeId -> Task Http.Error ()
deleteIncome incomeId =
- delete ("/income?id=" ++ (toString incomeId))
+ HttpUtils.request "DELETE" ("/income?id=" ++ (toString incomeId))
|> Task.map (always ())
signOut : Task Http.Error ()
signOut =
- post "/signOut"
+ HttpUtils.request "POST" "/signOut"
|> Task.map (always ())
diff --git a/src/client/elm/Utils/Form.elm b/src/client/elm/Utils/Form.elm
index 482db5f..8d75a32 100644
--- a/src/client/elm/Utils/Form.elm
+++ b/src/client/elm/Utils/Form.elm
@@ -1,6 +1,5 @@
module Utils.Form exposing
( fieldAsText
- , frequency
)
import Form exposing (Form)
@@ -12,10 +11,3 @@ 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/Utils/Http.elm b/src/client/elm/Utils/Http.elm
index 9bcfad7..4edc233 100644
--- a/src/client/elm/Utils/Http.elm
+++ b/src/client/elm/Utils/Http.elm
@@ -1,26 +1,28 @@
module Utils.Http exposing
- ( post
- , postWithBody
- , delete
+ ( jsonRequest
+ , request
+ , requestWithBody
, decodeHttpValue
, errorKey
)
import Http exposing (..)
import Task exposing (..)
-import Json.Decode as Json exposing (Decoder)
+import Json.Decode as JsonDecode exposing (Decoder)
+import Json.Encode as JsonEncode
-post : String -> Task Error Value
-post url = postWithBody url empty
+jsonRequest : String -> String -> JsonEncode.Value -> Task Error Value
+jsonRequest method url json =
+ json
+ |> JsonEncode.encode 0
+ |> Http.string
+ |> requestWithBody method url
-postWithBody : String -> Body -> Task Error Value
-postWithBody = request "POST"
+request : String -> String -> Task Error Value
+request method url = requestWithBody method url empty
-delete : String -> Task Error Value
-delete url = request "DELETE" url empty
-
-request : String -> String -> Body -> Task Error Value
-request method url body =
+requestWithBody : String -> String -> Body -> Task Error Value
+requestWithBody method url body =
{ verb = method
, headers = []
, url = url
@@ -52,7 +54,7 @@ decodeHttpValue : Decoder a -> Value -> Task Error a
decodeHttpValue decoder value =
case value of
Text str ->
- case Json.decodeString decoder str of
+ case JsonDecode.decodeString decoder str of
Ok v -> succeed v
Err msg -> fail (UnexpectedPayload msg)
_ ->
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 55edea5..96ac469 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -3,6 +3,7 @@
module Controller.Payment
( list
, create
+ , editOwn
, deleteOwn
) where
@@ -15,7 +16,6 @@ import Database.Persist
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
-import qualified Data.Text.Lazy as TL
import qualified Secure
@@ -23,8 +23,8 @@ import Json (jsonId)
import Model.Database
import qualified Model.Payment as Payment
-import Model.Message.Key (Key(PaymentNotDeleted))
import qualified Model.Json.CreatePayment as Json
+import qualified Model.Json.EditPayment as Json
list :: ActionM ()
list =
@@ -33,19 +33,25 @@ list =
)
create :: Json.CreatePayment -> ActionM ()
-create (Json.CreatePayment date name cost frequency) =
+create (Json.CreatePayment name cost date frequency) =
Secure.loggedAction (\user ->
- (liftIO . runDb $ Payment.create (entityKey user) date name cost frequency) >>= jsonId
+ (liftIO . runDb $ Payment.create (entityKey user) name cost date frequency) >>= jsonId
+ )
+
+editOwn :: Json.EditPayment -> ActionM ()
+editOwn (Json.EditPayment paymentId name cost date frequency) =
+ Secure.loggedAction (\user -> do
+ updated <- liftIO . runDb $ Payment.editOwn (entityKey user) paymentId name cost date frequency
+ if updated
+ then status ok200
+ else status badRequest400
)
deleteOwn :: Text -> ActionM ()
deleteOwn paymentId =
Secure.loggedAction (\user -> do
- deleted <- liftIO . runDb $ Payment.deleteOwn user (textToKey paymentId)
+ deleted <- liftIO . runDb $ Payment.deleteOwn (entityKey user) (textToKey paymentId)
if deleted
- then
- status ok200
- else do
- status badRequest400
- text . TL.pack . show $ PaymentNotDeleted
+ then status ok200
+ else status badRequest400
)
diff --git a/src/server/Design/Form.hs b/src/server/Design/Form.hs
index 612759b..caee8ff 100644
--- a/src/server/Design/Form.hs
+++ b/src/server/Design/Form.hs
@@ -51,6 +51,8 @@ design = do
right (px 0)
top (px 27)
zIndex inputZIndex
+ hover & "svg path" ? do
+ "fill" -: "rgb(220, 220, 220)"
(input # ".filled" |+ label) <> (input # focus |+ label) ? do
top (px 0)
diff --git a/src/server/Design/LoggedIn/Home/Table.hs b/src/server/Design/LoggedIn/Home/Table.hs
index 23b924f..3f55207 100644
--- a/src/server/Design/LoggedIn/Home/Table.hs
+++ b/src/server/Design/LoggedIn/Home/Table.hs
@@ -45,9 +45,9 @@ design = do
display tableCell
position relative
verticalAlign middle
- ".category" & width (pct 37)
+ ".category" & width (pct 36)
".cost" & do
- width (pct 17)
+ width (pct 15)
".refund" & color Color.mossGreen
".user" & width (pct 20)
".date" & do
@@ -63,4 +63,4 @@ design = do
width (pct 3)
textAlign (alignSide sideCenter)
button # hover ? "svg path" ? do
- "fill" -: "rgb(227, 112, 106)"
+ "fill" -: "rgb(237, 122, 116)"
diff --git a/src/server/Main.hs b/src/server/Main.hs
index 72e8675..19d78b3 100644
--- a/src/server/Main.hs
+++ b/src/server/Main.hs
@@ -54,6 +54,8 @@ main = do
post "/payment" $ jsonData >>= Payment.create
+ put "/payment" $ jsonData >>= Payment.editOwn
+
delete "/payment" $ do
paymentId <- param "id" :: ActionM Text
Payment.deleteOwn paymentId
diff --git a/src/server/Model/Database.hs b/src/server/Model/Database.hs
index 7e67f9a..4526fc5 100644
--- a/src/server/Model/Database.hs
+++ b/src/server/Model/Database.hs
@@ -35,12 +35,13 @@ User
deriving Show
Payment
userId UserId
- date Day
name Text
cost Int
+ date Day
+ frequency Frequency
createdAt UTCTime
+ editedAt UTCTime Maybe
deletedAt UTCTime Maybe
- frequency Frequency
deriving Show
SignIn
token Text
diff --git a/src/server/Model/Json/CreatePayment.hs b/src/server/Model/Json/CreatePayment.hs
index f117daf..4ba9e1a 100644
--- a/src/server/Model/Json/CreatePayment.hs
+++ b/src/server/Model/Json/CreatePayment.hs
@@ -13,9 +13,9 @@ import Data.Text (Text)
import Model.Frequency (Frequency)
data CreatePayment = CreatePayment
- { date :: Day
- , name :: Text
+ { name :: Text
, cost :: Int
+ , date :: Day
, frequency :: Frequency
} deriving (Show, Generic)
diff --git a/src/server/Model/Json/EditPayment.hs b/src/server/Model/Json/EditPayment.hs
new file mode 100644
index 0000000..4e91000
--- /dev/null
+++ b/src/server/Model/Json/EditPayment.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.EditPayment
+ ( EditPayment(..)
+ ) where
+
+import GHC.Generics
+
+import Data.Aeson
+import Data.Time.Calendar (Day)
+import Data.Text (Text)
+
+import Model.Frequency (Frequency)
+import Model.Database (PaymentId)
+
+data EditPayment = EditPayment
+ { id :: PaymentId
+ , name :: Text
+ , cost :: Int
+ , date :: Day
+ , frequency :: Frequency
+ } deriving (Show, Generic)
+
+instance FromJSON EditPayment
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 84ff486..b60067c 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -63,6 +63,8 @@ data Key =
| Frequency
| InvalidFrequency
| AddPayment
+ | ClonePayment
+ | EditPayment
| PaymentNotDeleted
| Punctual
| Monthly
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index a29b84e..3c92601 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -245,6 +245,16 @@ m l AddPayment =
English -> "Add a payment"
French -> "Ajouter un paiement"
+m l ClonePayment =
+ case l of
+ English -> "Clone a payment"
+ French -> "Cloner un paiement"
+
+m l EditPayment =
+ case l of
+ English -> "Edit a payment"
+ French -> "Modifier un paiement"
+
m l PaymentNotDeleted =
case l of
English -> "The payment could not have been deleted."
diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs
index 51ca152..0d5e188 100644
--- a/src/server/Model/Payment.hs
+++ b/src/server/Model/Payment.hs
@@ -4,6 +4,7 @@ module Model.Payment
( list
, listMonthly
, create
+ , editOwn
, deleteOwn
) where
@@ -45,17 +46,38 @@ getJsonPayment paymentEntity =
, P.frequency = paymentFrequency payment
}
-create :: UserId -> Day -> Text -> Int -> Frequency -> Persist PaymentId
-create userId date name cost frequency = do
+create :: UserId -> Text -> Int -> Day -> Frequency -> Persist PaymentId
+create userId name cost date frequency = do
now <- liftIO getCurrentTime
- insert (Payment userId date name cost now Nothing frequency)
+ insert (Payment userId name cost date frequency now Nothing Nothing)
-deleteOwn :: Entity User -> PaymentId -> Persist Bool
-deleteOwn user paymentId = do
+editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Persist Bool
+editOwn userId paymentId name cost date frequency = do
mbPayment <- get paymentId
case mbPayment of
Just payment ->
- if paymentUserId payment == entityKey user
+ if paymentUserId payment == userId
+ then do
+ now <- liftIO getCurrentTime
+ update paymentId
+ [ PaymentEditedAt =. Just now
+ , PaymentName =. name
+ , PaymentCost =. cost
+ , PaymentDate =. date
+ , PaymentFrequency =. frequency
+ ]
+ return True
+ else
+ return False
+ Nothing ->
+ return False
+
+deleteOwn :: UserId -> PaymentId -> Persist Bool
+deleteOwn userId paymentId = do
+ mbPayment <- get paymentId
+ case mbPayment of
+ Just payment ->
+ if paymentUserId payment == userId
then do
now <- liftIO getCurrentTime
update paymentId [PaymentDeletedAt =. Just now]