{-# LANGUAGE UndecidableInstances #-}
module Database.Beam.Migrate.Types.CheckedEntities where
import Database.Beam
import Database.Beam.Backend.SQL
import Database.Beam.Schema.Tables
import Database.Beam.Migrate.Checks
import Database.Beam.Migrate.Generics.Tables
import Database.Beam.Migrate.Types.Predicates
import Control.Applicative
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.Generics
import Lens.Micro (Lens', (&), (^.), (.~), (%~))
class IsDatabaseEntity be entity => IsCheckedDatabaseEntity be entity where
data CheckedDatabaseEntityDescriptor be entity :: Type
type CheckedDatabaseEntityDefaultRequirements be entity :: Constraint
unCheck :: CheckedDatabaseEntityDescriptor be entity -> DatabaseEntityDescriptor be entity
unCheck CheckedDatabaseEntityDescriptor be entity
d = CheckedDatabaseEntityDescriptor be entity
d CheckedDatabaseEntityDescriptor be entity
-> Getting
(DatabaseEntityDescriptor be entity)
(CheckedDatabaseEntityDescriptor be entity)
(DatabaseEntityDescriptor be entity)
-> DatabaseEntityDescriptor be entity
forall s a. s -> Getting a s a -> a
^. Getting
(DatabaseEntityDescriptor be entity)
(CheckedDatabaseEntityDescriptor be entity)
(DatabaseEntityDescriptor be entity)
forall be entity.
IsCheckedDatabaseEntity be entity =>
Lens'
(CheckedDatabaseEntityDescriptor be entity)
(DatabaseEntityDescriptor be entity)
Lens'
(CheckedDatabaseEntityDescriptor be entity)
(DatabaseEntityDescriptor be entity)
unChecked
unChecked :: Lens' (CheckedDatabaseEntityDescriptor be entity) (DatabaseEntityDescriptor be entity)
collectEntityChecks :: CheckedDatabaseEntityDescriptor be entity -> [ SomeDatabasePredicate ]
checkedDbEntityAuto :: CheckedDatabaseEntityDefaultRequirements be entity
=> Text -> CheckedDatabaseEntityDescriptor be entity
data CheckedDatabaseEntity be (db :: (Type -> Type) -> Type) entityType where
CheckedDatabaseEntity :: IsCheckedDatabaseEntity be entityType
=> CheckedDatabaseEntityDescriptor be entityType
-> [ SomeDatabasePredicate ]
-> CheckedDatabaseEntity be db entityType
type CheckedDatabaseSettings be db = db (CheckedDatabaseEntity be db)
renameCheckedEntity :: (Text -> Text) -> EntityModification (CheckedDatabaseEntity be db) be ent
renameCheckedEntity :: forall be (db :: (* -> *) -> *) ent.
(Text -> Text)
-> EntityModification (CheckedDatabaseEntity be db) be ent
renameCheckedEntity Text -> Text
renamer =
Endo (CheckedDatabaseEntity be db ent)
-> EntityModification (CheckedDatabaseEntity be db) be ent
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification ((CheckedDatabaseEntity be db ent
-> CheckedDatabaseEntity be db ent)
-> Endo (CheckedDatabaseEntity be db ent)
forall a. (a -> a) -> Endo a
Endo (\(CheckedDatabaseEntity CheckedDatabaseEntityDescriptor be ent
desc [SomeDatabasePredicate]
checks) -> (CheckedDatabaseEntityDescriptor be ent
-> [SomeDatabasePredicate] -> CheckedDatabaseEntity be db ent
forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity (CheckedDatabaseEntityDescriptor be ent
desc CheckedDatabaseEntityDescriptor be ent
-> (CheckedDatabaseEntityDescriptor be ent
-> CheckedDatabaseEntityDescriptor be ent)
-> CheckedDatabaseEntityDescriptor be ent
forall a b. a -> (a -> b) -> b
& (DatabaseEntityDescriptor be ent
-> Identity (DatabaseEntityDescriptor be ent))
-> CheckedDatabaseEntityDescriptor be ent
-> Identity (CheckedDatabaseEntityDescriptor be ent)
forall be entity.
IsCheckedDatabaseEntity be entity =>
Lens'
(CheckedDatabaseEntityDescriptor be entity)
(DatabaseEntityDescriptor be entity)
Lens'
(CheckedDatabaseEntityDescriptor be ent)
(DatabaseEntityDescriptor be ent)
unChecked ((DatabaseEntityDescriptor be ent
-> Identity (DatabaseEntityDescriptor be ent))
-> CheckedDatabaseEntityDescriptor be ent
-> Identity (CheckedDatabaseEntityDescriptor be ent))
-> ((Text -> Identity Text)
-> DatabaseEntityDescriptor be ent
-> Identity (DatabaseEntityDescriptor be ent))
-> (Text -> Identity Text)
-> CheckedDatabaseEntityDescriptor be ent
-> Identity (CheckedDatabaseEntityDescriptor be ent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text)
-> DatabaseEntityDescriptor be ent
-> Identity (DatabaseEntityDescriptor be ent)
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
Lens' (DatabaseEntityDescriptor be ent) Text
dbEntityName ((Text -> Identity Text)
-> CheckedDatabaseEntityDescriptor be ent
-> Identity (CheckedDatabaseEntityDescriptor be ent))
-> (Text -> Text)
-> CheckedDatabaseEntityDescriptor be ent
-> CheckedDatabaseEntityDescriptor be ent
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Text -> Text
renamer) [SomeDatabasePredicate]
checks)))
unCheckDatabase :: forall be db. Database be db => CheckedDatabaseSettings be db -> DatabaseSettings be db
unCheckDatabase :: forall be (db :: (* -> *) -> *).
Database be db =>
CheckedDatabaseSettings be db -> DatabaseSettings be db
unCheckDatabase CheckedDatabaseSettings be db
db = Identity (DatabaseSettings be db) -> DatabaseSettings be db
forall a. Identity a -> a
runIdentity (Identity (DatabaseSettings be db) -> DatabaseSettings be db)
-> Identity (DatabaseSettings be db) -> DatabaseSettings be db
forall a b. (a -> b) -> a -> b
$ Proxy be
-> (forall tbl.
(IsDatabaseEntity be tbl,
DatabaseEntityRegularRequirements be tbl) =>
CheckedDatabaseEntity be db tbl
-> CheckedDatabaseEntity be db tbl
-> Identity (DatabaseEntity be db tbl))
-> CheckedDatabaseSettings be db
-> CheckedDatabaseSettings be db
-> Identity (DatabaseSettings be db)
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
(IsDatabaseEntity be tbl,
DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
(IsDatabaseEntity be tbl,
DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be) (\(CheckedDatabaseEntity CheckedDatabaseEntityDescriptor be tbl
x [SomeDatabasePredicate]
_) CheckedDatabaseEntity be db tbl
_ -> DatabaseEntity be db tbl -> Identity (DatabaseEntity be db tbl)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DatabaseEntity be db tbl -> Identity (DatabaseEntity be db tbl))
-> DatabaseEntity be db tbl -> Identity (DatabaseEntity be db tbl)
forall a b. (a -> b) -> a -> b
$ DatabaseEntityDescriptor be tbl -> DatabaseEntity be db tbl
forall be entityType (db :: (* -> *) -> *).
IsDatabaseEntity be entityType =>
DatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
DatabaseEntity (CheckedDatabaseEntityDescriptor be tbl
-> DatabaseEntityDescriptor be tbl
forall be entity.
IsCheckedDatabaseEntity be entity =>
CheckedDatabaseEntityDescriptor be entity
-> DatabaseEntityDescriptor be entity
unCheck CheckedDatabaseEntityDescriptor be tbl
x)) CheckedDatabaseSettings be db
db CheckedDatabaseSettings be db
db
collectChecks :: forall be db. Database be db => CheckedDatabaseSettings be db -> [ SomeDatabasePredicate ]
collectChecks :: forall be (db :: (* -> *) -> *).
Database be db =>
CheckedDatabaseSettings be db -> [SomeDatabasePredicate]
collectChecks CheckedDatabaseSettings be db
db = let (CheckedDatabaseSettings be db
_ :: CheckedDatabaseSettings be db, [SomeDatabasePredicate]
a) =
Writer [SomeDatabasePredicate] (CheckedDatabaseSettings be db)
-> (CheckedDatabaseSettings be db, [SomeDatabasePredicate])
forall w a. Writer w a -> (a, w)
runWriter (Writer [SomeDatabasePredicate] (CheckedDatabaseSettings be db)
-> (CheckedDatabaseSettings be db, [SomeDatabasePredicate]))
-> Writer [SomeDatabasePredicate] (CheckedDatabaseSettings be db)
-> (CheckedDatabaseSettings be db, [SomeDatabasePredicate])
forall a b. (a -> b) -> a -> b
$ Proxy be
-> (forall tbl.
(IsDatabaseEntity be tbl,
DatabaseEntityRegularRequirements be tbl) =>
CheckedDatabaseEntity be db tbl
-> CheckedDatabaseEntity be db tbl
-> WriterT
[SomeDatabasePredicate] Identity (CheckedDatabaseEntity be db tbl))
-> CheckedDatabaseSettings be db
-> CheckedDatabaseSettings be db
-> Writer [SomeDatabasePredicate] (CheckedDatabaseSettings be db)
forall be (db :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
(Database be db, Applicative m) =>
Proxy be
-> (forall tbl.
(IsDatabaseEntity be tbl,
DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
Proxy be
-> (forall tbl.
(IsDatabaseEntity be tbl,
DatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be)
(\(CheckedDatabaseEntity CheckedDatabaseEntityDescriptor be tbl
entity [SomeDatabasePredicate]
cs :: CheckedDatabaseEntity be db entityType) CheckedDatabaseEntity be db tbl
b ->
do [SomeDatabasePredicate]
-> WriterT [SomeDatabasePredicate] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (CheckedDatabaseEntityDescriptor be tbl -> [SomeDatabasePredicate]
forall be entity.
IsCheckedDatabaseEntity be entity =>
CheckedDatabaseEntityDescriptor be entity
-> [SomeDatabasePredicate]
collectEntityChecks CheckedDatabaseEntityDescriptor be tbl
entity)
[SomeDatabasePredicate]
-> WriterT [SomeDatabasePredicate] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [SomeDatabasePredicate]
cs
CheckedDatabaseEntity be db tbl
-> WriterT
[SomeDatabasePredicate] Identity (CheckedDatabaseEntity be db tbl)
forall a. a -> WriterT [SomeDatabasePredicate] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CheckedDatabaseEntity be db tbl
b) CheckedDatabaseSettings be db
db CheckedDatabaseSettings be db
db
in [SomeDatabasePredicate]
a
instance IsCheckedDatabaseEntity be (DomainTypeEntity ty) where
data CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty) =
CheckedDatabaseDomainType (DatabaseEntityDescriptor be (DomainTypeEntity ty))
[ DomainCheck ]
type CheckedDatabaseEntityDefaultRequirements be (DomainTypeEntity ty) =
DatabaseEntityDefaultRequirements be (DomainTypeEntity ty)
unChecked :: Lens'
(CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty))
(DatabaseEntityDescriptor be (DomainTypeEntity ty))
unChecked DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> f (DatabaseEntityDescriptor be (DomainTypeEntity ty))
f (CheckedDatabaseDomainType DatabaseEntityDescriptor be (DomainTypeEntity ty)
x [DomainCheck]
cks) = (DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty))
-> f (DatabaseEntityDescriptor be (DomainTypeEntity ty))
-> f (CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DatabaseEntityDescriptor be (DomainTypeEntity ty)
x' -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> [DomainCheck]
-> CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty)
forall be ty.
DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> [DomainCheck]
-> CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty)
CheckedDatabaseDomainType DatabaseEntityDescriptor be (DomainTypeEntity ty)
x' [DomainCheck]
cks) (DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> f (DatabaseEntityDescriptor be (DomainTypeEntity ty))
f DatabaseEntityDescriptor be (DomainTypeEntity ty)
x)
collectEntityChecks :: CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty)
-> [SomeDatabasePredicate]
collectEntityChecks (CheckedDatabaseDomainType DatabaseEntityDescriptor be (DomainTypeEntity ty)
dt [DomainCheck]
domainChecks) =
(DomainCheck -> SomeDatabasePredicate)
-> [DomainCheck] -> [SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
map (\(DomainCheck QualifiedName -> SomeDatabasePredicate
mkCheck) -> QualifiedName -> SomeDatabasePredicate
mkCheck (DatabaseEntityDescriptor be (DomainTypeEntity ty) -> QualifiedName
forall be entity.
IsDatabaseEntity be entity =>
DatabaseEntityDescriptor be entity -> QualifiedName
qname DatabaseEntityDescriptor be (DomainTypeEntity ty)
dt)) [DomainCheck]
domainChecks
checkedDbEntityAuto :: CheckedDatabaseEntityDefaultRequirements
be (DomainTypeEntity ty) =>
Text -> CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty)
checkedDbEntityAuto Text
domTypeName =
DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> [DomainCheck]
-> CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty)
forall be ty.
DatabaseEntityDescriptor be (DomainTypeEntity ty)
-> [DomainCheck]
-> CheckedDatabaseEntityDescriptor be (DomainTypeEntity ty)
CheckedDatabaseDomainType (Text -> DatabaseEntityDescriptor be (DomainTypeEntity ty)
forall be entityType.
(IsDatabaseEntity be entityType,
DatabaseEntityDefaultRequirements be entityType) =>
Text -> DatabaseEntityDescriptor be entityType
dbEntityAuto Text
domTypeName) []
instance Beamable tbl => IsCheckedDatabaseEntity be (TableEntity tbl) where
data CheckedDatabaseEntityDescriptor be (TableEntity tbl) where
CheckedDatabaseTable :: Table tbl
=> DatabaseEntityDescriptor be (TableEntity tbl)
-> [ TableCheck ]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
type CheckedDatabaseEntityDefaultRequirements be (TableEntity tbl) =
( DatabaseEntityDefaultRequirements be (TableEntity tbl)
, Generic (tbl (Const [FieldCheck]))
, GMigratableTableSettings be (Rep (tbl Identity)) (Rep (tbl (Const [FieldCheck])))
, BeamSqlBackend be )
unChecked :: Lens'
(CheckedDatabaseEntityDescriptor be (TableEntity tbl))
(DatabaseEntityDescriptor be (TableEntity tbl))
unChecked DatabaseEntityDescriptor be (TableEntity tbl)
-> f (DatabaseEntityDescriptor be (TableEntity tbl))
f (CheckedDatabaseTable DatabaseEntityDescriptor be (TableEntity tbl)
x [TableCheck]
cks tbl (Const [FieldCheck])
fcks) = (DatabaseEntityDescriptor be (TableEntity tbl)
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl))
-> f (DatabaseEntityDescriptor be (TableEntity tbl))
-> f (CheckedDatabaseEntityDescriptor be (TableEntity tbl))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DatabaseEntityDescriptor be (TableEntity tbl)
x' -> DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
CheckedDatabaseTable DatabaseEntityDescriptor be (TableEntity tbl)
x' [TableCheck]
cks tbl (Const [FieldCheck])
fcks) (DatabaseEntityDescriptor be (TableEntity tbl)
-> f (DatabaseEntityDescriptor be (TableEntity tbl))
f DatabaseEntityDescriptor be (TableEntity tbl)
x)
collectEntityChecks :: CheckedDatabaseEntityDescriptor be (TableEntity tbl)
-> [SomeDatabasePredicate]
collectEntityChecks (CheckedDatabaseTable DatabaseEntityDescriptor be (TableEntity tbl)
dt [TableCheck]
tblChecks tbl (Const [FieldCheck])
tblFieldChecks) =
[Maybe SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [Maybe a] -> [a]
catMaybes ((TableCheck -> Maybe SomeDatabasePredicate)
-> [TableCheck] -> [Maybe SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
map (\(TableCheck forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate
mkCheck) -> QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate
forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate
mkCheck (DatabaseEntityDescriptor be (TableEntity tbl) -> QualifiedName
forall be entity.
IsDatabaseEntity be entity =>
DatabaseEntityDescriptor be entity -> QualifiedName
qname DatabaseEntityDescriptor be (TableEntity tbl)
dt) (DatabaseEntityDescriptor be (TableEntity tbl)
-> tbl (TableField tbl)
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity tbl)
dt)) [TableCheck]
tblChecks) [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. Semigroup a => a -> a -> a
<>
Writer [SomeDatabasePredicate] (tbl (Const [FieldCheck]))
-> [SomeDatabasePredicate]
forall w a. Writer w a -> w
execWriter ((forall a.
Columnar' (TableField tbl) a
-> Columnar' (Const [FieldCheck]) a
-> WriterT
[SomeDatabasePredicate]
Identity
(Columnar' (Const [FieldCheck]) a))
-> tbl (TableField tbl)
-> tbl (Const [FieldCheck])
-> Writer [SomeDatabasePredicate] (tbl (Const [FieldCheck]))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' Columnar (TableField tbl) a
fd) c :: Columnar' (Const [FieldCheck]) a
c@(Columnar' (Const [FieldCheck]
fieldChecks)) ->
[SomeDatabasePredicate]
-> WriterT [SomeDatabasePredicate] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ((FieldCheck -> SomeDatabasePredicate)
-> [FieldCheck] -> [SomeDatabasePredicate]
forall a b. (a -> b) -> [a] -> [b]
map (\(FieldCheck QualifiedName -> Text -> SomeDatabasePredicate
mkCheck) -> QualifiedName -> Text -> SomeDatabasePredicate
mkCheck (DatabaseEntityDescriptor be (TableEntity tbl) -> QualifiedName
forall be entity.
IsDatabaseEntity be entity =>
DatabaseEntityDescriptor be entity -> QualifiedName
qname DatabaseEntityDescriptor be (TableEntity tbl)
dt) (TableField tbl a
Columnar (TableField tbl) a
fd TableField tbl a -> Getting Text (TableField tbl a) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TableField tbl a) Text
forall (table :: (* -> *) -> *) ty (f :: * -> *).
Functor f =>
(Text -> f Text) -> TableField table ty -> f (TableField table ty)
fieldName)) [FieldCheck]
fieldChecks) WriterT [SomeDatabasePredicate] Identity ()
-> WriterT
[SomeDatabasePredicate] Identity (Columnar' (Const [FieldCheck]) a)
-> WriterT
[SomeDatabasePredicate] Identity (Columnar' (Const [FieldCheck]) a)
forall a b.
WriterT [SomeDatabasePredicate] Identity a
-> WriterT [SomeDatabasePredicate] Identity b
-> WriterT [SomeDatabasePredicate] Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Columnar' (Const [FieldCheck]) a
-> WriterT
[SomeDatabasePredicate] Identity (Columnar' (Const [FieldCheck]) a)
forall a. a -> WriterT [SomeDatabasePredicate] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Columnar' (Const [FieldCheck]) a
c)
(DatabaseEntityDescriptor be (TableEntity tbl)
-> tbl (TableField tbl)
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity tbl)
dt) tbl (Const [FieldCheck])
tblFieldChecks)
checkedDbEntityAuto :: CheckedDatabaseEntityDefaultRequirements be (TableEntity tbl) =>
Text -> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
checkedDbEntityAuto Text
tblTypeName =
let tblChecks :: [TableCheck]
tblChecks =
[ (forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
-> TableCheck
TableCheck ((forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
-> TableCheck)
-> (forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
-> TableCheck
forall a b. (a -> b) -> a -> b
$ \QualifiedName
tblName tbl (TableField tbl)
_ ->
SomeDatabasePredicate -> Maybe SomeDatabasePredicate
forall a. a -> Maybe a
Just (TableExistsPredicate -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName -> TableExistsPredicate
TableExistsPredicate QualifiedName
tblName))
, (forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
-> TableCheck
TableCheck ((forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
-> TableCheck)
-> (forall (tbl :: (* -> *) -> *).
Table tbl =>
QualifiedName
-> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
-> TableCheck
forall a b. (a -> b) -> a -> b
$ \QualifiedName
tblName tbl (TableField tbl)
tblFields ->
case (forall a. Columnar' (TableField tbl) a -> Text)
-> PrimaryKey tbl (TableField tbl) -> [Text]
forall (table :: (* -> *) -> *) (f :: * -> *) b.
Beamable table =>
(forall a. Columnar' f a -> b) -> table f -> [b]
allBeamValues (\(Columnar' Columnar (TableField tbl) a
fd) -> TableField tbl a
Columnar (TableField tbl) a
fd TableField tbl a -> Getting Text (TableField tbl a) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TableField tbl a) Text
forall (table :: (* -> *) -> *) ty (f :: * -> *).
Functor f =>
(Text -> f Text) -> TableField table ty -> f (TableField table ty)
fieldName) (tbl (TableField tbl) -> PrimaryKey tbl (TableField tbl)
forall (column :: * -> *). tbl column -> PrimaryKey tbl column
forall (table :: (* -> *) -> *) (column :: * -> *).
Table table =>
table column -> PrimaryKey table column
primaryKey tbl (TableField tbl)
tblFields) of
[] -> Maybe SomeDatabasePredicate
forall a. Maybe a
Nothing
[Text]
pkFields -> SomeDatabasePredicate -> Maybe SomeDatabasePredicate
forall a. a -> Maybe a
Just (TableHasPrimaryKey -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName -> [Text] -> TableHasPrimaryKey
TableHasPrimaryKey QualifiedName
tblName [Text]
pkFields))
]
fieldChecks :: tbl (Const [FieldCheck])
fieldChecks = Rep (tbl (Const [FieldCheck])) () -> tbl (Const [FieldCheck])
forall a x. Generic a => Rep a x -> a
forall x.
Rep (tbl (Const [FieldCheck])) x -> tbl (Const [FieldCheck])
to (Proxy be
-> Proxy (Rep (tbl Identity))
-> Bool
-> Rep (tbl (Const [FieldCheck])) ()
forall be (i :: * -> *) (fieldCheck :: * -> *).
GMigratableTableSettings be i fieldCheck =>
Proxy be -> Proxy i -> Bool -> fieldCheck ()
gDefaultTblSettingsChecks (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @be) (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(Rep (tbl Identity))) Bool
False)
in DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
CheckedDatabaseTable (Text -> DatabaseEntityDescriptor be (TableEntity tbl)
forall be entityType.
(IsDatabaseEntity be entityType,
DatabaseEntityDefaultRequirements be entityType) =>
Text -> DatabaseEntityDescriptor be entityType
dbEntityAuto Text
tblTypeName) [TableCheck]
tblChecks tbl (Const [FieldCheck])
fieldChecks
data CheckedFieldModification tbl a
= CheckedFieldModification
(TableField tbl a -> TableField tbl a)
([FieldCheck] -> [FieldCheck])
checkedFieldNamed :: Text -> CheckedFieldModification tbl a
checkedFieldNamed :: forall (tbl :: (* -> *) -> *) a.
Text -> CheckedFieldModification tbl a
checkedFieldNamed Text
t = (TableField tbl a -> TableField tbl a)
-> ([FieldCheck] -> [FieldCheck]) -> CheckedFieldModification tbl a
forall (tbl :: (* -> *) -> *) a.
(TableField tbl a -> TableField tbl a)
-> ([FieldCheck] -> [FieldCheck]) -> CheckedFieldModification tbl a
CheckedFieldModification ((Text -> Identity Text)
-> TableField tbl a -> Identity (TableField tbl a)
forall (table :: (* -> *) -> *) ty (f :: * -> *).
Functor f =>
(Text -> f Text) -> TableField table ty -> f (TableField table ty)
fieldName ((Text -> Identity Text)
-> TableField tbl a -> Identity (TableField tbl a))
-> Text -> TableField tbl a -> TableField tbl a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
t) [FieldCheck] -> [FieldCheck]
forall a. a -> a
id
instance IsString (CheckedFieldModification tbl a) where
fromString :: String -> CheckedFieldModification tbl a
fromString = Text -> CheckedFieldModification tbl a
forall (tbl :: (* -> *) -> *) a.
Text -> CheckedFieldModification tbl a
checkedFieldNamed (Text -> CheckedFieldModification tbl a)
-> (String -> Text) -> String -> CheckedFieldModification tbl a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
instance Beamable tbl => RenamableWithRule (tbl (CheckedFieldModification tbl)) where
renamingFields :: (NonEmpty Text -> Text) -> tbl (CheckedFieldModification tbl)
renamingFields NonEmpty Text -> Text
renamer =
Identity (tbl (CheckedFieldModification tbl))
-> tbl (CheckedFieldModification tbl)
forall a. Identity a -> a
runIdentity (Identity (tbl (CheckedFieldModification tbl))
-> tbl (CheckedFieldModification tbl))
-> Identity (tbl (CheckedFieldModification tbl))
-> tbl (CheckedFieldModification tbl)
forall a b. (a -> b) -> a -> b
$
(forall a.
Columnar' Ignored a
-> Columnar' Ignored a
-> Identity (Columnar' (CheckedFieldModification tbl) a))
-> tbl Ignored
-> tbl Ignored
-> Identity (tbl (CheckedFieldModification tbl))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' Columnar Ignored a
_ :: Columnar' Ignored x) (Columnar' Columnar Ignored a
_ :: Columnar' Ignored x) ->
Columnar' (CheckedFieldModification tbl) a
-> Identity (Columnar' (CheckedFieldModification tbl) a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar (CheckedFieldModification tbl) a
-> Columnar' (CheckedFieldModification tbl) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((TableField tbl a -> TableField tbl a)
-> ([FieldCheck] -> [FieldCheck]) -> CheckedFieldModification tbl a
forall (tbl :: (* -> *) -> *) a.
(TableField tbl a -> TableField tbl a)
-> ([FieldCheck] -> [FieldCheck]) -> CheckedFieldModification tbl a
CheckedFieldModification (Proxy (TableField tbl)
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar (TableField tbl) a
-> Columnar (TableField tbl) a
forall a.
Proxy (TableField tbl)
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar (TableField tbl) a
-> Columnar (TableField tbl) a
forall (f :: * -> *) a.
RenamableField f =>
Proxy f
-> Proxy a
-> (NonEmpty Text -> Text)
-> Columnar f a
-> Columnar f a
renameField (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(TableField tbl)) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @x) NonEmpty Text -> Text
renamer) [FieldCheck] -> [FieldCheck]
forall a. a -> a
id :: CheckedFieldModification tbl x) ::
Columnar' (CheckedFieldModification tbl) x))
(tbl Ignored
forall a. HasCallStack => a
undefined :: TableSkeleton tbl) (tbl Ignored
forall a. HasCallStack => a
undefined :: TableSkeleton tbl)
modifyCheckedTable
:: ( Text -> Text )
-> tbl (CheckedFieldModification tbl)
-> EntityModification (CheckedDatabaseEntity be db) be (TableEntity tbl)
modifyCheckedTable :: forall (tbl :: (* -> *) -> *) be (db :: (* -> *) -> *).
(Text -> Text)
-> tbl (CheckedFieldModification tbl)
-> EntityModification
(CheckedDatabaseEntity be db) be (TableEntity tbl)
modifyCheckedTable Text -> Text
renamer tbl (CheckedFieldModification tbl)
modFields =
Endo (CheckedDatabaseEntity be db (TableEntity tbl))
-> EntityModification
(CheckedDatabaseEntity be db) be (TableEntity tbl)
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification (Endo (CheckedDatabaseEntity be db (TableEntity tbl))
-> EntityModification
(CheckedDatabaseEntity be db) be (TableEntity tbl))
-> Endo (CheckedDatabaseEntity be db (TableEntity tbl))
-> EntityModification
(CheckedDatabaseEntity be db) be (TableEntity tbl)
forall a b. (a -> b) -> a -> b
$ (CheckedDatabaseEntity be db (TableEntity tbl)
-> CheckedDatabaseEntity be db (TableEntity tbl))
-> Endo (CheckedDatabaseEntity be db (TableEntity tbl))
forall a. (a -> a) -> Endo a
Endo ((CheckedDatabaseEntity be db (TableEntity tbl)
-> CheckedDatabaseEntity be db (TableEntity tbl))
-> Endo (CheckedDatabaseEntity be db (TableEntity tbl)))
-> (CheckedDatabaseEntity be db (TableEntity tbl)
-> CheckedDatabaseEntity be db (TableEntity tbl))
-> Endo (CheckedDatabaseEntity be db (TableEntity tbl))
forall a b. (a -> b) -> a -> b
$
\(CheckedDatabaseEntity (CheckedDatabaseTable DatabaseEntityDescriptor be (TableEntity tbl)
dt [TableCheck]
tblChecks tbl (Const [FieldCheck])
fieldChecks) [SomeDatabasePredicate]
extraChecks) ->
let fields' :: tbl (TableField tbl)
fields' =
Identity (tbl (TableField tbl)) -> tbl (TableField tbl)
forall a. Identity a -> a
runIdentity (Identity (tbl (TableField tbl)) -> tbl (TableField tbl))
-> Identity (tbl (TableField tbl)) -> tbl (TableField tbl)
forall a b. (a -> b) -> a -> b
$
(forall a.
Columnar' (CheckedFieldModification tbl) a
-> Columnar' (TableField tbl) a
-> Identity (Columnar' (TableField tbl) a))
-> tbl (CheckedFieldModification tbl)
-> tbl (TableField tbl)
-> Identity (tbl (TableField tbl))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' (CheckedFieldModification TableField tbl a -> TableField tbl a
fieldMod [FieldCheck] -> [FieldCheck]
_)) (Columnar' Columnar (TableField tbl) a
field) ->
Columnar' (TableField tbl) a
-> Identity (Columnar' (TableField tbl) a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar' (TableField tbl) a
-> Identity (Columnar' (TableField tbl) a))
-> Columnar' (TableField tbl) a
-> Identity (Columnar' (TableField tbl) a)
forall a b. (a -> b) -> a -> b
$ Columnar (TableField tbl) a -> Columnar' (TableField tbl) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' (TableField tbl a -> TableField tbl a
fieldMod TableField tbl a
Columnar (TableField tbl) a
field))
tbl (CheckedFieldModification tbl)
modFields (DatabaseEntityDescriptor be (TableEntity tbl)
-> tbl (TableField tbl)
forall (tbl :: (* -> *) -> *) be.
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings DatabaseEntityDescriptor be (TableEntity tbl)
dt)
fieldChecks' :: tbl (Const [FieldCheck])
fieldChecks' =
Identity (tbl (Const [FieldCheck])) -> tbl (Const [FieldCheck])
forall a. Identity a -> a
runIdentity (Identity (tbl (Const [FieldCheck])) -> tbl (Const [FieldCheck]))
-> Identity (tbl (Const [FieldCheck])) -> tbl (Const [FieldCheck])
forall a b. (a -> b) -> a -> b
$
(forall a.
Columnar' (CheckedFieldModification tbl) a
-> Columnar' (Const [FieldCheck]) a
-> Identity (Columnar' (Const [FieldCheck]) a))
-> tbl (CheckedFieldModification tbl)
-> tbl (Const [FieldCheck])
-> Identity (tbl (Const [FieldCheck]))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' (CheckedFieldModification TableField tbl a -> TableField tbl a
_ [FieldCheck] -> [FieldCheck]
csMod)) (Columnar' (Const [FieldCheck]
cs)) ->
Columnar' (Const [FieldCheck]) a
-> Identity (Columnar' (Const [FieldCheck]) a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar' (Const [FieldCheck]) a
-> Identity (Columnar' (Const [FieldCheck]) a))
-> Columnar' (Const [FieldCheck]) a
-> Identity (Columnar' (Const [FieldCheck]) a)
forall a b. (a -> b) -> a -> b
$ Columnar (Const [FieldCheck]) a -> Columnar' (Const [FieldCheck]) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ([FieldCheck] -> Const [FieldCheck] a
forall {k} a (b :: k). a -> Const a b
Const ([FieldCheck] -> [FieldCheck]
csMod [FieldCheck]
cs)))
tbl (CheckedFieldModification tbl)
modFields tbl (Const [FieldCheck])
fieldChecks
in CheckedDatabaseEntityDescriptor be (TableEntity tbl)
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db (TableEntity tbl)
forall be entityType (db :: (* -> *) -> *).
IsCheckedDatabaseEntity be entityType =>
CheckedDatabaseEntityDescriptor be entityType
-> [SomeDatabasePredicate]
-> CheckedDatabaseEntity be db entityType
CheckedDatabaseEntity (DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
DatabaseEntityDescriptor be (TableEntity tbl)
-> [TableCheck]
-> tbl (Const [FieldCheck])
-> CheckedDatabaseEntityDescriptor be (TableEntity tbl)
CheckedDatabaseTable
(DatabaseEntityDescriptor be (TableEntity tbl)
dt { dbTableCurrentName = renamer (dbTableCurrentName dt)
, dbTableSettings = fields'})
[TableCheck]
tblChecks tbl (Const [FieldCheck])
fieldChecks') [SomeDatabasePredicate]
extraChecks
checkedTableModification :: forall tbl. Beamable tbl => tbl (CheckedFieldModification tbl)
checkedTableModification :: forall (tbl :: (* -> *) -> *).
Beamable tbl =>
tbl (CheckedFieldModification tbl)
checkedTableModification =
Identity (tbl (CheckedFieldModification tbl))
-> tbl (CheckedFieldModification tbl)
forall a. Identity a -> a
runIdentity (Identity (tbl (CheckedFieldModification tbl))
-> tbl (CheckedFieldModification tbl))
-> Identity (tbl (CheckedFieldModification tbl))
-> tbl (CheckedFieldModification tbl)
forall a b. (a -> b) -> a -> b
$
(forall a.
Columnar' Ignored a
-> Columnar' Ignored a
-> Identity (Columnar' (CheckedFieldModification tbl) a))
-> tbl Ignored
-> tbl Ignored
-> Identity (tbl (CheckedFieldModification tbl))
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> tbl f -> tbl g -> m (tbl h)
forall (table :: (* -> *) -> *) (m :: * -> *) (f :: * -> *)
(g :: * -> *) (h :: * -> *).
(Beamable table, Applicative m) =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> table f -> table g -> m (table h)
zipBeamFieldsM (\(Columnar' Columnar Ignored a
_ :: Columnar' Ignored x) (Columnar' Columnar Ignored a
_ :: Columnar' Ignored x) ->
Columnar' (CheckedFieldModification tbl) a
-> Identity (Columnar' (CheckedFieldModification tbl) a)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Columnar (CheckedFieldModification tbl) a
-> Columnar' (CheckedFieldModification tbl) a
forall (f :: * -> *) a. Columnar f a -> Columnar' f a
Columnar' ((TableField tbl a -> TableField tbl a)
-> ([FieldCheck] -> [FieldCheck]) -> CheckedFieldModification tbl a
forall (tbl :: (* -> *) -> *) a.
(TableField tbl a -> TableField tbl a)
-> ([FieldCheck] -> [FieldCheck]) -> CheckedFieldModification tbl a
CheckedFieldModification TableField tbl a -> TableField tbl a
forall a. a -> a
id [FieldCheck] -> [FieldCheck]
forall a. a -> a
id :: CheckedFieldModification tbl x)))
(tbl Ignored
forall a. HasCallStack => a
undefined :: TableSkeleton tbl) (tbl Ignored
forall a. HasCallStack => a
undefined :: TableSkeleton tbl)