beam-postgres 0.5.4.4 → 0.5.5.0

raw patch · 6 files changed

+150/−8 lines, 6 filesdep ~beam-migratePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: beam-migrate

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• Database/Beam/Postgres/CustomTypes.hs +0/−3
• Database/Beam/Postgres/Migrate.hs +50/−2
• Database/Beam/Postgres/Syntax.hs +34/−1
• beam-postgres.cabal +2/−2
• test/Database/Beam/Postgres/Test/Migrate.hs +55/−0

@@ -1,3 +1,12 @@+# 0.5.5.0++## Added features++* Add support for creating secondary indices, supporting both `CREATE INDEX` and+  `CREATE UNIQUE INDEX`. `getDbConstraintsForSchemas` now discovers user-created+  secondary indices via `pg_index` (excluding primary keys and+  constraint-backing indices).+ # 0.5.4.4  ## Added features

@@ -40,9 +40,6 @@ import           Data.Functor.Const import qualified Data.HashSet as HS import           Data.Proxy (Proxy(..))-#if !MIN_VERSION_base(4,11,0)-import           Data.Semigroup-#endif import           Data.Text (Text) import qualified Data.Text.Encoding as TE 

@@ -31,7 +31,8 @@   ) where  import           Database.Beam.Backend.SQL-import           Database.Beam.Migrate.Actions (defaultActionProvider, defaultSchemaActionProvider)+import           Database.Beam.Migrate.Actions (defaultActionProvider, defaultSchemaActionProvider,+                                               createIndexActionProvider, dropIndexActionProvider) import qualified Database.Beam.Migrate.Backend as Tool import qualified Database.Beam.Migrate.Checks as Db import qualified Database.Beam.Migrate.SQL as Db@@ -65,6 +66,7 @@ import qualified Data.ByteString.Lazy.Char8 as BCL import qualified Data.HashMap.Strict as HM import           Data.Int+import qualified Data.List.NonEmpty as NE (nonEmpty) import           Data.Maybe import           Data.String import qualified Data.Text as T@@ -102,6 +104,8 @@                    , Tool.backendActionProvider =                        mconcat [ defaultActionProvider                                , defaultSchemaActionProvider+                               , createIndexActionProvider+                               , dropIndexActionProvider                                , pgExtensionActionProvider                                , pgCustomEnumActionProvider                                ]@@ -402,6 +406,50 @@                                            -- Recall that schema of the form 'pg_' are Postgres internal tables that should not be taken into account                                            , "WHERE nspname NOT LIKE '%pg_%' AND c.relkind='r' AND i.indisprimary GROUP BY nspname, relname, i.indrelid" ])) +     -- Collect user-created secondary indices.+     --+     -- Excludes:+     --   - primary keys+     --   - indices that back a constraint (i.e. those created implicitly by UNIQUE/EXCLUDE)+     --   - expression indices e.g. CREATE INDEX ON users (LOWER(email))+     secondaryIndices <-+       mapMaybe (\(schema, tblNm, idxNm, isUniq, cols) ->+         case NE.nonEmpty (V.toList cols) of+          Nothing -> Nothing+          Just colsNE ->+            let opts = Db.setUniqueIndexOptions @(BeamSqlBackendSyntax Postgres) isUniq+                     $ Db.defaultIndexOptions @(BeamSqlBackendSyntax Postgres)+            in+              Just $+                Db.SomeDatabasePredicate @(Db.TableHasIndex Postgres)+                  (Db.TableHasIndex (Db.QualifiedName schema tblNm) idxNm colsNE opts)) <$>+       Pg.query_ conn (fromString (unlines+         [ -- NULL out 'public' since it is the implicit default schema in Postgres+           "SELECT NULLIF(ns.nspname, 'public'), c.relname, i.relname, ix.indisunique,"+           -- re-aggregate column names in index-key order (see ORDINALITY below)+         , "       array_agg(a.attname ORDER BY k.n ASC)"+         , "FROM pg_index ix"+         , "JOIN pg_class c ON c.oid = ix.indrelid"+         , "JOIN pg_class i ON i.oid = ix.indexrelid"+         , "JOIN pg_namespace ns ON ns.oid = c.relnamespace"+           -- ORDINALITY allows retaining ordering of index columns+         , "CROSS JOIN unnest(ix.indkey) WITH ORDINALITY k(attid, n)"+         , "JOIN pg_attribute a ON a.attnum = k.attid AND a.attrelid = ix.indrelid"+           -- only regular tables (not views, sequences, etc.)+         , "WHERE c.relkind = 'r'"+           -- exclude Postgres system schemas+         , "  AND ns.nspname NOT LIKE 'pg_%'"+         , "  AND ns.nspname != 'information_schema'"+           -- exclude primary key indices+         , "  AND NOT ix.indisprimary"+           -- exclude indices created implicitly by a UNIQUE or EXCLUDE constraint+         , "  AND NOT EXISTS (SELECT 1 FROM pg_constraint con WHERE con.conindid = ix.indexrelid)"+           -- exclude expression indices: a key column number of 0 means that+           -- position is an expression (e.g. lower(col)) rather than a plain+           -- column reference, which TableHasIndex cannot represent+         , "  AND NOT EXISTS (SELECT 1 FROM unnest(ix.indkey) AS k(attnum) WHERE k.attnum = 0)"+         , "GROUP BY ns.nspname, c.relname, i.relname, ix.indisunique" ]))+      let enumerations =            map (\(enumNm, _, options) -> Db.SomeDatabasePredicate (PgHasEnum enumNm (V.toList options))) enumerationData @@ -409,7 +457,7 @@        map (\(Pg.Only extname) -> Db.SomeDatabasePredicate (PgHasExtension extname)) <$>        Pg.query_ conn "SELECT extname from pg_extension" -     pure (tblsExist ++ columnChecks ++ primaryKeys ++ enumerations ++ extensions)+     pure (tblsExist ++ columnChecks ++ primaryKeys ++ secondaryIndices ++ enumerations ++ extensions)  -- * Postgres-specific data types 

@@ -46,6 +46,7 @@      , PgAlterTableSyntax(..), PgAlterTableActionSyntax(..), PgAlterColumnActionSyntax(..) +     , PgWindowFrameSyntax(..), PgWindowFrameBoundsSyntax(..), PgWindowFrameBoundSyntax(..)      , PgSelectLockingClauseSyntax(..)@@ -58,6 +59,8 @@     , PgDataTypeDescr(..)     , PgHasEnum(..) +    , PgIndexOptions(..)+     , pgCreateExtensionSyntax, pgDropExtensionSyntax     , pgCreateEnumSyntax, pgDropTypeSyntax @@ -97,7 +100,7 @@ import           Control.Monad.Free import           Control.Monad.Free.Church -import           Data.Aeson (Value, object, (.=))+import           Data.Aeson (Value, object, withObject, (.=), (.:)) import           Data.Bits import           Data.ByteString (ByteString) import           Data.ByteString.Builder (Builder, doubleDec, floatDec, byteString, char8, toLazyByteString)@@ -110,6 +113,7 @@ import           Data.Functor.Classes import           Data.Hashable import           Data.Int+import qualified Data.List.NonEmpty as NE (toList) import           Data.Maybe import           Data.Scientific (Scientific) import           Data.String (IsString(..), fromString)@@ -426,6 +430,35 @@   createTableCmd = PgCommandSyntax PgCommandTypeDdl . coerce   dropTableCmd   = PgCommandSyntax PgCommandTypeDdl . coerce   alterTableCmd  = PgCommandSyntax PgCommandTypeDdl . coerce++newtype PgIndexOptions = PgIndexOptions { pgIndexUnique :: Bool }+    deriving (Show, Eq, Hashable)++instance IsSql92CreateDropIndexSyntax PgCommandSyntax where+  type instance Sql92CreateIndexOptionsSyntax PgCommandSyntax = PgIndexOptions++  defaultIndexOptions = PgIndexOptions { pgIndexUnique = False }++  createIndexCmd idxNm tblNm cols opts =+    PgCommandSyntax PgCommandTypeDdl $+    emit (if pgIndexUnique opts then "CREATE UNIQUE INDEX " else "CREATE INDEX ") <>+    pgQuotedIdentifier idxNm <>+    emit " ON " <> fromPgTableName tblNm <>+    pgParens (pgSepBy (emit ", ") (NE.toList $ fmap pgQuotedIdentifier cols))++  dropIndexCmd idxNm =+    PgCommandSyntax PgCommandTypeDdl (emit "DROP INDEX " <> pgQuotedIdentifier idxNm)++  serializeIndexOptions opts =+    object ["unique" .= pgIndexUnique opts]++  deserializeIndexOptions =+    withObject "PgIndexOptions" $ \v ->+      PgIndexOptions <$> v .: "unique"++instance IsSql92UniqueIndexSyntax PgCommandSyntax where+  setUniqueIndexOptions u opts = opts { pgIndexUnique = u }+  indexIsUnique opts = pgIndexUnique opts  instance IsSql92SchemaNameSyntax PgSchemaNameSyntax where   schemaName s = PgSchemaNameSyntax (pgQuotedIdentifier s)

@@ -1,5 +1,5 @@ name:                 beam-postgres-version:              0.5.4.4+version:              0.5.5.0 synopsis:             Connection layer between beam and postgres description:          Beam driver for <https://www.postgresql.org/ PostgreSQL>, an advanced open-source RDBMS homepage:             https://haskell-beam.github.io/beam/user-guide/backends/beam-postgres@@ -34,7 +34,7 @@    build-depends:      base                 >=4.11 && <5.0,                       beam-core            >=0.10 && <0.11,-                      beam-migrate         >=0.5  && <0.6,+                      beam-migrate         >=0.5.4.0 && <0.6,                        postgresql-libpq     >=0.8  && <0.12,                       postgresql-simple    >=0.5  && <0.8,

@@ -10,8 +10,12 @@ import Database.Beam.Migrate.Simple  import Data.ByteString (ByteString)+import Data.Int (Int32)+import qualified Data.List.NonEmpty as NE import Data.Text (Text) +import qualified Database.PostgreSQL.Simple as Pg+ import Test.Tasty import Test.Tasty.HUnit @@ -25,6 +29,8 @@       , extensionVerification postgresConn       , createTableWithSchemaWorks postgresConn       , dropSchemaWorks postgresConn+      , indexVerification postgresConn+      , uniqueIndexVerification postgresConn       ]  data CharT f@@ -137,3 +143,52 @@           verifySchema migrationBackend db >>= \case             VerificationFailed failures -> fail ("Verification failed: " ++ show failures)             VerificationSucceeded -> pure ()++-- Shared table type for index tests++newtype IdxT f = IdxT+  { _idx_value :: C f Int32+  } deriving (Generic, Beamable)++instance Table IdxT where+  newtype PrimaryKey IdxT f = IdxPk (C f Int32)+    deriving (Generic, Beamable)+  primaryKey = IdxPk . _idx_value++data IdxDb entity = IdxDb+  { _idx_tbl :: entity (TableEntity IdxT)+  } deriving (Generic, Database Postgres)++-- | Verifies that 'verifySchema' correctly detects a secondary index+indexVerification :: IO ByteString -> TestTree+indexVerification pgConn =+    testCase "verifySchema correctly detects a secondary index" $+      withTestPostgres "db_index" pgConn $ \conn -> do+        Pg.execute_ conn "CREATE TABLE idx_tbl (idx_value integer NOT NULL PRIMARY KEY)"+        Pg.execute_ conn "CREATE INDEX idx_tbl_value ON idx_tbl (idx_value)"+        let db :: CheckedDatabaseSettings Postgres IdxDb+            db = defaultMigratableDbSettings `withDbModification`+                  (dbModification @_ @Postgres)+                    { _idx_tbl = addTableIndex "idx_tbl_value" (defaultIndexOptions @PgCommandSyntax)+                                   (\t -> selectorColumnName _idx_value t NE.:| []) }+        runBeamPostgres conn (verifySchema migrationBackend db) >>= \case+          VerificationSucceeded -> return ()+          VerificationFailed failures -> fail ("Verification failed: " ++ show failures)++-- | Verifies that 'verifySchema' correctly detects a UNIQUE secondary index+uniqueIndexVerification :: IO ByteString -> TestTree+uniqueIndexVerification pgConn =+    testCase "verifySchema correctly detects a UNIQUE secondary index" $+      withTestPostgres "db_unique_index" pgConn $ \conn -> do+        Pg.execute_ conn "CREATE TABLE idx_tbl (idx_value integer NOT NULL PRIMARY KEY)"+        Pg.execute_ conn "CREATE UNIQUE INDEX idx_tbl_value_uniq ON idx_tbl (idx_value)"+        let idxOpts = setUniqueIndexOptions @PgCommandSyntax True+                    $ defaultIndexOptions @PgCommandSyntax+            db :: CheckedDatabaseSettings Postgres IdxDb+            db = defaultMigratableDbSettings `withDbModification`+                  (dbModification @_ @Postgres)+                    { _idx_tbl = addTableIndex "idx_tbl_value_uniq" idxOpts+                                   (\t -> selectorColumnName _idx_value t NE.:| []) }+        runBeamPostgres conn (verifySchema migrationBackend db) >>= \case+          VerificationSucceeded -> return ()+          VerificationFailed failures -> fail ("Verification failed: " ++ show failures)