{-# 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,
      -- path = path <> [unpackName 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
"-"