{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Support for defaulting checked tables
module Database.Beam.Migrate.Generics.Tables
  ( -- * Field data type defaulting
    HasDefaultSqlDataType(..)

  -- * Internal
  , 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))

-- * Nullability check

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
_ = []

-- * Default data types

-- | Used to define a default SQL data type for a haskell type in a particular
-- backend, as well as any constraints that are needed
--
-- Beam defines instances for several standard SQL types, which are
-- polymorphic over any standard data type syntax. Backends or
-- extensions which provide custom types should instantiate instances
-- of this class for any types they provide for which they would like
-- checked schema migrations
class BeamMigrateSqlBackend be => HasDefaultSqlDataType be ty where

  -- | Provide a data type for the given type
  defaultSqlDataType :: Proxy ty       -- ^ Concrete representation of the type
                     -> Proxy be       -- ^ Concrete representation of the backend
                     -> Bool           -- ^ 'True' if this field is in an embedded
                                       --   key or table, 'False' otherwise
                     -> BeamSqlBackendDataTypeSyntax be

  -- | Provide arbitrary constraints on a field of the requested type. See
  -- 'FieldCheck' for more information on the formatting of constraints.
  defaultSqlDataTypeConstraints
    :: Proxy ty -- ^ Concrete representation of the type
    -> Proxy be -- ^ Concrete representation of the backend
    -> Bool     -- ^ 'True' if this field is embedded in a
                --   foreign key, 'False' otherwise. For
                --   example, @SERIAL@ types in postgres get a
                --   @DEFAULT@ constraint, but @SERIAL@ types in
                --   a foreign key do not.
    -> [ 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)

-- TODO Not sure if individual databases will want to customize these types

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))