From f605541cbaaa3c339eef8f345547bcd653d3f721 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 27 Jun 2016 14:36:03 +0200
Subject: Add the edit functionnality on payments

---
 src/server/Controller/Payment.hs         | 26 ++++++++++++++----------
 src/server/Design/Form.hs                |  2 ++
 src/server/Design/LoggedIn/Home/Table.hs |  6 +++---
 src/server/Main.hs                       |  2 ++
 src/server/Model/Database.hs             |  5 +++--
 src/server/Model/Json/CreatePayment.hs   |  4 ++--
 src/server/Model/Json/EditPayment.hs     | 24 ++++++++++++++++++++++
 src/server/Model/Message/Key.hs          |  2 ++
 src/server/Model/Message/Translations.hs | 10 ++++++++++
 src/server/Model/Payment.hs              | 34 ++++++++++++++++++++++++++------
 10 files changed, 92 insertions(+), 23 deletions(-)
 create mode 100644 src/server/Model/Json/EditPayment.hs

(limited to 'src/server')

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]
-- 
cgit v1.2.3