beam-migrate 0.5.2.1 → 0.5.3.0

raw patch · 15 files changed

+370/−120 lines, 15 filesnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−2
• Database/Beam/Haskell/Syntax.hs +44/−26
• Database/Beam/Migrate/Actions.hs +83/−16
• Database/Beam/Migrate/Backend.hs +5/−8
• Database/Beam/Migrate/Checks.hs +22/−1
• Database/Beam/Migrate/Generics/Tables.hs +3/−2
• Database/Beam/Migrate/Log.hs +1/−1
• Database/Beam/Migrate/SQL/Builder.hs +23/−5
• Database/Beam/Migrate/SQL/SQL92.hs +67/−23
• Database/Beam/Migrate/SQL/Tables.hs +81/−7
• Database/Beam/Migrate/SQL/Types.hs +13/−0
• Database/Beam/Migrate/Serialization.hs +5/−7
• Database/Beam/Migrate/Types.hs +4/−4
• Database/Beam/Migrate/Types/CheckedEntities.hs +3/−3
• beam-migrate.cabal +8/−15

@@ -1,12 +1,18 @@+# 0.5.3.0++## Added features++* Added support for creating database schemas and associated tables with `createDatabaseSchema` and `createTableWithSchema`, as well as dropping schemas with `dropDatabaseSchema` (#716).+ # 0.5.2.1 -# Added features+## Added features   * Loosen some version bounds  # 0.5.2.0 -# Addded features+## Addded features   * `IN (SELECT ...)` syntax via `inSelectE` 

@@ -54,13 +54,12 @@   deriving (Show, Eq, Generic) instance Hashable HsImport instance Semigroup HsImport where-  (<>) = mappend+  HsImportAll <> _ = HsImportAll+  _ <> HsImportAll = HsImportAll+  (HsImportSome a) <> (HsImportSome b) =+    HsImportSome (a <> b) instance Monoid HsImport where   mempty = HsImportSome mempty-  mappend HsImportAll _ = HsImportAll-  mappend _ HsImportAll = HsImportAll-  mappend (HsImportSome a) (HsImportSome b) =-    HsImportSome (a <> b)  importSome :: T.Text -> [ Hs.ImportSpec () ] -> HsImports importSome modNm names = HsImports (M.singleton (Hs.ModuleName () (T.unpack modNm))@@ -77,11 +76,10 @@ instance Hashable HsImports where   hashWithSalt s (HsImports a) = hashWithSalt s (M.assocs a) instance Semigroup HsImports where-  (<>) = mappend+  (HsImports a) <> (HsImports b) =+      HsImports (M.unionWith mappend a b) instance Monoid HsImports where   mempty = HsImports mempty-  mappend (HsImports a) (HsImports b) =-    HsImports (M.unionWith mappend a b)  data HsDataType   = HsDataType@@ -140,11 +138,10 @@   }  instance Semigroup HsAction where-  (<>) = mappend+  (<>) (HsAction ma ea) (HsAction mb eb) =+    HsAction (ma <> mb) (ea <> eb) instance Monoid HsAction where   mempty = HsAction [] []-  mappend (HsAction ma ea) (HsAction mb eb) =-    HsAction (ma <> mb) (ea <> eb)  newtype HsBackendConstraint = HsBackendConstraint { buildHsBackendConstraint :: Hs.Type () -> Hs.Asst () } @@ -154,18 +151,17 @@   | HsBeamBackendNone  instance Semigroup (HsBeamBackend f) where-  (<>) = mappend+  (<>) (HsBeamBackendSingle aTy aExp) (HsBeamBackendSingle bTy _)+      | aTy == bTy = HsBeamBackendSingle aTy aExp+      | otherwise = HsBeamBackendNone+  (<>) a@HsBeamBackendSingle {} _ = a+  (<>) _ b@HsBeamBackendSingle {} = b+  (<>) HsBeamBackendNone _ = HsBeamBackendNone+  (<>) _ HsBeamBackendNone = HsBeamBackendNone+  (<>) (HsBeamBackendConstrained a) (HsBeamBackendConstrained b) =+    HsBeamBackendConstrained (a <> b) instance Monoid (HsBeamBackend f) where   mempty = HsBeamBackendConstrained []-  mappend (HsBeamBackendSingle aTy aExp) (HsBeamBackendSingle bTy _)-    | aTy == bTy = HsBeamBackendSingle aTy aExp-    | otherwise = HsBeamBackendNone-  mappend a@HsBeamBackendSingle {} _ = a-  mappend _ b@HsBeamBackendSingle {} = b-  mappend HsBeamBackendNone _ = HsBeamBackendNone-  mappend _ HsBeamBackendNone = HsBeamBackendNone-  mappend (HsBeamBackendConstrained a) (HsBeamBackendConstrained b) =-    HsBeamBackendConstrained (a <> b)  data HsEntity     = HsEntity@@ -189,12 +185,11 @@     }  instance Semigroup HsTableConstraintDecls where-  (<>) = mappend+  (<>) (HsTableConstraintDecls ai ad) (HsTableConstraintDecls bi bd) =+    HsTableConstraintDecls (ai <> bi) (ad <> bd)  instance Monoid HsTableConstraintDecls where   mempty = HsTableConstraintDecls [] []-  mappend (HsTableConstraintDecls ai ad) (HsTableConstraintDecls bi bd) =-    HsTableConstraintDecls (ai <> bi) (ad <> bd)  data HsModule   = HsModule@@ -415,10 +410,9 @@ instance Hashable HsNone  instance Semigroup HsNone where-  (<>) = mappend+  (<>) _ _ = HsNone instance Monoid HsNone where   mempty = HsNone-  mappend _ _ = HsNone  data HsMigrateBackend = HsMigrateBackend @@ -437,10 +431,20 @@         [] -> error "Empty schema name"         x:xs -> toNameCase x:xs ++ "_" ++ T.unpack nm +hsSchemaName :: SchemaName -> String+hsSchemaName (SchemaName nm) = T.unpack nm+ hsTableVarName, hsTableTypeName :: TableName -> String hsTableVarName = hsMkTableName toLower hsTableTypeName = hsMkTableName toUpper +instance IsSql92DdlSchemaCommandSyntax HsAction where+  type Sql92DdlCommandCreateSchemaSyntax HsAction = HsAction+  type Sql92DdlCommandDropSchemaSyntax HsAction = HsAction++  createSchemaCmd = id+  dropSchemaCmd = id+ instance IsSql92DdlCommandSyntax HsAction where   type Sql92DdlCommandCreateTableSyntax HsAction = HsAction   type Sql92DdlCommandAlterTableSyntax HsAction = HsAction@@ -476,6 +480,20 @@   dropTableSyntax nm = HsAction [ (Nothing, dropTable) ] []     where       dropTable = hsApp (hsVar "dropTable") [ hsVar (fromString (hsTableVarName nm)) ]++instance IsSql92CreateSchemaSyntax HsAction where+  type Sql92CreateSchemaSchemaNameSyntax HsAction = SchemaName+  createSchemaSyntax (SchemaName nm) = HsAction [ (Nothing, createSchema) ] []+    where+      createSchema = hsApp (hsVar "createDatabaseSchema") [ hsVar nm ]+++instance IsSql92DropSchemaSyntax HsAction where+  type Sql92DropSchemaSchemaNameSyntax HsAction = SchemaName+  dropSchemaSyntax (SchemaName nm) = HsAction [ (Nothing, dropSchema) ] []+    where+      dropSchema = hsApp (hsVar "dropDatabaseSchema") [ hsVar nm ]+  instance IsSql92CreateTableSyntax HsAction where   type Sql92CreateTableTableNameSyntax HsAction = TableName

@@ -77,12 +77,14 @@   , ensuringNot_   , justOne_ +  , createSchemaActionProvider   , createTableActionProvider   , dropTableActionProvider   , addColumnProvider   , addColumnNullProvider   , dropColumnNullProvider   , defaultActionProvider+  , defaultSchemaActionProvider    -- * Solver   , Solver(..), FinalSolution(..)@@ -194,7 +196,14 @@   }  instance Semigroup (PotentialAction be) where-  (<>) = mappend+  a <> b =+      PotentialAction (actionPreConditions a <> actionPreConditions b)+                      (actionPostConditions a <> actionPostConditions b)+                      (actionCommands a <> actionCommands b)+                      (if T.null (actionEnglish a) then actionEnglish b+                        else if T.null (actionEnglish b) then actionEnglish a+                            else actionEnglish a <> "; " <> actionEnglish b)+                      (actionScore a + actionScore b)  -- | 'PotentialAction's can represent edges or paths. Monadically combining two -- 'PotentialAction's results in the path between the source of the first and@@ -202,14 +211,6 @@ -- nothing (i.e., the edge going back to the same database state) instance Monoid (PotentialAction be) where   mempty = PotentialAction mempty mempty mempty  "" 0-  mappend a b =-    PotentialAction (actionPreConditions a <> actionPreConditions b)-                    (actionPostConditions a <> actionPostConditions b)-                    (actionCommands a <> actionCommands b)-                    (if T.null (actionEnglish a) then actionEnglish b-                      else if T.null (actionEnglish b) then actionEnglish a-                           else actionEnglish a <> "; " <> actionEnglish b)-                    (actionScore a + actionScore b)  -- | See 'ActionProvider' type ActionProviderFn be =@@ -254,11 +255,7 @@   = ActionProvider { getPotentialActions :: ActionProviderFn be }  instance Semigroup (ActionProvider be) where-  (<>) = mappend--instance Monoid (ActionProvider be) where-  mempty = ActionProvider (\_ _ -> [])-  mappend (ActionProvider a) (ActionProvider b) =+  (<>) (ActionProvider a) (ActionProvider b) =     ActionProvider $ \pre post ->     let aRes = a pre post         bRes = b pre post@@ -267,7 +264,12 @@        withStrategy (rparWith (parList rseq)) bRes `seq`        aRes ++ bRes -createTableWeight, dropTableWeight, addColumnWeight, dropColumnWeight :: Int+instance Monoid (ActionProvider be) where+  mempty = ActionProvider (\_ _ -> [])++createSchemaWeight, dropSchemaWeight, createTableWeight, dropTableWeight, addColumnWeight, dropColumnWeight :: Int+createSchemaWeight = 1000+dropSchemaWeight = 100 createTableWeight = 500 dropTableWeight = 100 addColumnWeight = 1@@ -285,6 +287,56 @@ justOne_ [x] = [x] justOne_ _ = [] ++-- IsSql92CreateTableSyntax++-- | Action provider for SQL92 @CREATE SCHEMA@ actions.+createSchemaActionProvider :: forall be+                           . ( Typeable be, BeamMigrateOnlySqlSchemaBackend be )+                           => ActionProvider be+createSchemaActionProvider =+  ActionProvider provider+  where+    provider :: ActionProviderFn be+    provider findPreConditions findPostConditions =+      do schemaP@(SchemaExistsPredicate postSchemaName) <- findPostConditions+         -- Make sure there's no corresponding predicate in the precondition+         ensuringNot_ $+           do SchemaExistsPredicate preSchemaName <- findPreConditions+              guard (preSchemaName == postSchemaName)++         let postConditions = [ p schemaP ]+             cmd = createSchemaCmd (createSchemaSyntax (schemaName postSchemaName))+         pure (PotentialAction mempty (HS.fromList postConditions)+                               (Seq.singleton (MigrationCommand cmd MigrationKeepsData))+                               ("Create the schema " <> postSchemaName) createSchemaWeight)++-- | Action provider for SQL92 @DROP SCHEMA@ actions+dropSchemaActionProvider :: forall be+                         . BeamMigrateOnlySqlSchemaBackend be+                         => ActionProvider be+dropSchemaActionProvider =+ ActionProvider provider+ where+   -- Look for tables that exist as a precondition but not a post condition+   provider :: ActionProviderFn be+   provider findPreConditions findPostConditions =+     do schemaP@(SchemaExistsPredicate preSchemaNm) <- findPreConditions+        ensuringNot_ $+          do SchemaExistsPredicate postSchemaNm <- findPostConditions+             guard (preSchemaNm == postSchemaNm)++        relatedPreds <-+          pure $ do p'@(SomeDatabasePredicate pred') <- findPreConditions+                    guard (pred' `predicateCascadesDropOn` schemaP)+                    pure p'++        -- Now, collect all preconditions that may be related to the dropped table+        let cmd = dropSchemaCmd (dropSchemaSyntax (schemaName preSchemaNm))+        pure (PotentialAction (HS.fromList (SomeDatabasePredicate schemaP:relatedPreds)) mempty+                              (Seq.singleton (MigrationCommand cmd MigrationLosesData))+                              ("Drop schema " <> preSchemaNm) dropSchemaWeight)+ -- | Action provider for SQL92 @CREATE TABLE@ actions. createTableActionProvider :: forall be                            . ( Typeable be, BeamMigrateOnlySqlBackend be )@@ -476,6 +528,8 @@ --  * ALTER TABLE ... ADD COLUMN ... --  * ALTER TABLE ... DROP COLUMN ... --  * ALTER TABLE ... ALTER COLUMN ... SET [NOT] NULL+--+-- For default schema actions, see 'defaultSchemaActionProvider'. defaultActionProvider :: ( Typeable be                          , BeamMigrateOnlySqlBackend be )                       => ActionProvider be@@ -488,7 +542,20 @@   , dropColumnProvider    , addColumnNullProvider-  , dropColumnNullProvider ]+  , dropColumnNullProvider +  ]++-- | Default action providers for any syntax which supports schemas.+--+-- In particular, this provides edges consisting of the following statements:+--+--  * CREATE SCHEMA+--  * DROP SCHEMA+defaultSchemaActionProvider :: ( Typeable be+                               , BeamMigrateOnlySqlSchemaBackend be )+                            => ActionProvider be+defaultSchemaActionProvider +  = createSchemaActionProvider <> dropSchemaActionProvider  -- | Represents current state of a database graph search. --

@@ -7,8 +7,6 @@ -- --   1. Ensure the command syntax for your backend satisfies 'Sql92SaneDdlCommandSyntax'. --   2. Create a value of type 'BeamMigrationBackend'---   3. For compatibility with @beam-migrate-cli@, export this value in an---      exposed module with the name 'migrationBackend'. -- -- This may sound trivial, but it's a bit more involved. In particular, in order -- to complete step 2, you will have to define several instances for some of@@ -24,8 +22,7 @@ -- -- Tools may be interested in the 'SomeBeamMigrationBackend' data type which -- provides a monomorphic type to wrap the polymorphic 'BeamMigrationBackend'--- type. Currently, @beam-migrate-cli@ uses this type to get the underlying--- 'BeamMigrationBackend' via the @hint@ package.+-- type. -- -- For an example migrate backend, see "Database.Beam.Sqlite.Migrate" module Database.Beam.Migrate.Backend@@ -116,15 +113,14 @@   = HaskellPredicateConverter (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)  instance Semigroup HaskellPredicateConverter where-  (<>) = mappend+  (HaskellPredicateConverter a) <> (HaskellPredicateConverter b) =+    HaskellPredicateConverter $ \r -> a r <|> b r  -- | 'HaskellPredicateConverter's can be combined monoidally. instance Monoid HaskellPredicateConverter where   mempty = HaskellPredicateConverter $ \_ -> Nothing-  mappend (HaskellPredicateConverter a) (HaskellPredicateConverter b) =-    HaskellPredicateConverter $ \r -> a r <|> b r --- | Converters for the 'TableExistsPredicate', 'TableHasPrimaryKey', and+-- | Converters for the 'SchemaExistsPredicate', 'TableExistsPredicate', 'TableHasPrimaryKey', and -- 'TableHasColumn' (when supplied with a function to convert a backend data -- type to a haskell one). sql92HsPredicateConverters :: forall fromBe@@ -132,6 +128,7 @@                             => (BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)                             -> HaskellPredicateConverter sql92HsPredicateConverters convType =+  trivialHsConverter @SchemaExistsPredicate <>   trivialHsConverter @TableExistsPredicate <>   trivialHsConverter @TableHasPrimaryKey   <>   hasColumnConverter @fromBe convType

@@ -22,6 +22,21 @@  import GHC.Generics (Generic) +-- * Schema checks++-- | Asserts that a schema with the given name exists in a database+data SchemaExistsPredicate = SchemaExistsPredicate Text {-^ Table name -}+  deriving (Show, Eq, Ord, Typeable, Generic)+instance Hashable SchemaExistsPredicate+instance DatabasePredicate SchemaExistsPredicate where+  englishDescription (SchemaExistsPredicate s) =+    "Schema " <> show s <> " must exist"++  serializePredicate (SchemaExistsPredicate s) =+    object [ "schema-exists" .= s ]++  predicateSpecificity _ = PredicateSpecificityAllBackends+ -- * Table checks  -- | Asserts that a table with the given name exists in a database@@ -131,12 +146,18 @@      , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) )   => BeamDeserializers be beamCheckDeserializers = mconcat-  [ beamDeserializer (const deserializeTableExistsPredicate)+  [ beamDeserializer (const deserializeSchemaExistsPredicate)+  , beamDeserializer (const deserializeTableExistsPredicate)   , beamDeserializer (const deserializeTableHasPrimaryKeyPredicate)   , beamDeserializer deserializeTableHasColumnPredicate   , beamDeserializer deserializeTableColumnHasConstraintPredicate   ]   where+    deserializeSchemaExistsPredicate :: Value -> Parser SomeDatabasePredicate+    deserializeSchemaExistsPredicate =+      withObject "SchemaExistsPredicate" $ \v ->+      SomeDatabasePredicate <$> (SchemaExistsPredicate <$> v .: "schema-exists")+     deserializeTableExistsPredicate :: Value -> Parser SomeDatabasePredicate     deserializeTableExistsPredicate =       withObject "TableExistPredicate" $ \v ->

@@ -23,6 +23,7 @@  import Control.Applicative (Const(..)) +import Data.Kind (Type) import Data.Proxy import Data.Text (Text) import Data.Scientific (Scientific)@@ -34,7 +35,7 @@ import GHC.Generics import GHC.TypeLits -class BeamMigrateSqlBackend be => GMigratableTableSettings be (i :: * -> *) fieldCheck where+class BeamMigrateSqlBackend be => GMigratableTableSettings be (i :: Type -> Type) fieldCheck where   gDefaultTblSettingsChecks :: Proxy be -> Proxy i -> Bool -> fieldCheck ()  instance (BeamMigrateSqlBackend be, GMigratableTableSettings be xId fieldCheckId) =>@@ -81,7 +82,7 @@  -- * Nullability check -type family NullableStatus (x :: *) :: Bool where+type family NullableStatus (x :: Type) :: Bool where   NullableStatus (Maybe x) = 'True   NullableStatus x = 'False 

@@ -1,5 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-}--- | Contains a schema for beam migration tools. Used by the CLI and+-- | Contains a schema for beam migration tools. Used by -- the managed migrations support here. module Database.Beam.Migrate.Log where 

@@ -28,6 +28,13 @@         SqlSyntaxBuilder     deriving Eq +instance IsSql92DdlSchemaCommandSyntax SqlSyntaxBuilder where+  type Sql92DdlCommandCreateSchemaSyntax SqlSyntaxBuilder = SqlSyntaxBuilder+  type Sql92DdlCommandDropSchemaSyntax SqlSyntaxBuilder = SqlSyntaxBuilder++  createSchemaCmd = id+  dropSchemaCmd = id+ instance IsSql92DdlCommandSyntax SqlSyntaxBuilder where   type Sql92DdlCommandCreateTableSyntax SqlSyntaxBuilder = SqlSyntaxBuilder   type Sql92DdlCommandDropTableSyntax SqlSyntaxBuilder = SqlSyntaxBuilder@@ -77,6 +84,18 @@   setNotNullSyntax = SqlSyntaxBuilder (byteString "SET NOT NULL")   setNullSyntax = SqlSyntaxBuilder (byteString "DROP NOT NULL") +instance IsSql92CreateSchemaSyntax SqlSyntaxBuilder where+  type Sql92CreateSchemaSchemaNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder+  createSchemaSyntax schName = +      SqlSyntaxBuilder $+        byteString "CREATE SCHEMA " <> buildSql schName++instance IsSql92DropSchemaSyntax SqlSyntaxBuilder where+  type Sql92DropSchemaSchemaNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder+  dropSchemaSyntax schName = +      SqlSyntaxBuilder $+        byteString "DROP SCHEMA " <> buildSql schName+ instance IsSql92CreateTableSyntax SqlSyntaxBuilder where   type Sql92CreateTableTableNameSyntax SqlSyntaxBuilder = SqlSyntaxBuilder   type Sql92CreateTableColumnSchemaSyntax SqlSyntaxBuilder = SqlSyntaxBuilder@@ -123,14 +142,13 @@   deriving (Show, Eq)  instance Semigroup SqlConstraintAttributesBuilder where-  (<>) = mappend--instance Monoid SqlConstraintAttributesBuilder where-  mempty = SqlConstraintAttributesBuilder Nothing Nothing-  mappend a b =+  a <> b =     SqlConstraintAttributesBuilder       (_sqlConstraintAttributeTiming b <|> _sqlConstraintAttributeTiming a)       (_sqlConstraintAttributeDeferrable b <|> _sqlConstraintAttributeDeferrable a)++instance Monoid SqlConstraintAttributesBuilder where+  mempty = SqlConstraintAttributesBuilder Nothing Nothing  -- | Convert a 'SqlConstraintAttributesBuilder' to its @SQL92@ representation in -- the returned 'ByteString' 'Builder'.

@@ -12,6 +12,7 @@  import Data.Aeson (Value) import Data.Hashable+import Data.Kind (Type) import Data.Text (Text) import Data.Typeable #if ! MIN_VERSION_base(4,11,0)@@ -29,6 +30,15 @@   , Sql92ColumnSchemaExpressionSyntax (Sql92DdlCommandColumnSchemaSyntax cmd) ~       Sql92ExpressionSyntax cmd ) +-- | Syntax equalities that any reasonable DDL syntax with schema support would follow,+-- including equalities between beam-migrate and beam-core types.+type Sql92SaneDdlSchemaCommandSyntax cmd =+  ( Sql92SaneDdlSchemaCommandSyntaxMigrateOnly cmd+  , Sql92ExpressionCastTargetSyntax (Sql92ExpressionSyntax cmd) ~+      Sql92DdlCommandDataTypeSyntax cmd+  , Sql92ColumnSchemaExpressionSyntax (Sql92DdlCommandColumnSchemaSyntax cmd) ~+      Sql92ExpressionSyntax cmd )+ -- | Syntax equalities for any reasonable DDL syntax, only including -- types defined here. type Sql92SaneDdlCommandSyntaxMigrateOnly cmd =@@ -41,6 +51,13 @@       Sql92CreateTableColumnSchemaSyntax (Sql92DdlCommandCreateTableSyntax cmd)   ) +-- | Syntax equalities for any reasonable DDL syntax, only including+-- types defined here.+type Sql92SaneDdlSchemaCommandSyntaxMigrateOnly cmd =+  ( Sql92SaneDdlCommandSyntaxMigrateOnly cmd+  , IsSql92DdlSchemaCommandSyntax cmd+  )+ type Sql92DdlCommandDataTypeSyntax syntax =   Sql92ColumnSchemaColumnTypeSyntax (Sql92DdlCommandColumnSchemaSyntax syntax) type Sql92DdlCommandColumnSchemaSyntax syntax = Sql92CreateTableColumnSchemaSyntax (Sql92DdlCommandCreateTableSyntax syntax)@@ -59,27 +76,54 @@ type Sql92DdlCommandAlterTableActionSyntax syntax =   Sql92AlterTableAlterTableActionSyntax (Sql92DdlCommandAlterTableSyntax syntax) +-- Creation/deletion of schemas isn't supported by all backends (e.g. sqlite)+-- and therefore is considered separately from other DDL commands such as CREATE TABLE+class ( IsSql92CreateSchemaSyntax (Sql92DdlCommandCreateSchemaSyntax syntax)+      , IsSql92DropSchemaSyntax (Sql92DdlCommandDropSchemaSyntax syntax)) =>+  IsSql92DdlSchemaCommandSyntax syntax where+  type Sql92DdlCommandCreateSchemaSyntax syntax :: Type+  type Sql92DdlCommandDropSchemaSyntax syntax :: Type++  createSchemaCmd :: Sql92DdlCommandCreateSchemaSyntax syntax -> syntax+  dropSchemaCmd   :: Sql92DdlCommandDropSchemaSyntax syntax -> syntax+ class ( IsSql92CreateTableSyntax (Sql92DdlCommandCreateTableSyntax syntax)       , IsSql92DropTableSyntax (Sql92DdlCommandDropTableSyntax syntax)       , IsSql92AlterTableSyntax (Sql92DdlCommandAlterTableSyntax syntax)) =>   IsSql92DdlCommandSyntax syntax where-  type Sql92DdlCommandCreateTableSyntax syntax :: *-  type Sql92DdlCommandAlterTableSyntax syntax :: *-  type Sql92DdlCommandDropTableSyntax syntax :: *+  type Sql92DdlCommandCreateTableSyntax syntax :: Type+  type Sql92DdlCommandAlterTableSyntax syntax :: Type+  type Sql92DdlCommandDropTableSyntax syntax :: Type -  createTableCmd :: Sql92DdlCommandCreateTableSyntax syntax -> syntax-  dropTableCmd   :: Sql92DdlCommandDropTableSyntax syntax -> syntax-  alterTableCmd  :: Sql92DdlCommandAlterTableSyntax syntax -> syntax+  createTableCmd  :: Sql92DdlCommandCreateTableSyntax syntax -> syntax+  dropTableCmd    :: Sql92DdlCommandDropTableSyntax syntax -> syntax+  alterTableCmd   :: Sql92DdlCommandAlterTableSyntax syntax -> syntax +class IsSql92SchemaNameSyntax (Sql92CreateSchemaSchemaNameSyntax syntax) => +    IsSql92CreateSchemaSyntax syntax where+  +  type Sql92CreateSchemaSchemaNameSyntax syntax :: Type++  createSchemaSyntax :: Sql92CreateSchemaSchemaNameSyntax syntax+                     -> syntax++class IsSql92SchemaNameSyntax (Sql92DropSchemaSchemaNameSyntax syntax) => +    IsSql92DropSchemaSyntax syntax where+  +  type Sql92DropSchemaSchemaNameSyntax syntax :: Type++  dropSchemaSyntax :: Sql92DropSchemaSchemaNameSyntax syntax+                   -> syntax+ class ( IsSql92TableConstraintSyntax (Sql92CreateTableTableConstraintSyntax syntax)       , IsSql92ColumnSchemaSyntax (Sql92CreateTableColumnSchemaSyntax syntax)       , IsSql92TableNameSyntax (Sql92CreateTableTableNameSyntax syntax) ) =>     IsSql92CreateTableSyntax syntax where -  type Sql92CreateTableTableNameSyntax syntax :: *-  type Sql92CreateTableColumnSchemaSyntax syntax :: *-  type Sql92CreateTableTableConstraintSyntax syntax :: *-  type Sql92CreateTableOptionsSyntax syntax :: *+  type Sql92CreateTableTableNameSyntax syntax :: Type+  type Sql92CreateTableColumnSchemaSyntax syntax :: Type+  type Sql92CreateTableTableConstraintSyntax syntax :: Type+  type Sql92CreateTableOptionsSyntax syntax :: Type    createTableSyntax :: Maybe (Sql92CreateTableOptionsSyntax syntax)                     -> Sql92CreateTableTableNameSyntax syntax@@ -90,15 +134,15 @@ class IsSql92TableNameSyntax (Sql92DropTableTableNameSyntax syntax) =>   IsSql92DropTableSyntax syntax where -  type Sql92DropTableTableNameSyntax syntax :: *+  type Sql92DropTableTableNameSyntax syntax :: Type   dropTableSyntax :: Sql92DropTableTableNameSyntax syntax -> syntax  class ( IsSql92TableNameSyntax (Sql92AlterTableTableNameSyntax syntax),         IsSql92AlterTableActionSyntax (Sql92AlterTableAlterTableActionSyntax syntax) ) =>   IsSql92AlterTableSyntax syntax where -  type Sql92AlterTableTableNameSyntax syntax :: *-  type Sql92AlterTableAlterTableActionSyntax syntax :: *+  type Sql92AlterTableTableNameSyntax syntax :: Type+  type Sql92AlterTableAlterTableActionSyntax syntax :: Type    alterTableSyntax :: Sql92AlterTableTableNameSyntax syntax -> Sql92AlterTableAlterTableActionSyntax syntax                    -> syntax@@ -106,8 +150,8 @@ class ( IsSql92ColumnSchemaSyntax (Sql92AlterTableColumnSchemaSyntax syntax)       , IsSql92AlterColumnActionSyntax (Sql92AlterTableAlterColumnActionSyntax syntax) ) =>   IsSql92AlterTableActionSyntax syntax where-  type Sql92AlterTableAlterColumnActionSyntax syntax :: *-  type Sql92AlterTableColumnSchemaSyntax syntax :: *+  type Sql92AlterTableAlterColumnActionSyntax syntax :: Type+  type Sql92AlterTableColumnSchemaSyntax syntax :: Type   alterColumnSyntax :: Text -> Sql92AlterTableAlterColumnActionSyntax syntax                     -> syntax   addColumnSyntax :: Text -> Sql92AlterTableColumnSchemaSyntax syntax -> syntax@@ -130,9 +174,9 @@       , IsSql92ExpressionSyntax (Sql92ColumnSchemaExpressionSyntax columnSchema)       , Typeable columnSchema, Sql92DisplaySyntax columnSchema, Eq columnSchema, Hashable columnSchema ) =>   IsSql92ColumnSchemaSyntax columnSchema where-  type Sql92ColumnSchemaColumnTypeSyntax columnSchema :: *-  type Sql92ColumnSchemaExpressionSyntax columnSchema :: *-  type Sql92ColumnSchemaColumnConstraintDefinitionSyntax columnSchema :: *+  type Sql92ColumnSchemaColumnTypeSyntax columnSchema :: Type+  type Sql92ColumnSchemaExpressionSyntax columnSchema :: Type+  type Sql92ColumnSchemaColumnConstraintDefinitionSyntax columnSchema :: Type    columnSchemaSyntax :: Sql92ColumnSchemaColumnTypeSyntax columnSchema {-^ Column type -}                      -> Maybe (Sql92ColumnSchemaExpressionSyntax columnSchema) {-^ Default value -}@@ -157,8 +201,8 @@       , IsSql92ConstraintAttributesSyntax (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)       , Typeable constraint ) =>       IsSql92ColumnConstraintDefinitionSyntax constraint where-  type Sql92ColumnConstraintDefinitionConstraintSyntax constraint :: *-  type Sql92ColumnConstraintDefinitionAttributesSyntax constraint :: *+  type Sql92ColumnConstraintDefinitionConstraintSyntax constraint :: Type+  type Sql92ColumnConstraintDefinitionAttributesSyntax constraint :: Type    constraintDefinitionSyntax :: Maybe Text -> Sql92ColumnConstraintDefinitionConstraintSyntax constraint                              -> Maybe (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)@@ -175,9 +219,9 @@       , Typeable (Sql92ColumnConstraintExpressionSyntax constraint)       , Typeable constraint ) =>   IsSql92ColumnConstraintSyntax constraint where-  type Sql92ColumnConstraintMatchTypeSyntax constraint :: *-  type Sql92ColumnConstraintReferentialActionSyntax constraint :: *-  type Sql92ColumnConstraintExpressionSyntax constraint :: *+  type Sql92ColumnConstraintMatchTypeSyntax constraint :: Type+  type Sql92ColumnConstraintReferentialActionSyntax constraint :: Type+  type Sql92ColumnConstraintExpressionSyntax constraint :: Type    notNullConstraintSyntax :: constraint   uniqueColumnConstraintSyntax :: constraint

@@ -8,7 +8,8 @@   ( -- * Table manipulation      -- ** Creation and deletion-    createTable, dropTable+    createTable, createTableWithSchema +  , dropTable   , preserve      -- ** @ALTER TABLE@@@ -19,6 +20,9 @@   , renameTableTo, renameColumnTo   , addColumn, dropColumn +    -- * Schema manipulation+  , createDatabaseSchema, dropDatabaseSchema, existingDatabaseSchema+     -- * Field specification   , DefaultValue, Constraint(..), NotNullConstraint @@ -49,6 +53,9 @@ import Control.Monad.Writer.Strict import Control.Monad.State +import Data.Coerce (coerce)+import Data.Kind (Type)+import Data.String (IsString) import Data.Text (Text) import Data.Typeable import qualified Data.Kind as Kind (Constraint)@@ -64,16 +71,70 @@ --   The first argument is the name of the table. -- --   The second argument is a table containing a 'FieldSchema' for each field.---   See documentation on the 'Field' command for more information.c+--   See documentation on the 'Field' command for more information.+--+--   To create a table in a specific schema, see 'createTableWithSchema'. createTable :: ( Beamable table, Table table                , BeamMigrateSqlBackend be )             => Text -> TableSchema be table             -> Migration be (CheckedDatabaseEntity be db (TableEntity table))-createTable newTblName tblSettings =+createTable = createTableWithSchema Nothing++-- * Schema manipulation++-- | Represents a database schema. To create one, see 'createDatabaseSchema'.+newtype DatabaseSchema +  = MkDatabaseSchema Text+  deriving (Eq, Show, IsString)++-- | Add a @CREATE SCHEMA@ statement to this migration+--+--   To create a table in a specific schema, see 'createTableWithSchema'.+--   To drop a schema, see 'dropDatabaseSchema'.+--   To materialize an existing schema for use in a migration, see 'existingDatabaseSchema'.+createDatabaseSchema :: BeamMigrateSchemaSqlBackend be+                     => Text+                     -> Migration be DatabaseSchema+createDatabaseSchema nm = do+  upDown (createSchemaCmd (createSchemaSyntax (schemaName nm))) Nothing+  pure $ MkDatabaseSchema nm++-- | Add a @DROP SCHEMA@ statement to this migration.+--+--   Depending on the backend, this may fail if the schema is not empty. +--+--   To create a schema, see 'createDatabaseSchema'.+--   To materialize a 'DatabaseSchema', see 'existingDatabaseSchema+dropDatabaseSchema :: BeamMigrateSchemaSqlBackend be+                   => DatabaseSchema+                   -> Migration be ()+dropDatabaseSchema (MkDatabaseSchema nm) +  = upDown (dropSchemaCmd (dropSchemaSyntax (schemaName nm))) Nothing++-- | Materialize a schema for use during a migration (for example, to drop it).+existingDatabaseSchema :: Text -> Migration be DatabaseSchema+existingDatabaseSchema = pure . MkDatabaseSchema++-- | Add a @CREATE TABLE@ statement to this migration, with an explicit schema+--+--   The first argument is the name of the schema, while the second argument is the name of the table.+--+--   The second argument is a table containing a 'FieldSchema' for each field.+--   See documentation on the 'Field' command for more information.+--+--   Note that the database schema is expected to exist; see 'createDatabaseSchema' to create+--   a database schema.+createTableWithSchema :: ( Beamable table, Table table+                         , BeamMigrateSqlBackend be )+                      => Maybe DatabaseSchema -- ^ Schema name, if any+                      -> Text       -- ^ Table name +                      -> TableSchema be table+                      -> Migration be (CheckedDatabaseEntity be db (TableEntity table))+createTableWithSchema maybeSchemaName newTblName tblSettings =   do let pkFields = allBeamValues (\(Columnar' (TableFieldSchema name _ _)) -> name) (primaryKey tblSettings)          tblConstraints = if null pkFields then [] else [ primaryKeyConstraintSyntax pkFields ]          createTableCommand =-           createTableSyntax Nothing (tableName Nothing newTblName)+           createTableSyntax Nothing (tableName (coerce <$> maybeSchemaName) newTblName)                              (allBeamValues (\(Columnar' (TableFieldSchema name (FieldSchema schema) _)) -> (name, schema)) tblSettings)                              tblConstraints          command = createTableCmd createTableCommand@@ -81,7 +142,7 @@          tbl' = changeBeamRep (\(Columnar' (TableFieldSchema name _ _)) -> Columnar' (TableField (pure name) name)) tblSettings           fieldChecks = changeBeamRep (\(Columnar' (TableFieldSchema _ _ cs)) -> Columnar' (Const cs)) tblSettings-+                  tblChecks = [ TableCheck (\tblName _ -> Just (SomeDatabasePredicate (TableExistsPredicate tblName))) ] ++                      primaryKeyCheck @@ -89,9 +150,22 @@            case allBeamValues (\(Columnar' (TableFieldSchema name _ _)) -> name) (primaryKey tblSettings) of              [] -> []              cols -> [ TableCheck (\tblName _ -> Just (SomeDatabasePredicate (TableHasPrimaryKey tblName cols))) ]+         +         -- If a schema has been defined explicitly, then it should be part of checks+         schemaCheck = +            case maybeSchemaName of+              Nothing -> []+              Just (MkDatabaseSchema sn) -> [ SomeDatabasePredicate (SchemaExistsPredicate sn) ]        upDown command Nothing-     pure (CheckedDatabaseEntity (CheckedDatabaseTable (DatabaseTable Nothing newTblName newTblName tbl') tblChecks fieldChecks) [])+     pure (CheckedDatabaseEntity +            (CheckedDatabaseTable +              (DatabaseTable (coerce <$> maybeSchemaName) newTblName newTblName tbl') +              tblChecks +              fieldChecks+            ) +            schemaCheck+          )  -- | Add a @DROP TABLE@ statement to this migration. dropTable :: BeamMigrateSqlBackend be@@ -332,7 +406,7 @@     where checks = [ FieldCheck (\tbl field'' -> SomeDatabasePredicate (TableHasColumn tbl field'' ty :: TableHasColumn be)) ] ++                    map (\cns -> FieldCheck (\tbl field'' -> SomeDatabasePredicate (TableColumnHasConstraint tbl field'' cns :: TableColumnHasConstraint be))) constraints -type family IsNotNull (x :: *) :: Kind.Constraint where+type family IsNotNull (x :: Type) :: Kind.Constraint where   IsNotNull (Maybe x) = TypeError ('Text "You used Database.Beam.Migrate.notNull on a column with type" ':$$:                                    'ShowType (Maybe x) ':$$:                                    'Text "Either remove 'notNull' from your migration or 'Maybe' from your table")

@@ -6,7 +6,9 @@   , FieldSchema(..)    , BeamMigrateOnlySqlBackend+  , BeamMigrateOnlySqlSchemaBackend   , BeamMigrateSqlBackend+  , BeamMigrateSchemaSqlBackend   , BeamMigrateSql99Backend   , BeamSqlBackendConstraintSyntax   , BeamSqlBackendColumnConstraintDefinitionSyntax@@ -53,9 +55,20 @@       , Typeable be       ) => BeamMigrateOnlySqlBackend be +type BeamMigrateOnlySqlSchemaBackend be+  = ( BeamMigrateOnlySqlBackend be+    , IsSql92DdlSchemaCommandSyntax (BeamSqlBackendSyntax be)+    , Sql92SaneDdlSchemaCommandSyntaxMigrateOnly (BeamSqlBackendSyntax be)+    )+ type BeamMigrateSqlBackend be =     ( BeamMigrateOnlySqlBackend be     , Sql92SaneDdlCommandSyntax (BeamSqlBackendSyntax be)+    , BeamSqlBackend be )++type BeamMigrateSchemaSqlBackend be =+    ( BeamMigrateOnlySqlSchemaBackend be+    , Sql92SaneDdlSchemaCommandSyntax (BeamSqlBackendSyntax be)     , BeamSqlBackend be )  type BeamMigrateSql99Backend be =

@@ -246,21 +246,19 @@   }  instance Semigroup (BeamDeserializer be) where-  (<>) = mappend+  (BeamDeserializer a) <> (BeamDeserializer b) =+    BeamDeserializer $ \d o ->+    a d o <|> b d o  instance Monoid (BeamDeserializer be) where   mempty = BeamDeserializer (const (const mzero))-  mappend (BeamDeserializer a) (BeamDeserializer b) =-    BeamDeserializer $ \d o ->-    a d o <|> b d o  instance Semigroup (BeamDeserializers be) where-  (<>) = mappend+  (BeamDeserializers a) <> (BeamDeserializers b) =+    BeamDeserializers (D.unionWithKey (const mappend) a b)  instance Monoid (BeamDeserializers be) where   mempty = BeamDeserializers mempty-  mappend (BeamDeserializers a) (BeamDeserializers b) =-    BeamDeserializers (D.unionWithKey (const mappend) a b)  -- | Helper function to deserialize data from a 'Maybe' 'Value'. --

@@ -98,13 +98,13 @@   deriving Show  instance Semigroup MigrationDataLoss where-    (<>) = mappend+    MigrationLosesData <> _ = MigrationLosesData+    _ <> MigrationLosesData = MigrationLosesData+    MigrationKeepsData <> MigrationKeepsData = MigrationKeepsData  instance Monoid MigrationDataLoss where     mempty = MigrationKeepsData-    mappend MigrationLosesData _ = MigrationLosesData-    mappend _ MigrationLosesData = MigrationLosesData-    mappend MigrationKeepsData MigrationKeepsData = MigrationKeepsData+  -- | A migration command along with metadata on whether the command can lose data data MigrationCommand be

@@ -15,13 +15,13 @@ import Control.Monad.Writer import Control.Monad.Identity +import Data.Kind (Constraint, Type) import Data.Maybe import Data.Monoid import Data.Proxy import Data.Text (Text) import Data.String -import GHC.Types import GHC.Generics  import Lens.Micro (Lens', (&), (^.), (.~), (%~))@@ -36,7 +36,7 @@   -- | The type of the descriptor for this checked entity. Usually this wraps   -- the corresponding 'DatabaseEntityDescriptor' from 'IsDatabaseEntity', along   -- with some mechanism for generating 'DatabasePredicate's.-  data CheckedDatabaseEntityDescriptor be entity :: *+  data CheckedDatabaseEntityDescriptor be entity :: Type    -- | Like 'DatabaseEntityDefaultRequirements' but for checked entities   type CheckedDatabaseEntityDefaultRequirements be entity :: Constraint@@ -57,7 +57,7 @@                       => Text -> CheckedDatabaseEntityDescriptor be entity  -- | Like 'DatabaseEntity' but for checked databases-data CheckedDatabaseEntity be (db :: (* -> *) -> *) entityType where+data CheckedDatabaseEntity be (db :: (Type -> Type) -> Type) entityType where   CheckedDatabaseEntity :: IsCheckedDatabaseEntity be entityType                         => CheckedDatabaseEntityDescriptor be entityType                         -> [ SomeDatabasePredicate ]

@@ -1,5 +1,5 @@ name:                beam-migrate-version:             0.5.2.1+version:             0.5.3.0 synopsis:            SQL DDL support and migrations support library for Beam description:         This package provides type classes to allow backends to implement                      SQL DDL support for beam. This allows you to use beam syntax to@@ -13,12 +13,6 @@                      library is used to write tooling to support DDL manipulation in                      your project, or to enable migrations support in beam backends. -                     For a more turnkey solution for database migrations, consider-                     the <http://hackage.haskell.org/package/beam-migrate-cli beam-migrate>-                     command line tool. This provides out-of-the-box support for migrations,-                     schema change management, and version control, based on the features-                     provided in this library.- homepage:            https://travis.athougies.net/projects/beam.html license:             MIT license-file:        LICENSE@@ -61,27 +55,26 @@    build-depends:       base                 >=4.9     && <5.0,                        beam-core            >=0.10    && <0.11,-                       text                 >=1.2     && <2.1,-                       aeson                >=0.11    && <2.2,-                       bytestring           >=0.10    && <0.12,+                       text                 >=1.2     && <2.2,+                       aeson                >=0.11    && <2.3,+                       bytestring           >=0.10    && <0.13,                        free                 >=4.12    && <5.3,                        time                 >=1.6     && <1.13,                        mtl                  >=2.2     && <2.4,                        scientific           >=0.3     && <0.4,                        vector               >=0.11    && <0.14,-                       containers           >=0.5     && <0.7,+                       containers           >=0.5     && <0.8,                        unordered-containers >=0.2     && <0.3,                        hashable             >=1.2     && <1.5,                        microlens            >=0.4     && <0.5,                        parallel             >=3.2     && <3.3,-                       deepseq              >=1.4     && <1.5,-                       ghc-prim             >=0.5     && <0.11,-                       containers           >=0.5     && <0.7,+                       deepseq              >=1.4     && <1.7,+                       ghc-prim             >=0.5     && <0.12,                        haskell-src-exts     >=1.18    && <1.24,                        pretty               >=1.1     && <1.2,                        dependent-map        >=0.2     && <0.5,                        dependent-sum        >=0.4     && <0.8,-                       pqueue               >=1.3     && <1.5,+                       pqueue               >=1.3     && <1.6,                        uuid-types           >=1.0     && <1.1   default-language:    Haskell2010   default-extensions:  KindSignatures, OverloadedStrings, TypeFamilies, FlexibleContexts,