From bc81084933f8ec1bfe6c2834defd12243117fdd9 Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 5 Aug 2019 21:53:30 +0200
Subject: Use updated payment categories from payment add in payment’s table

---
 server/src/Controller/Payment.hs          |  6 ++--
 server/src/Persistence/PaymentCategory.hs | 48 ++++++++++++++++++++-----------
 2 files changed, 35 insertions(+), 19 deletions(-)

(limited to 'server/src')

diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index fb7fcb2..e82fd49 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -10,6 +10,7 @@ import qualified Network.HTTP.Types.Status   as Status
 import           Web.Scotty
 
 import           Common.Model                (CreatePayment (..),
+                                              CreatedPayment (..),
                                               EditPayment (..), PaymentId,
                                               User (..))
 import qualified Model.Query                 as Query
@@ -30,8 +31,9 @@ create createPayment@(CreatePayment name cost date category frequency) =
     case CreatePaymentValidation.validate createPayment of
       Nothing ->
         (liftIO . Query.run $ do
-          PaymentCategoryPersistence.save name category
-          PaymentPersistence.create (_user_id user) name cost date frequency
+          pc <- PaymentCategoryPersistence.save name category
+          p <- PaymentPersistence.create (_user_id user) name cost date frequency
+          return $ CreatedPayment p pc
         ) >>= json
       Just validationError ->
         do
diff --git a/server/src/Persistence/PaymentCategory.hs b/server/src/Persistence/PaymentCategory.hs
index 1e377b1..1cfd702 100644
--- a/server/src/Persistence/PaymentCategory.hs
+++ b/server/src/Persistence/PaymentCategory.hs
@@ -4,7 +4,7 @@ module Persistence.PaymentCategory
   , save
   ) where
 
-import           Data.Maybe             (isJust, listToMaybe)
+import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
 import qualified Data.Text              as T
 import           Data.Time.Clock        (getCurrentTime)
@@ -40,27 +40,41 @@ listByCategory cat =
       SQLite.query conn "SELECT * FROM payment_category WHERE category = ?" (Only cat)
   )
 
-save :: Text -> CategoryId -> Query ()
+save :: Text -> CategoryId -> Query PaymentCategory
 save newName categoryId =
   Query (\conn -> do
     now <- getCurrentTime
-    hasPaymentCategory <- isJust <$> listToMaybe <$>
+    paymentCategory <- fmap (\(Row pc) -> pc) . Maybe.listToMaybe <$>
       (SQLite.query
         conn
         "SELECT * FROM payment_category WHERE name = ?"
-        (Only (formatPaymentName newName)) :: IO [Row])
-    if hasPaymentCategory
-      then
-        SQLite.execute
-          conn
-          "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?"
-          (categoryId, now, formatPaymentName newName)
-      else do
-        SQLite.execute
-          conn
-          "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)"
-          (formatPaymentName newName, categoryId, now)
+        (Only formattedNewName))
+    case paymentCategory of
+      Just pc ->
+        do
+          SQLite.execute
+            conn
+            "UPDATE payment_category SET category = ?, edited_at = ? WHERE name = ?"
+            (categoryId, now, formattedNewName)
+          return $ PaymentCategory
+            (_paymentCategory_id pc)
+            formattedNewName
+            categoryId
+            (_paymentCategory_createdAt pc)
+            (Just now)
+      Nothing ->
+        do
+          SQLite.execute
+            conn
+            "INSERT INTO payment_category (name, category, created_at) VALUES (?, ?, ?)"
+            (formattedNewName, categoryId, now)
+          paymentCategoryId <- SQLite.lastInsertRowId conn
+          return $ PaymentCategory
+            paymentCategoryId
+            formattedNewName
+            categoryId
+            now
+            Nothing
   )
   where
-    formatPaymentName :: Text -> Text
-    formatPaymentName = T.unaccent . T.toLower
+    formattedNewName = T.unaccent . T.toLower $ newName
-- 
cgit v1.2.3