hpqtypes-extras 1.7.1.0 → 1.8.0.0

raw patch · 10 files changed

+250/−91 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• hpqtypes-extras.cabal +2/−2
• src/Database/PostgreSQL/PQTypes/Checks.hs +111/−15
• src/Database/PostgreSQL/PQTypes/Checks/Util.hs +8/−9
• src/Database/PostgreSQL/PQTypes/Model/Check.hs +2/−2
• src/Database/PostgreSQL/PQTypes/Model/CompositeType.hs +53/−21
• src/Database/PostgreSQL/PQTypes/Model/ForeignKey.hs +2/−2
• src/Database/PostgreSQL/PQTypes/Model/Index.hs +7/−6
• src/Database/PostgreSQL/PQTypes/Model/Migration.hs +12/−4
• test/Main.hs +47/−30

@@ -1,3 +1,9 @@+# hpqtypes-extras-1.8.0.0 (2019-04-30)+* Make composite types subject to migration process+  ([#21](https://github.com/scrive/hpqtypes-extras/pull/21)).+* Add migration type for concurrent creation of an index+  ([#21](https://github.com/scrive/hpqtypes-extras/pull/21)).+ # hpqtypes-extras-1.7.1.0 (2019-02-04) * Fix an issue where unnecessary migrations were run sometimes   ([#18](https://github.com/scrive/hpqtypes-extras/pull/18)).

@@ -1,6 +1,6 @@ cabal-version:       1.18 name:                hpqtypes-extras-version:             1.7.1.0+version:             1.8.0.0 synopsis:            Extra utilities for hpqtypes library description:         The following extras for hpqtypes library:                      .@@ -20,7 +20,7 @@ copyright:           Scrive AB category:            Database build-type:          Simple-tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.3+tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5  Source-repository head   Type:     git

@@ -12,6 +12,7 @@   , migrateDatabase   ) where +import Control.Arrow ((&&&)) import Control.Applicative ((<$>)) import Control.Monad.Catch import Control.Monad.Reader@@ -29,6 +30,8 @@ import Prelude import TextShow import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S import qualified Data.Text as T  import Database.PostgreSQL.PQTypes.ExtrasOptions@@ -46,16 +49,22 @@  -- | Run migrations and check the database structure. migrateDatabase-  :: (MonadDB m, MonadLog m, MonadThrow m)-  => ExtrasOptions -> [Extension] -> [Domain] -> [Table] -> [Migration m]+  :: (MonadDB m, MonadLog m, MonadMask m)+  => ExtrasOptions+  -> [Extension]+  -> [CompositeType]+  -> [Domain]+  -> [Table]+  -> [Migration m]   -> m () migrateDatabase options@ExtrasOptions{..}-  extensions domains tables migrations = do+  extensions composites domains tables migrations = do   setDBTimeZoneToUTC   mapM_ checkExtension extensions   tablesWithVersions <- getTableVersions (tableVersions : tables)   -- 'checkDBConsistency' also performs migrations.   checkDBConsistency options domains tablesWithVersions migrations+  resultCheck =<< checkCompositesStructure True composites   resultCheck =<< checkDomainsStructure domains   resultCheck =<< checkDBStructure options tablesWithVersions   resultCheck =<< checkTablesWereDropped migrations@@ -69,22 +78,23 @@ -- needs to be migrated. Will do a full check of DB structure. checkDatabase   :: forall m . (MonadDB m, MonadLog m, MonadThrow m)-  => ExtrasOptions -> [Domain] -> [Table] -> m ()+  => ExtrasOptions -> [CompositeType] -> [Domain] -> [Table] -> m () checkDatabase options = checkDatabase_ options False  -- | Same as 'checkDatabase', but will not failed if there are -- additional tables in database. checkDatabaseAllowUnknownTables   :: forall m . (MonadDB m, MonadLog m, MonadThrow m)-  => ExtrasOptions -> [Domain] -> [Table] -> m ()+  => ExtrasOptions -> [CompositeType] -> [Domain] -> [Table] -> m () checkDatabaseAllowUnknownTables options = checkDatabase_ options True  checkDatabase_   :: forall m . (MonadDB m, MonadLog m, MonadThrow m)-  => ExtrasOptions -> Bool -> [Domain] -> [Table] -> m ()-checkDatabase_ options allowUnknownTables domains tables = do+  => ExtrasOptions -> Bool -> [CompositeType] -> [Domain] -> [Table] -> m ()+checkDatabase_ options allowUnknownTables composites domains tables = do   tablesWithVersions <- getTableVersions (tableVersions : tables)   resultCheck $ checkVersions tablesWithVersions+  resultCheck =<< checkCompositesStructure False composites   resultCheck =<< checkDomainsStructure domains   resultCheck =<< checkDBStructure options tablesWithVersions   when (not $ allowUnknownTables) $ do@@ -297,6 +307,64 @@                     <> "' that must have been dropped"                     <> " is still present in the database." +-- | Check that there is 1 to 1 correspondence between composite types in the+-- database and the list of their code definitions.+checkCompositesStructure+  :: MonadDB m+  => Bool -- ^ Create types if none are present in the database+  -> [CompositeType]+  -> m ValidationResult+checkCompositesStructure createTypes compositeList = getDBCompositeTypes >>= \case+  [] | createTypes -> do -- if there are no composite types in the database,+                         -- create them (if there are any as code definitions).+    mapM_ (runQuery_ . sqlCreateComposite) compositeList+    return mempty+  dbCompositeTypes -> pure $ mconcat+    [ checkNotPresentComposites+    , checkDatabaseComposites+    ]+    where+      compositeMap = M.fromList $+        map ((unRawSQL . ctName) &&& ctColumns) compositeList++      checkNotPresentComposites =+        let notPresent = S.toList $ M.keysSet compositeMap+              S.\\ S.fromList (map (unRawSQL . ctName) dbCompositeTypes)+        in validateIsNull "Composite types not present in the database:" notPresent++      checkDatabaseComposites = mconcat . (`map` dbCompositeTypes) $ \dbComposite ->+        let cname = unRawSQL $ ctName dbComposite+        in case cname `M.lookup` compositeMap of+          Just columns -> topMessage "composite type" cname $+            checkColumns 1 columns (ctColumns dbComposite)+          Nothing -> validationError $ "Composite type '" <> T.pack (show dbComposite)+            <> "' from the database doesn't have a corresponding code definition"+        where+          checkColumns+            :: Int -> [CompositeColumn] -> [CompositeColumn] -> ValidationResult+          checkColumns _ [] [] = mempty+          checkColumns _ rest [] = validationError $+            objectHasLess "Composite type" "columns" rest+          checkColumns _ [] rest = validationError $+            objectHasMore "Composite type" "columns" rest+          checkColumns !n (d:defs) (c:cols) = mconcat [+              validateNames $ ccName d == ccName c+            , validateTypes $ ccType d == ccType c+            , checkColumns (n+1) defs cols+            ]+            where+              validateNames True  = mempty+              validateNames False = validationError $+                errorMsg ("no. " <> showt n) "names" (unRawSQL . ccName)++              validateTypes True  = mempty+              validateTypes False = validationError $+                errorMsg (unRawSQL $ ccName d) "types" (T.pack . show . ccType)++              errorMsg ident attr f =+                "Column '" <> ident <> "' differs in"+                <+> attr <+> "(database:" <+> f c <> ", definition:" <+> f d <> ")."+ -- | Checks whether the database is consistent. checkDBStructure   :: forall m. (MonadDB m, MonadThrow m)@@ -360,8 +428,10 @@         checkColumns           :: Int -> [TableColumn] -> [TableColumn] -> ValidationResult         checkColumns _ [] [] = mempty-        checkColumns _ rest [] = validationError $ tableHasLess "columns" rest-        checkColumns _ [] rest = validationError $ tableHasMore "columns" rest+        checkColumns _ rest [] = validationError $+          objectHasLess "Table" "columns" rest+        checkColumns _ [] rest = validationError $+          objectHasMore "Table" "columns" rest         checkColumns !n (d:defs) (c:cols) = mconcat [             validateNames $ colName d == colName c           -- bigserial == bigint + autoincrement and there is no@@ -459,10 +529,13 @@ --   * all 'mgrFrom' are less than table version number of the table in --     the 'tables' list checkDBConsistency-  :: forall m. (MonadDB m, MonadLog m, MonadThrow m)+  :: forall m. (MonadDB m, MonadLog m, MonadMask m)   => ExtrasOptions -> [Domain] -> [(Table, Int32)] -> [Migration m]   -> m () checkDBConsistency options domains tablesWithVersions migrations = do+  autoTransaction <- tsAutoTransaction <$> getTransactionSettings+  unless autoTransaction $ do+    error "checkDBConsistency: tsAutoTransaction setting needs to be True"   -- Check the validity of the migrations list.   validateMigrations   validateDropTableMigrations@@ -682,18 +755,41 @@     runMigration Migration{..} = do       case mgrAction of         StandardMigration mgrDo -> do-          logInfo_ $ arrListTable mgrTableName <> showt mgrFrom <+> "->"-            <+> showt (succ mgrFrom)+          logMigration           mgrDo-          runQuery_ $ sqlUpdate "table_versions" $ do-            sqlSet "version"  (succ mgrFrom)-            sqlWhereEq "name" (T.unpack . unRawSQL $ mgrTableName)+          updateTableVersion          DropTableMigration mgrDropTableMode -> do           logInfo_ $ arrListTable mgrTableName <> "drop table"           runQuery_ $ sqlDropTable mgrTableName             mgrDropTableMode           runQuery_ $ sqlDelete "table_versions" $ do+            sqlWhereEq "name" (T.unpack . unRawSQL $ mgrTableName)++        CreateIndexConcurrentlyMigration tname idx -> do+          logMigration+          -- If migration was run before but creation of an index failed, index+          -- will be left in the database in an inactive state, so when we+          -- rerun, we need to remove it first (see+          -- https://www.postgresql.org/docs/9.6/sql-createindex.html for more+          -- information).+          runQuery_ $ "DROP INDEX IF EXISTS" <+> indexName tname idx+          -- We're in auto transaction mode (as ensured at the beginning of+          -- 'checkDBConsistency'), so we need to issue explicit SQL commit,+          -- because using 'commit' function automatically starts another+          -- transaction. We don't want that as concurrent creation of index+          -- won't run inside a transaction.+          runSQL_ "COMMIT"+          runQuery_ (sqlCreateIndexConcurrently tname idx) `finally` begin+          updateTableVersion+      where+        logMigration = do+          logInfo_ $ arrListTable mgrTableName+            <> showt mgrFrom <+> "->" <+> showt (succ mgrFrom)++        updateTableVersion = do+          runQuery_ $ sqlUpdate "table_versions" $ do+            sqlSet "version"  (succ mgrFrom)             sqlWhereEq "name" (T.unpack . unRawSQL $ mgrTableName)      runMigrations :: [(Text, Int32)] -> m ()

@@ -12,8 +12,8 @@   checkEquality,   checkNames,   checkPKPresence,-  tableHasLess,-  tableHasMore,+  objectHasLess,+  objectHasMore,   arrListTable   ) where @@ -152,15 +152,14 @@         , " has no primary key defined "         , " (" <> (mintercalate ", " msgs) <> ")"] --tableHasLess :: Show t => Text -> t -> Text-tableHasLess ptype missing =-  "Table in the database has *less*" <+> ptype <+>+objectHasLess :: Show t => Text -> Text -> t -> Text+objectHasLess otype ptype missing =+  otype <+> "in the database has *less*" <+> ptype <+>   "than its definition (missing:" <+> T.pack (show missing) <> ")" -tableHasMore :: Show t => Text -> t -> Text-tableHasMore ptype extra =-  "Table in the database has *more*" <+> ptype <+>+objectHasMore :: Show t => Text -> Text -> t -> Text+objectHasMore otype ptype extra =+  otype <+> "in the database has *more*" <+> ptype <+>   "than its definition (extra:" <+> T.pack (show extra) <> ")"  arrListTable :: RawSQL () -> Text

@@ -15,8 +15,8 @@ data Check = Check {   chkName      :: RawSQL () , chkCondition :: RawSQL ()-, chkValidated :: Bool -- ^ Set to 'True' if check is created as NOT VALID and-                       -- not validated afterwards.+, chkValidated :: Bool -- ^ Set to 'False' if check is created as NOT VALID and+                       -- left in such state (for whatever reason). } deriving (Eq, Ord, Show)  tblCheck :: Check

@@ -1,14 +1,20 @@ module Database.PostgreSQL.PQTypes.Model.CompositeType (     CompositeType(..)   , CompositeColumn(..)-  , defineComposites+  , compositeTypePqFormat+  , sqlCreateComposite+  , sqlDropComposite+  , getDBCompositeTypes   ) where +import Data.Int import Data.Monoid.Utils import Database.PostgreSQL.PQTypes-import Prelude+import qualified Data.ByteString as BS+import qualified Data.Text.Encoding as T  import Database.PostgreSQL.PQTypes.Model.ColumnType+import Database.PostgreSQL.PQTypes.SQL.Builder  data CompositeType = CompositeType {   ctName    :: !(RawSQL ())@@ -20,24 +26,50 @@ , ccType :: ColumnType } deriving (Eq, Ord, Show) --- | Composite types are static in a sense that they can either--- be created or dropped, altering them is not possible. Therefore--- they are not part of the migration process. This is not a problem--- since their exclusive usage is for intermediate representation--- of complex nested data structures fetched from the database.-defineComposites :: MonadDB m => [CompositeType] -> m ()-defineComposites ctypes = do-  mapM_ (runQuery_ . sqlDropComposite)   $ reverse ctypes-  mapM_ (runQuery_ . sqlCreateComposite) $ ctypes+-- | Convenience function for converting CompositeType definition to+-- corresponding 'pqFormat' definition.+compositeTypePqFormat :: CompositeType -> BS.ByteString+compositeTypePqFormat ct = "%" `BS.append` T.encodeUtf8 (unRawSQL $ ctName ct)++-- | Make SQL query that creates a composite type.+sqlCreateComposite :: CompositeType -> RawSQL ()+sqlCreateComposite CompositeType{..} = smconcat [+    "CREATE TYPE"+  , ctName+  , "AS ("+  , mintercalate ", " $ map columnToSQL ctColumns+  , ")"+  ]   where-    sqlCreateComposite CompositeType{..} = smconcat [-        "CREATE TYPE"-      , ctName-      , "AS ("-      , mintercalate ", " $ map columnToSQL ctColumns-      , ")"-      ]-      where-        columnToSQL CompositeColumn{..} = ccName <+> columnTypeToSQL ccType+    columnToSQL CompositeColumn{..} = ccName <+> columnTypeToSQL ccType -    sqlDropComposite = ("DROP TYPE IF EXISTS" <+>) . ctName+-- | Make SQL query that drops a composite type.+sqlDropComposite :: RawSQL () -> RawSQL ()+sqlDropComposite = ("DROP TYPE" <+>)++----------------------------------------++-- | Get composite types defined in the database.+getDBCompositeTypes :: forall m. MonadDB m => m [CompositeType]+getDBCompositeTypes = do+  runQuery_ . sqlSelect "pg_catalog.pg_class c" $ do+    sqlResult "c.relname::text"+    sqlResult "c.oid::int4"+    sqlWhere "pg_catalog.pg_table_is_visible(c.oid)"+    sqlWhereEq "c.relkind" 'c'+    sqlOrderBy "c.relname"+  mapM getComposite =<< fetchMany id+  where+    getComposite :: (String, Int32) -> m CompositeType+    getComposite (name, oid) = do+      runQuery_ . sqlSelect "pg_catalog.pg_attribute a" $ do+        sqlResult "a.attname::text"+        sqlResult "pg_catalog.format_type(a.atttypid, a.atttypmod)"+        sqlWhereEq "a.attrelid" oid+        sqlOrderBy "a.attnum"+      columns <- fetchMany fetch+      return CompositeType { ctName = unsafeSQL name, ctColumns = columns }+      where+        fetch :: (String, ColumnType) -> CompositeColumn+        fetch (cname, ctype) =+          CompositeColumn { ccName = unsafeSQL cname, ccType = ctype }

@@ -25,8 +25,8 @@ , fkOnDelete   :: ForeignKeyAction , fkDeferrable :: Bool , fkDeferred   :: Bool-, fkValidated  :: Bool -- ^ Set to 'True' if foreign key is created as NOT VALID-                       -- and not validated afterwards.+, fkValidated  :: Bool -- ^ Set to 'False' if foreign key is created as NOT+                       -- VALID and left in such state (for whatever reason). } deriving (Eq, Ord, Show)  data ForeignKeyAction

@@ -150,12 +150,13 @@  sqlCreateIndex_ :: Bool -> RawSQL () -> TableIndex -> RawSQL () sqlCreateIndex_ concurrently tname idx@TableIndex{..} = mconcat [-    "CREATE "-  , if idxUnique then "UNIQUE " else ""-  , "INDEX " <+> indexName tname idx-  , if concurrently then " CONCURRENTLY" else ""-  , " ON" <+> tname <+> ""-  , "USING" <+> (rawSQL (T.pack . show $ idxMethod) ()) <+> "("+    "CREATE"+  , if idxUnique then " UNIQUE" else ""+  , " INDEX "+  , if concurrently then "CONCURRENTLY " else ""+  , indexName tname idx+  , " ON" <+> tname+  , " USING" <+> (rawSQL (T.pack . show $ idxMethod) ()) <+> "("   , mintercalate ", " idxColumns   , ")"   , maybe "" (" WHERE" <+>) idxWhere

@@ -30,6 +30,7 @@  import Data.Int +import Database.PostgreSQL.PQTypes.Model.Index import Database.PostgreSQL.PQTypes.Model.Table import Database.PostgreSQL.PQTypes.SQL.Raw @@ -45,6 +46,11 @@   -- the table to drop.   | DropTableMigration DropTableMode +  -- | Migration for creating an index concurrently.+  | CreateIndexConcurrentlyMigration+      (RawSQL ()) -- ^ Table name+      TableIndex  -- ^ Index+ -- | Migration object. data Migration m =   Migration {@@ -62,11 +68,13 @@ isStandardMigration :: Migration m -> Bool isStandardMigration Migration{..} =   case mgrAction of-    StandardMigration _  -> True-    DropTableMigration _ -> False+    StandardMigration{}                -> True+    DropTableMigration{}               -> False+    CreateIndexConcurrentlyMigration{} -> False  isDropTableMigration :: Migration m -> Bool isDropTableMigration Migration{..} =   case mgrAction of-    StandardMigration _  -> False-    DropTableMigration _ -> True+    StandardMigration{}                -> False+    DropTableMigration{}               -> True+    CreateIndexConcurrentlyMigration{} -> False

@@ -15,6 +15,7 @@ import Database.PostgreSQL.PQTypes.Checks import Database.PostgreSQL.PQTypes.Model.ColumnType import Database.PostgreSQL.PQTypes.Model.ForeignKey+import Database.PostgreSQL.PQTypes.Model.Index import Database.PostgreSQL.PQTypes.Model.Migration import Database.PostgreSQL.PQTypes.Model.PrimaryKey import Database.PostgreSQL.PQTypes.Model.Table@@ -105,8 +106,8 @@   }  -tableBankMigration5 :: (MonadDB m) => Migration m-tableBankMigration5 = Migration+tableBankMigration5fst :: (MonadDB m) => Migration m+tableBankMigration5fst = Migration   { mgrTableName = tblName tableBankSchema3   , mgrFrom      = 2   , mgrAction    = StandardMigration $ do@@ -115,12 +116,21 @@         ]   } +tableBankMigration5snd :: (MonadDB m) => Migration m+tableBankMigration5snd = Migration+  { mgrTableName = tblName tableBankSchema3+  , mgrFrom      = 3+  , mgrAction    = CreateIndexConcurrentlyMigration+                     (tblName tableBankSchema3)+                     (indexOnColumn "name")+  }  tableBankSchema5 :: Table tableBankSchema5 = tableBankSchema4 {-    tblVersion = (tblVersion tableBankSchema4)  + 1+    tblVersion = (tblVersion tableBankSchema4) + 2   , tblColumns = filter (\c -> colName c /= "cash")       (tblColumns tableBankSchema4)+  , tblIndexes = [indexOnColumn "name"]   }  tableBadGuySchema1 :: Table@@ -394,7 +404,8 @@ schema5Migrations :: (MonadDB m) => [Migration m] schema5Migrations = schema4Migrations                  ++ [ createTableMigration tableFlash-                    , tableBankMigration5+                    , tableBankMigration5fst+                    , tableBankMigration5snd                     , dropTableMigration tableFlash                     ] @@ -428,11 +439,12 @@ createTablesSchema1 step = do   let extrasOptions = def       extensions    = []+      composites    = []       domains       = []   step "Creating the database (schema version 1)..."   migrateDatabase extrasOptions extensions domains-    schema1Tables schema1Migrations-  checkDatabase extrasOptions domains schema1Tables+    composites schema1Tables schema1Migrations+  checkDatabase extrasOptions composites domains schema1Tables  testDBSchema1 :: (String -> TestM ()) -> TestM ([Int64], [Int64]) testDBSchema1 step = do@@ -518,23 +530,25 @@ migrateDBToSchema2 step = do   let extrasOptions = def       extensions    = []+      composites    = []       domains       = []   step "Migrating the database (schema version 1 -> schema version 2)..."-  migrateDatabase extrasOptions extensions domains+  migrateDatabase extrasOptions extensions composites domains     schema2Tables schema2Migrations-  checkDatabase extrasOptions domains schema2Tables+  checkDatabase extrasOptions composites domains schema2Tables  -- | Hacky version of 'migrateDBToSchema2' used by 'migrationTest3'. migrateDBToSchema2Hacky :: (String -> TestM ()) -> TestM () migrateDBToSchema2Hacky step = do   let extrasOptions = def       extensions    = []+      composites    = []       domains       = []   step "Hackily migrating the database (schema version 1 \        \-> schema version 2)..."-  migrateDatabase extrasOptions extensions domains+  migrateDatabase extrasOptions extensions composites domains     schema2Tables schema2Migrations'-  checkDatabase extrasOptions domains schema2Tables+  checkDatabase extrasOptions composites domains schema2Tables     where       schema2Migrations' = createTableMigration tableFlash : schema2Migrations @@ -578,11 +592,12 @@ migrateDBToSchema3 step = do   let extrasOptions = def       extensions    = []+      composites    = []       domains       = []   step "Migrating the database (schema version 2 -> schema version 3)..."-  migrateDatabase extrasOptions extensions domains+  migrateDatabase extrasOptions extensions composites domains     schema3Tables schema3Migrations-  checkDatabase extrasOptions domains schema3Tables+  checkDatabase extrasOptions composites domains schema3Tables  testDBSchema3 :: (String -> TestM ()) -> [Int64] -> [Int64] -> TestM () testDBSchema3 step badGuyIds robberyIds = do@@ -629,11 +644,12 @@ migrateDBToSchema4 step = do   let extrasOptions = def       extensions    = []+      composites    = []       domains       = []   step "Migrating the database (schema version 3 -> schema version 4)..."-  migrateDatabase extrasOptions extensions domains+  migrateDatabase extrasOptions extensions composites domains     schema4Tables schema4Migrations-  checkDatabase extrasOptions domains schema4Tables+  checkDatabase extrasOptions composites domains schema4Tables  testDBSchema4 :: (String -> TestM ()) -> TestM () testDBSchema4 step = do@@ -654,11 +670,12 @@ migrateDBToSchema5 step = do   let extrasOptions = def       extensions    = []+      composites    = []       domains       = []   step "Migrating the database (schema version 4 -> schema version 5)..."-  migrateDatabase extrasOptions extensions domains+  migrateDatabase extrasOptions extensions composites domains     schema5Tables schema5Migrations-  checkDatabase extrasOptions domains schema5Tables+  checkDatabase extrasOptions composites domains schema5Tables  testDBSchema5 :: (String -> TestM ()) -> TestM () testDBSchema5 step = do@@ -729,38 +746,38 @@       differentSchema = schema5Tables       extrasOptions = def { eoEnforcePKs = True }   assertNoException "checkDatabase should run fine for consistent DB" $-    checkDatabase extrasOptions [] currentSchema+    checkDatabase extrasOptions [] [] currentSchema   assertNoException "checkDatabaseAllowUnknownTables runs fine \                     \for consistent DB" $-    checkDatabaseAllowUnknownTables extrasOptions [] currentSchema+    checkDatabaseAllowUnknownTables extrasOptions [] [] currentSchema   assertException "checkDatabase should throw exception for wrong schema" $-    checkDatabase extrasOptions [] differentSchema+    checkDatabase extrasOptions [] [] differentSchema   assertException ("checkDatabaseAllowUnknownTables \                    \should throw exception for wrong scheme") $-    checkDatabaseAllowUnknownTables extrasOptions [] differentSchema+    checkDatabaseAllowUnknownTables extrasOptions [] [] differentSchema    runSQL_ "INSERT INTO table_versions (name, version) \           \VALUES ('unknown_table', 0)"   assertException "checkDatabase throw when extra entry in 'table_versions'" $-    checkDatabase extrasOptions [] currentSchema+    checkDatabase extrasOptions [] [] currentSchema   assertNoException ("checkDatabaseAllowUnknownTables \                      \accepts extra entry in 'table_versions'") $-    checkDatabaseAllowUnknownTables extrasOptions [] currentSchema+    checkDatabaseAllowUnknownTables extrasOptions [] [] currentSchema   runSQL_ "DELETE FROM table_versions where name='unknown_table'"    runSQL_ "CREATE TABLE unknown_table (title text)"   assertException "checkDatabase should throw with unknown table" $-    checkDatabase extrasOptions [] currentSchema+    checkDatabase extrasOptions [] [] currentSchema   assertNoException "checkDatabaseAllowUnknownTables accepts unknown table" $-    checkDatabaseAllowUnknownTables extrasOptions [] currentSchema+    checkDatabaseAllowUnknownTables extrasOptions [] [] currentSchema    runSQL_ "INSERT INTO table_versions (name, version) \           \VALUES ('unknown_table', 0)"   assertException "checkDatabase should throw with unknown table" $-    checkDatabase extrasOptions [] currentSchema+    checkDatabase extrasOptions [] [] currentSchema   assertNoException ("checkDatabaseAllowUnknownTables \                      \accepts unknown tables with version") $-    checkDatabaseAllowUnknownTables extrasOptions [] currentSchema+    checkDatabaseAllowUnknownTables extrasOptions [] [] currentSchema    freshTestDB    step @@ -772,18 +789,18 @@    step "Recreating the database (schema version 1, one table is missing PK)..." -  migrateDatabase optionsNoPKCheck [] []+  migrateDatabase optionsNoPKCheck [] [] []     schema1TablesWithMissingPK [schema1MigrationsWithMissingPK]-  checkDatabase optionsNoPKCheck [] withMissingPKSchema+  checkDatabase optionsNoPKCheck [] [] withMissingPKSchema    assertException     "checkDatabase should throw when PK missing from table \     \'participated_in_robbery' and check is enabled" $-    checkDatabase optionsWithPKCheck [] withMissingPKSchema+    checkDatabase optionsWithPKCheck [] [] withMissingPKSchema   assertNoException     "checkDatabase should not throw when PK missing from table \     \'participated_in_robbery' and check is disabled" $-    checkDatabase optionsNoPKCheck [] withMissingPKSchema+    checkDatabase optionsNoPKCheck [] [] withMissingPKSchema    freshTestDB step