Allow to remove only unused categories

2 files changed, 56 insertions, 22 deletions

diff --git a/server/src/Persistence/Category.hs b/server/src/Persistence/Category.hs
index 2934b28..b0a6fca 100644
--- a/server/src/Persistence/Category.hs
+++ b/server/src/Persistence/Category.hs
@@ -10,7 +10,7 @@ module Persistence.Category
 import qualified Data.Maybe             as Maybe
 import           Data.Text              (Text)
 import           Data.Time.Clock        (getCurrentTime)
-import           Database.SQLite.Simple (FromRow (fromRow), Only (Only))
+import           Database.SQLite.Simple (FromRow (fromRow), NamedParam ((:=)))
 import qualified Database.SQLite.Simple as SQLite
 import           Prelude                hiding (id)
 
@@ -46,10 +46,12 @@ list :: Int -> Int -> Query [Category]
 list page perPage =
   Query (\conn ->
     map (\(Row c) -> c) <$>
-      SQLite.query
+      SQLite.queryNamed
           conn
-          "SELECT * FROM category WHERE deleted_at IS NULL ORDER BY edited_at, created_at DESC LIMIT ? OFFSET ?"
-          (perPage, (page - 1) * perPage)
+          "SELECT * FROM category WHERE deleted_at IS NULL ORDER BY name LIMIT :limit OFFSET :offset"
+          [ ":limit" := perPage
+          , ":offset" := (page - 1) * perPage
+          ]
   )
 
 listAll :: Query [Category]
@@ -60,43 +62,61 @@ listAll =
   )
 
 create :: Text -> Text -> Query ()
-create categoryName categoryColor =
+create name color =
   Query (\conn -> do
-    now <- getCurrentTime
-    SQLite.execute
+    currentTime <- getCurrentTime
+    SQLite.executeNamed
       conn
-      "INSERT INTO category (name, color, created_at) VALUES (?, ?, ?)"
-      (categoryName, categoryColor, now)
+      "INSERT INTO category (name, color, created_at) VALUES (:name, :color, :created_at)"
+      [ ":name" := name
+      , ":color" := color
+      , ":created_at" := currentTime
+      ]
   )
 
 edit :: CategoryId -> Text -> Text -> Query Bool
-edit categoryId categoryName categoryColor =
+edit id name color =
   Query (\conn -> do
     mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
-      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
+      (SQLite.queryNamed conn "SELECT * FROM category WHERE id = :id" [ ":id" := id ])
     if Maybe.isJust mbCategory
       then do
-        now <- getCurrentTime
-        SQLite.execute
+        currentTime <- getCurrentTime
+        SQLite.executeNamed
           conn
-          "UPDATE category SET edited_at = ?, name = ?, color = ? WHERE id = ?"
-          (now, categoryName, categoryColor, categoryId)
+          "UPDATE category SET edited_at = :editedAt, name = :name, color = :color WHERE id = :id"
+          [ ":editedAt" := currentTime
+          , ":name" := name
+          , ":color" := color
+          , ":id" := id
+          ]
         return True
       else
         return False
   )
 
+data BoolRow = BoolRow Int
+
+instance FromRow BoolRow where
+  fromRow = BoolRow <$> SQLite.field
+
 delete :: CategoryId -> Query Bool
-delete categoryId =
+delete id =
   Query (\conn -> do
-    mbCategory <- fmap (\(Row c) -> c) . Maybe.listToMaybe <$>
-      (SQLite.query conn "SELECT * FROM category WHERE id = ?" (Only categoryId))
-    if Maybe.isJust mbCategory
+    mbPayment <- (fmap (\(BoolRow b) -> b) . Maybe.listToMaybe) <$>
+      (SQLite.queryNamed
+        conn
+        "SELECT true FROM payment WHERE category = :id AND deleted_at IS NULL"
+        [ ":id" := id ])
+    if Maybe.isNothing mbPayment
       then do
-        now <- getCurrentTime
-        SQLite.execute
+        currentTime <- getCurrentTime
+        SQLite.executeNamed
           conn
-          "UPDATE category SET deleted_at = ? WHERE id = ?" (now, categoryId)
+          "UPDATE category SET deleted_at = :deletedAt WHERE id = :id AND deleted_at IS NULL"
+          [ ":deletedAt" := currentTime
+          , ":id" := id
+          ]
         return True
       else
         return False
diff --git a/server/src/Persistence/Payment.hs b/server/src/Persistence/Payment.hs
index a0cd580..b3eb141 100644
--- a/server/src/Persistence/Payment.hs
+++ b/server/src/Persistence/Payment.hs
@@ -12,6 +12,7 @@ module Persistence.Payment
   , searchCategory
   , repartition
   , getPreAndPostPaymentRepartition
+  , usedCategories
   ) where
 
 import           Data.Map                       (Map)
@@ -310,6 +311,19 @@ searchCategory paymentName =
         ]
   )
 
+usedCategories :: Query [CategoryId]
+usedCategories =
+  Query (\conn -> do
+    map (\(CategoryIdRow p) -> p) <$>
+      SQLite.query_
+        conn
+        (SQLite.Query $ T.intercalate " "
+          [ "SELECT DISTINCT category"
+          , "FROM payment"
+          , "WHERE deleted_at IS NULL"
+          ])
+  )
+
 data UserCostRow = UserCostRow (UserId, Int)
 
 instance FromRow UserCostRow where