| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Database.Beam.Migrate.Types
- type CheckedDatabaseSettings be db = db (CheckedDatabaseEntity be db)
- class IsDatabaseEntity be entity => IsCheckedDatabaseEntity be entity where
- data CheckedDatabaseEntityDescriptor be entity :: *
- type CheckedDatabaseEntityDefaultRequirements be entity syntax :: Constraint
- data CheckedDatabaseEntity be (db :: (* -> *) -> *) entityType where
- CheckedDatabaseEntity :: IsCheckedDatabaseEntity be entityType => CheckedDatabaseEntityDescriptor be entityType -> [SomeDatabasePredicate] -> CheckedDatabaseEntity be db entityType
- unCheckDatabase :: forall be db. Database db => CheckedDatabaseSettings be db -> DatabaseSettings be db
- collectChecks :: forall be db. Database db => CheckedDatabaseSettings be db -> [SomeDatabasePredicate]
- data CheckedFieldModification tbl a
- modifyCheckedTable :: (Text -> Text) -> tbl (CheckedFieldModification tbl) -> EntityModification (CheckedDatabaseEntity be db) be (TableEntity tbl)
- checkedTableModification :: forall tbl. Beamable tbl => tbl (CheckedFieldModification tbl)
- class (Typeable p, Hashable p, Eq p) => DatabasePredicate p where
- data SomeDatabasePredicate where
- SomeDatabasePredicate :: DatabasePredicate p => p -> SomeDatabasePredicate
- data PredicateSpecificity
- p :: DatabasePredicate p => p -> SomeDatabasePredicate
- newtype TableCheck = TableCheck (forall tbl. Table tbl => Text -> tbl (TableField tbl) -> SomeDatabasePredicate)
- newtype DomainCheck = DomainCheck (Text -> SomeDatabasePredicate)
- newtype FieldCheck = FieldCheck (Text -> Text -> SomeDatabasePredicate)
- data MigrationStep syntax next where
- MigrationStep :: Text -> Migration syntax a -> (a -> next) -> MigrationStep syntax next
- newtype MigrationSteps syntax from to = MigrationSteps (Kleisli (F (MigrationStep syntax)) from to)
- type Migration syntax = F (MigrationF syntax)
- data MigrationF syntax next where
- MigrationRunCommand :: {..} -> MigrationF syntax next
- migrationStepsToMigration :: Int -> Maybe Int -> MigrationSteps syntax () a -> (forall a'. Text -> Migration syntax a' -> IO a') -> IO a
- runMigrationSilenced :: Migration syntax a -> a
- runMigrationVerbose :: MonadBeam syntax be hdl m => (syntax -> String) -> Migration syntax a -> m a
- executeMigration :: Applicative m => (syntax -> m ()) -> Migration syntax a -> m a
- eraseMigrationType :: a -> MigrationSteps syntax a a' -> MigrationSteps syntax () ()
- migrationStep :: Text -> (a -> Migration syntax a') -> MigrationSteps syntax a a'
- upDown :: syntax -> Maybe syntax -> Migration syntax ()
- migrateScript :: forall syntax m a. Monoid m => (Text -> m) -> (syntax -> m) -> MigrationSteps syntax () a -> m
- evaluateDatabase :: forall syntax a. MigrationSteps syntax () a -> a
- stepNames :: forall syntax a. MigrationSteps syntax () a -> [Text]
Checked database entities
type CheckedDatabaseSettings be db = db (CheckedDatabaseEntity be db) Source #
The type of a checked database descriptor. Conceptually, this is just a
DatabaseSettings with a set of predicates. Use unCheckDatabase to get the
regular DatabaseSettings object and collectChecks to access the
predicates.
class IsDatabaseEntity be entity => IsCheckedDatabaseEntity be entity where Source #
Like IsDatabaseEntity in beam-core, but for entities against which we
can generate DatabasePredicates. Conceptually, this is the same as
IsDatabaseEntity, but with one extra function to generate
DatabasePredicates from the description.
Minimal complete definition
Associated Types
data CheckedDatabaseEntityDescriptor be entity :: * Source #
The type of the descriptor for this checked entity. Usually this wraps
the corresponding DatabaseEntityDescriptor from IsDatabaseEntity, along
with some mechanism for generating DatabasePredicates.
type CheckedDatabaseEntityDefaultRequirements be entity syntax :: Constraint Source #
Like DatabaseEntityDefaultRequirements but for checked entities
Methods
unCheck :: CheckedDatabaseEntityDescriptor be entity -> DatabaseEntityDescriptor be entity Source #
Produce the corresponding DatabaseEntityDescriptior
collectEntityChecks :: CheckedDatabaseEntityDescriptor be entity -> [SomeDatabasePredicate] Source #
Produce the set of DatabasePredicates that apply to this entity
checkedDbEntityAuto :: CheckedDatabaseEntityDefaultRequirements be entity syntax => Proxy syntax -> Text -> CheckedDatabaseEntityDescriptor be entity Source #
Like dbEntityAuto but for checked databases. Most often, this wraps
dbEntityAuto and provides some means to generate DatabasePredicates
Instances
| Beamable tbl => IsCheckedDatabaseEntity be (TableEntity tbl) Source # | |
| IsCheckedDatabaseEntity be (DomainTypeEntity ty) Source # | |
data CheckedDatabaseEntity be (db :: (* -> *) -> *) entityType where Source #
Like DatabaseEntity but for checked databases
Constructors
| CheckedDatabaseEntity :: IsCheckedDatabaseEntity be entityType => CheckedDatabaseEntityDescriptor be entityType -> [SomeDatabasePredicate] -> CheckedDatabaseEntity be db entityType |
unCheckDatabase :: forall be db. Database db => CheckedDatabaseSettings be db -> DatabaseSettings be db Source #
Convert a CheckedDatabaseSettings to a regular DatabaseSettings. The
return value is suitable for use in any regular beam query or DML statement.
collectChecks :: forall be db. Database db => CheckedDatabaseSettings be db -> [SomeDatabasePredicate] Source #
A beam-migrate database schema is defined completely by the set of
predicates that apply to it. This function allows you to access this
definition for a CheckedDatabaseSettings object.
Modifyinging checked entities
data CheckedFieldModification tbl a Source #
Purposefully opaque type describing how to modify a table field. Used to
parameterize the second argument to modifyCheckedTable. For now, the only
way to construct a value is the IsString instance, which allows you to
rename the field.
Instances
| Beamable tbl => RenamableWithRule (tbl (CheckedFieldModification tbl)) Source # | |
| IsString (CheckedFieldModification tbl a) Source # | |
modifyCheckedTable :: (Text -> Text) -> tbl (CheckedFieldModification tbl) -> EntityModification (CheckedDatabaseEntity be db) be (TableEntity tbl) Source #
Modify a checked table.
The first argument is a function that takes the original table name as input and produces a new table name.
The second argument gives instructions on how to rename each field in the
table. Use checkedTableModification to create a value of this type which
does no renaming. Each field in the table supplied here has the type
CheckedFieldModification. Most commonly, the programmer will use the
OverloadedStrings instance to provide a new name.
Examples
Rename a table, without renaming any of its fields:
modifyCheckedTable (_ -> NewTblNm) checkedTableModification
Modify a table, renaming the field called _field1 in Haskell to
FirstName. Note that below, FirstName represents a
CheckedFieldModification object.
modifyCheckedTable id (checkedTableModification { _field1 = FirstName })
checkedTableModification :: forall tbl. Beamable tbl => tbl (CheckedFieldModification tbl) Source #
Produce a table field modification that does nothing
Most commonly supplied as the second argument to modifyCheckedTable when
you just want to rename the table, not the fields.
Predicates
class (Typeable p, Hashable p, Eq p) => DatabasePredicate p where Source #
A predicate is a type that describes some condition that the database
schema must meet. Beam represents database schemas as the set of all
predicates that apply to a database schema. The Hashable and Eq instances
allow us to build HashSets of predicates to represent schemas in this way.
Minimal complete definition
englishDescription, predicateSpecificity, serializePredicate
Methods
englishDescription :: p -> String Source #
An english language description of this predicate. For example, "There is
a table named TableName"
predicateSpecificity :: proxy p -> PredicateSpecificity Source #
Whether or not this predicate applies to all backends or only one
backend. This is used when attempting to translate schemas between
backends. If you are unsure, provide PredicateSpecificityOnlyBackend
along with an identifier unique to your backend.
serializePredicate :: p -> Value Source #
Serialize a predicate to a JSON Value.
predicateCascadesDropOn :: DatabasePredicate p' => p -> p' -> Bool Source #
Some predicates require other predicates to be true. For example, in
order for a table to have a column, that table must exist. This function
takes in the current predicate and another arbitrary database predicate. It
should return True if this predicate needs the other predicate to be true
in order to exist.
By default, this simply returns False, which makes sense for many
predicates.
Instances
data SomeDatabasePredicate where Source #
A Database predicate is a value of any type which satisfies
DatabasePredicate. We often want to store these in lists and sets, so we
need a monomorphic container that can store these polymorphic values.
Constructors
| SomeDatabasePredicate :: DatabasePredicate p => p -> SomeDatabasePredicate |
data PredicateSpecificity Source #
Some predicates make sense in any backend. Others only make sense in one. This denotes the difference.
p :: DatabasePredicate p => p -> SomeDatabasePredicate Source #
Convenience synonym for SomeDatabasePredicate
Entity checks
newtype TableCheck Source #
A predicate that depends on the name of a table as well as its fields
Constructors
| TableCheck (forall tbl. Table tbl => Text -> tbl (TableField tbl) -> SomeDatabasePredicate) |
newtype DomainCheck Source #
A predicate that depends on the name of a domain type
Constructors
| DomainCheck (Text -> SomeDatabasePredicate) |
newtype FieldCheck Source #
A predicate that depedns on the name of a table and one of its fields
Constructors
| FieldCheck (Text -> Text -> SomeDatabasePredicate) |
Migrations
data MigrationStep syntax next where Source #
Constructors
| MigrationStep :: Text -> Migration syntax a -> (a -> next) -> MigrationStep syntax next |
Instances
| Functor (MigrationStep syntax) Source # | |
newtype MigrationSteps syntax from to Source #
Constructors
| MigrationSteps (Kleisli (F (MigrationStep syntax)) from to) |
Instances
| Arrow (MigrationSteps syntax) Source # | |
| Category * (MigrationSteps syntax) Source # | |
type Migration syntax = F (MigrationF syntax) Source #
data MigrationF syntax next where Source #
Constructors
| MigrationRunCommand :: {..} -> MigrationF syntax next | |
Fields
| |
Instances
| Functor (MigrationF syntax) Source # | |
migrationStepsToMigration :: Int -> Maybe Int -> MigrationSteps syntax () a -> (forall a'. Text -> Migration syntax a' -> IO a') -> IO a Source #
runMigrationSilenced :: Migration syntax a -> a Source #
runMigrationVerbose :: MonadBeam syntax be hdl m => (syntax -> String) -> Migration syntax a -> m a Source #
executeMigration :: Applicative m => (syntax -> m ()) -> Migration syntax a -> m a Source #
Execute a given migration, provided a command to execute arbitrary syntax.
You usually use this with runNoReturn.
eraseMigrationType :: a -> MigrationSteps syntax a a' -> MigrationSteps syntax () () Source #
migrationStep :: Text -> (a -> Migration syntax a') -> MigrationSteps syntax a a' Source #
migrateScript :: forall syntax m a. Monoid m => (Text -> m) -> (syntax -> m) -> MigrationSteps syntax () a -> m Source #
evaluateDatabase :: forall syntax a. MigrationSteps syntax () a -> a Source #
stepNames :: forall syntax a. MigrationSteps syntax () a -> [Text] Source #