diff options
23 files changed, 217 insertions, 93 deletions
@@ -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] |