{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE UndecidableInstances #-}
module Database.Beam.Migrate.Generics.Tables
(
HasDefaultSqlDataType(..)
, GMigratableTableSettings(..)
, HasNullableConstraint, NullableStatus
) where
import Database.Beam
import Database.Beam.Backend.Internal.Compat
import Database.Beam.Backend.SQL
import Database.Beam.Migrate.Types.Predicates
import Database.Beam.Migrate.SQL.Types
import Database.Beam.Migrate.SQL.SQL92
import Database.Beam.Migrate.Checks
import Control.Applicative (Const(..))
import Data.Proxy
import Data.Text (Text)
import Data.Scientific (Scientific)
import Data.Time.Calendar (Day)
import Data.Time (TimeOfDay)
import Data.Int
import Data.Word
import GHC.Generics
import GHC.TypeLits
class BeamMigrateSqlBackend be => GMigratableTableSettings be (i :: * -> *) fieldCheck where
gDefaultTblSettingsChecks :: Proxy be -> Proxy i -> Bool -> fieldCheck ()
instance (BeamMigrateSqlBackend be, GMigratableTableSettings be xId fieldCheckId) =>
GMigratableTableSettings be (M1 t s xId) (M1 t s fieldCheckId) where
gDefaultTblSettingsChecks :: Proxy be -> Proxy (M1 t s xId) -> Bool -> M1 t s fieldCheckId ()
gDefaultTblSettingsChecks Proxy be
be Proxy (M1 t s xId)
Proxy Bool
embedded =
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (forall be (i :: * -> *) (fieldCheck :: * -> *).
GMigratableTableSettings be i fieldCheck =>
Proxy be -> Proxy i -> Bool -> fieldCheck ()
gDefaultTblSettingsChecks Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @xId) Bool
embedded)
instance ( BeamMigrateSqlBackend be
, GMigratableTableSettings be aId aFieldCheck
, GMigratableTableSettings be bId bFieldCheck ) =>
GMigratableTableSettings be (aId :*: bId) (aFieldCheck :*: bFieldCheck) where
gDefaultTblSettingsChecks :: Proxy be
-> Proxy (aId :*: bId) -> Bool -> (:*:) aFieldCheck bFieldCheck ()
gDefaultTblSettingsChecks Proxy be
be Proxy (aId :*: bId)
Proxy Bool
embedded =
forall be (i :: * -> *) (fieldCheck :: * -> *).
GMigratableTableSettings be i fieldCheck =>
Proxy be -> Proxy i -> Bool -> fieldCheck ()
gDefaultTblSettingsChecks Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @aId) Bool
embedded forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*:
forall be (i :: * -> *) (fieldCheck :: * -> *).
GMigratableTableSettings be i fieldCheck =>
Proxy be -> Proxy i -> Bool -> fieldCheck ()
gDefaultTblSettingsChecks Proxy be
be (forall {k} (t :: k). Proxy t
Proxy @bId) Bool
embedded
instance ( HasDefaultSqlDataType be haskTy
, HasNullableConstraint (NullableStatus haskTy) be
, HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be)
, Typeable be, BeamMigrateSqlBackend be ) =>
GMigratableTableSettings be (Rec0 haskTy) (Rec0 (Const [FieldCheck] haskTy)) where
gDefaultTblSettingsChecks :: Proxy be
-> Proxy (Rec0 haskTy)
-> Bool
-> Rec0 (Const [FieldCheck] haskTy) ()
gDefaultTblSettingsChecks Proxy be
_ Proxy (Rec0 haskTy)
_ Bool
embedded =
forall k i c (p :: k). c -> K1 i c p
K1 (forall {k} a (b :: k). a -> Const a b
Const (forall (x :: Bool) be.
HasNullableConstraint x be =>
Proxy x -> Proxy be -> [FieldCheck]
nullableConstraint (forall {k} (t :: k). Proxy t
Proxy @(NullableStatus haskTy)) (forall {k} (t :: k). Proxy t
Proxy @be) forall a. [a] -> [a] -> [a]
++
forall be ty.
HasDefaultSqlDataType be ty =>
Proxy ty -> Proxy be -> Bool -> [FieldCheck]
defaultSqlDataTypeConstraints (forall {k} (t :: k). Proxy t
Proxy @haskTy) (forall {k} (t :: k). Proxy t
Proxy @be) Bool
embedded forall a. [a] -> [a] -> [a]
++
[ (QualifiedName -> Text -> SomeDatabasePredicate) -> FieldCheck
FieldCheck (\QualifiedName
tblNm Text
nm -> forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p (forall be.
HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) =>
QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
TableHasColumn QualifiedName
tblNm Text
nm (forall be ty.
HasDefaultSqlDataType be ty =>
Proxy ty -> Proxy be -> Bool -> BeamSqlBackendDataTypeSyntax be
defaultSqlDataType (forall {k} (t :: k). Proxy t
Proxy @haskTy) (forall {k} (t :: k). Proxy t
Proxy @be) Bool
embedded)
:: TableHasColumn be )) ]))
instance ( Generic (embeddedTbl (Const [FieldCheck]))
, BeamMigrateSqlBackend be
, GMigratableTableSettings be (Rep (embeddedTbl Identity)) (Rep (embeddedTbl (Const [FieldCheck]))) ) =>
GMigratableTableSettings be (Rec0 (embeddedTbl Identity)) (Rec0 (embeddedTbl (Const [FieldCheck]))) where
gDefaultTblSettingsChecks :: Proxy be
-> Proxy (Rec0 (embeddedTbl Identity))
-> Bool
-> Rec0 (embeddedTbl (Const [FieldCheck])) ()
gDefaultTblSettingsChecks Proxy be
be Proxy (Rec0 (embeddedTbl Identity))
_ Bool
_ =
forall k i c (p :: k). c -> K1 i c p
K1 (forall a x. Generic a => Rep a x -> a
to (forall be (i :: * -> *) (fieldCheck :: * -> *).
GMigratableTableSettings be i fieldCheck =>
Proxy be -> Proxy i -> Bool -> fieldCheck ()
gDefaultTblSettingsChecks Proxy be
be (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep (embeddedTbl Identity))) Bool
True))
instance ( Generic (embeddedTbl (Nullable (Const [FieldCheck])))
, BeamMigrateSqlBackend be
, GMigratableTableSettings be (Rep (embeddedTbl (Nullable Identity))) (Rep (embeddedTbl (Nullable (Const [FieldCheck])))) ) =>
GMigratableTableSettings be (Rec0 (embeddedTbl (Nullable Identity))) (Rec0 (embeddedTbl (Nullable (Const [FieldCheck])))) where
gDefaultTblSettingsChecks :: Proxy be
-> Proxy (Rec0 (embeddedTbl (Nullable Identity)))
-> Bool
-> Rec0 (embeddedTbl (Nullable (Const [FieldCheck]))) ()
gDefaultTblSettingsChecks Proxy be
be Proxy (Rec0 (embeddedTbl (Nullable Identity)))
_ Bool
_ =
forall k i c (p :: k). c -> K1 i c p
K1 (forall a x. Generic a => Rep a x -> a
to (forall be (i :: * -> *) (fieldCheck :: * -> *).
GMigratableTableSettings be i fieldCheck =>
Proxy be -> Proxy i -> Bool -> fieldCheck ()
gDefaultTblSettingsChecks Proxy be
be (forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep (embeddedTbl (Nullable Identity)))) Bool
True))
type family NullableStatus (x :: *) :: Bool where
NullableStatus (Maybe x) = 'True
NullableStatus x = 'False
class BeamMigrateSqlBackend be => HasNullableConstraint (x :: Bool) be where
nullableConstraint :: Proxy x -> Proxy be -> [ FieldCheck ]
instance ( Typeable be, BeamMigrateSqlBackend be ) =>
HasNullableConstraint 'False be where
nullableConstraint :: Proxy 'False -> Proxy be -> [FieldCheck]
nullableConstraint Proxy 'False
_ Proxy be
_ =
let c :: Sql92ColumnSchemaColumnConstraintDefinitionSyntax
(Sql92CreateTableColumnSchemaSyntax
(Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))
c = forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
(Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
constraintDefinitionSyntax forall a. Maybe a
Nothing forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
notNullConstraintSyntax forall a. Maybe a
Nothing
in [ (QualifiedName -> Text -> SomeDatabasePredicate) -> FieldCheck
FieldCheck forall a b. (a -> b) -> a -> b
$ \QualifiedName
tblNm Text
colNm -> forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p (forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
TableColumnHasConstraint QualifiedName
tblNm Text
colNm Sql92ColumnSchemaColumnConstraintDefinitionSyntax
(Sql92CreateTableColumnSchemaSyntax
(Sql92DdlCommandCreateTableSyntax (BeamSqlBackendSyntax be)))
c :: TableColumnHasConstraint be) ]
instance BeamMigrateSqlBackend be =>
HasNullableConstraint 'True be where
nullableConstraint :: Proxy 'True -> Proxy be -> [FieldCheck]
nullableConstraint Proxy 'True
_ Proxy be
_ = []
class BeamMigrateSqlBackend be => HasDefaultSqlDataType be ty where
defaultSqlDataType :: Proxy ty
-> Proxy be
-> Bool
-> BeamSqlBackendDataTypeSyntax be
defaultSqlDataTypeConstraints
:: Proxy ty
-> Proxy be
-> Bool
-> [ FieldCheck ]
defaultSqlDataTypeConstraints Proxy ty
_ Proxy be
_ Bool
_ = []
instance (BeamMigrateSqlBackend be, HasDefaultSqlDataType be ty) =>
HasDefaultSqlDataType be (Maybe ty) where
defaultSqlDataType :: Proxy (Maybe ty)
-> Proxy be -> Bool -> BeamSqlBackendDataTypeSyntax be
defaultSqlDataType Proxy (Maybe ty)
_ = forall be ty.
HasDefaultSqlDataType be ty =>
Proxy ty -> Proxy be -> Bool -> BeamSqlBackendDataTypeSyntax be
defaultSqlDataType (forall {k} (t :: k). Proxy t
Proxy @ty)
defaultSqlDataTypeConstraints :: Proxy (Maybe ty) -> Proxy be -> Bool -> [FieldCheck]
defaultSqlDataTypeConstraints Proxy (Maybe ty)
_ = forall be ty.
HasDefaultSqlDataType be ty =>
Proxy ty -> Proxy be -> Bool -> [FieldCheck]
defaultSqlDataTypeConstraints (forall {k} (t :: k). Proxy t
Proxy @ty)
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Int32 where
defaultSqlDataType :: Proxy Int32
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Int32
_ Proxy be
_ Bool
_ = forall dataType. IsSql92DataTypeSyntax dataType => dataType
intType
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Int16 where
defaultSqlDataType :: Proxy Int16
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Int16
_ Proxy be
_ Bool
_ = forall dataType. IsSql92DataTypeSyntax dataType => dataType
smallIntType
instance ( BeamMigrateSqlBackend be, BeamSqlT071Backend be ) => HasDefaultSqlDataType be Int64 where
defaultSqlDataType :: Proxy Int64
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Int64
_ Proxy be
_ Bool
_ = forall dataType. IsSql2008BigIntDataTypeSyntax dataType => dataType
bigIntType
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Word16 where
defaultSqlDataType :: Proxy Word16
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Word16
_ Proxy be
_ Bool
_ = forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType (forall a. a -> Maybe a
Just (Word
5, forall a. Maybe a
Nothing))
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Word32 where
defaultSqlDataType :: Proxy Word32
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Word32
_ Proxy be
_ Bool
_ = forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType (forall a. a -> Maybe a
Just (Word
10, forall a. Maybe a
Nothing))
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Word64 where
defaultSqlDataType :: Proxy Word64
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Word64
_ Proxy be
_ Bool
_ = forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType (forall a. a -> Maybe a
Just (Word
20, forall a. Maybe a
Nothing))
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Text where
defaultSqlDataType :: Proxy Text
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Text
_ Proxy be
_ Bool
_ = forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Maybe Text -> dataType
varCharType forall a. Maybe a
Nothing forall a. Maybe a
Nothing
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be SqlBitString where
defaultSqlDataType :: Proxy SqlBitString
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy SqlBitString
_ Proxy be
_ Bool
_ = forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
varBitType forall a. Maybe a
Nothing
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Double where
defaultSqlDataType :: Proxy Double
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Double
_ Proxy be
_ Bool
_ = forall dataType. IsSql92DataTypeSyntax dataType => dataType
doubleType
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Scientific where
defaultSqlDataType :: Proxy Scientific
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Scientific
_ Proxy be
_ Bool
_ = forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType (forall a. a -> Maybe a
Just (Word
20, forall a. a -> Maybe a
Just Word
10))
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be Day where
defaultSqlDataType :: Proxy Day
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Day
_ Proxy be
_ Bool
_ = forall dataType. IsSql92DataTypeSyntax dataType => dataType
dateType
instance BeamMigrateSqlBackend be => HasDefaultSqlDataType be TimeOfDay where
defaultSqlDataType :: Proxy TimeOfDay
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy TimeOfDay
_ Proxy be
_ Bool
_ = forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timeType forall a. Maybe a
Nothing Bool
False
instance BeamMigrateSql99Backend be => HasDefaultSqlDataType be Bool where
defaultSqlDataType :: Proxy Bool
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Bool
_ Proxy be
_ Bool
_ = forall dataType. IsSql99DataTypeSyntax dataType => dataType
booleanType
instance (TypeError (PreferExplicitSize Int Int32), BeamMigrateSqlBackend be) => HasDefaultSqlDataType be Int where
defaultSqlDataType :: Proxy Int
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Int
_ = forall be ty.
HasDefaultSqlDataType be ty =>
Proxy ty -> Proxy be -> Bool -> BeamSqlBackendDataTypeSyntax be
defaultSqlDataType (forall {k} (t :: k). Proxy t
Proxy @Int32)
instance (TypeError (PreferExplicitSize Word Word32), BeamMigrateSqlBackend be) => HasDefaultSqlDataType be Word where
defaultSqlDataType :: Proxy Word
-> Proxy be
-> Bool
-> Sql92ExpressionCastTargetSyntax
(Sql92ExpressionSyntax (BeamSqlBackendSyntax be))
defaultSqlDataType Proxy Word
_ Proxy be
_ Bool
_ = forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType (forall a. a -> Maybe a
Just (Word
10, forall a. Maybe a
Nothing))