{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Types.Directives
( GQLDirective (..),
ToLocations (..),
getLocations,
visitTypeName',
visitTypeDescription',
visitFieldName',
visitFieldDescription',
visitEnumName',
visitEnumDescription',
visitFieldNames',
visitEnumNames',
)
where
import Data.Morpheus.Server.Types.TypeName (getTypename)
import qualified Data.Morpheus.Server.Types.Visitors as Visitors
import Data.Morpheus.Types.Internal.AST
( Description,
DirectiveLocation (..),
FALSE,
FieldName,
TRUE,
TypeName,
packName,
unpackName,
)
import Relude
type family OR (a :: Bool) (b :: Bool) where
OR FALSE FALSE = FALSE
OR a b = TRUE
type family INCLUDES (x :: DirectiveLocation) (xs :: [DirectiveLocation]) :: Bool where
INCLUDES x '[] = FALSE
INCLUDES x (x ': xs) = TRUE
INCLUDES x (a ': xs) = INCLUDES x xs
type family OVERLAPS (xs :: [DirectiveLocation]) (ys :: [DirectiveLocation]) :: Bool where
OVERLAPS (x ': xs) ys = OR (INCLUDES x ys) (OVERLAPS xs ys)
OVERLAPS '[] ys = FALSE
class ToLocation (l :: DirectiveLocation) where
toLocation :: f l -> DirectiveLocation
instance ToLocation 'OBJECT where
toLocation :: forall (f :: DirectiveLocation -> *).
f 'OBJECT -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
OBJECT
instance ToLocation 'ENUM where
toLocation :: forall (f :: DirectiveLocation -> *). f 'ENUM -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
ENUM
instance ToLocation 'INPUT_OBJECT where
toLocation :: forall (f :: DirectiveLocation -> *).
f 'INPUT_OBJECT -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
INPUT_OBJECT
instance ToLocation 'UNION where
toLocation :: forall (f :: DirectiveLocation -> *). f 'UNION -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
UNION
instance ToLocation 'SCALAR where
toLocation :: forall (f :: DirectiveLocation -> *).
f 'SCALAR -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
SCALAR
instance ToLocation 'INTERFACE where
toLocation :: forall (f :: DirectiveLocation -> *).
f 'INTERFACE -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
INTERFACE
instance ToLocation 'INPUT_FIELD_DEFINITION where
toLocation :: forall (f :: DirectiveLocation -> *).
f 'INPUT_FIELD_DEFINITION -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
INPUT_FIELD_DEFINITION
instance ToLocation 'ARGUMENT_DEFINITION where
toLocation :: forall (f :: DirectiveLocation -> *).
f 'ARGUMENT_DEFINITION -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
ARGUMENT_DEFINITION
instance ToLocation 'FIELD_DEFINITION where
toLocation :: forall (f :: DirectiveLocation -> *).
f 'FIELD_DEFINITION -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
FIELD_DEFINITION
instance ToLocation 'ENUM_VALUE where
toLocation :: forall (f :: DirectiveLocation -> *).
f 'ENUM_VALUE -> DirectiveLocation
toLocation = forall a b. a -> b -> a
const DirectiveLocation
ENUM_VALUE
class ToLocations (k :: [DirectiveLocation]) where
toLocations :: f k -> [DirectiveLocation]
instance (ToLocation l, ToLocations ls) => ToLocations (l : ls) where
toLocations :: forall (f :: [DirectiveLocation] -> *).
f (l : ls) -> [DirectiveLocation]
toLocations f (l : ls)
_ = forall (l :: DirectiveLocation) (f :: DirectiveLocation -> *).
ToLocation l =>
f l -> DirectiveLocation
toLocation (forall {k} (t :: k). Proxy t
Proxy @l) forall a. a -> [a] -> [a]
: forall (k :: [DirectiveLocation]) (f :: [DirectiveLocation] -> *).
ToLocations k =>
f k -> [DirectiveLocation]
toLocations (forall {k} (t :: k). Proxy t
Proxy @ls)
instance ToLocations '[] where
toLocations :: forall (f :: [DirectiveLocation] -> *).
f '[] -> [DirectiveLocation]
toLocations f '[]
_ = []
getLocations :: forall f a. ToLocations (DIRECTIVE_LOCATIONS a) => f a -> [DirectiveLocation]
getLocations :: forall (f :: * -> *) a.
ToLocations (DIRECTIVE_LOCATIONS a) =>
f a -> [DirectiveLocation]
getLocations f a
_ = forall (k :: [DirectiveLocation]) (f :: [DirectiveLocation] -> *).
ToLocations k =>
f k -> [DirectiveLocation]
toLocations (forall {k} (t :: k). Proxy t
Proxy :: Proxy (DIRECTIVE_LOCATIONS a))
type ALLOWED (a :: Type) (l :: [DirectiveLocation]) = OVERLAPS l (DIRECTIVE_LOCATIONS a)
type WITH_VISITOR (a :: Type) (f :: Type -> Bool -> Constraint) (l :: [DirectiveLocation]) = f a (ALLOWED a l)
type TYPE_VISITOR_KIND = '[ 'OBJECT, 'ENUM, 'INPUT_OBJECT, 'UNION, 'SCALAR, 'INTERFACE]
type FIELD_VISITOR_KIND = '[ 'INPUT_FIELD_DEFINITION, 'FIELD_DEFINITION]
type ENUM_VISITOR_KIND = '[ 'ENUM_VALUE]
__directiveName :: GQLDirective a => f a -> FieldName
__directiveName :: forall a (f :: * -> *). GQLDirective a => f a -> FieldName
__directiveName = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *). Typeable a => f a -> TypeName
getTypename
class
( Typeable a,
WITH_VISITOR a VISIT_TYPE TYPE_VISITOR_KIND,
WITH_VISITOR a VISIT_FIELD FIELD_VISITOR_KIND,
WITH_VISITOR a VISIT_ENUM ENUM_VISITOR_KIND
) =>
GQLDirective a
where
type DIRECTIVE_LOCATIONS a :: [DirectiveLocation]
excludeFromSchema :: f a -> Bool
excludeFromSchema f a
_ = Bool
False
visitTypeName' :: forall a. GQLDirective a => a -> Bool -> TypeName -> TypeName
visitTypeName' :: forall a. GQLDirective a => a -> Bool -> TypeName -> TypeName
visitTypeName' = forall a (t :: Bool) (f :: Bool -> *).
VISIT_TYPE a t =>
f t -> a -> Bool -> TypeName -> TypeName
__visitTypeName (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ALLOWED a TYPE_VISITOR_KIND))
visitTypeDescription' :: forall a. GQLDirective a => a -> Maybe Description -> Maybe Description
visitTypeDescription' :: forall a.
GQLDirective a =>
a -> Maybe Description -> Maybe Description
visitTypeDescription' = forall a (t :: Bool) (f :: Bool -> *).
VISIT_TYPE a t =>
f t -> a -> Maybe Description -> Maybe Description
__visitTypeDescription (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ALLOWED a TYPE_VISITOR_KIND))
visitFieldNames' :: forall a. GQLDirective a => a -> FieldName -> FieldName
visitFieldNames' :: forall a. GQLDirective a => a -> FieldName -> FieldName
visitFieldNames' = forall a (t :: Bool) (f :: Bool -> *).
VISIT_TYPE a t =>
f t -> a -> FieldName -> FieldName
__visitFieldNames (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ALLOWED a TYPE_VISITOR_KIND))
visitEnumNames' :: forall a. GQLDirective a => a -> TypeName -> TypeName
visitEnumNames' :: forall a. GQLDirective a => a -> TypeName -> TypeName
visitEnumNames' = forall a (t :: Bool) (f :: Bool -> *).
VISIT_TYPE a t =>
f t -> a -> TypeName -> TypeName
__visitEnumNames (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ALLOWED a TYPE_VISITOR_KIND))
class VISIT_TYPE a (t :: Bool) where
__visitTypeName :: f t -> a -> Bool -> TypeName -> TypeName
__visitTypeDescription :: f t -> a -> Maybe Description -> Maybe Description
__visitFieldNames :: f t -> a -> FieldName -> FieldName
__visitEnumNames :: f t -> a -> TypeName -> TypeName
instance VISIT_TYPE a 'False where
__visitTypeName :: forall (f :: Bool -> *).
f FALSE -> a -> Bool -> TypeName -> TypeName
__visitTypeName f FALSE
_ a
_ Bool
_ = forall a. a -> a
id
__visitTypeDescription :: forall (f :: Bool -> *).
f FALSE -> a -> Maybe Description -> Maybe Description
__visitTypeDescription f FALSE
_ a
_ = forall a. a -> a
id
__visitFieldNames :: forall (f :: Bool -> *). f FALSE -> a -> FieldName -> FieldName
__visitFieldNames f FALSE
_ a
_ = forall a. a -> a
id
__visitEnumNames :: forall (f :: Bool -> *). f FALSE -> a -> TypeName -> TypeName
__visitEnumNames f FALSE
_ a
_ = forall a. a -> a
id
instance Visitors.VisitType a => VISIT_TYPE a TRUE where
__visitTypeName :: forall (f :: Bool -> *).
f TRUE -> a -> Bool -> TypeName -> TypeName
__visitTypeName f TRUE
_ a
x Bool
isInput TypeName
name = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ forall a. VisitType a => a -> Bool -> Description -> Description
Visitors.visitTypeName a
x Bool
isInput (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name)
__visitTypeDescription :: forall (f :: Bool -> *).
f TRUE -> a -> Maybe Description -> Maybe Description
__visitTypeDescription f TRUE
_ = forall a.
VisitType a =>
a -> Maybe Description -> Maybe Description
Visitors.visitTypeDescription
__visitFieldNames :: forall (f :: Bool -> *). f TRUE -> a -> FieldName -> FieldName
__visitFieldNames f TRUE
_ a
x = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. VisitType a => a -> Description -> Description
Visitors.visitFieldNames a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName
__visitEnumNames :: forall (f :: Bool -> *). f TRUE -> a -> TypeName -> TypeName
__visitEnumNames f TRUE
_ a
x = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. VisitType a => a -> Description -> Description
Visitors.visitEnumNames a
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName
visitFieldName' :: forall a. GQLDirective a => a -> FieldName -> FieldName
visitFieldName' :: forall a. GQLDirective a => a -> FieldName -> FieldName
visitFieldName' = forall a (t :: Bool) (f :: Bool -> *).
VISIT_FIELD a t =>
f t -> a -> FieldName -> FieldName
__visitFieldName (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ALLOWED a FIELD_VISITOR_KIND))
visitFieldDescription' :: forall a. GQLDirective a => a -> Maybe Description -> Maybe Description
visitFieldDescription' :: forall a.
GQLDirective a =>
a -> Maybe Description -> Maybe Description
visitFieldDescription' = forall a (t :: Bool) (f :: Bool -> *).
VISIT_FIELD a t =>
f t -> a -> Maybe Description -> Maybe Description
__visitFieldDescription (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ALLOWED a FIELD_VISITOR_KIND))
class VISIT_FIELD a (t :: Bool) where
__visitFieldName :: f t -> a -> FieldName -> FieldName
__visitFieldDescription :: f t -> a -> Maybe Description -> Maybe Description
instance VISIT_FIELD a FALSE where
__visitFieldName :: forall (f :: Bool -> *). f FALSE -> a -> FieldName -> FieldName
__visitFieldName f FALSE
_ a
_ = forall a. a -> a
id
__visitFieldDescription :: forall (f :: Bool -> *).
f FALSE -> a -> Maybe Description -> Maybe Description
__visitFieldDescription f FALSE
_ a
_ = forall a. a -> a
id
instance Visitors.VisitField a => VISIT_FIELD a TRUE where
__visitFieldName :: forall (f :: Bool -> *). f TRUE -> a -> FieldName -> FieldName
__visitFieldName f TRUE
_ a
x FieldName
name = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ forall a. VisitField a => a -> Description -> Description
Visitors.visitFieldName a
x (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName FieldName
name)
__visitFieldDescription :: forall (f :: Bool -> *).
f TRUE -> a -> Maybe Description -> Maybe Description
__visitFieldDescription f TRUE
_ = forall a.
VisitField a =>
a -> Maybe Description -> Maybe Description
Visitors.visitFieldDescription
visitEnumName' :: forall a. GQLDirective a => a -> TypeName -> TypeName
visitEnumName' :: forall a. GQLDirective a => a -> TypeName -> TypeName
visitEnumName' = forall a (t :: Bool) (f :: Bool -> *).
VISIT_ENUM a t =>
f t -> a -> TypeName -> TypeName
__visitEnumName (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ALLOWED a ENUM_VISITOR_KIND))
visitEnumDescription' :: forall a. GQLDirective a => a -> Maybe Description -> Maybe Description
visitEnumDescription' :: forall a.
GQLDirective a =>
a -> Maybe Description -> Maybe Description
visitEnumDescription' = forall a (t :: Bool) (f :: Bool -> *).
VISIT_ENUM a t =>
f t -> a -> Maybe Description -> Maybe Description
__visitEnumDescription (forall {k} (t :: k). Proxy t
Proxy :: Proxy (ALLOWED a ENUM_VISITOR_KIND))
class VISIT_ENUM a (t :: Bool) where
__visitEnumName :: f t -> a -> TypeName -> TypeName
__visitEnumDescription :: f t -> a -> Maybe Description -> Maybe Description
instance VISIT_ENUM a FALSE where
__visitEnumName :: forall (f :: Bool -> *). f FALSE -> a -> TypeName -> TypeName
__visitEnumName f FALSE
_ a
_ = forall a. a -> a
id
__visitEnumDescription :: forall (f :: Bool -> *).
f FALSE -> a -> Maybe Description -> Maybe Description
__visitEnumDescription f FALSE
_ a
_ = forall a. a -> a
id
instance Visitors.VisitEnum a => VISIT_ENUM a TRUE where
__visitEnumName :: forall (f :: Bool -> *). f TRUE -> a -> TypeName -> TypeName
__visitEnumName f TRUE
_ a
x TypeName
name = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall a b. (a -> b) -> a -> b
$ forall a. VisitEnum a => a -> Description -> Description
Visitors.visitEnumName a
x (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name)
__visitEnumDescription :: forall (f :: Bool -> *).
f TRUE -> a -> Maybe Description -> Maybe Description
__visitEnumDescription f TRUE
_ = forall a.
VisitEnum a =>
a -> Maybe Description -> Maybe Description
Visitors.visitEnumDescription