beam-migrate 0.5.4.0 → 0.5.5.0

raw patch · 12 files changed

+506/−21 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +27/−0
• Database/Beam/Haskell/Syntax.hs +3/−1
• Database/Beam/Migrate/Actions.hs +54/−13
• Database/Beam/Migrate/Checks.hs +78/−1
• Database/Beam/Migrate/SQL/Builder.hs +15/−1
• Database/Beam/Migrate/SQL/SQL92.hs +30/−2
• Database/Beam/Migrate/SQL/Tables.hs +5/−1
• Database/Beam/Migrate/SQL/Types.hs +3/−0
• Database/Beam/Migrate/TempTable.hs +247/−0
• Database/Beam/Migrate/Types.hs +3/−0
• Database/Beam/Migrate/Types/CheckedEntities.hs +37/−0
• beam-migrate.cabal +4/−2

@@ -1,3 +1,30 @@+# 0.5.5.0++## Added features++* Added support for foreign key constraints:++  * New `ForeignKeyAction` datatype representing possible actions when updating+    or deleting a row with referencing foreign keys.+  * The `IsSql92TableConstraintSyntax` typeclass now has an additional method,+    `foreignKeyConstraintSyntax`, for constructing foreign key constraint syntax.+  * Introduce `addTableForeignKey` for declaring new foreign key constraints.++* Added support for temporary tables:++  * The `BeamHasTempTables` typeclass is used for backends to emit+    `CREATE TEMPORARY TABLE` syntax.+  * The `runCreateTempTable` command allows creating a temporary table.+    The returned table entity can be used in queries like any other table.++## Bug fixes++* Fix an issue in which `beam-migrate` would fail to migrate a unique index+  to a non-unique index or vice-versa.++* Fixed an issue in which the migration solver could end up taking an+  exponentially long time to conclude that migration isn't possible.+ # 0.5.4.0  ## Added features

@@ -25,6 +25,7 @@ import           Data.Hashable import           Data.Int import           Data.List (find, nub)+import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import           Data.Maybe import qualified Data.Set as S@@ -584,6 +585,7 @@                             map hsConstraintDefinitionConstraint cs)  instance IsSql92TableConstraintSyntax HsTableConstraint where+  foreignKeyConstraintSyntax _ _ _ _ _ = HsTableConstraint $ \_ _ -> mempty   primaryKeyConstraintSyntax fields =     HsTableConstraint $ \tblNm tblFields ->     let primaryKeyDataDecl = insDataDecl primaryKeyType [ primaryKeyConDecl ] (Just primaryKeyDeriving)@@ -591,7 +593,7 @@         tableTypeNm = tblNm <> "T"         tableTypeKeyNm = tblNm <> "Key" -        (fieldRecordNames, fieldTys) = unzip (fromMaybe (error "fieldTys") (mapM (hsFieldLookup tblFields) fields))+        (fieldRecordNames, fieldTys) = unzip (fromMaybe (error "fieldTys") (mapM (hsFieldLookup tblFields) $ NE.toList fields))          primaryKeyType = tyApp (tyConNamed "PrimaryKey") [ tyConNamed (T.unpack tableTypeNm), tyVarNamed "f" ]         primaryKeyConDecl  = Hs.QualConDecl () Nothing Nothing (Hs.ConDecl () (Hs.Ident () (T.unpack tableTypeKeyNm)) fieldTys)

@@ -107,6 +107,7 @@ import           Control.Parallel.Strategies  import           Data.Foldable+import qualified Data.List.NonEmpty as NE  import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS@@ -377,9 +378,41 @@            guard (tblNm == postTblNm)            pure (primaryKeyP, primaryKey) -         let postConditions = [ p tblP, p primaryKeyP ] ++ concat columnsP+         -- For each foreign key constraint, ensure the referenced table+         -- already exists in the current state.+         -- This enforces a topological ordering, so that the solver schedules+         -- CREATE TABLE for all referenced tables first.+         --+         -- Note: this does not support cycles in the foreign key reference graph,+         -- for which we would need ALTER TABLE ADD CONSTRAINT, which we don't+         -- currently support.+         (fkPs, fkConstraints) <- do+           let fkData =+                 unzip+                   [ ( p fkP+                     , foreignKeyConstraintSyntax localCols (qnameAsText refTbl) refCols onUpd onDel )+                   | fkP@(TableHasForeignKey tblNm localCols refTbl refCols onUpd onDel)+                       <- findPostConditions+                   , tblNm == postTblNm+                   ]+               refTbls =+                 [ refTbl+                 | TableHasForeignKey tblNm _ refTbl _ _ _ <- findPostConditions+                 , tblNm == postTblNm+                 , refTbl /= postTblNm+                 ]+           for_ refTbls $ \refTbl -> do+             TableExistsPredicate nm <- findPreConditions+             guard (nm == refTbl)+           pure fkData+++         let postConditions = [ p tblP, p primaryKeyP ] ++ concat columnsP ++ fkPs              cmd = createTableCmd (createTableSyntax Nothing (qnameAsTableName postTblNm) colsSyntax tblConstraints)-             tblConstraints = if null primaryKey then [] else [ primaryKeyConstraintSyntax primaryKey ]+             tblConstraints = (case NE.nonEmpty primaryKey of+                                Nothing   -> []+                                Just pkey -> [primaryKeyConstraintSyntax pkey])+                           ++ fkConstraints              colsSyntax = map (\(colNm, type_, cs) -> (colNm, columnSchemaSyntax type_ Nothing cs Nothing)) columns          pure (PotentialAction mempty (HS.fromList postConditions)                                (Seq.singleton (MigrationCommand cmd MigrationKeepsData))@@ -453,16 +486,14 @@ dropColumnProvider = ActionProvider provider   where     provider :: ActionProviderFn be-    provider findPreConditions _ =+    provider findPreConditions findPostConditions =       do colP@(TableHasColumn tblNm colNm _ :: TableHasColumn be)            <- findPreConditions ---         TableExistsPredicate tblNm' <- trace ("COnsider drop " <> show tblNm <> " " <> show colNm)  findPreConditions---         guard (any (\(TableExistsPredicate tblNm') -> tblNm' == tblNm) findPreConditions) --tblNm' == tblNm)---         ensuringNot_ $ do---           TableHasColumn tblNm' colNm' colType' :: TableHasColumn (Sql92DdlCommandColumnSchemaSyntax cmd) <----             findPostConditions---           guard (tblNm' == tblNm && colNm == colNm' && colType == colType') -- This column exists as a different type+         -- Don't drop a column that the goal still requires with the same type.+         ensuringNot_ $ do+           (colPost :: TableHasColumn be) <- findPostConditions+           guard (p colPost == p colP)           relatedPreds <- --pure []            pure $ do p'@(SomeDatabasePredicate pred') <- findPreConditions@@ -506,11 +537,16 @@ dropColumnNullProvider = ActionProvider provider   where     provider :: ActionProviderFn be-    provider findPreConditions _ =+    provider findPreConditions findPostConditions =       do colP@(TableColumnHasConstraint tblNm colNm _ :: TableColumnHasConstraint be)            <- findPreConditions -- TODO         guard (c == notNullConstraintSyntax) +         -- Don't drop a constraint that is still required in the goal.+         ensuringNot_ $+           do (sdp :: SomeDatabasePredicate) <- findPostConditions+              guard (sdp == p colP)+          TableExistsPredicate tblNm' <- findPreConditions          guard (tblNm == tblNm') @@ -564,10 +600,15 @@     provider findPreConditions findPostConditions =       do (idxP@(TableHasIndex { hasIndex_table = preTblNm, hasIndex_name = idxNm })             :: TableHasIndex be) <- findPreConditions++         -- Supress DROP INDEX if the exact same index is still required+         -- in the goal (including options such as uniqueness).+         --+         -- Comparing only by name would wrongly prevent dropping a non-unique+         -- index that must be replaced by a unique one (or vice-versa).          ensuringNot_ $-           do (TableHasIndex { hasIndex_table = postTblNm, hasIndex_name = idxNm' }-                :: TableHasIndex be) <- findPostConditions-              guard (preTblNm == postTblNm && idxNm' == idxNm)+           do (postIdx :: TableHasIndex be) <- findPostConditions+              guard (p postIdx == p idxP)           let cmd = dropIndexCmd idxNm          pure (PotentialAction (HS.singleton (p idxP)) mempty

@@ -11,7 +11,8 @@ import Database.Beam.Migrate.Serialization import Database.Beam.Migrate.Types.Predicates -import Data.Aeson ((.:), (.=), withObject, object)+import Data.Aeson ((.:), (.:?), (.=), withObject, object)+import Data.Maybe (fromMaybe) import Data.Aeson.Types (Parser, Value) import Data.Hashable (Hashable(..)) import qualified Data.List.NonEmpty as NE (NonEmpty)@@ -168,6 +169,67 @@     | Just (TableExistsPredicate tblNm') <- cast p' = tblNm' == tblNm     | otherwise = False +-- | Asserts that the given table has a foreign key referencing another table.+-- Create these predicates with+-- 'Database.Beam.Migrate.Types.CheckedEntities.addTableForeignKey'.+data TableHasForeignKey+  = TableHasForeignKey+  { hasForeignKey_table      :: QualifiedName      -- ^ source table+  , hasForeignKey_columns    :: NE.NonEmpty Text   -- ^ local columns (in order)+  , hasForeignKey_refTable   :: QualifiedName      -- ^ referenced table+  , hasForeignKey_refColumns :: NE.NonEmpty Text   -- ^ referenced columns (in order)+  , hasForeignKey_onUpdate   :: ForeignKeyAction+  , hasForeignKey_onDelete   :: ForeignKeyAction+  } deriving (Show, Eq, Generic)+instance Hashable TableHasForeignKey+instance DatabasePredicate TableHasForeignKey where+  englishDescription (TableHasForeignKey { hasForeignKey_table = tbl+                                         , hasForeignKey_columns = cols+                                         , hasForeignKey_refTable = refTbl+                                         , hasForeignKey_refColumns = refCols+                                         , hasForeignKey_onUpdate = onUpd+                                         , hasForeignKey_onDelete = onDel }) =+    "Table " <> show tbl <> " has foreign key on " <> show cols <>+    " referencing " <> show refTbl <> " " <> show refCols <>+    " ON UPDATE " <> show onUpd <>+    " ON DELETE " <> show onDel++  predicateSpecificity _ = PredicateSpecificityAllBackends++  serializePredicate (TableHasForeignKey { hasForeignKey_table = tbl+                                         , hasForeignKey_columns = cols+                                         , hasForeignKey_refTable = refTbl+                                         , hasForeignKey_refColumns = refCols+                                         , hasForeignKey_onUpdate = onUpd+                                         , hasForeignKey_onDelete = onDel }) =+    object [ "has-foreign-key" .= object+               [ "table"       .= tbl+               , "columns"     .= cols+               , "ref-table"   .= refTbl+               , "ref-columns" .= refCols+               , "on-update"   .= serializeForeignKeyAction onUpd+               , "on-delete"   .= serializeForeignKeyAction onDel+               ] ]++  predicateCascadesDropOn (TableHasForeignKey { hasForeignKey_table = tblNm }) p'+    | Just (TableExistsPredicate tblNm') <- cast p' = tblNm' == tblNm+    | otherwise = False++serializeForeignKeyAction :: ForeignKeyAction -> Text+serializeForeignKeyAction ForeignKeyActionCascade    = "cascade"+serializeForeignKeyAction ForeignKeyActionSetNull    = "set-null"+serializeForeignKeyAction ForeignKeyActionSetDefault = "set-default"+serializeForeignKeyAction ForeignKeyActionRestrict   = "restrict"+serializeForeignKeyAction ForeignKeyNoAction         = "no-action"++deserializeForeignKeyAction :: Text -> Maybe ForeignKeyAction+deserializeForeignKeyAction "cascade"     = Just ForeignKeyActionCascade+deserializeForeignKeyAction "set-null"    = Just ForeignKeyActionSetNull+deserializeForeignKeyAction "set-default" = Just ForeignKeyActionSetDefault+deserializeForeignKeyAction "restrict"    = Just ForeignKeyActionRestrict+deserializeForeignKeyAction "no-action"   = Just ForeignKeyNoAction+deserializeForeignKeyAction _             = Nothing+ -- * Deserialization  -- | 'BeamDeserializers' for all the predicates defined in this module@@ -182,6 +244,7 @@   , beamDeserializer (const deserializeTableExistsPredicate)   , beamDeserializer (const deserializeTableHasPrimaryKeyPredicate)   , beamDeserializer (const deserializeTableHasIndexPredicate)+  , beamDeserializer (const deserializeTableHasForeignKeyPredicate)   , beamDeserializer deserializeTableHasColumnPredicate   , beamDeserializer deserializeTableColumnHasConstraintPredicate   ]@@ -213,6 +276,20 @@          (TableHasIndex <$> v' .: "table" <*> v' .: "name"                         <*> v' .: "columns"                         <*> (deserializeIndexOptions @(BeamSqlBackendSyntax be) =<< v' .: "options")))++    deserializeTableHasForeignKeyPredicate :: Value -> Parser SomeDatabasePredicate+    deserializeTableHasForeignKeyPredicate =+      withObject "TableHasForeignKey" $ \v ->+      v .: "has-foreign-key" >>=+      (withObject "TableHasForeignKey" $ \v' ->+       SomeDatabasePredicate <$>+         (TableHasForeignKey+           <$> v' .: "table"+           <*> v' .: "columns"+           <*> v' .: "ref-table"+           <*> v' .: "ref-columns"+           <*> (fromMaybe ForeignKeyNoAction . (>>= deserializeForeignKeyAction) <$> v' .:? "on-update")+           <*> (fromMaybe ForeignKeyNoAction . (>>= deserializeForeignKeyAction) <$> v' .:? "on-delete")))      deserializeTableHasColumnPredicate :: BeamDeserializers be'                                        -> Value -> Parser SomeDatabasePredicate

@@ -14,6 +14,7 @@ import           Data.ByteString.Builder (Builder, byteString, toLazyByteString) import qualified Data.ByteString.Lazy.Char8 as BCL +import qualified Data.List.NonEmpty as NE  -- | Options for @CREATE TABLE@. Given as a separate ADT because the options may -- go in different places syntactically.@@ -124,7 +125,20 @@ instance IsSql92TableConstraintSyntax SqlSyntaxBuilder where   primaryKeyConstraintSyntax fs =     SqlSyntaxBuilder $-    byteString "PRIMARY KEY(" <> buildSepBy (byteString ", ") (map quoteSql fs) <> byteString ")"+    byteString "PRIMARY KEY(" <> buildSepBy (byteString ", ") (map quoteSql $ NE.toList fs) <> byteString ")"+  foreignKeyConstraintSyntax localCols refTbl refCols onUpdate onDelete =+    SqlSyntaxBuilder $+    byteString "FOREIGN KEY(" <> buildSepBy (byteString ", ") (map quoteSql $ NE.toList localCols) <> byteString ")" <>+    byteString " REFERENCES " <> quoteSql refTbl <>+    byteString "(" <> buildSepBy (byteString ", ") (map quoteSql $ NE.toList refCols) <> byteString ")" <>+    byteString " ON UPDATE " <> buildSql (sqlForeignKeyAction onUpdate) <>+    byteString " ON DELETE " <> buildSql (sqlForeignKeyAction onDelete)+    where+      sqlForeignKeyAction ForeignKeyActionCascade    = SqlSyntaxBuilder (byteString "CASCADE")+      sqlForeignKeyAction ForeignKeyActionSetNull    = SqlSyntaxBuilder (byteString "SET NULL")+      sqlForeignKeyAction ForeignKeyActionSetDefault = SqlSyntaxBuilder (byteString "SET DEFAULT")+      sqlForeignKeyAction ForeignKeyActionRestrict   = SqlSyntaxBuilder (byteString "RESTRICT")+      sqlForeignKeyAction ForeignKeyNoAction         = SqlSyntaxBuilder (byteString "NO ACTION")  -- | Some backends use this to represent their constraint attributes. Does not -- need to be used in practice.

@@ -17,7 +17,8 @@ import Data.Kind (Type) import qualified Data.List.NonEmpty as NE (NonEmpty) import Data.Text (Text)-import Data.Typeable+import Data.Typeable (Typeable)+import GHC.Generics (Generic)  -- * Convenience type synonyms @@ -184,8 +185,35 @@                      -> Maybe Text {-^ Default collation -}                      -> columnSchema +-- | Action to perform on referencing foreign keys when a row is modified.+data ForeignKeyAction+  = ForeignKeyActionCascade+    -- ^ @CASCADE@: propagate the action to referencing foreign key columns.+  | ForeignKeyActionSetNull+    -- ^ @SET NULL@: set the referencing foreign key colums to @NULL@.+  | ForeignKeyActionSetDefault+    -- ^ @SET DEFAULT@: set the referencing foreign key columns to their default+    -- values.+  | ForeignKeyActionRestrict+    -- ^ @RESTRICT@: prohibit modification of a row when foreign key references+    -- to that row exist.+  | ForeignKeyNoAction+    -- ^ @NO ACTION@+  deriving (Show, Eq, Ord, Generic)+instance Hashable ForeignKeyAction+ class Typeable constraint => IsSql92TableConstraintSyntax constraint where-  primaryKeyConstraintSyntax :: [ Text ] -> constraint+  primaryKeyConstraintSyntax :: NE.NonEmpty Text -> constraint+  -- | Emit a @FOREIGN KEY (cols) REFERENCES tbl (refCols)@ table constraint.+  --+  -- Use 'addTableForeignKey' to attach a foreign key to a schema definition.+  foreignKeyConstraintSyntax+    :: NE.NonEmpty Text  -- ^ local columns+    -> Text              -- ^ referenced table name+    -> NE.NonEmpty Text  -- ^ referenced columns+    -> ForeignKeyAction  -- ^ ON UPDATE action+    -> ForeignKeyAction  -- ^ ON DELETE action+    -> constraint  class Typeable match => IsSql92MatchTypeSyntax match where   fullMatchSyntax :: match

@@ -55,6 +55,7 @@  import Data.Coerce (coerce) import Data.Kind (Type)+import qualified Data.List.NonEmpty as NE import Data.Text (Text) import Data.Typeable import qualified Data.Kind as Kind (Constraint)@@ -143,7 +144,10 @@                       -> 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 ]+         tblConstraints =+          case NE.nonEmpty pkFields of+            Nothing  -> []+            Just pks -> [ primaryKeyConstraintSyntax pks ]          createTableCommand =            createTableSyntax Nothing (tableName (coerce <$> maybeSchemaName) newTblName)                              (allBeamValues (\(Columnar' (TableFieldSchema name (FieldSchema schema) _)) -> (name, schema)) tblSettings)

@@ -19,6 +19,7 @@   , BeamSqlBackendReferentialActionSyntax   , BeamSqlBackendConstraintAttributesSyntax   , BeamSqlBackendIndexSyntax+  , BeamSqlBackendTableConstraintSyntax   ) where  import Database.Beam.Migrate.Types.Predicates@@ -94,3 +95,5 @@   = Sql92DdlCommandConstraintAttributesSyntax (BeamSqlBackendSyntax be) type BeamSqlBackendIndexSyntax be   = Sql92CreateIndexOptionsSyntax (BeamSqlBackendSyntax be)+type BeamSqlBackendTableConstraintSyntax be+  = Sql92CreateTableTableConstraintSyntax (Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be))

@@ -0,0 +1,247 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Database.Beam.Migrate.TempTable+  ( -- * Temporary tables++    -- ** @CREATE TEMPORARY TABLE@+    runCreateTempTable++    -- ** Options+  , TempTableCreateMode(..)+  , TempTableOptions(..)+  , defaultTempTableOptions++    -- ** Backend support for temporary tables+  , BeamHasTempTables(..)++    -- ** Schema constraint+  , HasDefaultTempTableSchema++    -- ** Internals+  , GNullableConstraintsForSchema(..)+  , GDefaultBackendFieldSchemas(..)+  ) where++import           Control.Monad.Writer (execWriter, tell)++import           Data.Functor.Const (Const(..))+import           Data.Functor.Identity (Identity(..))+import           Data.Kind (Type)+import           Data.Proxy (Proxy(..))+import qualified Data.Text as T+import           GHC.Generics++import           Database.Beam.Backend.SQL+  ( MonadBeam(..), BeamSqlBackendSyntax )+import           Database.Beam.Backend.Types (Nullable)+import           Database.Beam.Migrate.Generics (HasDefaultSqlDataType(..), NullableStatus)+import           Database.Beam.Migrate.SQL.SQL92+  ( IsSql92ColumnSchemaSyntax(..)+  , IsSql92ColumnConstraintDefinitionSyntax(..)+  , IsSql92ColumnConstraintSyntax(..)+  )+import           Database.Beam.Migrate.SQL.Types+  ( BeamMigrateSqlBackend+  , BeamSqlBackendColumnSchemaSyntax+  , BeamSqlBackendColumnConstraintDefinitionSyntax+  )+import           Database.Beam.Query (HasQBuilder)+import           Database.Beam.Schema.Tables+  ( DatabaseEntity(..), DatabaseEntityDescriptor(..)+  , TableEntity+  , TableSettings, TableField(..)+  , defTblFieldSettings, allBeamValues, zipBeamFieldsM+  , Columnar'(..), Table(..)+  , GDefaultTableFieldSettings+  )++--------------------------------------------------------------------------------++-- | How to handle an existing temporary table when calling 'runCreateTempTable'.+data TempTableCreateMode+  = CreateIfNotExists+    -- ^ Emit @CREATE TEMPORARY TABLE IF NOT EXISTS@.+    -- If the table already exists, do nothing.+  | DropAndCreate+    -- ^ Emit @DROP TABLE IF EXISTS@ followed by @CREATE TEMPORARY TABLE@.+    -- The table is always (re)created fresh.+  deriving (Eq, Ord, Show)++-- | Options for 'runCreateTempTable'.+data TempTableOptions = TempTableOptions+  { tempTableCreateMode :: TempTableCreateMode+    -- ^ Whether to preserve an existing table or recreate it from scratch.+  }++-- | Default options: use @CREATE TEMPORARY TABLE IF NOT EXISTS@.+defaultTempTableOptions :: TempTableOptions+defaultTempTableOptions =+  TempTableOptions { tempTableCreateMode = CreateIfNotExists }++-- | Support for temporary tables in a Beam backend.+class (BeamMigrateSqlBackend be, HasQBuilder be) => BeamHasTempTables be where+  -- | Render a @CREATE TEMPORARY TABLE@ command.+  createTempTableCmd+    :: T.Text+       -- ^ table name+    -> [(T.Text, BeamSqlBackendColumnSchemaSyntax be)]+       -- ^ ordered (column name, column schema) pairs+    -> [T.Text]+       -- ^ primary key column names (empty for no primary key constraint)+    -> Bool+       -- ^ include @IF NOT EXISTS@?+    -> BeamSqlBackendSyntax be++  -- | Render a @DROP TABLE IF EXISTS@ command.+  dropTempTableIfExistsCmd+    :: T.Text+       -- ^ table name+    -> BeamSqlBackendSyntax be+++-- | Constraint used for deriving the schema of a temporary table.+type HasDefaultTempTableSchema be tbl =+  ( BeamHasTempTables be+  , Generic (tbl (Const (BeamSqlBackendColumnSchemaSyntax be)))+  , GDefaultBackendFieldSchemas be+      (Rep (tbl Identity))+      (Rep (tbl (Const (BeamSqlBackendColumnSchemaSyntax be))))+  , Table tbl+  , Generic (TableSettings tbl)+  , GDefaultTableFieldSettings (Rep (TableSettings tbl) ())+  )++-- ---------------------------------------------------------------------------+-- CREATE TEMPORARY TABLE++-- | Execute @CREATE TEMPORARY TABLE@, returning the created temporary table+-- entity.+--+-- Note that the @db@ parameter is phantom; if you need to change it you can+-- use 'Data.Coerce.coerce'.+runCreateTempTable+  :: forall be db tbl m+  .  ( HasDefaultTempTableSchema be tbl+     , MonadBeam be m )+  => TempTableOptions+  -> T.Text -- ^ temporary table name+  -> m (DatabaseEntity be db (TableEntity tbl))+runCreateTempTable opts nm = do+  let tblSettings = defTblFieldSettings :: TableSettings tbl+      colSchemas  = deriveTblColSchemas (Proxy @be) (Proxy @tbl)++      -- Collect (columnName, columnSchema) pairs in field declaration order.+      fieldDefs :: [(T.Text, BeamSqlBackendColumnSchemaSyntax be)]+      fieldDefs = execWriter $+        zipBeamFieldsM+          (\(Columnar' tf) c@(Columnar' (Const schema)) ->+              do tell [(_fieldName tf, schema)]+                 return c+          )+          tblSettings colSchemas++      pkFields =+        allBeamValues (\(Columnar' tf) -> _fieldName tf) (primaryKey tblSettings)++  case tempTableCreateMode opts of+    CreateIfNotExists ->+      runNoReturn (createTempTableCmd @be nm fieldDefs pkFields True)+    DropAndCreate -> do+      runNoReturn (dropTempTableIfExistsCmd @be nm)+      runNoReturn (createTempTableCmd @be nm fieldDefs pkFields False)++  let entity = DatabaseEntity $ DatabaseTable+        { dbTableSchema      = Nothing+        , dbTableOrigName    = nm+        , dbTableCurrentName = nm+        , dbTableSettings    = tblSettings+        }+  pure entity++deriveTblColSchemas+  :: forall be tbl+  .  HasDefaultTempTableSchema be tbl+  => Proxy be -> Proxy tbl -> tbl (Const (BeamSqlBackendColumnSchemaSyntax be))+deriveTblColSchemas pBe _ =+  to $ gDefaultBackendFieldSchemas pBe (Proxy @(Rep (tbl Identity))) False++------------------------------------------------------------------------------+-- Generics machinery (internal)++class BeamMigrateSqlBackend be+    => GNullableConstraintsForSchema (nullable :: Bool) be where+  nullableConstraintsForSchema+    :: Proxy nullable+    -> Proxy be+    -> [BeamSqlBackendColumnConstraintDefinitionSyntax be]++instance BeamMigrateSqlBackend be+    => GNullableConstraintsForSchema 'False be where+  nullableConstraintsForSchema _ _ =+    [ constraintDefinitionSyntax Nothing notNullConstraintSyntax Nothing ]++instance BeamMigrateSqlBackend be+    => GNullableConstraintsForSchema 'True be where+  nullableConstraintsForSchema _ _ = []++class BeamMigrateSqlBackend be+    => GDefaultBackendFieldSchemas be (i :: Type -> Type) (o :: Type -> Type) where+  gDefaultBackendFieldSchemas :: Proxy be -> Proxy i -> Bool -> o ()++instance ( BeamMigrateSqlBackend be+         , GDefaultBackendFieldSchemas be xId schemaId )+    => GDefaultBackendFieldSchemas be (M1 t s xId) (M1 t s schemaId) where+  gDefaultBackendFieldSchemas pBe _ embedded =+    M1 (gDefaultBackendFieldSchemas pBe (Proxy @xId) embedded)++instance ( BeamMigrateSqlBackend be+         , GDefaultBackendFieldSchemas be aId aSchema+         , GDefaultBackendFieldSchemas be bId bSchema )+    => GDefaultBackendFieldSchemas be (aId :*: bId) (aSchema :*: bSchema) where+  gDefaultBackendFieldSchemas pBe _ embedded =+    gDefaultBackendFieldSchemas pBe (Proxy @aId) embedded :*:+    gDefaultBackendFieldSchemas pBe (Proxy @bId) embedded+++instance ( HasDefaultSqlDataType be haskTy+         , GNullableConstraintsForSchema (NullableStatus haskTy) be+         , cs ~ BeamSqlBackendColumnSchemaSyntax be )+    => GDefaultBackendFieldSchemas be+         (Rec0 haskTy)+         (Rec0 (Const cs haskTy)) where+  gDefaultBackendFieldSchemas pBe _ embedded =+    K1 $ Const $ columnSchemaSyntax+      (defaultSqlDataType (Proxy @haskTy) pBe embedded)+      Nothing+      (nullableConstraintsForSchema (Proxy @(NullableStatus haskTy)) pBe)+      Nothing++instance ( BeamMigrateSqlBackend be+         , cs ~ BeamSqlBackendColumnSchemaSyntax be+         , Generic (embeddedTbl (Const cs))+         , GDefaultBackendFieldSchemas be+             (Rep (embeddedTbl Identity))+             (Rep (embeddedTbl (Const cs))) )+    => GDefaultBackendFieldSchemas be+         (Rec0 (embeddedTbl Identity))+         (Rec0 (embeddedTbl (Const cs))) where+  gDefaultBackendFieldSchemas pBe _ _ =+    K1 $ to $ gDefaultBackendFieldSchemas pBe+      (Proxy @(Rep (embeddedTbl Identity))) True++instance ( BeamMigrateSqlBackend be+         , cs ~ BeamSqlBackendColumnSchemaSyntax be+         , Generic (embeddedTbl (Nullable (Const cs)))+         , GDefaultBackendFieldSchemas be+             (Rep (embeddedTbl (Nullable Identity)))+             (Rep (embeddedTbl (Nullable (Const cs)))) )+    => GDefaultBackendFieldSchemas be+         (Rec0 (embeddedTbl (Nullable Identity)))+         (Rec0 (embeddedTbl (Nullable (Const cs)))) where+  gDefaultBackendFieldSchemas pBe _ _ =+    K1 $ to $ gDefaultBackendFieldSchemas pBe+      (Proxy @(Rep (embeddedTbl (Nullable Identity)))) True+

@@ -30,6 +30,9 @@    , IsSql92CreateDropIndexSyntax(..) +  , addTableForeignKey+  , primaryKeyColumns+     -- * Predicates   , DatabasePredicate(..)   , SomeDatabasePredicate(..)

@@ -298,6 +298,43 @@     in CheckedDatabaseEntity (CheckedDatabaseTable dt (tblChecks ++ [idxCheck]) fieldChecks)                              extraChecks +-- | Declare a foreign key constraint on a checked table entity.+--+-- Example referencing the primary key of a @UserT@ table:+--+-- @+-- addTableForeignKey (db ^. usersTable)+--   (\\ t -> selectorColumnName _postAuthorId t NE.:| [])+--   primaryKeyColumns+--   ForeignKeyNoAction    -- ON UPDATE action+--   ForeignKeyActionCascade -- ON DELETE action+-- @+addTableForeignKey+  :: forall be db localTbl refTbl.+     (Table localTbl, Table refTbl)+  => CheckedDatabaseEntity be db (TableEntity refTbl)         -- ^ referenced table+  -> (localTbl (TableField localTbl) -> NE.NonEmpty Text)     -- ^ local columns+  -> (refTbl (TableField refTbl) -> NE.NonEmpty Text)         -- ^ referenced columns+  -> ForeignKeyAction -- ^ ON UPDATE action+  -> ForeignKeyAction -- ^ ON DELETE action+  -> EntityModification (CheckedDatabaseEntity be db) be (TableEntity localTbl)+addTableForeignKey refTableEntity getLocalFk getRefFk onUpdate onDelete =+  EntityModification $ Endo $+  \(CheckedDatabaseEntity (CheckedDatabaseTable dt tblChecks fieldChecks) extraChecks) ->+    let+        CheckedDatabaseEntity (CheckedDatabaseTable refDt _ _) _ = refTableEntity+        refTableName = QualifiedName (dbTableSchema refDt) (dbTableCurrentName refDt)++        localCols = getLocalFk (dbTableSettings dt)+        refCols   = getRefFk (dbTableSettings refDt)++        fkCheck = TableCheck $ \tblNm _flds ->+          Just (SomeDatabasePredicate+                  (TableHasForeignKey tblNm localCols refTableName refCols onUpdate onDelete))++    in CheckedDatabaseEntity (CheckedDatabaseTable dt (tblChecks ++ [fkCheck]) fieldChecks)+                             extraChecks+ -- | Produce a table field modification that does nothing -- --   Most commonly supplied as the second argument to 'modifyCheckedTable' when

@@ -1,5 +1,5 @@ name:                beam-migrate-version:             0.5.4.0+version:             0.5.5.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@@ -45,6 +45,8 @@                         Database.Beam.Migrate.Simple +                       Database.Beam.Migrate.TempTable+                        Database.Beam.Haskell.Syntax    other-modules:       Database.Beam.Migrate.Generics.Types@@ -73,7 +75,7 @@                        pretty               >=1.1     && <1.2,                        dependent-map        >=0.2     && <0.5,                        dependent-sum        >=0.4     && <0.8,-                       pqueue               >=1.3     && <1.7,+                       pqueue               >=1.3     && <1.8,                        uuid-types           >=1.0     && <1.1   default-language:    Haskell2010   default-extensions:  KindSignatures, OverloadedStrings, TypeFamilies, FlexibleContexts,