{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Types.DirectiveDefinitions
  ( Prefixes (..),
    Deprecated (..),
    Describe (..),
    Rename (..),
  )
where

import Data.Morpheus.Server.Types.Directives (GQLDirective (..))
import Data.Morpheus.Server.Types.GQLType (GQLType (__type))
import Data.Morpheus.Server.Types.Internal (mkTypeData)
import Data.Morpheus.Server.Types.Visitors
  ( VisitEnum (..),
    VisitField (..),
    VisitType (..),
  )
import Data.Morpheus.Types.Internal.AST
  ( DirectiveLocation (..),
  )
import qualified Data.Text as T
import Relude

-- | a custom GraphQL directive for adding or removing
-- of prefixes
data Prefixes = Prefixes
  { Prefixes -> Text
addPrefix :: Text,
    Prefixes -> Text
removePrefix :: Text
  }
  deriving (forall x. Rep Prefixes x -> Prefixes
forall x. Prefixes -> Rep Prefixes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prefixes x -> Prefixes
$cfrom :: forall x. Prefixes -> Rep Prefixes x
Generic, forall a.
(forall (f :: * -> *). f a -> Maybe Text)
-> (forall (f :: * -> *). f a -> DirectiveUsages)
-> (forall (f :: * -> *). f a -> Map Text Text)
-> (forall (f :: * -> *). f a -> GQLTypeOptions -> GQLTypeOptions)
-> (forall (f :: * -> *). f a -> Map Text (Directives CONST))
-> (forall (f :: * -> *). f a -> Map Text (Value CONST))
-> (forall (f :: * -> *). f a -> TypeCategory -> TypeData)
-> GQLType a
forall (f :: * -> *). f Prefixes -> Maybe Text
forall (f :: * -> *). f Prefixes -> Map Text Text
forall (f :: * -> *). f Prefixes -> Map Text (Value CONST)
forall (f :: * -> *). f Prefixes -> Map Text (Directives CONST)
forall (f :: * -> *). f Prefixes -> DirectiveUsages
forall (f :: * -> *). f Prefixes -> TypeCategory -> TypeData
forall (f :: * -> *).
f Prefixes -> GQLTypeOptions -> GQLTypeOptions
__type :: forall (f :: * -> *). f Prefixes -> TypeCategory -> TypeData
$c__type :: forall (f :: * -> *). f Prefixes -> TypeCategory -> TypeData
defaultValues :: forall (f :: * -> *). f Prefixes -> Map Text (Value CONST)
$cdefaultValues :: forall (f :: * -> *). f Prefixes -> Map Text (Value CONST)
getDirectives :: forall (f :: * -> *). f Prefixes -> Map Text (Directives CONST)
$cgetDirectives :: forall (f :: * -> *). f Prefixes -> Map Text (Directives CONST)
typeOptions :: forall (f :: * -> *).
f Prefixes -> GQLTypeOptions -> GQLTypeOptions
$ctypeOptions :: forall (f :: * -> *).
f Prefixes -> GQLTypeOptions -> GQLTypeOptions
getDescriptions :: forall (f :: * -> *). f Prefixes -> Map Text Text
$cgetDescriptions :: forall (f :: * -> *). f Prefixes -> Map Text Text
directives :: forall (f :: * -> *). f Prefixes -> DirectiveUsages
$cdirectives :: forall (f :: * -> *). f Prefixes -> DirectiveUsages
description :: forall (f :: * -> *). f Prefixes -> Maybe Text
$cdescription :: forall (f :: * -> *). f Prefixes -> Maybe Text
GQLType)

instance GQLDirective Prefixes where
  type
    DIRECTIVE_LOCATIONS Prefixes =
      '[ 'OBJECT,
         'ENUM,
         'INPUT_OBJECT,
         'UNION,
         'SCALAR,
         'INTERFACE
       ]

instance VisitType Prefixes where
  visitTypeName :: Prefixes -> Text -> Text
visitTypeName Prefixes {Text
addPrefix :: Text
addPrefix :: Prefixes -> Text
addPrefix, Text
removePrefix :: Text
removePrefix :: Prefixes -> Text
removePrefix} Text
name = Text
addPrefix forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop (Text -> Int
T.length Text
removePrefix) Text
name
  visitTypeDescription :: Prefixes -> Maybe Text -> Maybe Text
visitTypeDescription Prefixes
_ = forall a. a -> a
id

-- native GraphQL directive @deprecated
--
newtype Deprecated = Deprecated
  { Deprecated -> Maybe Text
reason :: Maybe Text
  }
  deriving
    ( forall x. Rep Deprecated x -> Deprecated
forall x. Deprecated -> Rep Deprecated x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Deprecated x -> Deprecated
$cfrom :: forall x. Deprecated -> Rep Deprecated x
Generic,
      Deprecated -> Maybe Text -> Maybe Text
Deprecated -> Text -> Text
forall a.
(a -> Text -> Text)
-> (a -> Maybe Text -> Maybe Text) -> VisitEnum a
visitEnumDescription :: Deprecated -> Maybe Text -> Maybe Text
$cvisitEnumDescription :: Deprecated -> Maybe Text -> Maybe Text
visitEnumName :: Deprecated -> Text -> Text
$cvisitEnumName :: Deprecated -> Text -> Text
VisitEnum,
      Deprecated -> Maybe Text -> Maybe Text
Deprecated -> Text -> Text
forall a.
(a -> Text -> Text)
-> (a -> Maybe Text -> Maybe Text) -> VisitField a
visitFieldDescription :: Deprecated -> Maybe Text -> Maybe Text
$cvisitFieldDescription :: Deprecated -> Maybe Text -> Maybe Text
visitFieldName :: Deprecated -> Text -> Text
$cvisitFieldName :: Deprecated -> Text -> Text
VisitField
    )

instance GQLType Deprecated where
  __type :: forall (f :: * -> *). f Deprecated -> TypeCategory -> TypeData
__type f Deprecated
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"deprecated"

instance GQLDirective Deprecated where
  type
    DIRECTIVE_LOCATIONS Deprecated =
      '[ 'FIELD_DEFINITION,
         'ENUM_VALUE
       ]

-- description

newtype Describe = Describe {Describe -> Text
text :: Text}
  deriving
    ( forall a.
(forall (f :: * -> *). f a -> Maybe Text)
-> (forall (f :: * -> *). f a -> DirectiveUsages)
-> (forall (f :: * -> *). f a -> Map Text Text)
-> (forall (f :: * -> *). f a -> GQLTypeOptions -> GQLTypeOptions)
-> (forall (f :: * -> *). f a -> Map Text (Directives CONST))
-> (forall (f :: * -> *). f a -> Map Text (Value CONST))
-> (forall (f :: * -> *). f a -> TypeCategory -> TypeData)
-> GQLType a
forall (f :: * -> *). f Describe -> Maybe Text
forall (f :: * -> *). f Describe -> Map Text Text
forall (f :: * -> *). f Describe -> Map Text (Value CONST)
forall (f :: * -> *). f Describe -> Map Text (Directives CONST)
forall (f :: * -> *). f Describe -> DirectiveUsages
forall (f :: * -> *). f Describe -> TypeCategory -> TypeData
forall (f :: * -> *).
f Describe -> GQLTypeOptions -> GQLTypeOptions
__type :: forall (f :: * -> *). f Describe -> TypeCategory -> TypeData
$c__type :: forall (f :: * -> *). f Describe -> TypeCategory -> TypeData
defaultValues :: forall (f :: * -> *). f Describe -> Map Text (Value CONST)
$cdefaultValues :: forall (f :: * -> *). f Describe -> Map Text (Value CONST)
getDirectives :: forall (f :: * -> *). f Describe -> Map Text (Directives CONST)
$cgetDirectives :: forall (f :: * -> *). f Describe -> Map Text (Directives CONST)
typeOptions :: forall (f :: * -> *).
f Describe -> GQLTypeOptions -> GQLTypeOptions
$ctypeOptions :: forall (f :: * -> *).
f Describe -> GQLTypeOptions -> GQLTypeOptions
getDescriptions :: forall (f :: * -> *). f Describe -> Map Text Text
$cgetDescriptions :: forall (f :: * -> *). f Describe -> Map Text Text
directives :: forall (f :: * -> *). f Describe -> DirectiveUsages
$cdirectives :: forall (f :: * -> *). f Describe -> DirectiveUsages
description :: forall (f :: * -> *). f Describe -> Maybe Text
$cdescription :: forall (f :: * -> *). f Describe -> Maybe Text
GQLType,
      forall x. Rep Describe x -> Describe
forall x. Describe -> Rep Describe x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Describe x -> Describe
$cfrom :: forall x. Describe -> Rep Describe x
Generic
    )

instance GQLDirective Describe where
  type
    DIRECTIVE_LOCATIONS Describe =
      '[ 'ENUM_VALUE,
         'FIELD_DEFINITION,
         'INPUT_FIELD_DEFINITION,
         'OBJECT,
         'ENUM,
         'INPUT_OBJECT,
         'UNION,
         'SCALAR,
         'INTERFACE,
         'ARGUMENT_DEFINITION
       ]

instance VisitEnum Describe where
  visitEnumDescription :: Describe -> Maybe Text -> Maybe Text
visitEnumDescription Describe {Text
text :: Text
text :: Describe -> Text
text} Maybe Text
_ = forall a. a -> Maybe a
Just Text
text

instance VisitField Describe where
  visitFieldDescription :: Describe -> Maybe Text -> Maybe Text
visitFieldDescription Describe {Text
text :: Text
text :: Describe -> Text
text} Maybe Text
_ = forall a. a -> Maybe a
Just Text
text

instance VisitType Describe where
  visitTypeDescription :: Describe -> Maybe Text -> Maybe Text
visitTypeDescription Describe {Text
text :: Text
text :: Describe -> Text
text} Maybe Text
_ = forall a. a -> Maybe a
Just Text
text

-- | a custom GraphQL directive for adding or removing
-- of prefixes
newtype Rename = Rename {Rename -> Text
name :: Text} deriving (forall x. Rep Rename x -> Rename
forall x. Rename -> Rep Rename x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rename x -> Rename
$cfrom :: forall x. Rename -> Rep Rename x
Generic, forall a.
(forall (f :: * -> *). f a -> Maybe Text)
-> (forall (f :: * -> *). f a -> DirectiveUsages)
-> (forall (f :: * -> *). f a -> Map Text Text)
-> (forall (f :: * -> *). f a -> GQLTypeOptions -> GQLTypeOptions)
-> (forall (f :: * -> *). f a -> Map Text (Directives CONST))
-> (forall (f :: * -> *). f a -> Map Text (Value CONST))
-> (forall (f :: * -> *). f a -> TypeCategory -> TypeData)
-> GQLType a
forall (f :: * -> *). f Rename -> Maybe Text
forall (f :: * -> *). f Rename -> Map Text Text
forall (f :: * -> *). f Rename -> Map Text (Value CONST)
forall (f :: * -> *). f Rename -> Map Text (Directives CONST)
forall (f :: * -> *). f Rename -> DirectiveUsages
forall (f :: * -> *). f Rename -> TypeCategory -> TypeData
forall (f :: * -> *). f Rename -> GQLTypeOptions -> GQLTypeOptions
__type :: forall (f :: * -> *). f Rename -> TypeCategory -> TypeData
$c__type :: forall (f :: * -> *). f Rename -> TypeCategory -> TypeData
defaultValues :: forall (f :: * -> *). f Rename -> Map Text (Value CONST)
$cdefaultValues :: forall (f :: * -> *). f Rename -> Map Text (Value CONST)
getDirectives :: forall (f :: * -> *). f Rename -> Map Text (Directives CONST)
$cgetDirectives :: forall (f :: * -> *). f Rename -> Map Text (Directives CONST)
typeOptions :: forall (f :: * -> *). f Rename -> GQLTypeOptions -> GQLTypeOptions
$ctypeOptions :: forall (f :: * -> *). f Rename -> GQLTypeOptions -> GQLTypeOptions
getDescriptions :: forall (f :: * -> *). f Rename -> Map Text Text
$cgetDescriptions :: forall (f :: * -> *). f Rename -> Map Text Text
directives :: forall (f :: * -> *). f Rename -> DirectiveUsages
$cdirectives :: forall (f :: * -> *). f Rename -> DirectiveUsages
description :: forall (f :: * -> *). f Rename -> Maybe Text
$cdescription :: forall (f :: * -> *). f Rename -> Maybe Text
GQLType)

instance GQLDirective Rename where
  type
    DIRECTIVE_LOCATIONS Rename =
      '[ 'OBJECT,
         'ENUM,
         'INPUT_OBJECT,
         'UNION,
         'SCALAR,
         'INTERFACE,
         'ENUM_VALUE,
         'FIELD_DEFINITION,
         'INPUT_FIELD_DEFINITION
       ]

instance VisitType Rename where
  visitTypeName :: Rename -> Text -> Text
visitTypeName Rename {Text
name :: Text
name :: Rename -> Text
name} Text
_ = Text
name
  visitTypeDescription :: Rename -> Maybe Text -> Maybe Text
visitTypeDescription Rename
_ = forall a. a -> a
id

instance VisitEnum Rename where
  visitEnumName :: Rename -> Text -> Text
visitEnumName Rename {Text
name :: Text
name :: Rename -> Text
name} Text
_ = Text
name

instance VisitField Rename where
  visitFieldName :: Rename -> Text -> Text
visitFieldName Rename {Text
name :: Text
name :: Rename -> Text
name} Text
_ = Text
name