{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Types.Internal
  ( GQLTypeOptions (..),
    defaultTypeOptions,
    TypeData (..),
    prefixInputs,
    mkTypeData,
    dropNamespaceOptions,
    stripConstructorNamespace,
    stripFieldNamespace,
  )
where

-- MORPHEUS

import Data.Char (toLower)
import Data.Morpheus.Server.Types.TypeName (TypeFingerprint (..))
import Data.Morpheus.Types.Internal.AST
  ( TypeKind (..),
    TypeName,
    TypeWrapper (..),
    mkBaseType,
  )
import Data.Text (length)
import Relude hiding (Seq, Undefined, intercalate, length)

data TypeData = TypeData
  { TypeData -> TypeName
gqlTypeName :: TypeName,
    TypeData -> TypeWrapper
gqlWrappers :: TypeWrapper,
    TypeData -> TypeFingerprint
gqlFingerprint :: TypeFingerprint
  }
  deriving (Int -> TypeData -> ShowS
[TypeData] -> ShowS
TypeData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeData] -> ShowS
$cshowList :: [TypeData] -> ShowS
show :: TypeData -> String
$cshow :: TypeData -> String
showsPrec :: Int -> TypeData -> ShowS
$cshowsPrec :: Int -> TypeData -> ShowS
Show)

{-# DEPRECATED GQLTypeOptions "use: custom directives with 'VisitType'" #-}

-- | Options that specify how to map GraphQL field, type, and constructor names
-- to and from their Haskell equivalent.
--
-- Options can be set using record syntax on 'defaultOptions' with the fields
-- below.
data GQLTypeOptions = GQLTypeOptions
  { -- | Function applied to field labels.
    -- Handy for removing common record prefixes for example.
    GQLTypeOptions -> ShowS
fieldLabelModifier :: String -> String,
    -- | Function applied to constructor tags.
    GQLTypeOptions -> ShowS
constructorTagModifier :: String -> String,
    -- | Construct a new type name depending on whether it is an input,
    -- and being given the original type name.
    GQLTypeOptions -> Bool -> ShowS
typeNameModifier :: Bool -> String -> String
  }

{-# DEPRECATED defaultTypeOptions "use: custom directives with 'VisitType'" #-}

-- | Default encoding 'GQLTypeOptions':
--
-- @
-- 'GQLTypeOptions'
--   { 'fieldLabelModifier'      = id
--   , 'constructorTagModifier'  = id
--   , 'typeNameModifier'        = const id
--   }
-- @
defaultTypeOptions :: GQLTypeOptions
defaultTypeOptions :: GQLTypeOptions
defaultTypeOptions =
  GQLTypeOptions
    { fieldLabelModifier :: ShowS
fieldLabelModifier = forall a. a -> a
id,
      constructorTagModifier :: ShowS
constructorTagModifier = forall a. a -> a
id,
      -- default is just a pass through for the original type name
      typeNameModifier :: Bool -> ShowS
typeNameModifier = forall a b. a -> b -> a
const forall a. a -> a
id
    }

{-# DEPRECATED prefixInputs "use: custom directives" #-}
prefixInputs :: GQLTypeOptions -> GQLTypeOptions
prefixInputs :: GQLTypeOptions -> GQLTypeOptions
prefixInputs GQLTypeOptions
options = GQLTypeOptions
options {typeNameModifier :: Bool -> ShowS
typeNameModifier = \Bool
isInput String
name -> if Bool
isInput then String
"Input" forall a. Semigroup a => a -> a -> a
<> String
name else String
name}

mkTypeData :: TypeName -> a -> TypeData
mkTypeData :: forall a. TypeName -> a -> TypeData
mkTypeData TypeName
name a
_ =
  TypeData
    { gqlTypeName :: TypeName
gqlTypeName = TypeName
name,
      gqlFingerprint :: TypeFingerprint
gqlFingerprint = TypeName -> TypeFingerprint
InternalFingerprint TypeName
name,
      gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper
mkBaseType
    }

dropPrefix :: Text -> String -> String
dropPrefix :: Text -> ShowS
dropPrefix Text
name = forall a. Int -> [a] -> [a]
drop (Text -> Int
length Text
name)

stripConstructorNamespace :: Text -> String -> String
stripConstructorNamespace :: Text -> ShowS
stripConstructorNamespace = Text -> ShowS
dropPrefix

stripFieldNamespace :: Text -> String -> String
stripFieldNamespace :: Text -> ShowS
stripFieldNamespace Text
prefix = ShowS
__uncapitalize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ShowS
dropPrefix Text
prefix
  where
    __uncapitalize :: ShowS
__uncapitalize [] = []
    __uncapitalize (Char
x : String
xs) = Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: String
xs

{-# DEPRECATED dropNamespaceOptions "use: custom directives" #-}
dropNamespaceOptions :: TypeKind -> Text -> GQLTypeOptions -> GQLTypeOptions
dropNamespaceOptions :: TypeKind -> Text -> GQLTypeOptions -> GQLTypeOptions
dropNamespaceOptions TypeKind
KindInterface Text
tName GQLTypeOptions
opt =
  GQLTypeOptions
opt
    { typeNameModifier :: Bool -> ShowS
typeNameModifier = forall a b. a -> b -> a
const (Text -> ShowS
stripConstructorNamespace Text
"Interface"),
      fieldLabelModifier :: ShowS
fieldLabelModifier = Text -> ShowS
stripFieldNamespace Text
tName
    }
dropNamespaceOptions TypeKind
KindEnum Text
tName GQLTypeOptions
opt = GQLTypeOptions
opt {constructorTagModifier :: ShowS
constructorTagModifier = Text -> ShowS
stripConstructorNamespace Text
tName}
dropNamespaceOptions TypeKind
_ Text
tName GQLTypeOptions
opt = GQLTypeOptions
opt {fieldLabelModifier :: ShowS
fieldLabelModifier = Text -> ShowS
stripFieldNamespace Text
tName}