{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.Internal.Validation.Scope
( Scope (..),
ScopeKind (..),
renderScope,
renderSection,
setPosition,
setSelection,
setDirective,
setType,
)
where
import Data.Morpheus.Rendering.RenderGQL (RenderGQL, render)
import Data.Morpheus.Types.Internal.AST
( Directive (..),
FieldName,
GQLError,
Msg (msg),
Position,
Ref (..),
TypeDefinition (..),
TypeKind,
TypeName,
TypeWrapper,
kindOf,
)
import Data.Morpheus.Types.Internal.AST.Error (PropName)
import Relude
data ScopeKind
= DIRECTIVE
| SELECTION
| TYPE
deriving (Int -> ScopeKind -> ShowS
[ScopeKind] -> ShowS
ScopeKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopeKind] -> ShowS
$cshowList :: [ScopeKind] -> ShowS
show :: ScopeKind -> String
$cshow :: ScopeKind -> String
showsPrec :: Int -> ScopeKind -> ShowS
$cshowsPrec :: Int -> ScopeKind -> ShowS
Show)
data Scope = Scope
{ Scope -> Maybe Position
position :: Maybe Position,
Scope -> TypeName
currentTypeName :: TypeName,
Scope -> TypeKind
currentTypeKind :: TypeKind,
Scope -> TypeWrapper
currentTypeWrappers :: TypeWrapper,
Scope -> FieldName
fieldName :: FieldName,
Scope -> ScopeKind
kind :: ScopeKind,
Scope -> [PropName]
path :: [PropName]
}
deriving (Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show)
setSelection :: TypeDefinition a s -> Ref FieldName -> Scope -> Scope
setSelection :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> Ref FieldName -> Scope -> Scope
setSelection TypeDefinition a s
currentType Ref {FieldName
refName :: forall name. Ref name -> name
refName :: FieldName
refName, Position
refPosition :: forall name. Ref name -> Position
refPosition :: Position
refPosition} Scope {[PropName]
Maybe Position
TypeName
FieldName
TypeWrapper
TypeKind
ScopeKind
path :: [PropName]
kind :: ScopeKind
fieldName :: FieldName
currentTypeWrappers :: TypeWrapper
currentTypeKind :: TypeKind
currentTypeName :: TypeName
position :: Maybe Position
path :: Scope -> [PropName]
kind :: Scope -> ScopeKind
fieldName :: Scope -> FieldName
currentTypeWrappers :: Scope -> TypeWrapper
currentTypeKind :: Scope -> TypeKind
currentTypeName :: Scope -> TypeName
position :: Scope -> Maybe Position
..} =
Scope
{ fieldName :: FieldName
fieldName = FieldName
refName,
currentTypeName :: TypeName
currentTypeName = forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition a s
currentType,
currentTypeKind :: TypeKind
currentTypeKind = forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf TypeDefinition a s
currentType,
position :: Maybe Position
position = forall a. a -> Maybe a
Just Position
refPosition,
[PropName]
TypeWrapper
ScopeKind
path :: [PropName]
kind :: ScopeKind
currentTypeWrappers :: TypeWrapper
path :: [PropName]
kind :: ScopeKind
currentTypeWrappers :: TypeWrapper
..
}
setPosition ::
Position ->
Scope ->
Scope
setPosition :: Position -> Scope -> Scope
setPosition Position
pos Scope {[PropName]
Maybe Position
TypeName
FieldName
TypeWrapper
TypeKind
ScopeKind
path :: [PropName]
kind :: ScopeKind
fieldName :: FieldName
currentTypeWrappers :: TypeWrapper
currentTypeKind :: TypeKind
currentTypeName :: TypeName
position :: Maybe Position
path :: Scope -> [PropName]
kind :: Scope -> ScopeKind
fieldName :: Scope -> FieldName
currentTypeWrappers :: Scope -> TypeWrapper
currentTypeKind :: Scope -> TypeKind
currentTypeName :: Scope -> TypeName
position :: Scope -> Maybe Position
..} = Scope {position :: Maybe Position
position = forall a. a -> Maybe a
Just Position
pos, [PropName]
TypeName
FieldName
TypeWrapper
TypeKind
ScopeKind
path :: [PropName]
kind :: ScopeKind
fieldName :: FieldName
currentTypeWrappers :: TypeWrapper
currentTypeKind :: TypeKind
currentTypeName :: TypeName
path :: [PropName]
kind :: ScopeKind
fieldName :: FieldName
currentTypeWrappers :: TypeWrapper
currentTypeKind :: TypeKind
currentTypeName :: TypeName
..}
setDirective :: Directive s -> Scope -> Scope
setDirective :: forall (s :: Stage). Directive s -> Scope -> Scope
setDirective Directive {Arguments s
Position
FieldName
directiveArgs :: forall (s :: Stage). Directive s -> Arguments s
directiveName :: forall (s :: Stage). Directive s -> FieldName
directivePosition :: forall (s :: Stage). Directive s -> Position
directiveArgs :: Arguments s
directiveName :: FieldName
directivePosition :: Position
..} Scope {[PropName]
Maybe Position
TypeName
FieldName
TypeWrapper
TypeKind
ScopeKind
path :: [PropName]
kind :: ScopeKind
fieldName :: FieldName
currentTypeWrappers :: TypeWrapper
currentTypeKind :: TypeKind
currentTypeName :: TypeName
position :: Maybe Position
path :: Scope -> [PropName]
kind :: Scope -> ScopeKind
fieldName :: Scope -> FieldName
currentTypeWrappers :: Scope -> TypeWrapper
currentTypeKind :: Scope -> TypeKind
currentTypeName :: Scope -> TypeName
position :: Scope -> Maybe Position
..} =
Scope
{ fieldName :: FieldName
fieldName = FieldName
directiveName,
position :: Maybe Position
position = forall a. a -> Maybe a
Just Position
directivePosition,
kind :: ScopeKind
kind = ScopeKind
DIRECTIVE,
[PropName]
TypeName
TypeWrapper
TypeKind
path :: [PropName]
currentTypeWrappers :: TypeWrapper
currentTypeKind :: TypeKind
currentTypeName :: TypeName
path :: [PropName]
currentTypeWrappers :: TypeWrapper
currentTypeKind :: TypeKind
currentTypeName :: TypeName
..
}
setType :: TypeDefinition c s -> TypeWrapper -> Scope -> Scope
setType :: forall (c :: TypeCategory) (s :: Stage).
TypeDefinition c s -> TypeWrapper -> Scope -> Scope
setType TypeDefinition c s
t TypeWrapper
wrappers Scope {[PropName]
Maybe Position
TypeName
FieldName
TypeWrapper
TypeKind
ScopeKind
path :: [PropName]
kind :: ScopeKind
fieldName :: FieldName
currentTypeWrappers :: TypeWrapper
currentTypeKind :: TypeKind
currentTypeName :: TypeName
position :: Maybe Position
path :: Scope -> [PropName]
kind :: Scope -> ScopeKind
fieldName :: Scope -> FieldName
currentTypeWrappers :: Scope -> TypeWrapper
currentTypeKind :: Scope -> TypeKind
currentTypeName :: Scope -> TypeName
position :: Scope -> Maybe Position
..} =
Scope
{ currentTypeName :: TypeName
currentTypeName = forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition c s
t,
currentTypeKind :: TypeKind
currentTypeKind = forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf TypeDefinition c s
t,
currentTypeWrappers :: TypeWrapper
currentTypeWrappers = TypeWrapper
wrappers,
[PropName]
Maybe Position
FieldName
ScopeKind
path :: [PropName]
kind :: ScopeKind
fieldName :: FieldName
position :: Maybe Position
path :: [PropName]
kind :: ScopeKind
fieldName :: FieldName
position :: Maybe Position
..
}
renderScope :: Scope -> GQLError
renderScope :: Scope -> GQLError
renderScope
Scope
{ TypeName
currentTypeName :: TypeName
currentTypeName :: Scope -> TypeName
currentTypeName,
TypeKind
currentTypeKind :: TypeKind
currentTypeKind :: Scope -> TypeKind
currentTypeKind,
FieldName
fieldName :: FieldName
fieldName :: Scope -> FieldName
fieldName
} =
forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection
GQLError
"Scope"
( ByteString
"referenced by type "
forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> ByteString
render TypeName
currentTypeName
forall a. Semigroup a => a -> a -> a
<> ByteString
" of kind "
forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> ByteString
render TypeKind
currentTypeKind
forall a. Semigroup a => a -> a -> a
<> ByteString
" in field "
forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> ByteString
render FieldName
fieldName
)
renderSection :: RenderGQL a => GQLError -> a -> GQLError
renderSection :: forall a. RenderGQL a => GQLError -> a -> GQLError
renderSection GQLError
label a
content =
GQLError
"\n\n"
forall a. Semigroup a => a -> a -> a
<> GQLError
label
forall a. Semigroup a => a -> a -> a
<> GQLError
":\n"
forall a. Semigroup a => a -> a -> a
<> GQLError
line
forall a. Semigroup a => a -> a -> a
<> GQLError
"\n\n"
forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (forall a. RenderGQL a => a -> ByteString
render a
content)
forall a. Semigroup a => a -> a -> a
<> GQLError
"\n\n"
where
line :: GQLError
line = forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes (Int
50 :: Int) GQLError
"-"