Add check for overlapping indices

src/Database/PostgreSQL/PQTypes/Checks.hs

@@ -426,6 +426,7 @@ checkDBStructure options tables = fmap mconcat . forM tables $ \(table, version)
       runQuery_ $ sqlGetForeignKeys table
       fkeys <- fetchMany fetchForeignKey
       triggers <- getDBTriggers tblName
+      checkedOverlaps <- checkOverlappingIndexes 
       return $ mconcat [
           checkColumns 1 tblColumns desc
         , checkPrimaryKey tblPrimaryKey pk
@@ -434,6 +435,7 @@ checkDBStructure options tables = fmap mconcat . forM tables $ \(table, version)
         , checkForeignKeys tblForeignKeys fkeys
         , checkForeignKeyIndexes tblForeignKeys tblIndexes
         , checkTriggers tblTriggers triggers
+        , checkedOverlaps
         ]
       where
         fetchTableColumn
@@ -589,6 +591,26 @@ checkDBStructure options tables = fmap mconcat . forM tables $ \(table, version)
                 \expected output into source code.)"
               ]
 
+        checkOverlappingIndexes :: (MonadDB m) => m ValidationResult
+        checkOverlappingIndexes =
+          if eoCheckOverlappingIndexes options
+          then go
+          else pure mempty
+          where 
+            go = do
+              let handleOverlap (contained, contains) =
+                    mconcat
+                      [ "\n  ●  Index "
+                      , contains
+                      , " contains index "
+                      , contained
+                      ]
+              runSQL_ checkOverlappingIndexesQuery
+              overlaps <- fetchMany handleOverlap
+              pure $ if null overlaps
+                then mempty
+                else validationError . T.unlines $ "Some indexes are overlapping" : overlaps
+
 -- | Checks whether database is consistent, performing migrations if
 -- necessary. Requires all table names to be in lower case.
 --

src/Database/PostgreSQL/PQTypes/Checks/Util.hs

@@ -14,7 +14,8 @@ module Database.PostgreSQL.PQTypes.Checks.Util (
   checkPKPresence,
   objectHasLess,
   objectHasMore,
-  arrListTable
+  arrListTable,
+  checkOverlappingIndexesQuery,
   ) where
 
 import Control.Monad.Catch
@@ -166,3 +167,42 @@ objectHasMore otype ptype extra =
 
 arrListTable :: RawSQL () -> Text
 arrListTable tableName = " ->" <+> unRawSQL tableName <> ": "
+
+checkOverlappingIndexesQuery :: SQL
+checkOverlappingIndexesQuery =
+  smconcat
+    [ "WITH",
+      -- get predicates (WHERE clause) definition in text format (ugly but the parsed version
+      -- can differ even if the predicate is the same), ignore functional indexes at the same time
+      -- as that would make this query very ugly
+      "     indexdata1 AS (SELECT *",
+      "                         , ((regexp_match(pg_get_indexdef(indexrelid)",
+      "                                        , 'WHERE (.*)$')))[1] AS preddef",
+      "                    FROM pg_index",
+      "                    WHERE indexprs IS NULL)",
+      -- add the rest of metadata and do the join
+      "   , indexdata2 AS (SELECT t1.*",
+      "                         , pg_get_indexdef(t1.indexrelid) AS contained",
+      "                         , pg_get_indexdef(t2.indexrelid) AS contains",
+      "                         , array_to_string(t1.indkey, '+') AS colindex",
+      "                         , array_to_string(t2.indkey, '+') AS colotherindex",
+      "                         , t2.indexrelid AS other_index",
+      "                         , t2.indisunique AS other_indisunique",
+      "                         , t2.preddef AS other_preddef",
+      -- cross join all indexes on the same table to try all combination (except oneself)
+      "                    FROM indexdata1 AS t1",
+      "                         INNER JOIN indexdata1 AS t2 ON t1.indrelid = t2.indrelid",
+      "                                                    AND t1.indexrelid <> t2.indexrelid)",
+      "  SELECT contained",
+      "       , contains",
+      "  FROM indexdata2",
+      -- The indexes are the same or the "other" is larger than us
+      "  WHERE (colotherindex = colindex",
+      "      OR colotherindex LIKE colindex || '+%')",
+      -- and we have the same predicate
+      "    AND other_preddef IS NOT DISTINCT FROM preddef",
+      -- and either the other is unique (so better than us) or none of us is unique
+      "    AND (other_indisunique",
+      "      OR (NOT other_indisunique",
+      "      AND NOT indisunique));"
+    ]

src/Database/PostgreSQL/PQTypes/ExtrasOptions.hs

@@ -16,6 +16,8 @@ data ExtrasOptions =
       -- the one in the code definition.
     , eoCheckForeignKeysIndexes  :: !Bool
       -- ^ Check if all foreign keys have indexes.
+    , eoCheckOverlappingIndexes :: !Bool
+      -- ^ Check if some index are redundant
     } deriving Eq
 
 defaultExtrasOptions :: ExtrasOptions
@@ -25,6 +27,7 @@ defaultExtrasOptions = ExtrasOptions
   , eoObjectsValidationMode    = DontAllowUnknownObjects
   , eoAllowHigherTableVersions = False
   , eoCheckForeignKeysIndexes  = False
+  , eoCheckOverlappingIndexes  = False
   }
 
 data ObjectsValidationMode = AllowUnknownObjects | DontAllowUnknownObjects

test/Main.hs

@@ -1745,6 +1745,36 @@ foreignKeyIndexesTests connSource =
         ]
       }
 
+overlapingIndexesTests :: ConnectionSourceM (LogT IO) -> TestTree
+overlapingIndexesTests connSource = do
+  testCaseSteps' "Overlapping indexes tests" connSource $ \step -> do
+    freshTestDB step
+
+    step "Check that overlapping indexes get flagged"
+    do
+      let options = defaultExtrasOptions { eoCheckOverlappingIndexes = True }
+      assertException "Some indexes are overlapping" $ migrateDatabase options ["pgcrypto"] [] [] [table1]
+        [createTableMigration table1]
+    where
+      table1 :: Table
+      table1 = tblTable
+        { tblName = "idxTest"
+        , tblVersion = 1
+        , tblColumns =
+          [ tblColumn { colName = "id", colType = UuidT, colNullable = False }
+          , tblColumn { colName = "idx1", colType = UuidT }
+          , tblColumn { colName = "idx2", colType = UuidT }
+          , tblColumn { colName = "idx3", colType = UuidT }
+          ]
+        , tblPrimaryKey = pkOnColumn "id"
+        , tblIndexes = 
+          [ indexOnColumns [ indexColumn "idx1", indexColumn "idx2" ] 
+          , indexOnColumns [ indexColumn "idx1" ]
+          ]
+        }
+
+
+
 
 assertNoException :: String -> TestM () -> TestM ()
 assertNoException t = eitherExc
@@ -1792,6 +1822,7 @@ main = do
                          , unionAllTests connSource
                          , sqlWithRecursiveTests connSource
                          , foreignKeyIndexesTests connSource
+                         , overlapingIndexesTests connSource
                          ]
   where
     ings =