{- This Source Code Form is subject to the terms of the Mozilla Public License,
   v. 2.0. If a copy of the MPL was not distributed with this file, You can
   obtain one at https://mozilla.org/MPL/2.0/. -}

{-# LANGUAGE Safe #-}

-- | Various parts of a GraphQL document can be annotated with directives. 
-- This module describes locations in a document where directives can appear.
module Language.GraphQL.AST.DirectiveLocation
    ( DirectiveLocation(..)
    , ExecutableDirectiveLocation(..)
    , TypeSystemDirectiveLocation(..)
    ) where

-- | All directives can be splitted in two groups: directives used to annotate
-- various parts of executable definitions and the ones used in the schema
-- definition.
data DirectiveLocation
    = ExecutableDirectiveLocation ExecutableDirectiveLocation
    | TypeSystemDirectiveLocation TypeSystemDirectiveLocation
    deriving DirectiveLocation -> DirectiveLocation -> Bool
(DirectiveLocation -> DirectiveLocation -> Bool)
-> (DirectiveLocation -> DirectiveLocation -> Bool)
-> Eq DirectiveLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DirectiveLocation -> DirectiveLocation -> Bool
$c/= :: DirectiveLocation -> DirectiveLocation -> Bool
== :: DirectiveLocation -> DirectiveLocation -> Bool
$c== :: DirectiveLocation -> DirectiveLocation -> Bool
Eq

instance Show DirectiveLocation where
    show :: DirectiveLocation -> String
show (ExecutableDirectiveLocation directiveLocation :: ExecutableDirectiveLocation
directiveLocation) =
        ExecutableDirectiveLocation -> String
forall a. Show a => a -> String
show ExecutableDirectiveLocation
directiveLocation
    show (TypeSystemDirectiveLocation directiveLocation :: TypeSystemDirectiveLocation
directiveLocation) =
        TypeSystemDirectiveLocation -> String
forall a. Show a => a -> String
show TypeSystemDirectiveLocation
directiveLocation

-- | Where directives can appear in an executable definition, like a query.
data ExecutableDirectiveLocation
    = Query
    | Mutation
    | Subscription
    | Field
    | FragmentDefinition
    | FragmentSpread
    | InlineFragment
    deriving ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
(ExecutableDirectiveLocation
 -> ExecutableDirectiveLocation -> Bool)
-> (ExecutableDirectiveLocation
    -> ExecutableDirectiveLocation -> Bool)
-> Eq ExecutableDirectiveLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
$c/= :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
== :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
$c== :: ExecutableDirectiveLocation -> ExecutableDirectiveLocation -> Bool
Eq

instance Show ExecutableDirectiveLocation where
    show :: ExecutableDirectiveLocation -> String
show Query = "QUERY"
    show Mutation = "MUTATION"
    show Subscription = "SUBSCRIPTION"
    show Field = "FIELD"
    show FragmentDefinition = "FRAGMENT_DEFINITION"
    show FragmentSpread = "FRAGMENT_SPREAD"
    show InlineFragment = "INLINE_FRAGMENT"

-- | Where directives can appear in a type system definition.
data TypeSystemDirectiveLocation
    = Schema
    | Scalar
    | Object
    | FieldDefinition
    | ArgumentDefinition
    | Interface
    | Union
    | Enum
    | EnumValue
    | InputObject
    | InputFieldDefinition
    deriving TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
(TypeSystemDirectiveLocation
 -> TypeSystemDirectiveLocation -> Bool)
-> (TypeSystemDirectiveLocation
    -> TypeSystemDirectiveLocation -> Bool)
-> Eq TypeSystemDirectiveLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
$c/= :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
== :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
$c== :: TypeSystemDirectiveLocation -> TypeSystemDirectiveLocation -> Bool
Eq

instance Show TypeSystemDirectiveLocation where
    show :: TypeSystemDirectiveLocation -> String
show Schema = "SCHEMA"
    show Scalar = "SCALAR"
    show Object = "OBJECT"
    show FieldDefinition = "FIELD_DEFINITION"
    show ArgumentDefinition = "ARGUMENT_DEFINITION"
    show Interface = "INTERFACE"
    show Union = "UNION"
    show Enum = "ENUM"
    show EnumValue = "ENUM_VALUE"
    show InputObject = "INPUT_OBJECT"
    show InputFieldDefinition = "INPUT_FIELD_DEFINITION"