From fb8f0fe577e28dae69903413b761da50586e0099 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sat, 10 Aug 2019 14:53:41 +0200
Subject: Remove payment category if unused after a payment is deleted

---
 README.md                                 | 11 ++++---
 client/src/View/Payment.hs                | 49 +++++++++++++++++++++----------
 client/src/View/Payment/Add.hs            |  3 +-
 client/src/View/Payment/Delete.hs         | 35 +++++++++++-----------
 client/src/View/Payment/Table.hs          | 12 ++++----
 common/src/Common/Message/Key.hs          |  1 -
 common/src/Common/Message/Translation.hs  |  5 ----
 server/migrations/2.sql                   | 23 +++++++++++++++
 server/src/Controller/Income.hs           | 33 ++++++++-------------
 server/src/Controller/Payment.hs          | 37 ++++++++++++++---------
 server/src/Main.hs                        |  8 ++---
 server/src/Persistence/Income.hs          | 34 ++++++++-------------
 server/src/Persistence/Payment.hs         | 34 +++++++--------------
 server/src/Persistence/PaymentCategory.hs | 14 +++++++--
 14 files changed, 163 insertions(+), 136 deletions(-)
 create mode 100644 server/migrations/2.sql

diff --git a/README.md b/README.md
index 39dd428..dbffc41 100644
--- a/README.md
+++ b/README.md
@@ -60,10 +60,9 @@ See [application.conf](application.conf).
 
 ### Payment view
 
-- When removing / modifying a payment, remove the payment category if there is
-  no other payment with the same name
 - Check monthly payment UX
 - Edit a payment.
+- Possibly remove payment category after payment edit
 - Clone a payment.
 
 ### Income view
@@ -89,11 +88,15 @@ See [application.conf](application.conf).
 
 ### Code
 
+- Move the CSS out from the index page
 - Add tests about exceedingPayers
-- Move up element ids security (editOwn is actually at db level).
 - try DuplicateRecordFields (https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields)
 
+### DB
+
+- Add DB indexes
+
 ### Tooling
 
-- use Obelisk
+- deploy command
 - migration diff (use flyway?).
diff --git a/client/src/View/Payment.hs b/client/src/View/Payment.hs
index 915cc18..46ab642 100644
--- a/client/src/View/Payment.hs
+++ b/client/src/View/Payment.hs
@@ -45,18 +45,14 @@ widget paymentIn = do
       paymentCategories <- getPaymentCategories
         (_init_paymentCategories init)
         (_createdPayment_paymentCategory <$> _headerOut_addPayment header)
+        payments
+        (_tableOut_deletePayment table)
 
-      let searchPayments =
-            getSearchPayments
-              debouncedSearchName
-              (_headerOut_searchFrequency header)
-              payments
-
-      debouncedSearchNameEvt <-
-        R.debounce (0.5 :: NominalDiffTime) (R.updated $ _headerOut_searchName header)
+      (searchNameEvent, searchName) <-
+        debounceSearchName (_headerOut_searchName header)
 
-      debouncedSearchName <-
-        R.holdDyn "" debouncedSearchNameEvt
+      let searchPayments =
+            getSearchPayments searchName (_headerOut_searchFrequency header) payments
 
       header <- Header.widget $ HeaderIn
         { _headerIn_init = init
@@ -77,34 +73,57 @@ widget paymentIn = do
         { _pagesIn_total = length <$> searchPayments
         , _pagesIn_perPage = paymentsPerPage
         , _pagesIn_reset = R.leftmost $
-            [ const () <$> debouncedSearchNameEvt
+            [ const () <$> searchNameEvent
             , const () <$> _headerOut_addPayment header
             ]
         }
 
     pure $ PaymentOut {}
 
+debounceSearchName
+  :: forall t m. MonadWidget t m
+  => Dynamic t Text
+  -> m (Event t Text, Dynamic t Text)
+debounceSearchName searchName = do
+  event <- R.debounce (0.5 :: NominalDiffTime) (R.updated searchName)
+  dynamic <- R.holdDyn "" event
+  return (event, dynamic)
+
 getPayments
   :: forall t m. MonadWidget t m
   => [Payment]
   -> Event t Payment
-  -> Event t PaymentId
+  -> Event t Payment
   -> m (Dynamic t [Payment])
 getPayments initPayments addPayment deletePayment =
   R.foldDyn id initPayments $ R.leftmost
     [ (:) <$> addPayment
-    , flip fmap deletePayment (\paymentId -> filter ((/= paymentId) . _payment_id))
+    , R.ffor deletePayment (\p -> filter ((/= (_payment_id p)) . _payment_id))
     ]
 
 getPaymentCategories
   :: forall t m. MonadWidget t m
   => [PaymentCategory]
-  -> Event t PaymentCategory
+  -> Event t PaymentCategory  -- add payment category
+  -> Dynamic t [Payment]      -- payments
+  -> Event t Payment          -- delete payment
   -> m (Dynamic t [PaymentCategory])
-getPaymentCategories initPaymentCategories addPaymentCategory =
+getPaymentCategories initPaymentCategories addPaymentCategory payments deletePayment =
   R.foldDyn id initPaymentCategories $ R.leftmost
     [ (:) <$> addPaymentCategory
+    , R.ffor deletePaymentName (\name -> filter ((/=) (T.toLower name) . _paymentCategory_name))
     ]
+  where
+    deletePaymentName =
+      R.attachWithMaybe
+        (\ps p ->
+          if any (\p2 -> _payment_id p2 /= _payment_id p && lowerName p2 == lowerName p) ps then
+            Nothing
+          else
+            Just (_payment_name p))
+        (R.current payments)
+        deletePayment
+    lowerName = T.toLower . _payment_name
 
 getSearchPayments
   :: forall t. Reflex t
diff --git a/client/src/View/Payment/Add.hs b/client/src/View/Payment/Add.hs
index e0772f7..bd10e5a 100644
--- a/client/src/View/Payment/Add.hs
+++ b/client/src/View/Payment/Add.hs
@@ -23,7 +23,6 @@ import           Common.Model              (Category (..), CategoryId,
                                             CreatedPayment (..), Frequency (..),
                                             Payment (..), PaymentCategory (..))
 import qualified Common.Msg                as Msg
-import qualified Common.Util.Text          as Text
 import qualified Common.Util.Time          as Time
 import qualified Common.Validation.Payment as PaymentValidation
 import           Component                 (ButtonIn (..), InputIn (..),
@@ -168,4 +167,4 @@ view addIn = do
 findCategory :: Text -> [PaymentCategory] -> Maybe CategoryId
 findCategory paymentName =
   fmap _paymentCategory_category
-    . L.find ((==) (Text.formatSearch paymentName) . _paymentCategory_name)
+    . L.find ((==) (T.toLower paymentName) . _paymentCategory_name)
diff --git a/client/src/View/Payment/Delete.hs b/client/src/View/Payment/Delete.hs
index 4aa10f3..65ce660 100644
--- a/client/src/View/Payment/Delete.hs
+++ b/client/src/View/Payment/Delete.hs
@@ -4,26 +4,26 @@ module View.Payment.Delete
   , DeleteOut(..)
   ) where
 
-import           Data.Text            (Text)
-import qualified Data.Text            as T
-import           Reflex.Dom           (Dynamic, Event, MonadWidget)
-import qualified Reflex.Dom           as R
-
-import           Common.Model.Payment (PaymentId)
-import qualified Common.Msg           as Msg
-import           Component            (ButtonIn (..), ButtonOut (..))
-import qualified Component            as Component
-import qualified Util.Ajax            as Ajax
-import qualified Util.Either          as EitherUtil
-import qualified Util.WaitFor         as WaitFor
+import           Data.Text    (Text)
+import qualified Data.Text    as T
+import           Reflex.Dom   (Dynamic, Event, MonadWidget)
+import qualified Reflex.Dom   as R
+
+import           Common.Model (Payment (..))
+import qualified Common.Msg   as Msg
+import           Component    (ButtonIn (..), ButtonOut (..))
+import qualified Component    as Component
+import qualified Util.Ajax    as Ajax
+import qualified Util.Either  as EitherUtil
+import qualified Util.WaitFor as WaitFor
 
 data DeleteIn t = DeleteIn
-  { _deleteIn_id :: Dynamic t PaymentId
+  { _deleteIn_payment :: Dynamic t Payment
   }
 
 data DeleteOut t = DeleteOut
   { _deleteOut_cancel   :: Event t ()
-  , _deleteOut_validate :: Event t PaymentId
+  , _deleteOut_validate :: Event t Payment
   }
 
 view :: forall t m. MonadWidget t m => (DeleteIn t) -> m (DeleteOut t)
@@ -47,8 +47,9 @@ view deleteIn =
               , _buttonIn_waiting = waiting
               })
 
-          let url = flip fmap (_deleteIn_id deleteIn) (\id ->
-                  T.concat ["/payment/", T.pack . show $ id]
+          let url =
+                R.ffor (_deleteIn_payment deleteIn) (\id ->
+                  T.concat ["/payment/", T.pack . show $ _payment_id id]
                 )
 
           (result, waiting) <- WaitFor.waitFor
@@ -59,5 +60,5 @@ view deleteIn =
 
       return DeleteOut
         { _deleteOut_cancel = cancel
-        , _deleteOut_validate = R.tag (R.current $ _deleteIn_id deleteIn) deletedPayment
+        , _deleteOut_validate = R.tag (R.current $ _deleteIn_payment deleteIn) deletedPayment
         }
diff --git a/client/src/View/Payment/Table.hs b/client/src/View/Payment/Table.hs
index cdc4bb3..b09f30f 100644
--- a/client/src/View/Payment/Table.hs
+++ b/client/src/View/Payment/Table.hs
@@ -13,11 +13,9 @@ import           Reflex.Dom          (Dynamic, Event, MonadWidget)
 import qualified Reflex.Dom          as R
 
 import           Common.Model        (Category (..), Init (..), Payment (..),
-                                      PaymentCategory (..), PaymentId,
-                                      User (..))
+                                      PaymentCategory (..), User (..))
 import qualified Common.Model        as CM
 import qualified Common.Msg          as Msg
-import qualified Common.Util.Text    as T
 import qualified Common.View.Format  as Format
 import           Component           (ButtonIn (..), ButtonOut (..),
                                       ModalIn (..), ModalOut (..))
@@ -37,7 +35,7 @@ data TableIn t = TableIn
   }
 
 data TableOut t = TableOut
-  { _tableOut_deletePayment :: Event t PaymentId
+  { _tableOut_deletePayment :: Event t Payment
   }
 
 widget :: forall t m. MonadWidget t m => TableIn t -> m (TableOut t)
@@ -84,7 +82,7 @@ paymentRow
   => Init
   -> Dynamic t [PaymentCategory]
   -> Dynamic t Payment
-  -> m (Event t PaymentId)
+  -> m (Event t Payment)
 paymentRow init paymentCategories payment =
   R.divClass "row" $ do
 
@@ -151,13 +149,13 @@ paymentRow init paymentCategories payment =
             [ _deleteOut_cancel . _modalOut_content $ modalOut
             , fmap (const ()) . _deleteOut_validate . _modalOut_content $ modalOut
             ]
-        , _modalIn_content = Delete.view (DeleteIn { _deleteIn_id = fmap _payment_id payment })
+        , _modalIn_content = Delete.view (DeleteIn { _deleteIn_payment = payment })
         }
     return (_deleteOut_validate . _modalOut_content $ modalOut)
 
 findCategory :: [Category] -> [PaymentCategory] -> Text -> Maybe Category
 findCategory categories paymentCategories paymentName = do
   paymentCategory <- L.find
-    ((== T.formatSearch paymentName) . _paymentCategory_name)
+    ((== T.toLower paymentName) . _paymentCategory_name)
     paymentCategories
   L.find ((== (_paymentCategory_category paymentCategory)) . _category_id) categories
diff --git a/common/src/Common/Message/Key.hs b/common/src/Common/Message/Key.hs
index 4acba93..e460d3e 100644
--- a/common/src/Common/Message/Key.hs
+++ b/common/src/Common/Message/Key.hs
@@ -64,7 +64,6 @@ data Key =
   | Income_Edit
   | Income_Empty
   | Income_MonthlyNet
-  | Income_NotDeleted
   | Income_Title
 
   | Month_January
diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs
index 4eb0523..6b9e7be 100644
--- a/common/src/Common/Message/Translation.hs
+++ b/common/src/Common/Message/Translation.hs
@@ -277,11 +277,6 @@ m l Income_MonthlyNet =
     English -> "Net monthly incomes"
     French  -> "Revenus mensuels nets"
 
-m l Income_NotDeleted =
-  case l of
-    English -> "The income could not have been deleted."
-    French  -> "Le revenu n’a pas pu être supprimé."
-
 m l Income_Title =
   case l of
     English -> "Income"
diff --git a/server/migrations/2.sql b/server/migrations/2.sql
new file mode 100644
index 0000000..1c829ec
--- /dev/null
+++ b/server/migrations/2.sql
@@ -0,0 +1,23 @@
+-- Add payment categories with accents from payment with accents
+
+INSERT INTO
+  payment_category (name, category, created_at)
+SELECT
+  DISTINCT lower(payment.name), payment_category.category, datetime('now')
+FROM
+  payment
+INNER JOIN
+  payment_category
+ON
+  replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(replace(lower(payment.name), 'é', 'e'), 'è', 'e'), 'à', 'a'), 'û', 'u'), 'â', 'a'), 'ê', 'e'), 'â', 'a'), 'î', 'i'), 'ï', 'i'), 'ô', 'o'), 'ë', 'e') = payment_category.name
+WHERE
+  payment.name
+IN
+  (SELECT DISTINCT payment.name FROM payment WHERE lower(payment.name) NOT IN (SELECT payment_category.name FROM payment_category) AND payment.deleted_at IS NULL);
+
+-- Remove unused payment categories
+
+DELETE FROM
+  payment_category
+WHERE
+  name NOT IN (SELECT DISTINCT lower(name) FROM payment);
diff --git a/server/src/Controller/Income.hs b/server/src/Controller/Income.hs
index 3f623e5..ed58ac8 100644
--- a/server/src/Controller/Income.hs
+++ b/server/src/Controller/Income.hs
@@ -1,17 +1,15 @@
 module Controller.Income
   ( create
-  , editOwn
-  , deleteOwn
+  , edit
+  , delete
   ) where
 
 import           Control.Monad.IO.Class    (liftIO)
-import qualified Data.Text.Lazy            as TL
-import           Network.HTTP.Types.Status (badRequest400, ok200)
-import           Web.Scotty
+import qualified Network.HTTP.Types.Status as Status
+import           Web.Scotty                hiding (delete)
 
 import           Common.Model              (CreateIncome (..), EditIncome (..),
                                             IncomeId, User (..))
-import qualified Common.Msg                as Msg
 
 import           Json                      (jsonId)
 import qualified Model.Query               as Query
@@ -24,23 +22,18 @@ create (CreateIncome date amount) =
     (liftIO . Query.run $ IncomePersistence.create (_user_id user) date amount) >>= jsonId
   )
 
-editOwn :: EditIncome -> ActionM ()
-editOwn (EditIncome incomeId date amount) =
+edit :: EditIncome -> ActionM ()
+edit (EditIncome incomeId date amount) =
   Secure.loggedAction (\user -> do
-    updated <- liftIO . Query.run $ IncomePersistence.editOwn (_user_id user) incomeId date amount
+    updated <- liftIO . Query.run $ IncomePersistence.edit (_user_id user) incomeId date amount
     if updated
-      then status ok200
-      else status badRequest400
+      then status Status.ok200
+      else status Status.badRequest400
   )
 
-deleteOwn :: IncomeId -> ActionM ()
-deleteOwn incomeId =
+delete :: IncomeId -> ActionM ()
+delete incomeId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ IncomePersistence.deleteOwn user incomeId
-    if deleted
-      then
-        status ok200
-      else do
-        status badRequest400
-        text . TL.fromStrict $ Msg.get Msg.Income_NotDeleted
+    _ <- liftIO . Query.run $ IncomePersistence.delete (_user_id user) incomeId
+    status Status.ok200
   )
diff --git a/server/src/Controller/Payment.hs b/server/src/Controller/Payment.hs
index e82fd49..3d857be 100644
--- a/server/src/Controller/Payment.hs
+++ b/server/src/Controller/Payment.hs
@@ -1,18 +1,18 @@
 module Controller.Payment
   ( list
   , create
-  , editOwn
-  , deleteOwn
+  , edit
+  , delete
   ) where
 
 import           Control.Monad.IO.Class      (liftIO)
 import qualified Network.HTTP.Types.Status   as Status
-import           Web.Scotty
+import           Web.Scotty                  hiding (delete)
 
 import           Common.Model                (CreatePayment (..),
                                               CreatedPayment (..),
-                                              EditPayment (..), PaymentId,
-                                              User (..))
+                                              EditPayment (..), Payment (..),
+                                              PaymentId, User (..))
 import qualified Model.Query                 as Query
 import qualified Persistence.Payment         as PaymentPersistence
 import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
@@ -41,11 +41,11 @@ create createPayment@(CreatePayment name cost date category frequency) =
           json validationError
   )
 
-editOwn :: EditPayment -> ActionM ()
-editOwn (EditPayment paymentId name cost date category frequency) =
+edit :: EditPayment -> ActionM ()
+edit (EditPayment paymentId name cost date category frequency) =
   Secure.loggedAction (\user -> do
     updated <- liftIO . Query.run $ do
-      edited <- PaymentPersistence.editOwn (_user_id user) paymentId name cost date frequency
+      edited <- PaymentPersistence.edit (_user_id user) paymentId name cost date frequency
       _ <- if edited
         then PaymentCategoryPersistence.save name category >> return ()
         else return ()
@@ -55,11 +55,20 @@ editOwn (EditPayment paymentId name cost date category frequency) =
       else status Status.badRequest400
   )
 
-deleteOwn :: PaymentId -> ActionM ()
-deleteOwn paymentId =
+delete :: PaymentId -> ActionM ()
+delete paymentId =
   Secure.loggedAction (\user -> do
-    deleted <- liftIO . Query.run $ PaymentPersistence.deleteOwn (_user_id user) paymentId
-    if deleted
-      then status Status.ok200
-      else status Status.badRequest400
+    deleted <- liftIO . Query.run $ do
+      payment <- PaymentPersistence.find paymentId
+      case payment of
+        Just p | _payment_user p == _user_id user -> do
+          PaymentPersistence.delete (_user_id user) paymentId
+          PaymentCategoryPersistence.deleteIfUnused (_payment_name p)
+          return True
+        _ ->
+          return False
+    if deleted then
+      status Status.ok200
+    else
+      status Status.badRequest400
   )
diff --git a/server/src/Main.hs b/server/src/Main.hs
index 745071c..0ccf5e2 100644
--- a/server/src/Main.hs
+++ b/server/src/Main.hs
@@ -35,21 +35,21 @@ main = do
       S.jsonData >>= Payment.create
 
     S.put "/payment" $
-      S.jsonData >>= Payment.editOwn
+      S.jsonData >>= Payment.edit
 
     S.delete "/payment/:id" $ do
       paymentId <- S.param "id"
-      Payment.deleteOwn paymentId
+      Payment.delete paymentId
 
     S.post "/income" $
       S.jsonData >>= Income.create
 
     S.put "/income" $
-      S.jsonData >>= Income.editOwn
+      S.jsonData >>= Income.edit
 
     S.delete "/income/:id" $ do
       incomeId <- S.param "id"
-      Income.deleteOwn incomeId
+      Income.delete incomeId
 
     S.post "/category" $
       S.jsonData >>= Category.create
diff --git a/server/src/Persistence/Income.hs b/server/src/Persistence/Income.hs
index a863f85..cee9892 100644
--- a/server/src/Persistence/Income.hs
+++ b/server/src/Persistence/Income.hs
@@ -1,8 +1,8 @@
 module Persistence.Income
   ( list
   , create
-  , editOwn
-  , deleteOwn
+  , edit
+  , delete
   ) where
 
 import           Data.Maybe             (listToMaybe)
@@ -12,7 +12,7 @@ import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
 import qualified Database.SQLite.Simple as SQLite
 import           Prelude                hiding (id)
 
-import           Common.Model           (Income (..), IncomeId, User (..),
+import           Common.Model           (Income (..), IncomeId, PaymentId,
                                          UserId)
 
 import           Model.Query            (Query (Query))
@@ -47,8 +47,8 @@ create incomeUserId incomeDate incomeAmount =
     SQLite.lastInsertRowId conn
   )
 
-editOwn :: UserId -> IncomeId -> Day -> Int -> Query Bool
-editOwn incomeUserId incomeId incomeDate incomeAmount =
+edit :: UserId -> IncomeId -> Day -> Int -> Query Bool
+edit incomeUserId incomeId incomeDate incomeAmount =
   Query (\conn -> do
     mbIncome <- fmap (\(Row i) -> i) . listToMaybe <$>
       SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
@@ -68,21 +68,11 @@ editOwn incomeUserId incomeId incomeDate incomeAmount =
         return False
   )
 
-deleteOwn :: User -> IncomeId -> Query Bool
-deleteOwn user incomeId =
-  Query (\conn -> do
-    mbIncome <-
-      fmap (\(Row i) -> i) . listToMaybe <$>
-        SQLite.query conn "SELECT * FROM income WHERE id = ?" (Only incomeId)
-    case mbIncome of
-      Just income ->
-        if _income_userId income == _user_id user
-          then do
-            now <- getCurrentTime
-            SQLite.execute conn "UPDATE income SET deleted_at = ? WHERE id = ?" (now, incomeId)
-            return True
-          else
-            return False
-      Nothing ->
-        return False
+delete :: UserId -> PaymentId -> Query ()
+delete userId paymentId =
+  Query (\conn ->
+    SQLite.execute
+      conn
+      "UPDATE income SET deleted_at = datetime('now') WHERE id = ? AND user_id = ?"
+      (paymentId, userId)
   )
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index 272cd39..3d8f129 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -6,8 +6,8 @@ module Persistence.Payment
   , listActiveMonthlyOrderedByName
   , create
   , createMany
-  , editOwn
-  , deleteOwn
+  , edit
+  , delete
   ) where
 
 import           Data.Maybe                     (listToMaybe)
@@ -129,8 +129,8 @@ createMany payments =
       (map InsertRow payments)
   )
 
-editOwn :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
-editOwn userId paymentId paymentName paymentCost paymentDate paymentFrequency =
+edit :: UserId -> PaymentId -> Text -> Int -> Day -> Frequency -> Query Bool
+edit userId paymentId paymentName paymentCost paymentDate paymentFrequency =
   Query (\conn -> do
     mbPayment <- fmap (\(Row p) -> p) . listToMaybe <$>
       SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
@@ -158,23 +158,11 @@ editOwn userId paymentId paymentName paymentCost paymentDate paymentFrequency =
         return False
   )
 
-deleteOwn :: UserId -> PaymentId -> Query Bool
-deleteOwn userId paymentId =
-  Query (\conn -> do
-    mbPayment <- listToMaybe <$>
-      SQLite.query conn "SELECT * FROM payment WHERE id = ?" (Only paymentId)
-    case mbPayment of
-      Just (Row payment) ->
-        if _payment_user payment == userId
-          then do
-            now <- getCurrentTime
-            SQLite.execute
-              conn
-              "UPDATE payment SET deleted_at = ? WHERE id = ?"
-              (now, paymentId)
-            return True
-          else
-            return False
-      Nothing ->
-        return False
+delete :: UserId -> PaymentId -> Query ()
+delete userId paymentId =
+  Query (\conn ->
+    SQLite.execute
+      conn
+      "UPDATE payment SET deleted_at = datetime('now') WHERE id = ? AND user_id = ?"
+      (paymentId, userId)
   )
diff --git a/server/src/Persistence/PaymentCategory.hs b/server/src/Persistence/PaymentCategory.hs
index 5fd035a..7dc363c 100644
--- a/server/src/Persistence/PaymentCategory.hs
+++ b/server/src/Persistence/PaymentCategory.hs
@@ -2,16 +2,17 @@ module Persistence.PaymentCategory
   ( list
   , listByCategory
   , save
+  , deleteIfUnused
   ) where
 
 import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
+import qualified Data.Text              as T
 import           Data.Time.Clock        (getCurrentTime)
 import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
 import qualified Database.SQLite.Simple as SQLite
 
 import           Common.Model           (CategoryId, PaymentCategory (..))
-import qualified Common.Util.Text       as T
 
 import           Model.Query            (Query (Query))
 
@@ -76,4 +77,13 @@ save newName categoryId =
             Nothing
   )
   where
-    formattedNewName = T.formatSearch newName
+    formattedNewName = T.toLower newName
+
+deleteIfUnused :: Text -> Query ()
+deleteIfUnused name =
+  Query (\conn ->
+    SQLite.execute
+      conn
+      "DELETE FROM payment_category WHERE name = lower(?) AND name IN (SELECT DISTINCT lower(name) FROM payment WHERE name = lower(?) AND deleted_at IS NOT NULL)"
+      (name, name)
+  ) >> return ()
-- 
cgit v1.2.3