Fix update payment category constraint error

2 files changed, 21 insertions, 37 deletions

diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index e3f1082..831abbf 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -7,25 +7,20 @@ module Controller.Payment
   , deleteOwn
   ) where
 
-import Web.Scotty
-
-import Network.HTTP.Types.Status (ok200, badRequest400)
-
-import Database.Persist
-
 import Control.Monad.IO.Class (liftIO)
 
 import Data.Text (Text)
-
-import qualified Secure
+import Database.Persist
+import Network.HTTP.Types.Status (ok200, badRequest400)
+import Web.Scotty
 
 import Json (jsonId)
-
 import Model.Database
-import qualified Model.Payment as Payment
-import qualified Model.PaymentCategory as PaymentCategory
 import qualified Model.Json.CreatePayment as Json
 import qualified Model.Json.EditPayment as Json
+import qualified Model.Payment as Payment
+import qualified Model.PaymentCategory as PaymentCategory
+import qualified Secure
 
 list :: ActionM ()
 list =
@@ -37,7 +32,7 @@ create :: Json.CreatePayment -> ActionM ()
 create (Json.CreatePayment name cost date category frequency) =
   Secure.loggedAction (\user ->
     (liftIO . runDb $ do
-      PaymentCategory.set name category
+      PaymentCategory.save name category
       Payment.create (entityKey user) name cost date frequency
     ) >>= jsonId
   )
@@ -46,15 +41,11 @@ editOwn :: Json.EditPayment -> ActionM ()
 editOwn (Json.EditPayment paymentId name cost date category frequency) =
   Secure.loggedAction (\user -> do
     updated <- liftIO . runDb $ do
-      mbPayment <- fmap entityVal <$> Payment.find paymentId
-      case mbPayment of
-        Just payment -> do
-          edited <- Payment.editOwn (entityKey user) paymentId name cost date frequency
-          if edited
-            then PaymentCategory.edit (paymentName payment) name category >> return True
-            else return edited
-        _ ->
-          return False
+      edited <- Payment.editOwn (entityKey user) paymentId name cost date frequency
+      _ <- if edited
+        then PaymentCategory.save name category >> return ()
+        else return ()
+      return edited
     if updated
       then status ok200
       else status badRequest400
diff --git a/src/server/Model/PaymentCategory.hs b/src/server/Model/PaymentCategory.hs
index 6df77e2..3b0b858 100644
--- a/src/server/Model/PaymentCategory.hs
+++ b/src/server/Model/PaymentCategory.hs
@@ -3,19 +3,16 @@
 module Model.PaymentCategory
   ( list
   , listByCategory
-  , set
-  , edit
-  , delete
+  , save
   ) where
 
+import Control.Monad.IO.Class (liftIO)
 import Data.Maybe (isJust)
+
 import Data.Text (Text)
 import Data.Time.Clock (getCurrentTime)
-import qualified Data.Text as T
-
-import Control.Monad.IO.Class (liftIO)
-
 import Database.Persist
+import qualified Data.Text as T
 
 import Model.Database
 import qualified Model.Json.PaymentCategory as Json
@@ -32,19 +29,15 @@ getJsonPaymentCategory entity =
   Json.PaymentCategory (paymentCategoryName pc) (paymentCategoryCategory pc)
   where pc = entityVal entity
 
-set :: Text -> CategoryId -> Persist ()
-set name category = edit name name category
-
-edit :: Text -> Text -> CategoryId -> Persist ()
-edit oldName newName category = do
+save :: Text -> CategoryId -> Persist ()
+save newName category = do
   now <- liftIO getCurrentTime
-  mbPaymentCategory <- selectFirst [PaymentCategoryName ==. (formatPaymentName oldName)] []
+  mbPaymentCategory <- selectFirst [PaymentCategoryName ==. (formatPaymentName newName)] []
   if isJust mbPaymentCategory
     then
       updateWhere
-        [ PaymentCategoryName ==. (formatPaymentName oldName) ]
-        [ PaymentCategoryName =. (formatPaymentName newName)
-        , PaymentCategoryCategory =. category
+        [ PaymentCategoryName ==. (formatPaymentName newName) ]
+        [ PaymentCategoryCategory =. category
         , PaymentCategoryEditedAt =. Just now
         ]
     else do