{-# LANGUAGE CPP #-}
module Database.Beam.Migrate.Types.Predicates where
import Database.Beam
import Database.Beam.Backend.SQL.SQL92 (IsSql92TableNameSyntax(..))
import Database.Beam.Schema.Tables
import Control.DeepSeq
import Data.Aeson
import Data.Text (Text)
import Data.Hashable
import Data.Typeable
#if !MIN_VERSION_base(4, 11, 0)
import Data.Semigroup
#endif
import Lens.Micro ((^.))
class (Typeable p, Hashable p, Eq p) => DatabasePredicate p where
englishDescription :: p -> String
predicateSpecificity :: proxy p -> PredicateSpecificity
serializePredicate :: p -> Value
predicateCascadesDropOn :: DatabasePredicate p' => p -> p' -> Bool
predicateCascadesDropOn p
_ p'
_ = Bool
False
data SomeDatabasePredicate where
SomeDatabasePredicate :: DatabasePredicate p
=> p -> SomeDatabasePredicate
instance NFData SomeDatabasePredicate where
rnf :: SomeDatabasePredicate -> ()
rnf SomeDatabasePredicate
p' = SomeDatabasePredicate
p' seq :: forall a b. a -> b -> b
`seq` ()
instance Show SomeDatabasePredicate where
showsPrec :: Int -> SomeDatabasePredicate -> ShowS
showsPrec Int
_ (SomeDatabasePredicate p
p') =
(Char
'('forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Typeable a => a -> TypeRep
typeOf p
p') forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
": " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall p. DatabasePredicate p => p -> String
englishDescription p
p' forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
')'forall a. a -> [a] -> [a]
:)
instance Eq SomeDatabasePredicate where
SomeDatabasePredicate p
a == :: SomeDatabasePredicate -> SomeDatabasePredicate -> Bool
== SomeDatabasePredicate p
b =
case forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
a of
Maybe p
Nothing -> Bool
False
Just p
a' -> p
a' forall a. Eq a => a -> a -> Bool
== p
b
instance Hashable SomeDatabasePredicate where
hashWithSalt :: Int -> SomeDatabasePredicate -> Int
hashWithSalt Int
salt (SomeDatabasePredicate p
p') = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (forall a. Typeable a => a -> TypeRep
typeOf p
p', p
p')
data PredicateSpecificity
= PredicateSpecificityOnlyBackend String
| PredicateSpecificityAllBackends
deriving (Int -> PredicateSpecificity -> ShowS
[PredicateSpecificity] -> ShowS
PredicateSpecificity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PredicateSpecificity] -> ShowS
$cshowList :: [PredicateSpecificity] -> ShowS
show :: PredicateSpecificity -> String
$cshow :: PredicateSpecificity -> String
showsPrec :: Int -> PredicateSpecificity -> ShowS
$cshowsPrec :: Int -> PredicateSpecificity -> ShowS
Show, PredicateSpecificity -> PredicateSpecificity -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PredicateSpecificity -> PredicateSpecificity -> Bool
$c/= :: PredicateSpecificity -> PredicateSpecificity -> Bool
== :: PredicateSpecificity -> PredicateSpecificity -> Bool
$c== :: PredicateSpecificity -> PredicateSpecificity -> Bool
Eq, forall x. Rep PredicateSpecificity x -> PredicateSpecificity
forall x. PredicateSpecificity -> Rep PredicateSpecificity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PredicateSpecificity x -> PredicateSpecificity
$cfrom :: forall x. PredicateSpecificity -> Rep PredicateSpecificity x
Generic)
instance Hashable PredicateSpecificity
instance ToJSON PredicateSpecificity where
toJSON :: PredicateSpecificity -> Value
toJSON PredicateSpecificity
PredicateSpecificityAllBackends = Value
"all"
toJSON (PredicateSpecificityOnlyBackend String
s) = [Pair] -> Value
object [ Key
"backend" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON String
s ]
instance FromJSON PredicateSpecificity where
parseJSON :: Value -> Parser PredicateSpecificity
parseJSON Value
"all" = forall (f :: * -> *) a. Applicative f => a -> f a
pure PredicateSpecificity
PredicateSpecificityAllBackends
parseJSON (Object Object
o) = String -> PredicateSpecificity
PredicateSpecificityOnlyBackend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"backend"
parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"PredicateSource"
p :: DatabasePredicate p => p -> SomeDatabasePredicate
p :: forall p. DatabasePredicate p => p -> SomeDatabasePredicate
p = forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate
data QualifiedName = QualifiedName (Maybe Text) Text
deriving (Int -> QualifiedName -> ShowS
[QualifiedName] -> ShowS
QualifiedName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QualifiedName] -> ShowS
$cshowList :: [QualifiedName] -> ShowS
show :: QualifiedName -> String
$cshow :: QualifiedName -> String
showsPrec :: Int -> QualifiedName -> ShowS
$cshowsPrec :: Int -> QualifiedName -> ShowS
Show, QualifiedName -> QualifiedName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QualifiedName -> QualifiedName -> Bool
$c/= :: QualifiedName -> QualifiedName -> Bool
== :: QualifiedName -> QualifiedName -> Bool
$c== :: QualifiedName -> QualifiedName -> Bool
Eq, Eq QualifiedName
QualifiedName -> QualifiedName -> Bool
QualifiedName -> QualifiedName -> Ordering
QualifiedName -> QualifiedName -> QualifiedName
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 :: QualifiedName -> QualifiedName -> QualifiedName
$cmin :: QualifiedName -> QualifiedName -> QualifiedName
max :: QualifiedName -> QualifiedName -> QualifiedName
$cmax :: QualifiedName -> QualifiedName -> QualifiedName
>= :: QualifiedName -> QualifiedName -> Bool
$c>= :: QualifiedName -> QualifiedName -> Bool
> :: QualifiedName -> QualifiedName -> Bool
$c> :: QualifiedName -> QualifiedName -> Bool
<= :: QualifiedName -> QualifiedName -> Bool
$c<= :: QualifiedName -> QualifiedName -> Bool
< :: QualifiedName -> QualifiedName -> Bool
$c< :: QualifiedName -> QualifiedName -> Bool
compare :: QualifiedName -> QualifiedName -> Ordering
$ccompare :: QualifiedName -> QualifiedName -> Ordering
Ord)
instance ToJSON QualifiedName where
toJSON :: QualifiedName -> Value
toJSON (QualifiedName Maybe Text
Nothing Text
t) = forall a. ToJSON a => a -> Value
toJSON Text
t
toJSON (QualifiedName (Just Text
s) Text
t) = [Pair] -> Value
object [ Key
"schema" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
s, Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t ]
instance FromJSON QualifiedName where
parseJSON :: Value -> Parser QualifiedName
parseJSON s :: Value
s@(String {}) = Maybe Text -> Text -> QualifiedName
QualifiedName forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
parseJSON (Object Object
o) = Maybe Text -> Text -> QualifiedName
QualifiedName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"schema" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"QualifiedName: expects either string or {schema: ..., name: ...}"
instance Hashable QualifiedName where
hashWithSalt :: Int -> QualifiedName -> Int
hashWithSalt Int
s (QualifiedName Maybe Text
sch Text
t) =
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Maybe Text
sch, Text
t)
qname :: IsDatabaseEntity be entity => DatabaseEntityDescriptor be entity -> QualifiedName
qname :: forall be entity.
IsDatabaseEntity be entity =>
DatabaseEntityDescriptor be entity -> QualifiedName
qname DatabaseEntityDescriptor be entity
e = Maybe Text -> Text -> QualifiedName
QualifiedName (DatabaseEntityDescriptor be entity
e forall s a. s -> Getting a s a -> a
^. forall be entityType.
IsDatabaseEntity be entityType =>
Traversal' (DatabaseEntityDescriptor be entityType) (Maybe Text)
dbEntitySchema) (DatabaseEntityDescriptor be entity
e forall s a. s -> Getting a s a -> a
^. forall be entityType.
IsDatabaseEntity be entityType =>
Lens' (DatabaseEntityDescriptor be entityType) Text
dbEntityName)
qnameAsText :: QualifiedName -> Text
qnameAsText :: QualifiedName -> Text
qnameAsText (QualifiedName Maybe Text
Nothing Text
tbl) = Text
tbl
qnameAsText (QualifiedName (Just Text
sch) Text
tbl) = Text
sch forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
tbl
qnameAsTableName :: IsSql92TableNameSyntax syntax => QualifiedName -> syntax
qnameAsTableName :: forall syntax.
IsSql92TableNameSyntax syntax =>
QualifiedName -> syntax
qnameAsTableName (QualifiedName Maybe Text
sch Text
t) = forall tblName.
IsSql92TableNameSyntax tblName =>
Maybe Text -> Text -> tblName
tableName Maybe Text
sch Text
t
newtype TableCheck = TableCheck (forall tbl. Table tbl => QualifiedName -> tbl (TableField tbl) -> Maybe SomeDatabasePredicate)
newtype DomainCheck = DomainCheck (QualifiedName -> SomeDatabasePredicate)
newtype FieldCheck = FieldCheck (QualifiedName -> Text -> SomeDatabasePredicate)