Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Documentation
Instances
ReifyActions ('[] :: [ActionK]) ('[] :: [DdlColumnK]) new Source # | |
Defined in Sqel.Migration.Column reifyActions :: NP DdlColumn '[] -> NP DdlColumn new -> [ColumnAction] Source # | |
(ReifyNewAction action new, ReifyActions actions ('[] :: [DdlColumnK]) new) => ReifyActions (action ': actions) ('[] :: [DdlColumnK]) new Source # | |
Defined in Sqel.Migration.Column reifyActions :: NP DdlColumn '[] -> NP DdlColumn new -> [ColumnAction] Source # | |
(ReifyOldAction action o new, ReifyActions actions old new) => ReifyActions (action ': actions) (o ': old) new Source # | |
Defined in Sqel.Migration.Column reifyActions :: NP DdlColumn (o ': old) -> NP DdlColumn new -> [ColumnAction] Source # |
type family MkMigrationAction (old :: OldK) (check :: [NewK]) (other :: [NewK]) :: (ActionK, [NewK]) where ... Source #
MkMigrationAction ('OldK _ _ 'True) '[] other = '('RemoveK, other) | |
MkMigrationAction ('OldK name comp 'False) ('NewK index name comp 'Nothing 'Nothing ': news) other = '('ActionK 'KeepK index, news ++ other) | |
MkMigrationAction ('OldK oldName comp 'False) ('NewK index _ comp ('Just oldName) 'Nothing ': news) other = '('ActionK 'RenameK index, news ++ other) | |
MkMigrationAction ('OldK oldName ('Just oldComp) 'False) ('NewK index newName _ rename ('Just oldComp) ': news) other = MkMigrationAction ('OldK oldName ('Just oldComp) 'False) ('NewK index newName ('Just oldComp) rename 'Nothing ': news) other | |
MkMigrationAction old (new ': news) other = MkMigrationAction old news (new ': other) | |
MkMigrationAction old '[] other = TypeError ("MkMigrationAction:" % (old % other)) |
type family NewMigrationActions (cols :: [NewK]) :: [ActionK] where ... Source #
NewMigrationActions '[] = '[] | |
NewMigrationActions ('NewK index _ _ 'Nothing 'Nothing ': news) = 'ActionK 'AddK index ': NewMigrationActions news | |
NewMigrationActions cols = TypeError ("NewMigrationActions:" % cols) |
type family MigrationActionsCont (cur :: (ActionK, [NewK])) (old :: [OldK]) :: [ActionK] where ... Source #
MigrationActionsCont '(cur, new) old = cur ': MigrationActions old new |
type family MigrationActions (old :: [OldK]) (new :: [NewK]) :: [ActionK] where ... Source #
MigrationActions '[] rest = NewMigrationActions rest | |
MigrationActions (old ': olds) new = MigrationActionsCont (MkMigrationAction old new '[]) olds |
class ColumnAddition (comp :: Maybe Symbol) (def :: Type) where Source #
columnAddition :: def -> PgColumnName -> ColumnType -> [ColumnAction] Source #
Instances
ColumnAddition ('Nothing :: Maybe Symbol) () Source # | |
Defined in Sqel.Migration.Column columnAddition :: () -> PgColumnName -> ColumnType -> [ColumnAction] Source # | |
PrimColumn a => ColumnAddition ('Nothing :: Maybe Symbol) (MigrationDefault a) Source # | |
Defined in Sqel.Migration.Column columnAddition :: MigrationDefault a -> PgColumnName -> ColumnType -> [ColumnAction] Source # | |
ColumnAddition ('Just tname) () Source # | |
Defined in Sqel.Migration.Column columnAddition :: () -> PgColumnName -> ColumnType -> [ColumnAction] Source # |
class ColIndex index cols col | index cols -> col where Source #
class ReifyModAction action old new where Source #
reifyModAction :: DdlColumn old -> DdlColumn new -> [ColumnAction] Source #
Instances
ReifyModAction 'KeepK old new Source # | |
Defined in Sqel.Migration.Column reifyModAction :: DdlColumn old -> DdlColumn new -> [ColumnAction] Source # | |
ReifyModAction 'RenameK ('DdlColumnK name compOld modsOld renameOld renameTOld deleteOld typeOld) ('DdlColumnK nameNew compNew modsNew ('Just name) renameTNew delNew typeNew) Source # | |
Defined in Sqel.Migration.Column reifyModAction :: DdlColumn ('DdlColumnK name compOld modsOld renameOld renameTOld deleteOld typeOld) -> DdlColumn ('DdlColumnK nameNew compNew modsNew ('Just name) renameTNew delNew typeNew) -> [ColumnAction] Source # |
class ReifyOldAction action old new where Source #
reifyOldAction :: DdlColumn old -> NP DdlColumn new -> [ColumnAction] Source #
Instances
ReifyOldAction 'RemoveK old new Source # | |
Defined in Sqel.Migration.Column reifyOldAction :: DdlColumn old -> NP DdlColumn new -> [ColumnAction] Source # | |
(ColIndex index news new, ReifyModAction mod old new) => ReifyOldAction ('ActionK mod index) old news Source # | |
Defined in Sqel.Migration.Column reifyOldAction :: DdlColumn old -> NP DdlColumn news -> [ColumnAction] Source # |
class ReifyNewAction action new where Source #
reifyNewAction :: NP DdlColumn new -> [ColumnAction] Source #
Instances
(ColIndex index news ('DdlColumnK name comp mods rename renameT delete tpe), OptMod (MigrationDefault tpe) mods def, ColumnAddition comp def) => ReifyNewAction ('ActionK 'AddK index) news Source # | |
Defined in Sqel.Migration.Column reifyNewAction :: NP DdlColumn news -> [ColumnAction] Source # |
class ReifyActions actions old new where Source #
reifyActions :: NP DdlColumn old -> NP DdlColumn new -> [ColumnAction] Source #
Instances
ReifyActions ('[] :: [ActionK]) ('[] :: [DdlColumnK]) new Source # | |
Defined in Sqel.Migration.Column reifyActions :: NP DdlColumn '[] -> NP DdlColumn new -> [ColumnAction] Source # | |
(ReifyNewAction action new, ReifyActions actions ('[] :: [DdlColumnK]) new) => ReifyActions (action ': actions) ('[] :: [DdlColumnK]) new Source # | |
Defined in Sqel.Migration.Column reifyActions :: NP DdlColumn '[] -> NP DdlColumn new -> [ColumnAction] Source # | |
(ReifyOldAction action o new, ReifyActions actions old new) => ReifyActions (action ': actions) (o ': old) new Source # | |
Defined in Sqel.Migration.Column reifyActions :: NP DdlColumn (o ': old) -> NP DdlColumn new -> [ColumnAction] Source # |
class ColumnsChanges old new where Source #
columnsChanges :: NP DdlColumn old -> NP DdlColumn new -> [ColumnAction] Source #
Instances
(actions ~ MigrationActions (OldKs 0 old) (NewKs 0 new), ReifyActions actions old new) => ColumnsChanges old new Source # | |
Defined in Sqel.Migration.Column columnsChanges :: NP DdlColumn old -> NP DdlColumn new -> [ColumnAction] Source # |