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

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

import Data.Morpheus.Server.Types.Directives (GQLDirective (..))
import Data.Morpheus.Server.Types.GQLType (GQLType (..))
import Data.Morpheus.Server.Types.Internal
  ( mkTypeData,
    stripConstructorNamespace,
    stripFieldNamespace,
  )
import Data.Morpheus.Server.Types.Kind (DIRECTIVE)
import Data.Morpheus.Server.Types.Visitors
  ( VisitEnum (..),
    VisitField (..),
    VisitType (..),
  )
import Data.Morpheus.Types.Internal.AST (CONST, DirectiveLocation (..), Value)
import Data.Text (drop, length, pack, take, unpack)
import Relude hiding (drop, length, take)

-- | a custom GraphQL directive for adding or removing
-- of prefixes
data Prefixes = Prefixes
  { Prefixes -> Text
addPrefix :: Text,
    Prefixes -> Text
removePrefix :: Text
  }
  deriving ((forall x. Prefixes -> Rep Prefixes x)
-> (forall x. Rep Prefixes x -> Prefixes) -> Generic Prefixes
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
$cfrom :: forall x. Prefixes -> Rep Prefixes x
from :: forall x. Prefixes -> Rep Prefixes x
$cto :: forall x. Rep Prefixes x -> Prefixes
to :: forall x. Rep Prefixes x -> Prefixes
Generic)

instance GQLType Prefixes where
  type KIND Prefixes = DIRECTIVE

instance GQLDirective Prefixes where
  type
    DIRECTIVE_LOCATIONS Prefixes =
      '[ 'LOCATION_OBJECT,
         'LOCATION_ENUM,
         'LOCATION_INPUT_OBJECT,
         'LOCATION_UNION,
         'LOCATION_SCALAR,
         'LOCATION_INTERFACE
       ]
  excludeFromSchema :: forall (f :: * -> *). f Prefixes -> Bool
excludeFromSchema f Prefixes
_ = Bool
True

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

-- native GraphQL directive @deprecated
--
newtype Deprecated = Deprecated
  { Deprecated -> Maybe Text
reason :: Maybe Text
  }
  deriving ((forall x. Deprecated -> Rep Deprecated x)
-> (forall x. Rep Deprecated x -> Deprecated) -> Generic Deprecated
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
$cfrom :: forall x. Deprecated -> Rep Deprecated x
from :: forall x. Deprecated -> Rep Deprecated x
$cto :: forall x. Rep Deprecated x -> Deprecated
to :: forall x. Rep Deprecated x -> Deprecated
Generic)
  deriving anyclass
    ( Deprecated -> Maybe Text -> Maybe Text
Deprecated -> Text -> Text
(Deprecated -> Text -> Text)
-> (Deprecated -> Maybe Text -> Maybe Text) -> VisitEnum Deprecated
forall a.
(a -> Text -> Text)
-> (a -> Maybe Text -> Maybe Text) -> VisitEnum a
$cvisitEnumName :: Deprecated -> Text -> Text
visitEnumName :: Deprecated -> Text -> Text
$cvisitEnumDescription :: Deprecated -> Maybe Text -> Maybe Text
visitEnumDescription :: Deprecated -> Maybe Text -> Maybe Text
VisitEnum,
      Deprecated -> Maybe Text -> Maybe Text
Deprecated -> Maybe (Value CONST) -> Maybe (Value CONST)
Deprecated -> Text -> Text
(Deprecated -> Text -> Text)
-> (Deprecated -> Maybe Text -> Maybe Text)
-> (Deprecated -> Maybe (Value CONST) -> Maybe (Value CONST))
-> VisitField Deprecated
forall a.
(a -> Text -> Text)
-> (a -> Maybe Text -> Maybe Text)
-> (a -> Maybe (Value CONST) -> Maybe (Value CONST))
-> VisitField a
$cvisitFieldName :: Deprecated -> Text -> Text
visitFieldName :: Deprecated -> Text -> Text
$cvisitFieldDescription :: Deprecated -> Maybe Text -> Maybe Text
visitFieldDescription :: Deprecated -> Maybe Text -> Maybe Text
$cvisitFieldDefaultValue :: Deprecated -> Maybe (Value CONST) -> Maybe (Value CONST)
visitFieldDefaultValue :: Deprecated -> Maybe (Value CONST) -> Maybe (Value CONST)
VisitField
    )

instance GQLType Deprecated where
  type KIND Deprecated = DIRECTIVE
  __type :: forall (cat :: TypeCategory). CatType cat Deprecated -> TypeData
__type = TypeName -> CatType cat Deprecated -> TypeData
forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"deprecated"

instance GQLDirective Deprecated where
  type
    DIRECTIVE_LOCATIONS Deprecated =
      '[ 'LOCATION_FIELD_DEFINITION,
         'LOCATION_ENUM_VALUE
       ]

newtype Describe = Describe {Describe -> Text
text :: Text}
  deriving
    ( (forall x. Describe -> Rep Describe x)
-> (forall x. Rep Describe x -> Describe) -> Generic Describe
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
$cfrom :: forall x. Describe -> Rep Describe x
from :: forall x. Describe -> Rep Describe x
$cto :: forall x. Rep Describe x -> Describe
to :: forall x. Rep Describe x -> Describe
Generic
    )

instance GQLType Describe where
  type KIND Describe = DIRECTIVE

instance GQLDirective Describe where
  type
    DIRECTIVE_LOCATIONS Describe =
      '[ 'LOCATION_ENUM_VALUE,
         'LOCATION_FIELD_DEFINITION,
         'LOCATION_INPUT_FIELD_DEFINITION,
         'LOCATION_OBJECT,
         'LOCATION_ENUM,
         'LOCATION_INPUT_OBJECT,
         'LOCATION_UNION,
         'LOCATION_SCALAR,
         'LOCATION_INTERFACE,
         'LOCATION_ARGUMENT_DEFINITION
       ]

instance VisitEnum Describe where
  visitEnumDescription :: Describe -> Maybe Text -> Maybe Text
visitEnumDescription Describe {Text
text :: Describe -> Text
text :: Text
text} Maybe 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 :: Describe -> Text
text :: Text
text} Maybe 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 :: Describe -> Text
text :: Text
text} Maybe 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
newName :: Text}
  deriving
    ( (forall x. Rename -> Rep Rename x)
-> (forall x. Rep Rename x -> Rename) -> Generic Rename
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
$cfrom :: forall x. Rename -> Rep Rename x
from :: forall x. Rename -> Rep Rename x
$cto :: forall x. Rep Rename x -> Rename
to :: forall x. Rep Rename x -> Rename
Generic
    )

instance GQLType Rename where
  type KIND Rename = DIRECTIVE

instance GQLDirective Rename where
  excludeFromSchema :: forall (f :: * -> *). f Rename -> Bool
excludeFromSchema f Rename
_ = Bool
True
  type
    DIRECTIVE_LOCATIONS Rename =
      '[ 'LOCATION_OBJECT,
         'LOCATION_ENUM,
         'LOCATION_INPUT_OBJECT,
         'LOCATION_UNION,
         'LOCATION_SCALAR,
         'LOCATION_INTERFACE,
         'LOCATION_ENUM_VALUE,
         'LOCATION_FIELD_DEFINITION,
         'LOCATION_INPUT_FIELD_DEFINITION
       ]

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

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

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

-- DropTypeNamespace
newtype DropNamespace = DropNamespace
  { DropNamespace -> Text
dropNamespace :: Text
  }
  deriving
    ( (forall x. DropNamespace -> Rep DropNamespace x)
-> (forall x. Rep DropNamespace x -> DropNamespace)
-> Generic DropNamespace
forall x. Rep DropNamespace x -> DropNamespace
forall x. DropNamespace -> Rep DropNamespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DropNamespace -> Rep DropNamespace x
from :: forall x. DropNamespace -> Rep DropNamespace x
$cto :: forall x. Rep DropNamespace x -> DropNamespace
to :: forall x. Rep DropNamespace x -> DropNamespace
Generic
    )

instance GQLType DropNamespace where
  type KIND DropNamespace = DIRECTIVE

instance GQLDirective DropNamespace where
  type
    DIRECTIVE_LOCATIONS DropNamespace =
      '[ 'LOCATION_OBJECT,
         'LOCATION_ENUM,
         'LOCATION_INPUT_OBJECT,
         'LOCATION_UNION,
         'LOCATION_SCALAR,
         'LOCATION_INTERFACE
       ]
  excludeFromSchema :: forall (f :: * -> *). f DropNamespace -> Bool
excludeFromSchema f DropNamespace
_ = Bool
True

instance VisitType DropNamespace where
  visitFieldNames :: DropNamespace -> Text -> Text
visitFieldNames DropNamespace {Text
dropNamespace :: DropNamespace -> Text
dropNamespace :: Text
dropNamespace} = String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String -> String
stripFieldNamespace Text
dropNamespace (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
  visitEnumNames :: DropNamespace -> Text -> Text
visitEnumNames DropNamespace {Text
dropNamespace :: DropNamespace -> Text
dropNamespace :: Text
dropNamespace} = String -> Text
pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String -> String
stripConstructorNamespace Text
dropNamespace (String -> String) -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack

newtype DefaultValue = DefaultValue
  { DefaultValue -> Value CONST
defaultValue :: Value CONST
  }
  deriving ((forall x. DefaultValue -> Rep DefaultValue x)
-> (forall x. Rep DefaultValue x -> DefaultValue)
-> Generic DefaultValue
forall x. Rep DefaultValue x -> DefaultValue
forall x. DefaultValue -> Rep DefaultValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DefaultValue -> Rep DefaultValue x
from :: forall x. DefaultValue -> Rep DefaultValue x
$cto :: forall x. Rep DefaultValue x -> DefaultValue
to :: forall x. Rep DefaultValue x -> DefaultValue
Generic)

instance GQLType DefaultValue where
  type KIND DefaultValue = DIRECTIVE

instance GQLDirective DefaultValue where
  type DIRECTIVE_LOCATIONS DefaultValue = '[ 'LOCATION_INPUT_FIELD_DEFINITION]
  excludeFromSchema :: forall (f :: * -> *). f DefaultValue -> Bool
excludeFromSchema f DefaultValue
_ = Bool
True

instance VisitField DefaultValue where
  visitFieldDefaultValue :: DefaultValue -> Maybe (Value CONST) -> Maybe (Value CONST)
visitFieldDefaultValue DefaultValue {Value CONST
defaultValue :: DefaultValue -> Value CONST
defaultValue :: Value CONST
defaultValue} Maybe (Value CONST)
_ = Value CONST -> Maybe (Value CONST)
forall a. a -> Maybe a
Just Value CONST
defaultValue

-- | a custom GraphQL directive for adding or removing
-- of suffixes
data Suffixes = Suffixes
  { Suffixes -> Text
addSuffix :: Text,
    Suffixes -> Text
removeSuffix :: Text
  }
  deriving ((forall x. Suffixes -> Rep Suffixes x)
-> (forall x. Rep Suffixes x -> Suffixes) -> Generic Suffixes
forall x. Rep Suffixes x -> Suffixes
forall x. Suffixes -> Rep Suffixes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Suffixes -> Rep Suffixes x
from :: forall x. Suffixes -> Rep Suffixes x
$cto :: forall x. Rep Suffixes x -> Suffixes
to :: forall x. Rep Suffixes x -> Suffixes
Generic)

instance GQLType Suffixes where
  type KIND Suffixes = DIRECTIVE

instance GQLDirective Suffixes where
  type
    DIRECTIVE_LOCATIONS Suffixes =
      '[ 'LOCATION_OBJECT,
         'LOCATION_ENUM,
         'LOCATION_INPUT_OBJECT,
         'LOCATION_UNION,
         'LOCATION_SCALAR,
         'LOCATION_INTERFACE
       ]
  excludeFromSchema :: forall (f :: * -> *). f Suffixes -> Bool
excludeFromSchema f Suffixes
_ = Bool
True

instance VisitType Suffixes where
  visitTypeName :: Suffixes -> Bool -> Text -> Text
visitTypeName Suffixes {Text
addSuffix :: Suffixes -> Text
addSuffix :: Text
addSuffix, Text
removeSuffix :: Suffixes -> Text
removeSuffix :: Text
removeSuffix} Bool
_ Text
name =
    Int -> Text -> Text
take (Text -> Int
length Text
name Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
length Text
removeSuffix) Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
addSuffix
  visitTypeDescription :: Suffixes -> Maybe Text -> Maybe Text
visitTypeDescription Suffixes
_ = Maybe Text -> Maybe Text
forall a. a -> a
id