{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Database.Beam.AutoMigrate.Annotated
(
Annotation (..),
AnnotatedDatabaseSettings,
AnnotatedDatabaseEntity (..),
IsAnnotatedDatabaseEntity (..),
TableSchema,
TableFieldSchema (..),
FieldSchema (..),
dbAnnotatedSchema,
dbAnnotatedConstraints,
annotatedDescriptor,
defaultTableSchema,
GDefaultTableSchema(..),
lowerEntityDescriptor,
deannotate,
annotateTableFields,
defaultsTo,
UniqueConstraint (..),
uniqueConstraintOn,
ForeignKeyConstraint (..),
foreignKeyOnPk,
foreignKeyOn,
TableKind,
DatabaseKind,
zipTables,
GZipDatabase,
pgDefaultConstraint,
)
where
import Data.Kind
import Data.Monoid (Endo (..))
import Data.Proxy
import Data.Set (Set)
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Database.Beam as Beam
import Database.Beam.AutoMigrate.Compat
import Database.Beam.AutoMigrate.Types
import Database.Beam.AutoMigrate.Util
import Database.Beam.Backend.SQL (HasSqlValueSyntax (..), displaySyntax)
import Database.Beam.Postgres (Postgres)
import qualified Database.Beam.Postgres.Syntax as Pg
import Database.Beam.Query (QExpr)
import Database.Beam.Schema.Tables
( DatabaseEntity,
DatabaseEntityDefaultRequirements,
DatabaseEntityDescriptor,
DatabaseEntityRegularRequirements,
EntityModification (..),
FieldModification (..),
IsDatabaseEntity,
PrimaryKey,
TableEntity,
dbEntityDescriptor,
dbEntityName,
dbTableSettings,
)
import GHC.Generics as Generic
import Lens.Micro (SimpleGetter, (^.))
import qualified Lens.Micro as Lens
type DatabaseKind = (Type -> Type) -> Type
type TableKind = (Type -> Type) -> Type
data Annotation where
UserDefinedFk :: TableKind -> Annotation
zipTables ::
( Generic (db f),
Generic (db g),
Generic (db h),
Monad m,
GZipDatabase be f g h (Rep (db f)) (Rep (db g)) (Rep (db h))
) =>
Proxy be ->
(forall tbl. (IsAnnotatedDatabaseEntity be tbl, AnnotatedDatabaseEntityRegularRequirements be tbl) => f tbl -> g tbl -> m (h tbl)) ->
db f ->
db g ->
m (db h)
zipTables :: Proxy be
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables Proxy be
be forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine (db f
f :: db f) (db g
g :: db g) =
(Proxy h -> m (db h)) -> m (db h)
forall (h :: * -> *) (m :: * -> *).
(Proxy h -> m (db h)) -> m (db h)
refl ((Proxy h -> m (db h)) -> m (db h))
-> (Proxy h -> m (db h)) -> m (db h)
forall a b. (a -> b) -> a -> b
$ \Proxy h
h ->
Rep (db h) () -> db h
forall a x. Generic a => Rep a x -> a
to (Rep (db h) () -> db h) -> m (Rep (db h) ()) -> m (db h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> Rep (db f) ()
-> Rep (db g) ()
-> m (Rep (db h) ())
forall be (f :: * -> *) (g :: * -> *) (h :: * -> *) (x :: * -> *)
(y :: * -> *) (z :: * -> *) (m :: * -> *).
(GZipDatabase be f g h x y z, Monad m) =>
(Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> x ()
-> y ()
-> m (z ())
gZipDatabase (Proxy f
forall k (t :: k). Proxy t
Proxy @f, Proxy g
forall k (t :: k). Proxy t
Proxy @g, Proxy h
h, Proxy be
be) forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine (db f -> Rep (db f) ()
forall a x. Generic a => a -> Rep a x
from db f
f) (db g -> Rep (db g) ()
forall a x. Generic a => a -> Rep a x
from db g
g)
where
refl :: (Proxy h -> m (db h)) -> m (db h)
refl :: (Proxy h -> m (db h)) -> m (db h)
refl Proxy h -> m (db h)
fn = Proxy h -> m (db h)
fn Proxy h
forall k (t :: k). Proxy t
Proxy
class GZipDatabase be f g h x y z where
gZipDatabase ::
Monad m =>
(Proxy f, Proxy g, Proxy h, Proxy be) ->
(forall tbl. (IsAnnotatedDatabaseEntity be tbl, AnnotatedDatabaseEntityRegularRequirements be tbl) => f tbl -> g tbl -> m (h tbl)) ->
x () ->
y () ->
m (z ())
instance GZipDatabase be f g h x y z => GZipDatabase be f g h (M1 a b x) (M1 a b y) (M1 a b z) where
gZipDatabase :: (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> M1 a b x ()
-> M1 a b y ()
-> m (M1 a b z ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ~(M1 x ()
f) ~(M1 y ()
g) = z () -> M1 a b z ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (z () -> M1 a b z ()) -> m (z ()) -> m (M1 a b z ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> x ()
-> y ()
-> m (z ())
forall be (f :: * -> *) (g :: * -> *) (h :: * -> *) (x :: * -> *)
(y :: * -> *) (z :: * -> *) (m :: * -> *).
(GZipDatabase be f g h x y z, Monad m) =>
(Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> x ()
-> y ()
-> m (z ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine x ()
f y ()
g
instance
( GZipDatabase be f g h ax ay az,
GZipDatabase be f g h bx by bz
) =>
GZipDatabase be f g h (ax :*: bx) (ay :*: by) (az :*: bz)
where
gZipDatabase :: (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> (:*:) ax bx ()
-> (:*:) ay by ()
-> m ((:*:) az bz ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ~(ax ()
ax :*: bx ()
bx) ~(ay ()
ay :*: by ()
by) = do
az ()
a <- (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> ax ()
-> ay ()
-> m (az ())
forall be (f :: * -> *) (g :: * -> *) (h :: * -> *) (x :: * -> *)
(y :: * -> *) (z :: * -> *) (m :: * -> *).
(GZipDatabase be f g h x y z, Monad m) =>
(Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> x ()
-> y ()
-> m (z ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ax ()
ax ay ()
ay
bz ()
b <- (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> bx ()
-> by ()
-> m (bz ())
forall be (f :: * -> *) (g :: * -> *) (h :: * -> *) (x :: * -> *)
(y :: * -> *) (z :: * -> *) (m :: * -> *).
(GZipDatabase be f g h x y z, Monad m) =>
(Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> x ()
-> y ()
-> m (z ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
p forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine bx ()
bx by ()
by
(:*:) az bz () -> m ((:*:) az bz ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (az ()
a az () -> bz () -> (:*:) az bz ()
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: bz ()
b)
instance
( IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl
) =>
GZipDatabase be f g h (K1 Generic.R (f tbl)) (K1 Generic.R (g tbl)) (K1 Generic.R (h tbl))
where
gZipDatabase :: (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> K1 R (f tbl) ()
-> K1 R (g tbl) ()
-> m (K1 R (h tbl) ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
_ forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ~(K1 f tbl
x) ~(K1 g tbl
y) =
h tbl -> K1 R (h tbl) ()
forall k i c (p :: k). c -> K1 i c p
K1 (h tbl -> K1 R (h tbl) ()) -> m (h tbl) -> m (K1 R (h tbl) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f tbl -> g tbl -> m (h tbl)
forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine f tbl
x g tbl
y
instance
( Beam.Database be db,
Generic (db f),
Generic (db g),
Generic (db h),
GZipDatabase be f g h (Rep (db f)) (Rep (db g)) (Rep (db h))
) =>
GZipDatabase be f g h (K1 Generic.R (db f)) (K1 Generic.R (db g)) (K1 Generic.R (db h))
where
gZipDatabase :: (Proxy f, Proxy g, Proxy h, Proxy be)
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> K1 R (db f) ()
-> K1 R (db g) ()
-> m (K1 R (db h) ())
gZipDatabase (Proxy f, Proxy g, Proxy h, Proxy be)
_ forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine ~(K1 db f
x) ~(K1 db g
y) =
db h -> K1 R (db h) ()
forall k i c (p :: k). c -> K1 i c p
K1 (db h -> K1 R (db h) ()) -> m (db h) -> m (K1 R (db h) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy be
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
forall (db :: (* -> *) -> *) (f :: * -> *) (g :: * -> *)
(h :: * -> *) (m :: * -> *) be.
(Generic (db f), Generic (db g), Generic (db h), Monad m,
GZipDatabase be f g h (Rep (db f)) (Rep (db g)) (Rep (db h))) =>
Proxy be
-> (forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl))
-> db f
-> db g
-> m (db h)
zipTables (Proxy be
forall k (t :: k). Proxy t
Proxy :: Proxy be) forall tbl.
(IsAnnotatedDatabaseEntity be tbl,
AnnotatedDatabaseEntityRegularRequirements be tbl) =>
f tbl -> g tbl -> m (h tbl)
combine db f
x db g
y
type AnnotatedDatabaseSettings be db = db (AnnotatedDatabaseEntity be db)
data AnnotatedDatabaseEntity be (db :: (* -> *) -> *) entityType where
AnnotatedDatabaseEntity ::
(IsAnnotatedDatabaseEntity be entityType, IsDatabaseEntity be entityType) =>
AnnotatedDatabaseEntityDescriptor be entityType ->
DatabaseEntity be db entityType ->
AnnotatedDatabaseEntity be db entityType
class IsDatabaseEntity be entityType => IsAnnotatedDatabaseEntity be entityType where
data AnnotatedDatabaseEntityDescriptor be entityType :: *
type AnnotatedDatabaseEntityDefaultRequirements be entityType :: Constraint
type AnnotatedDatabaseEntityRegularRequirements be entityType :: Constraint
dbAnnotatedEntityAuto ::
AnnotatedDatabaseEntityRegularRequirements be entityType =>
DatabaseEntityDescriptor be entityType ->
AnnotatedDatabaseEntityDescriptor be entityType
instance
IsDatabaseEntity be (TableEntity tbl) =>
IsAnnotatedDatabaseEntity be (TableEntity tbl)
where
data AnnotatedDatabaseEntityDescriptor be (TableEntity tbl) where
AnnotatedDatabaseTable ::
Beam.Table tbl =>
{ AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
dbAnnotatedSchema :: TableSchema tbl,
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
dbAnnotatedConstraints :: Set TableConstraint
} ->
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
type
AnnotatedDatabaseEntityDefaultRequirements be (TableEntity tbl) =
(DatabaseEntityDefaultRequirements be (TableEntity tbl))
type
AnnotatedDatabaseEntityRegularRequirements be (TableEntity tbl) =
( DatabaseEntityRegularRequirements be (TableEntity tbl),
GDefaultTableSchema (Rep (TableSchema tbl) ()) (Rep (Beam.TableSettings tbl) ()),
Generic (TableSchema tbl),
Generic (Beam.TableSettings tbl)
)
dbAnnotatedEntityAuto :: DatabaseEntityDescriptor be (TableEntity tbl)
-> AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
dbAnnotatedEntityAuto DatabaseEntityDescriptor be (TableEntity tbl)
edesc = TableSchema tbl
-> Set TableConstraint
-> AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
forall (tbl :: (* -> *) -> *) be.
Table tbl =>
TableSchema tbl
-> Set TableConstraint
-> AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
AnnotatedDatabaseTable (TableSettings tbl -> TableSchema tbl
forall (tbl :: (* -> *) -> *).
(GDefaultTableSchema
(Rep (TableSchema tbl) ()) (Rep (TableSettings tbl) ()),
Generic (TableSchema tbl), Generic (TableSettings tbl)) =>
TableSettings tbl -> TableSchema tbl
defaultTableSchema (TableSettings tbl -> TableSchema tbl)
-> (DatabaseEntityDescriptor be (TableEntity tbl)
-> TableSettings tbl)
-> DatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
forall be (tbl :: (* -> *) -> *).
DatabaseEntityDescriptor be (TableEntity tbl) -> TableSettings tbl
dbTableSettings (DatabaseEntityDescriptor be (TableEntity tbl) -> TableSchema tbl)
-> DatabaseEntityDescriptor be (TableEntity tbl) -> TableSchema tbl
forall a b. (a -> b) -> a -> b
$ DatabaseEntityDescriptor be (TableEntity tbl)
edesc) Set TableConstraint
forall a. Monoid a => a
mempty
lowerEntityDescriptor :: SimpleGetter (AnnotatedDatabaseEntity be db entityType) (DatabaseEntityDescriptor be entityType)
lowerEntityDescriptor :: Getting
r
(AnnotatedDatabaseEntity be db entityType)
(DatabaseEntityDescriptor be entityType)
lowerEntityDescriptor = (AnnotatedDatabaseEntity be db entityType
-> DatabaseEntityDescriptor be entityType)
-> SimpleGetter
(AnnotatedDatabaseEntity be db entityType)
(DatabaseEntityDescriptor be entityType)
forall s a. (s -> a) -> SimpleGetter s a
Lens.to (\(AnnotatedDatabaseEntity AnnotatedDatabaseEntityDescriptor be entityType
_ DatabaseEntity be db entityType
e) -> DatabaseEntity be db entityType
e DatabaseEntity be db entityType
-> Getting
(DatabaseEntityDescriptor be entityType)
(DatabaseEntity be db entityType)
(DatabaseEntityDescriptor be entityType)
-> DatabaseEntityDescriptor be entityType
forall s a. s -> Getting a s a -> a
^. Getting
(DatabaseEntityDescriptor be entityType)
(DatabaseEntity be db entityType)
(DatabaseEntityDescriptor be entityType)
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
(DatabaseEntity be db entityType)
(DatabaseEntityDescriptor be entityType)
dbEntityDescriptor)
annotatedDescriptor :: SimpleGetter (AnnotatedDatabaseEntity be db entityType) (AnnotatedDatabaseEntityDescriptor be entityType)
annotatedDescriptor :: Getting
r
(AnnotatedDatabaseEntity be db entityType)
(AnnotatedDatabaseEntityDescriptor be entityType)
annotatedDescriptor = (AnnotatedDatabaseEntity be db entityType
-> AnnotatedDatabaseEntityDescriptor be entityType)
-> SimpleGetter
(AnnotatedDatabaseEntity be db entityType)
(AnnotatedDatabaseEntityDescriptor be entityType)
forall s a. (s -> a) -> SimpleGetter s a
Lens.to (\(AnnotatedDatabaseEntity AnnotatedDatabaseEntityDescriptor be entityType
e DatabaseEntity be db entityType
_) -> AnnotatedDatabaseEntityDescriptor be entityType
e)
deannotate :: SimpleGetter (AnnotatedDatabaseEntity be db entityType) (DatabaseEntity be db entityType)
deannotate :: Getting
r
(AnnotatedDatabaseEntity be db entityType)
(DatabaseEntity be db entityType)
deannotate = (AnnotatedDatabaseEntity be db entityType
-> DatabaseEntity be db entityType)
-> SimpleGetter
(AnnotatedDatabaseEntity be db entityType)
(DatabaseEntity be db entityType)
forall s a. (s -> a) -> SimpleGetter s a
Lens.to (\(AnnotatedDatabaseEntity AnnotatedDatabaseEntityDescriptor be entityType
_ DatabaseEntity be db entityType
e) -> DatabaseEntity be db entityType
e)
type TableSchema tbl =
tbl (TableFieldSchema tbl)
data TableFieldSchema (tbl :: (* -> *) -> *) ty where
TableFieldSchema ::
{ TableFieldSchema tbl ty -> ColumnName
tableFieldName :: ColumnName,
TableFieldSchema tbl ty -> FieldSchema ty
tableFieldSchema :: FieldSchema ty
} ->
TableFieldSchema tbl ty
data FieldSchema ty where
FieldSchema ::
ColumnType ->
Set ColumnConstraint ->
FieldSchema ty
deriving instance Show (FieldSchema ty)
class GDefaultTableSchema x y where
gDefTblSchema :: Proxy x -> y -> x
instance GDefaultTableSchema (x p) (y p) => GDefaultTableSchema (D1 f x p) (D1 f y p) where
gDefTblSchema :: Proxy (D1 f x p) -> D1 f y p -> D1 f x p
gDefTblSchema (Proxy (D1 f x p)
Proxy :: Proxy (D1 f x p)) (M1 y p
y) =
x p -> D1 f x p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (x p -> D1 f x p) -> x p -> D1 f x p
forall a b. (a -> b) -> a -> b
$ Proxy (x p) -> y p -> x p
forall x y. GDefaultTableSchema x y => Proxy x -> y -> x
gDefTblSchema (Proxy (x p)
forall k (t :: k). Proxy t
Proxy :: Proxy (x p)) y p
y
instance GDefaultTableSchema (x p) (y p) => GDefaultTableSchema (C1 f x p) (C1 f y p) where
gDefTblSchema :: Proxy (C1 f x p) -> C1 f y p -> C1 f x p
gDefTblSchema (Proxy (C1 f x p)
Proxy :: Proxy (C1 f x p)) (M1 y p
y) =
x p -> C1 f x p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (x p -> C1 f x p) -> x p -> C1 f x p
forall a b. (a -> b) -> a -> b
$ Proxy (x p) -> y p -> x p
forall x y. GDefaultTableSchema x y => Proxy x -> y -> x
gDefTblSchema (Proxy (x p)
forall k (t :: k). Proxy t
Proxy :: Proxy (x p)) y p
y
instance
(GDefaultTableSchema (a p) (c p), GDefaultTableSchema (b p) (d p)) =>
GDefaultTableSchema ((a :*: b) p) ((c :*: d) p)
where
gDefTblSchema :: Proxy ((:*:) a b p) -> (:*:) c d p -> (:*:) a b p
gDefTblSchema (Proxy ((:*:) a b p)
Proxy :: Proxy ((a :*: b) p)) (c p
c :*: d p
d) =
Proxy (a p) -> c p -> a p
forall x y. GDefaultTableSchema x y => Proxy x -> y -> x
gDefTblSchema (Proxy (a p)
forall k (t :: k). Proxy t
Proxy :: Proxy (a p)) c p
c
a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Proxy (b p) -> d p -> b p
forall x y. GDefaultTableSchema x y => Proxy x -> y -> x
gDefTblSchema (Proxy (b p)
forall k (t :: k). Proxy t
Proxy :: Proxy (b p)) d p
d
instance
( SchemaConstraint (Beam.TableField tbl ty) ~ ColumnConstraint,
HasSchemaConstraints (Beam.TableField tbl ty),
HasColumnType ty
) =>
GDefaultTableSchema
(S1 f (K1 Generic.R (TableFieldSchema tbl ty)) p)
(S1 f (K1 Generic.R (Beam.TableField tbl ty)) p)
where
gDefTblSchema :: Proxy (S1 f (K1 R (TableFieldSchema tbl ty)) p)
-> S1 f (K1 R (TableField tbl ty)) p
-> S1 f (K1 R (TableFieldSchema tbl ty)) p
gDefTblSchema (Proxy (S1 f (K1 R (TableFieldSchema tbl ty)) p)
_ :: Proxy (S1 f (K1 Generic.R (TableFieldSchema tbl ty)) p)) (M1 (K1 TableField tbl ty
fName)) = K1 R (TableFieldSchema tbl ty) p
-> S1 f (K1 R (TableFieldSchema tbl ty)) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (TableFieldSchema tbl ty -> K1 R (TableFieldSchema tbl ty) p
forall k i c (p :: k). c -> K1 i c p
K1 TableFieldSchema tbl ty
s)
where
s :: TableFieldSchema tbl ty
s = ColumnName -> FieldSchema ty -> TableFieldSchema tbl ty
forall ty (tbl :: (* -> *) -> *).
ColumnName -> FieldSchema ty -> TableFieldSchema tbl ty
TableFieldSchema (Text -> ColumnName
ColumnName (Text -> ColumnName) -> Text -> ColumnName
forall a b. (a -> b) -> a -> b
$ TableField tbl ty
fName TableField tbl ty -> Getting Text (TableField tbl ty) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TableField tbl ty) Text
forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) Text
Beam.fieldName) FieldSchema ty
defaultFieldSchema
defaultFieldSchema :: FieldSchema ty
defaultFieldSchema =
ColumnType -> Set ColumnConstraint -> FieldSchema ty
forall ty. ColumnType -> Set ColumnConstraint -> FieldSchema ty
FieldSchema
(Proxy ty -> ColumnType
forall ty. HasColumnType ty => Proxy ty -> ColumnType
defaultColumnType (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty))
(Proxy (TableField tbl ty)
-> Set (SchemaConstraint (TableField tbl ty))
forall ty.
HasSchemaConstraints ty =>
Proxy ty -> Set (SchemaConstraint ty)
schemaConstraints (Proxy (TableField tbl ty)
forall k (t :: k). Proxy t
Proxy @(Beam.TableField tbl ty)))
instance
( Generic (g (Beam.TableField tbl2)),
Generic (g (TableFieldSchema tbl2)),
GDefaultTableSchema
(Rep (g (TableFieldSchema tbl2)) ())
(Rep (g (Beam.TableField tbl2)) ())
) =>
GDefaultTableSchema
(S1 f (K1 Generic.R (g (TableFieldSchema tbl2))) ())
(S1 f (K1 Generic.R (g (Beam.TableField tbl2))) ())
where
gDefTblSchema :: Proxy (S1 f (K1 R (g (TableFieldSchema tbl2))) ())
-> S1 f (K1 R (g (TableField tbl2))) ()
-> S1 f (K1 R (g (TableFieldSchema tbl2))) ()
gDefTblSchema (Proxy (S1 f (K1 R (g (TableFieldSchema tbl2))) ())
_ :: Proxy (S1 f (K1 Generic.R (g (TableFieldSchema tbl2))) ())) (M1 (K1 g (TableField tbl2)
fName)) =
K1 R (g (TableFieldSchema tbl2)) ()
-> S1 f (K1 R (g (TableFieldSchema tbl2))) ()
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (g (TableFieldSchema tbl2) -> K1 R (g (TableFieldSchema tbl2)) ()
forall k i c (p :: k). c -> K1 i c p
K1 (g (TableFieldSchema tbl2) -> K1 R (g (TableFieldSchema tbl2)) ())
-> g (TableFieldSchema tbl2) -> K1 R (g (TableFieldSchema tbl2)) ()
forall a b. (a -> b) -> a -> b
$ Rep (g (TableFieldSchema tbl2)) () -> g (TableFieldSchema tbl2)
forall a. Generic a => Rep a () -> a
to' (Rep (g (TableFieldSchema tbl2)) () -> g (TableFieldSchema tbl2))
-> Rep (g (TableFieldSchema tbl2)) () -> g (TableFieldSchema tbl2)
forall a b. (a -> b) -> a -> b
$ Proxy (Rep (g (TableFieldSchema tbl2)) ())
-> Rep (g (TableField tbl2)) ()
-> Rep (g (TableFieldSchema tbl2)) ()
forall x y. GDefaultTableSchema x y => Proxy x -> y -> x
gDefTblSchema Proxy (Rep (g (TableFieldSchema tbl2)) ())
forall k (t :: k). Proxy t
Proxy (g (TableField tbl2) -> Rep (g (TableField tbl2)) ()
forall a. Generic a => a -> Rep a ()
from' g (TableField tbl2)
fName))
instance
( Generic (PrimaryKey tbl1 (g (Beam.TableField tbl2))),
Generic (PrimaryKey tbl1 (g (TableFieldSchema tbl2))),
GDefaultTableSchema
(Rep (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) ())
(Rep (PrimaryKey tbl1 (g (Beam.TableField tbl2))) ())
) =>
GDefaultTableSchema
(S1 f (K1 Generic.R (PrimaryKey tbl1 (g (TableFieldSchema tbl2)))) p)
(S1 f (K1 Generic.R (PrimaryKey tbl1 (g (Beam.TableField tbl2)))) p)
where
gDefTblSchema :: Proxy (S1 f (K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2)))) p)
-> S1 f (K1 R (PrimaryKey tbl1 (g (TableField tbl2)))) p
-> S1 f (K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2)))) p
gDefTblSchema (Proxy (S1 f (K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2)))) p)
_ :: Proxy (S1 f (K1 Generic.R (PrimaryKey tbl1 (g (TableFieldSchema tbl2)))) p)) (M1 (K1 PrimaryKey tbl1 (g (TableField tbl2))
fName)) =
K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) p
-> S1 f (K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2)))) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (PrimaryKey tbl1 (g (TableFieldSchema tbl2))
-> K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) p
forall k i c (p :: k). c -> K1 i c p
K1 (PrimaryKey tbl1 (g (TableFieldSchema tbl2))
-> K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) p)
-> PrimaryKey tbl1 (g (TableFieldSchema tbl2))
-> K1 R (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) p
forall a b. (a -> b) -> a -> b
$ Rep (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) ()
-> PrimaryKey tbl1 (g (TableFieldSchema tbl2))
forall a. Generic a => Rep a () -> a
to' (Rep (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) ()
-> PrimaryKey tbl1 (g (TableFieldSchema tbl2)))
-> Rep (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) ()
-> PrimaryKey tbl1 (g (TableFieldSchema tbl2))
forall a b. (a -> b) -> a -> b
$ Proxy (Rep (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) ())
-> Rep (PrimaryKey tbl1 (g (TableField tbl2))) ()
-> Rep (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) ()
forall x y. GDefaultTableSchema x y => Proxy x -> y -> x
gDefTblSchema Proxy (Rep (PrimaryKey tbl1 (g (TableFieldSchema tbl2))) ())
forall k (t :: k). Proxy t
Proxy (PrimaryKey tbl1 (g (TableField tbl2))
-> Rep (PrimaryKey tbl1 (g (TableField tbl2))) ()
forall a. Generic a => a -> Rep a ()
from' PrimaryKey tbl1 (g (TableField tbl2))
fName))
defaultTableSchema ::
forall tbl.
( GDefaultTableSchema (Rep (TableSchema tbl) ()) (Rep (Beam.TableSettings tbl) ()),
Generic (TableSchema tbl),
Generic (Beam.TableSettings tbl)
) =>
Beam.TableSettings tbl ->
TableSchema tbl
defaultTableSchema :: TableSettings tbl -> TableSchema tbl
defaultTableSchema TableSettings tbl
tSettings =
Rep (TableSchema tbl) () -> TableSchema tbl
forall a x. Generic a => Rep a x -> a
to (Rep (TableSchema tbl) () -> TableSchema tbl)
-> Rep (TableSchema tbl) () -> TableSchema tbl
forall a b. (a -> b) -> a -> b
$ Proxy (Rep (TableSchema tbl) ())
-> Rep (TableSettings tbl) () -> Rep (TableSchema tbl) ()
forall x y. GDefaultTableSchema x y => Proxy x -> y -> x
gDefTblSchema (Proxy (Rep (TableSchema tbl) ())
forall k (t :: k). Proxy t
Proxy :: Proxy (Rep (TableSchema tbl) ())) (TableSettings tbl -> Rep (TableSettings tbl) ()
forall a. Generic a => a -> Rep a ()
from' TableSettings tbl
tSettings)
from' :: Generic a => a -> Rep a ()
from' :: a -> Rep a ()
from' = a -> Rep a ()
forall a x. Generic a => a -> Rep a x
from
to' :: Generic a => Rep a () -> a
to' :: Rep a () -> a
to' = Rep a () -> a
forall a x. Generic a => Rep a x -> a
to
annotateTableFields ::
tbl (FieldModification (TableFieldSchema tbl)) ->
EntityModification (AnnotatedDatabaseEntity be db) be (TableEntity tbl)
annotateTableFields :: tbl (FieldModification (TableFieldSchema tbl))
-> EntityModification
(AnnotatedDatabaseEntity be db) be (TableEntity tbl)
annotateTableFields tbl (FieldModification (TableFieldSchema tbl))
modFields =
Endo (AnnotatedDatabaseEntity be db (TableEntity tbl))
-> EntityModification
(AnnotatedDatabaseEntity be db) be (TableEntity tbl)
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification
( (AnnotatedDatabaseEntity be db (TableEntity tbl)
-> AnnotatedDatabaseEntity be db (TableEntity tbl))
-> Endo (AnnotatedDatabaseEntity be db (TableEntity tbl))
forall a. (a -> a) -> Endo a
Endo
( \(AnnotatedDatabaseEntity tbl :: AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
tbl@(AnnotatedDatabaseTable {}) DatabaseEntity be db (TableEntity tbl)
e) ->
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> DatabaseEntity be db (TableEntity tbl)
-> AnnotatedDatabaseEntity be db (TableEntity tbl)
forall be entityType (db :: (* -> *) -> *).
(IsAnnotatedDatabaseEntity be entityType,
IsDatabaseEntity be entityType) =>
AnnotatedDatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
-> AnnotatedDatabaseEntity be db entityType
AnnotatedDatabaseEntity
( AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
R:AnnotatedDatabaseEntityDescriptorbeTableEntity be tbl
tbl
{ dbAnnotatedSchema :: TableSchema tbl
dbAnnotatedSchema = tbl (FieldModification (TableFieldSchema tbl))
-> TableSchema tbl -> TableSchema tbl
forall (tbl :: (* -> *) -> *) (f :: * -> *).
Beamable tbl =>
tbl (FieldModification f) -> tbl f -> tbl f
Beam.withTableModification tbl (FieldModification (TableFieldSchema tbl))
modFields (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
forall be (tbl :: (* -> *) -> *).
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> TableSchema tbl
dbAnnotatedSchema AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
tbl)
}
)
DatabaseEntity be db (TableEntity tbl)
e
)
)
defaultsTo ::
(HasColumnType ty, HasSqlValueSyntax Pg.PgValueSyntax ty) =>
(forall ctx s. Beam.QGenExpr ctx Postgres s ty) ->
FieldModification (TableFieldSchema tbl) ty
defaultsTo :: (forall ctx s. QGenExpr ctx Postgres s ty)
-> FieldModification (TableFieldSchema tbl) ty
defaultsTo forall ctx s. QGenExpr ctx Postgres s ty
tyVal = (Columnar (TableFieldSchema tbl) ty
-> Columnar (TableFieldSchema tbl) ty)
-> FieldModification (TableFieldSchema tbl) ty
forall (f :: * -> *) a.
(Columnar f a -> Columnar f a) -> FieldModification f a
FieldModification ((Columnar (TableFieldSchema tbl) ty
-> Columnar (TableFieldSchema tbl) ty)
-> FieldModification (TableFieldSchema tbl) ty)
-> (Columnar (TableFieldSchema tbl) ty
-> Columnar (TableFieldSchema tbl) ty)
-> FieldModification (TableFieldSchema tbl) ty
forall a b. (a -> b) -> a -> b
$ \Columnar (TableFieldSchema tbl) ty
old ->
case TableFieldSchema tbl ty -> FieldSchema ty
forall (tbl :: (* -> *) -> *) ty.
TableFieldSchema tbl ty -> FieldSchema ty
tableFieldSchema Columnar (TableFieldSchema tbl) ty
TableFieldSchema tbl ty
old of
FieldSchema ColumnType
ty Set ColumnConstraint
c ->
Columnar (TableFieldSchema tbl) ty
TableFieldSchema tbl ty
old
{ tableFieldSchema :: FieldSchema ty
tableFieldSchema =
ColumnType -> Set ColumnConstraint -> FieldSchema ty
forall ty. ColumnType -> Set ColumnConstraint -> FieldSchema ty
FieldSchema ColumnType
ty (Set ColumnConstraint -> FieldSchema ty)
-> Set ColumnConstraint -> FieldSchema ty
forall a b. (a -> b) -> a -> b
$ ColumnConstraint -> Set ColumnConstraint
forall a. a -> Set a
S.singleton ((forall ctx s. QGenExpr ctx Postgres s ty) -> ColumnConstraint
forall ty.
(HasColumnType ty, HasSqlValueSyntax PgValueSyntax ty) =>
(forall ctx s. QGenExpr ctx Postgres s ty) -> ColumnConstraint
pgDefaultConstraint forall ctx s. QGenExpr ctx Postgres s ty
tyVal) Set ColumnConstraint
-> Set ColumnConstraint -> Set ColumnConstraint
forall a. Semigroup a => a -> a -> a
<> Set ColumnConstraint
c
}
pgDefaultConstraint ::
forall ty.
(HasColumnType ty, HasSqlValueSyntax Pg.PgValueSyntax ty) =>
(forall ctx s. Beam.QGenExpr ctx Postgres s ty) ->
ColumnConstraint
pgDefaultConstraint :: (forall ctx s. QGenExpr ctx Postgres s ty) -> ColumnConstraint
pgDefaultConstraint forall ctx s. QGenExpr ctx Postgres s ty
tyVal =
let syntaxFragment :: Text
syntaxFragment = String -> Text
T.pack (String -> Text)
-> (PgExpressionSyntax -> String) -> PgExpressionSyntax -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgSyntax -> String
forall syntax. Sql92DisplaySyntax syntax => syntax -> String
displaySyntax (PgSyntax -> String)
-> (PgExpressionSyntax -> PgSyntax) -> PgExpressionSyntax -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PgExpressionSyntax -> PgSyntax
Pg.fromPgExpression (PgExpressionSyntax -> Text) -> PgExpressionSyntax -> Text
forall a b. (a -> b) -> a -> b
$ (forall s. QExpr Postgres s ty) -> PgExpressionSyntax
forall a. (forall s. QExpr Postgres s a) -> PgExpressionSyntax
defaultTo_ forall s. QExpr Postgres s ty
forall ctx s. QGenExpr ctx Postgres s ty
tyVal
dVal :: Text
dVal = case Proxy ty -> Maybe Text
forall ty. HasColumnType ty => Proxy ty -> Maybe Text
defaultTypeCast (Proxy ty
forall k (t :: k). Proxy t
Proxy @ty) of
Maybe Text
Nothing -> Text
syntaxFragment
Just Text
tc | Text -> Char
T.head Text
syntaxFragment Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' -> Text
syntaxFragment Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tc
Just Text
tc | Text
syntaxFragment Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"CURRENT_TIMESTAMP" -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
syntaxFragment Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tc
Just Text
tc -> Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
syntaxFragment Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'::" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tc
in Text -> ColumnConstraint
Default Text
dVal
where
defaultTo_ :: (forall s. QExpr Postgres s a) -> Pg.PgExpressionSyntax
defaultTo_ :: (forall s. QExpr Postgres s a) -> PgExpressionSyntax
defaultTo_ (Beam.QExpr e) = Text -> BeamSqlBackendExpressionSyntax Postgres
e Text
"t"
data UniqueConstraint (tbl :: ((* -> *) -> *)) where
U :: HasColumnNames entity tbl => (tbl (Beam.TableField tbl) -> entity) -> UniqueConstraint tbl
uniqueConstraintOn ::
[UniqueConstraint tbl] ->
EntityModification (AnnotatedDatabaseEntity be db) be (TableEntity tbl)
uniqueConstraintOn :: [UniqueConstraint tbl]
-> EntityModification
(AnnotatedDatabaseEntity be db) be (TableEntity tbl)
uniqueConstraintOn [UniqueConstraint tbl]
us =
Endo (AnnotatedDatabaseEntity be db (TableEntity tbl))
-> EntityModification
(AnnotatedDatabaseEntity be db) be (TableEntity tbl)
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification
( (AnnotatedDatabaseEntity be db (TableEntity tbl)
-> AnnotatedDatabaseEntity be db (TableEntity tbl))
-> Endo (AnnotatedDatabaseEntity be db (TableEntity tbl))
forall a. (a -> a) -> Endo a
Endo
( \(AnnotatedDatabaseEntity tbl :: AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
tbl@(AnnotatedDatabaseTable {}) DatabaseEntity be db (TableEntity tbl)
e) ->
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> DatabaseEntity be db (TableEntity tbl)
-> AnnotatedDatabaseEntity be db (TableEntity tbl)
forall be entityType (db :: (* -> *) -> *).
(IsAnnotatedDatabaseEntity be entityType,
IsDatabaseEntity be entityType) =>
AnnotatedDatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
-> AnnotatedDatabaseEntity be db entityType
AnnotatedDatabaseEntity
( AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
R:AnnotatedDatabaseEntityDescriptorbeTableEntity be tbl
tbl
{ dbAnnotatedConstraints :: Set TableConstraint
dbAnnotatedConstraints =
let cols :: [ColumnName]
cols = (UniqueConstraint tbl -> [ColumnName])
-> [UniqueConstraint tbl] -> [ColumnName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\case (U tbl (TableField tbl) -> entity
f) -> tbl (TableField tbl)
-> (tbl (TableField tbl) -> entity) -> [ColumnName]
forall entity (tbl :: (* -> *) -> *).
HasColumnNames entity tbl =>
tbl (TableField tbl)
-> (tbl (TableField tbl) -> entity) -> [ColumnName]
colNames (DatabaseEntity be db (TableEntity tbl) -> tbl (TableField tbl)
forall be (db :: (* -> *) -> *) (tbl :: (* -> *) -> *).
DatabaseEntity be db (TableEntity tbl) -> TableSettings tbl
tableSettings DatabaseEntity be db (TableEntity tbl)
e) tbl (TableField tbl) -> entity
f) [UniqueConstraint tbl]
us
tName :: Text
tName = DatabaseEntity be db (TableEntity tbl)
e DatabaseEntity be db (TableEntity tbl)
-> Getting Text (DatabaseEntity be db (TableEntity tbl)) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting
Text
(DatabaseEntity be db (TableEntity tbl))
(DatabaseEntityDescriptor be (TableEntity tbl))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
(DatabaseEntity be db entityType)
(DatabaseEntityDescriptor be entityType)
dbEntityDescriptor Getting
Text
(DatabaseEntity be db (TableEntity tbl))
(DatabaseEntityDescriptor be (TableEntity tbl))
-> ((Text -> Const Text Text)
-> DatabaseEntityDescriptor be (TableEntity tbl)
-> Const Text (DatabaseEntityDescriptor be (TableEntity tbl)))
-> Getting Text (DatabaseEntity be db (TableEntity tbl)) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> DatabaseEntityDescriptor be (TableEntity tbl)
-> Const Text (DatabaseEntityDescriptor be (TableEntity tbl))
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
dbEntityName
conname :: Text
conname = Text -> [Text] -> Text
T.intercalate Text
"_" (Text
tName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (ColumnName -> Text) -> [ColumnName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ColumnName -> Text
columnName [ColumnName]
cols) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_ukey"
in TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => a -> Set a -> Set a
S.insert (Text -> Set ColumnName -> TableConstraint
Unique Text
conname ([ColumnName] -> Set ColumnName
forall a. Ord a => [a] -> Set a
S.fromList [ColumnName]
cols)) (AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
forall be (tbl :: (* -> *) -> *).
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
dbAnnotatedConstraints AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
tbl)
}
)
DatabaseEntity be db (TableEntity tbl)
e
)
)
data ForeignKeyConstraint (tbl :: ((* -> *) -> *)) (tbl' :: ((* -> *) -> *)) where
References ::
Beam.Beamable (PrimaryKey tbl') =>
(tbl (Beam.TableField tbl) -> PrimaryKey tbl' (Beam.TableField tbl)) ->
(tbl' (Beam.TableField tbl') -> Beam.Columnar Beam.Identity (Beam.TableField tbl' ty)) ->
ForeignKeyConstraint tbl tbl'
foreignKeyOnPk ::
( Beam.Beamable (PrimaryKey tbl'),
Beam.Beamable tbl',
Beam.Table tbl',
PrimaryKey tbl' f ~ PrimaryKey tbl' g
) =>
DatabaseEntity be db (TableEntity tbl') ->
(tbl (Beam.TableField tbl) -> PrimaryKey tbl' (Beam.TableField tbl)) ->
ReferenceAction ->
ReferenceAction ->
EntityModification (AnnotatedDatabaseEntity be db) be (TableEntity tbl)
foreignKeyOnPk :: DatabaseEntity be db (TableEntity tbl')
-> (tbl (TableField tbl) -> PrimaryKey tbl' (TableField tbl))
-> ReferenceAction
-> ReferenceAction
-> EntityModification
(AnnotatedDatabaseEntity be db) be (TableEntity tbl)
foreignKeyOnPk DatabaseEntity be db (TableEntity tbl')
externalEntity tbl (TableField tbl) -> PrimaryKey tbl' (TableField tbl)
ourColumn ReferenceAction
onDelete ReferenceAction
onUpdate =
Endo (AnnotatedDatabaseEntity be db (TableEntity tbl))
-> EntityModification
(AnnotatedDatabaseEntity be db) be (TableEntity tbl)
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification
( (AnnotatedDatabaseEntity be db (TableEntity tbl)
-> AnnotatedDatabaseEntity be db (TableEntity tbl))
-> Endo (AnnotatedDatabaseEntity be db (TableEntity tbl))
forall a. (a -> a) -> Endo a
Endo
( \(AnnotatedDatabaseEntity tbl :: AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
tbl@(AnnotatedDatabaseTable {}) DatabaseEntity be db (TableEntity tbl)
e) ->
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> DatabaseEntity be db (TableEntity tbl)
-> AnnotatedDatabaseEntity be db (TableEntity tbl)
forall be entityType (db :: (* -> *) -> *).
(IsAnnotatedDatabaseEntity be entityType,
IsDatabaseEntity be entityType) =>
AnnotatedDatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
-> AnnotatedDatabaseEntity be db entityType
AnnotatedDatabaseEntity
( AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
R:AnnotatedDatabaseEntityDescriptorbeTableEntity be tbl
tbl
{ dbAnnotatedConstraints :: Set TableConstraint
dbAnnotatedConstraints =
let colPairs :: [(ColumnName, ColumnName)]
colPairs =
(ColumnName -> ColumnName -> (ColumnName, ColumnName))
-> [ColumnName] -> [ColumnName] -> [(ColumnName, ColumnName)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(,)
(PrimaryKey tbl' (TableField tbl) -> [ColumnName]
forall (tbl :: (* -> *) -> *) (c :: (* -> *) -> *).
Beamable tbl =>
tbl (TableField c) -> [ColumnName]
fieldAsColumnNames (tbl (TableField tbl) -> PrimaryKey tbl' (TableField tbl)
ourColumn (DatabaseEntity be db (TableEntity tbl) -> tbl (TableField tbl)
forall be (db :: (* -> *) -> *) (tbl :: (* -> *) -> *).
DatabaseEntity be db (TableEntity tbl) -> TableSettings tbl
tableSettings DatabaseEntity be db (TableEntity tbl)
e)))
(PrimaryKey tbl' (TableField tbl') -> [ColumnName]
forall (tbl :: (* -> *) -> *) (c :: (* -> *) -> *).
Beamable tbl =>
tbl (TableField c) -> [ColumnName]
fieldAsColumnNames (tbl' (TableField tbl') -> PrimaryKey tbl' (TableField tbl')
forall (t :: (* -> *) -> *) (f :: * -> *).
Table t =>
t f -> PrimaryKey t f
Beam.pk (DatabaseEntity be db (TableEntity tbl') -> tbl' (TableField tbl')
forall be (db :: (* -> *) -> *) (tbl :: (* -> *) -> *).
DatabaseEntity be db (TableEntity tbl) -> TableSettings tbl
tableSettings DatabaseEntity be db (TableEntity tbl')
externalEntity)))
tName :: Text
tName = DatabaseEntity be db (TableEntity tbl')
externalEntity DatabaseEntity be db (TableEntity tbl')
-> Getting Text (DatabaseEntity be db (TableEntity tbl')) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting
Text
(DatabaseEntity be db (TableEntity tbl'))
(DatabaseEntityDescriptor be (TableEntity tbl'))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
(DatabaseEntity be db entityType)
(DatabaseEntityDescriptor be entityType)
dbEntityDescriptor Getting
Text
(DatabaseEntity be db (TableEntity tbl'))
(DatabaseEntityDescriptor be (TableEntity tbl'))
-> ((Text -> Const Text Text)
-> DatabaseEntityDescriptor be (TableEntity tbl')
-> Const Text (DatabaseEntityDescriptor be (TableEntity tbl')))
-> Getting Text (DatabaseEntity be db (TableEntity tbl')) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> DatabaseEntityDescriptor be (TableEntity tbl')
-> Const Text (DatabaseEntityDescriptor be (TableEntity tbl'))
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
dbEntityName
conname :: Text
conname = Text -> [Text] -> Text
T.intercalate Text
"_" (Text
tName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((ColumnName, ColumnName) -> Text)
-> [(ColumnName, ColumnName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ColumnName -> Text
columnName (ColumnName -> Text)
-> ((ColumnName, ColumnName) -> ColumnName)
-> (ColumnName, ColumnName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnName, ColumnName) -> ColumnName
forall a b. (a, b) -> b
snd) [(ColumnName, ColumnName)]
colPairs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_fkey"
in TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => a -> Set a -> Set a
S.insert
(Text
-> TableName
-> Set (ColumnName, ColumnName)
-> ReferenceAction
-> ReferenceAction
-> TableConstraint
ForeignKey Text
conname (Text -> TableName
TableName Text
tName) ([(ColumnName, ColumnName)] -> Set (ColumnName, ColumnName)
forall a. Ord a => [a] -> Set a
S.fromList [(ColumnName, ColumnName)]
colPairs) ReferenceAction
onDelete ReferenceAction
onUpdate)
(AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
forall be (tbl :: (* -> *) -> *).
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
dbAnnotatedConstraints AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
tbl)
}
)
DatabaseEntity be db (TableEntity tbl)
e
)
)
foreignKeyOn ::
Beam.Beamable tbl' =>
DatabaseEntity be db (TableEntity tbl') ->
[ForeignKeyConstraint tbl tbl'] ->
ReferenceAction ->
ReferenceAction ->
EntityModification (AnnotatedDatabaseEntity be db) be (TableEntity tbl)
foreignKeyOn :: DatabaseEntity be db (TableEntity tbl')
-> [ForeignKeyConstraint tbl tbl']
-> ReferenceAction
-> ReferenceAction
-> EntityModification
(AnnotatedDatabaseEntity be db) be (TableEntity tbl)
foreignKeyOn DatabaseEntity be db (TableEntity tbl')
externalEntity [ForeignKeyConstraint tbl tbl']
us ReferenceAction
onDelete ReferenceAction
onUpdate =
Endo (AnnotatedDatabaseEntity be db (TableEntity tbl))
-> EntityModification
(AnnotatedDatabaseEntity be db) be (TableEntity tbl)
forall (f :: * -> *) be e. Endo (f e) -> EntityModification f be e
EntityModification
( (AnnotatedDatabaseEntity be db (TableEntity tbl)
-> AnnotatedDatabaseEntity be db (TableEntity tbl))
-> Endo (AnnotatedDatabaseEntity be db (TableEntity tbl))
forall a. (a -> a) -> Endo a
Endo
( \(AnnotatedDatabaseEntity tbl :: AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
tbl@(AnnotatedDatabaseTable {}) DatabaseEntity be db (TableEntity tbl)
e) ->
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> DatabaseEntity be db (TableEntity tbl)
-> AnnotatedDatabaseEntity be db (TableEntity tbl)
forall be entityType (db :: (* -> *) -> *).
(IsAnnotatedDatabaseEntity be entityType,
IsDatabaseEntity be entityType) =>
AnnotatedDatabaseEntityDescriptor be entityType
-> DatabaseEntity be db entityType
-> AnnotatedDatabaseEntity be db entityType
AnnotatedDatabaseEntity
( AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
R:AnnotatedDatabaseEntityDescriptorbeTableEntity be tbl
tbl
{ dbAnnotatedConstraints :: Set TableConstraint
dbAnnotatedConstraints =
let colPairs :: [(ColumnName, ColumnName)]
colPairs =
(ForeignKeyConstraint tbl tbl' -> [(ColumnName, ColumnName)])
-> [ForeignKeyConstraint tbl tbl'] -> [(ColumnName, ColumnName)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
( \case
(References tbl (TableField tbl) -> PrimaryKey tbl' (TableField tbl)
ours tbl' (TableField tbl') -> Columnar Identity (TableField tbl' ty)
theirs) ->
(ColumnName -> ColumnName -> (ColumnName, ColumnName))
-> [ColumnName] -> [ColumnName] -> [(ColumnName, ColumnName)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
(,)
(PrimaryKey tbl' (TableField tbl) -> [ColumnName]
forall (tbl :: (* -> *) -> *) (c :: (* -> *) -> *).
Beamable tbl =>
tbl (TableField c) -> [ColumnName]
fieldAsColumnNames (tbl (TableField tbl) -> PrimaryKey tbl' (TableField tbl)
ours (DatabaseEntity be db (TableEntity tbl) -> tbl (TableField tbl)
forall be (db :: (* -> *) -> *) (tbl :: (* -> *) -> *).
DatabaseEntity be db (TableEntity tbl) -> TableSettings tbl
tableSettings DatabaseEntity be db (TableEntity tbl)
e)))
[Text -> ColumnName
ColumnName (tbl' (TableField tbl') -> Columnar Identity (TableField tbl' ty)
theirs (DatabaseEntity be db (TableEntity tbl') -> tbl' (TableField tbl')
forall be (db :: (* -> *) -> *) (tbl :: (* -> *) -> *).
DatabaseEntity be db (TableEntity tbl) -> TableSettings tbl
tableSettings DatabaseEntity be db (TableEntity tbl')
externalEntity) TableField tbl' ty
-> Getting Text (TableField tbl' ty) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TableField tbl' ty) Text
forall (table :: (* -> *) -> *) ty.
Lens' (TableField table ty) Text
Beam.fieldName)]
)
[ForeignKeyConstraint tbl tbl']
us
tName :: Text
tName = DatabaseEntity be db (TableEntity tbl')
externalEntity DatabaseEntity be db (TableEntity tbl')
-> Getting Text (DatabaseEntity be db (TableEntity tbl')) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting
Text
(DatabaseEntity be db (TableEntity tbl'))
(DatabaseEntityDescriptor be (TableEntity tbl'))
forall be (db :: (* -> *) -> *) entityType.
SimpleGetter
(DatabaseEntity be db entityType)
(DatabaseEntityDescriptor be entityType)
dbEntityDescriptor Getting
Text
(DatabaseEntity be db (TableEntity tbl'))
(DatabaseEntityDescriptor be (TableEntity tbl'))
-> ((Text -> Const Text Text)
-> DatabaseEntityDescriptor be (TableEntity tbl')
-> Const Text (DatabaseEntityDescriptor be (TableEntity tbl')))
-> Getting Text (DatabaseEntity be db (TableEntity tbl')) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> DatabaseEntityDescriptor be (TableEntity tbl')
-> Const Text (DatabaseEntityDescriptor be (TableEntity tbl'))
forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
dbEntityName
conname :: Text
conname = Text -> [Text] -> Text
T.intercalate Text
"_" (Text
tName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((ColumnName, ColumnName) -> Text)
-> [(ColumnName, ColumnName)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ColumnName -> Text
columnName (ColumnName -> Text)
-> ((ColumnName, ColumnName) -> ColumnName)
-> (ColumnName, ColumnName)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnName, ColumnName) -> ColumnName
forall a b. (a, b) -> b
snd) [(ColumnName, ColumnName)]
colPairs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_fkey"
in TableConstraint -> Set TableConstraint -> Set TableConstraint
forall a. Ord a => a -> Set a -> Set a
S.insert
(Text
-> TableName
-> Set (ColumnName, ColumnName)
-> ReferenceAction
-> ReferenceAction
-> TableConstraint
ForeignKey Text
conname (Text -> TableName
TableName Text
tName) ([(ColumnName, ColumnName)] -> Set (ColumnName, ColumnName)
forall a. Ord a => [a] -> Set a
S.fromList [(ColumnName, ColumnName)]
colPairs) ReferenceAction
onDelete ReferenceAction
onUpdate)
(AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
forall be (tbl :: (* -> *) -> *).
AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
-> Set TableConstraint
dbAnnotatedConstraints AnnotatedDatabaseEntityDescriptor be (TableEntity tbl)
tbl)
}
)
DatabaseEntity be db (TableEntity tbl)
e
)
)