{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}

-- | Defines common 'DatabasePredicate's that are shared among backends
module Database.Beam.Migrate.Checks where

import Database.Beam.Backend.SQL.SQL92
import Database.Beam.Migrate.SQL.SQL92
import Database.Beam.Migrate.SQL.Types
import Database.Beam.Migrate.Serialization
import Database.Beam.Migrate.Types.Predicates

import Data.Aeson ((.:), (.=), withObject, object)
import Data.Aeson.Types (Parser, Value)
import Data.Hashable (Hashable(..))
import Data.Text (Text)
import Data.Typeable (Typeable, cast)
#if !MIN_VERSION_base(4, 11, 0)
import Data.Semigroup
#endif

import GHC.Generics (Generic)

-- * Table checks

-- | Asserts that a table with the given name exists in a database
data TableExistsPredicate = TableExistsPredicate QualifiedName {-^ Table name -}
  deriving (Int -> TableExistsPredicate -> ShowS
[TableExistsPredicate] -> ShowS
TableExistsPredicate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableExistsPredicate] -> ShowS
$cshowList :: [TableExistsPredicate] -> ShowS
show :: TableExistsPredicate -> String
$cshow :: TableExistsPredicate -> String
showsPrec :: Int -> TableExistsPredicate -> ShowS
$cshowsPrec :: Int -> TableExistsPredicate -> ShowS
Show, TableExistsPredicate -> TableExistsPredicate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableExistsPredicate -> TableExistsPredicate -> Bool
$c/= :: TableExistsPredicate -> TableExistsPredicate -> Bool
== :: TableExistsPredicate -> TableExistsPredicate -> Bool
$c== :: TableExistsPredicate -> TableExistsPredicate -> Bool
Eq, Eq TableExistsPredicate
TableExistsPredicate -> TableExistsPredicate -> Bool
TableExistsPredicate -> TableExistsPredicate -> Ordering
TableExistsPredicate
-> TableExistsPredicate -> TableExistsPredicate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TableExistsPredicate
-> TableExistsPredicate -> TableExistsPredicate
$cmin :: TableExistsPredicate
-> TableExistsPredicate -> TableExistsPredicate
max :: TableExistsPredicate
-> TableExistsPredicate -> TableExistsPredicate
$cmax :: TableExistsPredicate
-> TableExistsPredicate -> TableExistsPredicate
>= :: TableExistsPredicate -> TableExistsPredicate -> Bool
$c>= :: TableExistsPredicate -> TableExistsPredicate -> Bool
> :: TableExistsPredicate -> TableExistsPredicate -> Bool
$c> :: TableExistsPredicate -> TableExistsPredicate -> Bool
<= :: TableExistsPredicate -> TableExistsPredicate -> Bool
$c<= :: TableExistsPredicate -> TableExistsPredicate -> Bool
< :: TableExistsPredicate -> TableExistsPredicate -> Bool
$c< :: TableExistsPredicate -> TableExistsPredicate -> Bool
compare :: TableExistsPredicate -> TableExistsPredicate -> Ordering
$ccompare :: TableExistsPredicate -> TableExistsPredicate -> Ordering
Ord, Typeable, forall x. Rep TableExistsPredicate x -> TableExistsPredicate
forall x. TableExistsPredicate -> Rep TableExistsPredicate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableExistsPredicate x -> TableExistsPredicate
$cfrom :: forall x. TableExistsPredicate -> Rep TableExistsPredicate x
Generic)
instance Hashable TableExistsPredicate
instance DatabasePredicate TableExistsPredicate where
  englishDescription :: TableExistsPredicate -> String
englishDescription (TableExistsPredicate QualifiedName
t) =
    String
"Table " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show QualifiedName
t forall a. Semigroup a => a -> a -> a
<> String
" must exist"

  serializePredicate :: TableExistsPredicate -> Value
serializePredicate (TableExistsPredicate QualifiedName
t) =
    [Pair] -> Value
object [ Key
"table-exists" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= QualifiedName
t ]

  predicateSpecificity :: forall (proxy :: * -> *).
proxy TableExistsPredicate -> PredicateSpecificity
predicateSpecificity proxy TableExistsPredicate
_ = PredicateSpecificity
PredicateSpecificityAllBackends

-- | A class that can check whether a particular data type is present
-- in a set of preconditions.
class HasDataTypeCreatedCheck dataType where
  dataTypeHasBeenCreated :: dataType -> (forall preCondition. Typeable preCondition => [ preCondition ]) -> Bool

-- | Asserts that the table specified has a column with the given data type. The
-- type paramater @syntax@ should be an instance of 'IsSql92ColumnSchemaSyntax'.
data TableHasColumn be where
  TableHasColumn
    :: ( HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) )
    => { forall be. TableHasColumn be -> QualifiedName
hasColumn_table  :: QualifiedName {-^ Table name -}
       , forall be. TableHasColumn be -> Text
hasColumn_column :: Text {-^ Column name -}
       , forall be.
TableHasColumn be -> BeamMigrateSqlBackendDataTypeSyntax be
hasColumn_type   :: BeamMigrateSqlBackendDataTypeSyntax be {-^ Data type -}
       }
    -> TableHasColumn be
instance Hashable (BeamMigrateSqlBackendDataTypeSyntax be) => Hashable (TableHasColumn be) where
  hashWithSalt :: Int -> TableHasColumn be -> Int
hashWithSalt Int
salt (TableHasColumn QualifiedName
t Text
c BeamMigrateSqlBackendDataTypeSyntax be
s) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (QualifiedName
t, Text
c, BeamMigrateSqlBackendDataTypeSyntax be
s)
instance Eq (BeamMigrateSqlBackendDataTypeSyntax be) => Eq (TableHasColumn be) where
  TableHasColumn QualifiedName
aTbl Text
aCol BeamMigrateSqlBackendDataTypeSyntax be
aDt == :: TableHasColumn be -> TableHasColumn be -> Bool
== TableHasColumn QualifiedName
bTbl Text
bCol BeamMigrateSqlBackendDataTypeSyntax be
bDt =
    QualifiedName
aTbl forall a. Eq a => a -> a -> Bool
== QualifiedName
bTbl Bool -> Bool -> Bool
&& Text
aCol forall a. Eq a => a -> a -> Bool
== Text
bCol Bool -> Bool -> Bool
&& BeamMigrateSqlBackendDataTypeSyntax be
aDt forall a. Eq a => a -> a -> Bool
== BeamMigrateSqlBackendDataTypeSyntax be
bDt
instance ( Typeable be
         , BeamMigrateOnlySqlBackend be
         , Hashable (BeamMigrateSqlBackendDataTypeSyntax be) ) =>
  DatabasePredicate (TableHasColumn be) where
  englishDescription :: TableHasColumn be -> String
englishDescription (TableHasColumn QualifiedName
tbl Text
col BeamMigrateSqlBackendDataTypeSyntax be
type_) =
    String
"Table " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show QualifiedName
tbl forall a. Semigroup a => a -> a -> a
<> String
" must have a column " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
col forall a. Semigroup a => a -> a -> a
<> String
" of " forall a. Semigroup a => a -> a -> a
<> forall syntax. Sql92DisplaySyntax syntax => syntax -> String
displaySyntax BeamMigrateSqlBackendDataTypeSyntax be
type_

  predicateSpecificity :: forall (proxy :: * -> *).
proxy (TableHasColumn be) -> PredicateSpecificity
predicateSpecificity proxy (TableHasColumn be)
_ = PredicateSpecificity
PredicateSpecificityAllBackends

  serializePredicate :: TableHasColumn be -> Value
serializePredicate (TableHasColumn QualifiedName
tbl Text
col BeamMigrateSqlBackendDataTypeSyntax be
type_) =
    [Pair] -> Value
object [ Key
"has-column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"table" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= QualifiedName
tbl, Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
col
                                    , Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall dataType.
Sql92SerializableDataTypeSyntax dataType =>
dataType -> Value
serializeDataType BeamMigrateSqlBackendDataTypeSyntax be
type_ ]]

  predicateCascadesDropOn :: forall p'. DatabasePredicate p' => TableHasColumn be -> p' -> Bool
predicateCascadesDropOn (TableHasColumn QualifiedName
tblNm Text
_ BeamMigrateSqlBackendDataTypeSyntax be
_) p'
p'
    | Just (TableExistsPredicate QualifiedName
tblNm') <- forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p'
p' = QualifiedName
tblNm' forall a. Eq a => a -> a -> Bool
== QualifiedName
tblNm
    | Bool
otherwise = Bool
False

-- | Asserts that a particular column of a table has a given constraint. The
-- @syntax@ type parameter should be an instance of 'IsSql92ColumnSchemaSyntax'
data TableColumnHasConstraint be
  = TableColumnHasConstraint
  { forall be. TableColumnHasConstraint be -> QualifiedName
hasConstraint_table  :: QualifiedName {-^ Table name -}
  , forall be. TableColumnHasConstraint be -> Text
hasConstraint_column :: Text {-^ Column name -}
  , forall be.
TableColumnHasConstraint be
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
hasConstraint_defn   :: BeamSqlBackendColumnConstraintDefinitionSyntax be {-^ Constraint definition -}
  } deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall be x.
Rep (TableColumnHasConstraint be) x -> TableColumnHasConstraint be
forall be x.
TableColumnHasConstraint be -> Rep (TableColumnHasConstraint be) x
$cto :: forall be x.
Rep (TableColumnHasConstraint be) x -> TableColumnHasConstraint be
$cfrom :: forall be x.
TableColumnHasConstraint be -> Rep (TableColumnHasConstraint be) x
Generic
instance Hashable (BeamSqlBackendColumnConstraintDefinitionSyntax be) => Hashable (TableColumnHasConstraint be)
deriving instance Eq (BeamSqlBackendColumnConstraintDefinitionSyntax be) => Eq (TableColumnHasConstraint be)
instance ( Typeable be, BeamMigrateOnlySqlBackend be
         , Hashable (BeamSqlBackendColumnConstraintDefinitionSyntax be) ) =>
         DatabasePredicate (TableColumnHasConstraint be) where
  englishDescription :: TableColumnHasConstraint be -> String
englishDescription (TableColumnHasConstraint QualifiedName
tbl Text
col BeamSqlBackendColumnConstraintDefinitionSyntax be
cns) =
    String
"Column " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show QualifiedName
tbl forall a. Semigroup a => a -> a -> a
<> String
"." forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
col forall a. Semigroup a => a -> a -> a
<> String
" has constraint " forall a. Semigroup a => a -> a -> a
<> forall syntax. Sql92DisplaySyntax syntax => syntax -> String
displaySyntax BeamSqlBackendColumnConstraintDefinitionSyntax be
cns

  predicateSpecificity :: forall (proxy :: * -> *).
proxy (TableColumnHasConstraint be) -> PredicateSpecificity
predicateSpecificity proxy (TableColumnHasConstraint be)
_ = PredicateSpecificity
PredicateSpecificityAllBackends
  serializePredicate :: TableColumnHasConstraint be -> Value
serializePredicate (TableColumnHasConstraint QualifiedName
tbl Text
col BeamSqlBackendColumnConstraintDefinitionSyntax be
cns) =
    [Pair] -> Value
object [ Key
"has-column-constraint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"table" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= QualifiedName
tbl, Key
"column" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
col
                                               , Key
"constraint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall constraint.
Sql92SerializableConstraintDefinitionSyntax constraint =>
constraint -> Value
serializeConstraint BeamSqlBackendColumnConstraintDefinitionSyntax be
cns ] ]

  predicateCascadesDropOn :: forall p'.
DatabasePredicate p' =>
TableColumnHasConstraint be -> p' -> Bool
predicateCascadesDropOn (TableColumnHasConstraint QualifiedName
tblNm Text
colNm BeamSqlBackendColumnConstraintDefinitionSyntax be
_) p'
p'
    | Just (TableExistsPredicate QualifiedName
tblNm') <- forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p'
p' = QualifiedName
tblNm' forall a. Eq a => a -> a -> Bool
== QualifiedName
tblNm
    | Just (TableHasColumn QualifiedName
tblNm' Text
colNm' BeamMigrateSqlBackendDataTypeSyntax be
_ :: TableHasColumn be) <- forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p'
p' = QualifiedName
tblNm' forall a. Eq a => a -> a -> Bool
== QualifiedName
tblNm Bool -> Bool -> Bool
&& Text
colNm' forall a. Eq a => a -> a -> Bool
== Text
colNm
    | Bool
otherwise = Bool
False

-- | Asserts that the given table has a primary key made of the given columns.
-- The order of the columns is significant.
data TableHasPrimaryKey
  = TableHasPrimaryKey
  { TableHasPrimaryKey -> QualifiedName
hasPrimaryKey_table :: QualifiedName   {-^ Table name -}
  , TableHasPrimaryKey -> [Text]
hasPrimaryKey_cols  :: [Text] {-^ Column names -}
  } deriving (Int -> TableHasPrimaryKey -> ShowS
[TableHasPrimaryKey] -> ShowS
TableHasPrimaryKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableHasPrimaryKey] -> ShowS
$cshowList :: [TableHasPrimaryKey] -> ShowS
show :: TableHasPrimaryKey -> String
$cshow :: TableHasPrimaryKey -> String
showsPrec :: Int -> TableHasPrimaryKey -> ShowS
$cshowsPrec :: Int -> TableHasPrimaryKey -> ShowS
Show, TableHasPrimaryKey -> TableHasPrimaryKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableHasPrimaryKey -> TableHasPrimaryKey -> Bool
$c/= :: TableHasPrimaryKey -> TableHasPrimaryKey -> Bool
== :: TableHasPrimaryKey -> TableHasPrimaryKey -> Bool
$c== :: TableHasPrimaryKey -> TableHasPrimaryKey -> Bool
Eq, forall x. Rep TableHasPrimaryKey x -> TableHasPrimaryKey
forall x. TableHasPrimaryKey -> Rep TableHasPrimaryKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableHasPrimaryKey x -> TableHasPrimaryKey
$cfrom :: forall x. TableHasPrimaryKey -> Rep TableHasPrimaryKey x
Generic)
instance Hashable TableHasPrimaryKey
instance DatabasePredicate TableHasPrimaryKey where
  englishDescription :: TableHasPrimaryKey -> String
englishDescription (TableHasPrimaryKey QualifiedName
tblName [Text]
colNames) =
    String
"Table " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show QualifiedName
tblName forall a. Semigroup a => a -> a -> a
<> String
" has primary key " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Text]
colNames

  predicateSpecificity :: forall (proxy :: * -> *).
proxy TableHasPrimaryKey -> PredicateSpecificity
predicateSpecificity proxy TableHasPrimaryKey
_ = PredicateSpecificity
PredicateSpecificityAllBackends

  serializePredicate :: TableHasPrimaryKey -> Value
serializePredicate (TableHasPrimaryKey QualifiedName
tbl [Text]
cols) =
    [Pair] -> Value
object [ Key
"has-primary-key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Pair] -> Value
object [ Key
"table" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= QualifiedName
tbl
                                         , Key
"columns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
cols ] ]

  predicateCascadesDropOn :: forall p'. DatabasePredicate p' => TableHasPrimaryKey -> p' -> Bool
predicateCascadesDropOn (TableHasPrimaryKey QualifiedName
tblNm [Text]
_) p'
p'
    | Just (TableExistsPredicate QualifiedName
tblNm') <- forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p'
p' = QualifiedName
tblNm' forall a. Eq a => a -> a -> Bool
== QualifiedName
tblNm
    | Bool
otherwise = Bool
False

-- * Deserialization

-- | 'BeamDeserializers' for all the predicates defined in this module
beamCheckDeserializers
  :: forall be
   . ( Typeable be, BeamMigrateOnlySqlBackend be
     , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) )
  => BeamDeserializers be
beamCheckDeserializers :: forall be.
(Typeable be, BeamMigrateOnlySqlBackend be,
 HasDataTypeCreatedCheck
   (BeamMigrateSqlBackendDataTypeSyntax be)) =>
BeamDeserializers be
beamCheckDeserializers = forall a. Monoid a => [a] -> a
mconcat
  [ forall ty be.
Typeable ty =>
(forall be'. BeamDeserializers be' -> Value -> Parser ty)
-> BeamDeserializers be
beamDeserializer (forall a b. a -> b -> a
const Value -> Parser SomeDatabasePredicate
deserializeTableExistsPredicate)
  , forall ty be.
Typeable ty =>
(forall be'. BeamDeserializers be' -> Value -> Parser ty)
-> BeamDeserializers be
beamDeserializer (forall a b. a -> b -> a
const Value -> Parser SomeDatabasePredicate
deserializeTableHasPrimaryKeyPredicate)
  , forall ty be.
Typeable ty =>
(forall be'. BeamDeserializers be' -> Value -> Parser ty)
-> BeamDeserializers be
beamDeserializer forall be'.
BeamDeserializers be' -> Value -> Parser SomeDatabasePredicate
deserializeTableHasColumnPredicate
  , forall ty be.
Typeable ty =>
(forall be'. BeamDeserializers be' -> Value -> Parser ty)
-> BeamDeserializers be
beamDeserializer forall be'.
BeamDeserializers be' -> Value -> Parser SomeDatabasePredicate
deserializeTableColumnHasConstraintPredicate
  ]
  where
    deserializeTableExistsPredicate :: Value -> Parser SomeDatabasePredicate
    deserializeTableExistsPredicate :: Value -> Parser SomeDatabasePredicate
deserializeTableExistsPredicate =
      forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TableExistPredicate" forall a b. (a -> b) -> a -> b
$ \Object
v ->
      forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QualifiedName -> TableExistsPredicate
TableExistsPredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table-exists")

    deserializeTableHasPrimaryKeyPredicate :: Value -> Parser SomeDatabasePredicate
    deserializeTableHasPrimaryKeyPredicate :: Value -> Parser SomeDatabasePredicate
deserializeTableHasPrimaryKeyPredicate =
      forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TableHasPrimaryKey" forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"has-primary-key" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      (forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TableHasPrimaryKey" forall a b. (a -> b) -> a -> b
$ \Object
v' ->
       forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QualifiedName -> [Text] -> TableHasPrimaryKey
TableHasPrimaryKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columns"))

    deserializeTableHasColumnPredicate :: BeamDeserializers be'
                                       -> Value -> Parser SomeDatabasePredicate
    deserializeTableHasColumnPredicate :: forall be'.
BeamDeserializers be' -> Value -> Parser SomeDatabasePredicate
deserializeTableHasColumnPredicate BeamDeserializers be'
d =
      forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TableHasColumn" forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"has-column" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      (forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TableHasColumn" forall a b. (a -> b) -> a -> b
$ \Object
v' ->
       forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a
id @(TableHasColumn be))
         (forall be.
HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) =>
QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
TableHasColumn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"column"
                         forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a be.
Typeable a =>
BeamDeserializers be -> Value -> Parser a
beamDeserialize BeamDeserializers be'
d forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
v' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type")))

    deserializeTableColumnHasConstraintPredicate :: BeamDeserializers be'
                                                 -> Value -> Parser SomeDatabasePredicate
    deserializeTableColumnHasConstraintPredicate :: forall be'.
BeamDeserializers be' -> Value -> Parser SomeDatabasePredicate
deserializeTableColumnHasConstraintPredicate BeamDeserializers be'
d =
      forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TableColumnHasConstraint" forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"has-column-constraint" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      (forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TableColumnHasConstraint" forall a b. (a -> b) -> a -> b
$ \Object
v' ->
       forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> a
id @(TableColumnHasConstraint be))
         (forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
TableColumnHasConstraint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"table" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"column"
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a be.
Typeable a =>
BeamDeserializers be -> Value -> Parser a
beamDeserialize BeamDeserializers be'
d forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
v' forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"constraint")))