{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.Base
  ( Ref (..),
    Position (..),
    Message (..),
    FieldName (..),
    Description,
    OperationType (..),
    QUERY,
    MUTATION,
    SUBSCRIPTION,
    Token,
    isNotSystemTypeName,
    sysFields,
    hsTypeName,
    toOperationType,
    GQLError (..),
    GQLErrors,
    TRUE,
    FALSE,
    TypeName (..),
    Msg (..),
    intercalateName,
    toFieldName,
    convertToJSONName,
    convertToHaskellName,
    InternalError (..),
    msgInternal,
    ValidationError (..),
    msgValidation,
    ValidationErrors,
    withPosition,
    toGQLError,
    unitTypeName,
    unitFieldName,
    anonymousRef,
  )
where

import Data.Aeson
  ( FromJSON,
    ToJSON,
    Value,
    encode,
  )
import Data.ByteString.Lazy (ByteString)
import Data.Char (toLower)
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    fromText,
    renderGQL,
  )
import Data.Text (intercalate, pack)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding (decodeUtf8)
import Language.Haskell.TH
  ( ExpQ,
    stringE,
  )
import Language.Haskell.TH.Syntax
  ( Lift (..),
    Q,
    TExp,
    unsafeTExpCoerce,
  )
import Relude hiding
  ( ByteString,
    decodeUtf8,
    intercalate,
  )

type TRUE = 'True

type FALSE = 'False

-- Strings
type Token = Text

-- Error / Warning Messages
newtype Message = Message {Message -> Text
readMessage :: Text}
  deriving
    ((forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic)
  deriving newtype
    (Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Eq Message
Eq Message
-> (Message -> Message -> Ordering)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Message)
-> (Message -> Message -> Message)
-> Ord Message
Message -> Message -> Bool
Message -> Message -> Ordering
Message -> Message -> Message
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Message -> Message -> Message
$cmin :: Message -> Message -> Message
max :: Message -> Message -> Message
$cmax :: Message -> Message -> Message
>= :: Message -> Message -> Bool
$c>= :: Message -> Message -> Bool
> :: Message -> Message -> Bool
$c> :: Message -> Message -> Bool
<= :: Message -> Message -> Bool
$c<= :: Message -> Message -> Bool
< :: Message -> Message -> Bool
$c< :: Message -> Message -> Bool
compare :: Message -> Message -> Ordering
$ccompare :: Message -> Message -> Ordering
$cp1Ord :: Eq Message
Ord, String -> Message
(String -> Message) -> IsString Message
forall a. (String -> a) -> IsString a
fromString :: String -> Message
$cfromString :: String -> Message
IsString, b -> Message -> Message
NonEmpty Message -> Message
Message -> Message -> Message
(Message -> Message -> Message)
-> (NonEmpty Message -> Message)
-> (forall b. Integral b => b -> Message -> Message)
-> Semigroup Message
forall b. Integral b => b -> Message -> Message
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Message -> Message
$cstimes :: forall b. Integral b => b -> Message -> Message
sconcat :: NonEmpty Message -> Message
$csconcat :: NonEmpty Message -> Message
<> :: Message -> Message -> Message
$c<> :: Message -> Message -> Message
Semigroup, Int -> Message -> Int
Message -> Int
(Int -> Message -> Int) -> (Message -> Int) -> Hashable Message
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Message -> Int
$chash :: Message -> Int
hashWithSalt :: Int -> Message -> Int
$chashWithSalt :: Int -> Message -> Int
Hashable, Value -> Parser [Message]
Value -> Parser Message
(Value -> Parser Message)
-> (Value -> Parser [Message]) -> FromJSON Message
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Message]
$cparseJSONList :: Value -> Parser [Message]
parseJSON :: Value -> Parser Message
$cparseJSON :: Value -> Parser Message
FromJSON, [Message] -> Encoding
[Message] -> Value
Message -> Encoding
Message -> Value
(Message -> Value)
-> (Message -> Encoding)
-> ([Message] -> Value)
-> ([Message] -> Encoding)
-> ToJSON Message
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Message] -> Encoding
$ctoEncodingList :: [Message] -> Encoding
toJSONList :: [Message] -> Value
$ctoJSONList :: [Message] -> Value
toEncoding :: Message -> Encoding
$ctoEncoding :: Message -> Encoding
toJSON :: Message -> Value
$ctoJSON :: Message -> Value
ToJSON)

instance Lift Message where
  lift :: Message -> Q Exp
lift = Text -> Q Exp
liftString (Text -> Q Exp) -> (Message -> Text) -> Message -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Text
readMessage

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: Message -> Q (TExp Message)
liftTyped = Text -> Q (TExp Message)
forall a. IsString a => Text -> Q (TExp a)
liftTypedString (Text -> Q (TExp Message))
-> (Message -> Text) -> Message -> Q (TExp Message)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Text
readMessage
#endif

newtype InternalError = InternalError
  { InternalError -> Text
readInternalError :: Text
  }
  deriving
    ((forall x. InternalError -> Rep InternalError x)
-> (forall x. Rep InternalError x -> InternalError)
-> Generic InternalError
forall x. Rep InternalError x -> InternalError
forall x. InternalError -> Rep InternalError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InternalError x -> InternalError
$cfrom :: forall x. InternalError -> Rep InternalError x
Generic)
  deriving newtype
    (Int -> InternalError -> ShowS
[InternalError] -> ShowS
InternalError -> String
(Int -> InternalError -> ShowS)
-> (InternalError -> String)
-> ([InternalError] -> ShowS)
-> Show InternalError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalError] -> ShowS
$cshowList :: [InternalError] -> ShowS
show :: InternalError -> String
$cshow :: InternalError -> String
showsPrec :: Int -> InternalError -> ShowS
$cshowsPrec :: Int -> InternalError -> ShowS
Show, InternalError -> InternalError -> Bool
(InternalError -> InternalError -> Bool)
-> (InternalError -> InternalError -> Bool) -> Eq InternalError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalError -> InternalError -> Bool
$c/= :: InternalError -> InternalError -> Bool
== :: InternalError -> InternalError -> Bool
$c== :: InternalError -> InternalError -> Bool
Eq, Eq InternalError
Eq InternalError
-> (InternalError -> InternalError -> Ordering)
-> (InternalError -> InternalError -> Bool)
-> (InternalError -> InternalError -> Bool)
-> (InternalError -> InternalError -> Bool)
-> (InternalError -> InternalError -> Bool)
-> (InternalError -> InternalError -> InternalError)
-> (InternalError -> InternalError -> InternalError)
-> Ord InternalError
InternalError -> InternalError -> Bool
InternalError -> InternalError -> Ordering
InternalError -> InternalError -> InternalError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InternalError -> InternalError -> InternalError
$cmin :: InternalError -> InternalError -> InternalError
max :: InternalError -> InternalError -> InternalError
$cmax :: InternalError -> InternalError -> InternalError
>= :: InternalError -> InternalError -> Bool
$c>= :: InternalError -> InternalError -> Bool
> :: InternalError -> InternalError -> Bool
$c> :: InternalError -> InternalError -> Bool
<= :: InternalError -> InternalError -> Bool
$c<= :: InternalError -> InternalError -> Bool
< :: InternalError -> InternalError -> Bool
$c< :: InternalError -> InternalError -> Bool
compare :: InternalError -> InternalError -> Ordering
$ccompare :: InternalError -> InternalError -> Ordering
$cp1Ord :: Eq InternalError
Ord, String -> InternalError
(String -> InternalError) -> IsString InternalError
forall a. (String -> a) -> IsString a
fromString :: String -> InternalError
$cfromString :: String -> InternalError
IsString, b -> InternalError -> InternalError
NonEmpty InternalError -> InternalError
InternalError -> InternalError -> InternalError
(InternalError -> InternalError -> InternalError)
-> (NonEmpty InternalError -> InternalError)
-> (forall b. Integral b => b -> InternalError -> InternalError)
-> Semigroup InternalError
forall b. Integral b => b -> InternalError -> InternalError
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> InternalError -> InternalError
$cstimes :: forall b. Integral b => b -> InternalError -> InternalError
sconcat :: NonEmpty InternalError -> InternalError
$csconcat :: NonEmpty InternalError -> InternalError
<> :: InternalError -> InternalError -> InternalError
$c<> :: InternalError -> InternalError -> InternalError
Semigroup, Int -> InternalError -> Int
InternalError -> Int
(Int -> InternalError -> Int)
-> (InternalError -> Int) -> Hashable InternalError
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: InternalError -> Int
$chash :: InternalError -> Int
hashWithSalt :: Int -> InternalError -> Int
$chashWithSalt :: Int -> InternalError -> Int
Hashable, Value -> Parser [InternalError]
Value -> Parser InternalError
(Value -> Parser InternalError)
-> (Value -> Parser [InternalError]) -> FromJSON InternalError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InternalError]
$cparseJSONList :: Value -> Parser [InternalError]
parseJSON :: Value -> Parser InternalError
$cparseJSON :: Value -> Parser InternalError
FromJSON, [InternalError] -> Encoding
[InternalError] -> Value
InternalError -> Encoding
InternalError -> Value
(InternalError -> Value)
-> (InternalError -> Encoding)
-> ([InternalError] -> Value)
-> ([InternalError] -> Encoding)
-> ToJSON InternalError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InternalError] -> Encoding
$ctoEncodingList :: [InternalError] -> Encoding
toJSONList :: [InternalError] -> Value
$ctoJSONList :: [InternalError] -> Value
toEncoding :: InternalError -> Encoding
$ctoEncoding :: InternalError -> Encoding
toJSON :: InternalError -> Value
$ctoJSON :: InternalError -> Value
ToJSON)

data ValidationError = ValidationError
  { ValidationError -> Message
validationMessage :: Message,
    ValidationError -> [Position]
validationLocations :: [Position]
  }
  deriving (Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
(Int -> ValidationError -> ShowS)
-> (ValidationError -> String)
-> ([ValidationError] -> ShowS)
-> Show ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValidationError] -> ShowS
$cshowList :: [ValidationError] -> ShowS
show :: ValidationError -> String
$cshow :: ValidationError -> String
showsPrec :: Int -> ValidationError -> ShowS
$cshowsPrec :: Int -> ValidationError -> ShowS
Show)

instance IsString ValidationError where
  fromString :: String -> ValidationError
fromString = (Message -> [Position] -> ValidationError
`ValidationError` []) (Message -> ValidationError)
-> (String -> Message) -> String -> ValidationError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Message
forall a. Msg a => a -> Message
msg

instance Semigroup ValidationError where
  ValidationError Message
m1 [Position]
p1 <> :: ValidationError -> ValidationError -> ValidationError
<> ValidationError Message
m2 [Position]
p2 =
    Message -> [Position] -> ValidationError
ValidationError (Message
m1 Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> Message
m2) ([Position]
p1 [Position] -> [Position] -> [Position]
forall a. Semigroup a => a -> a -> a
<> [Position]
p2)

withPosition :: Maybe Position -> ValidationError -> ValidationError
withPosition :: Maybe Position -> ValidationError -> ValidationError
withPosition Maybe Position
pos (ValidationError Message
m [Position]
ps) = Message -> [Position] -> ValidationError
ValidationError Message
m ([Position]
ps [Position] -> [Position] -> [Position]
forall a. Semigroup a => a -> a -> a
<> Maybe Position -> [Position]
forall a. Maybe a -> [a]
maybeToList Maybe Position
pos)

type ValidationErrors = [ValidationError]

toGQLError :: ValidationError -> GQLError
toGQLError :: ValidationError -> GQLError
toGQLError (ValidationError Message
m [Position]
p) = Message -> [Position] -> GQLError
GQLError Message
m [Position]
p

-- instance Lift InternalError where
--   lift = liftString . readInternalError

-- #if MIN_VERSION_template_haskell(2,16,0)
--   liftTyped = liftTypedString . readInternalError
-- #endif

msgInternal :: (Msg a) => a -> InternalError
msgInternal :: a -> InternalError
msgInternal = Text -> InternalError
InternalError (Text -> InternalError) -> (a -> Text) -> a -> InternalError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Text
readMessage (Message -> Text) -> (a -> Message) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Message
forall a. Msg a => a -> Message
msg

msgValidation :: (Msg a) => a -> ValidationError
msgValidation :: a -> ValidationError
msgValidation = (Message -> [Position] -> ValidationError
`ValidationError` []) (Message -> ValidationError)
-> (a -> Message) -> a -> ValidationError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Message
forall a. Msg a => a -> Message
msg

class Msg a where
  msg :: a -> Message
  msgSepBy :: Text -> [a] -> Message
  msgSepBy Text
t = Text -> Message
Message (Text -> Message) -> ([a] -> Text) -> [a] -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
intercalate Text
t ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Message -> Text
readMessage (Message -> Text) -> (a -> Message) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Message
forall a. Msg a => a -> Message
msg)

instance Msg Message where
  msg :: Message -> Message
msg = Message -> Message
forall a. a -> a
id

instance Msg InternalError where
  msg :: InternalError -> Message
msg = Text -> Message
Message (Text -> Message)
-> (InternalError -> Text) -> InternalError -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"Internal Error! " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (InternalError -> Text) -> InternalError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternalError -> Text
readInternalError

instance Msg String where
  msg :: String -> Message
msg = Text -> Message
Message (Text -> Message) -> (String -> Text) -> String -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack

instance Msg ByteString where
  msg :: ByteString -> Message
msg = Text -> Message
Message (Text -> Message) -> (ByteString -> Text) -> ByteString -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8

instance Msg Text where
  msg :: Text -> Message
msg = Text -> Message
Message

instance Msg Value where
  msg :: Value -> Message
msg = ByteString -> Message
forall a. Msg a => a -> Message
msg (ByteString -> Message)
-> (Value -> ByteString) -> Value -> Message
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode

-- FieldName : lower case names
newtype FieldName = FieldName {FieldName -> Text
readName :: Text}
  deriving
    ((forall x. FieldName -> Rep FieldName x)
-> (forall x. Rep FieldName x -> FieldName) -> Generic FieldName
forall x. Rep FieldName x -> FieldName
forall x. FieldName -> Rep FieldName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FieldName x -> FieldName
$cfrom :: forall x. FieldName -> Rep FieldName x
Generic)
  deriving newtype
    (Int -> FieldName -> ShowS
[FieldName] -> ShowS
FieldName -> String
(Int -> FieldName -> ShowS)
-> (FieldName -> String)
-> ([FieldName] -> ShowS)
-> Show FieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldName] -> ShowS
$cshowList :: [FieldName] -> ShowS
show :: FieldName -> String
$cshow :: FieldName -> String
showsPrec :: Int -> FieldName -> ShowS
$cshowsPrec :: Int -> FieldName -> ShowS
Show, Eq FieldName
Eq FieldName
-> (FieldName -> FieldName -> Ordering)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> FieldName)
-> (FieldName -> FieldName -> FieldName)
-> Ord FieldName
FieldName -> FieldName -> Bool
FieldName -> FieldName -> Ordering
FieldName -> FieldName -> FieldName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldName -> FieldName -> FieldName
$cmin :: FieldName -> FieldName -> FieldName
max :: FieldName -> FieldName -> FieldName
$cmax :: FieldName -> FieldName -> FieldName
>= :: FieldName -> FieldName -> Bool
$c>= :: FieldName -> FieldName -> Bool
> :: FieldName -> FieldName -> Bool
$c> :: FieldName -> FieldName -> Bool
<= :: FieldName -> FieldName -> Bool
$c<= :: FieldName -> FieldName -> Bool
< :: FieldName -> FieldName -> Bool
$c< :: FieldName -> FieldName -> Bool
compare :: FieldName -> FieldName -> Ordering
$ccompare :: FieldName -> FieldName -> Ordering
$cp1Ord :: Eq FieldName
Ord, FieldName -> FieldName -> Bool
(FieldName -> FieldName -> Bool)
-> (FieldName -> FieldName -> Bool) -> Eq FieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldName -> FieldName -> Bool
$c/= :: FieldName -> FieldName -> Bool
== :: FieldName -> FieldName -> Bool
$c== :: FieldName -> FieldName -> Bool
Eq, String -> FieldName
(String -> FieldName) -> IsString FieldName
forall a. (String -> a) -> IsString a
fromString :: String -> FieldName
$cfromString :: String -> FieldName
IsString, Int -> FieldName -> Int
FieldName -> Int
(Int -> FieldName -> Int)
-> (FieldName -> Int) -> Hashable FieldName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: FieldName -> Int
$chash :: FieldName -> Int
hashWithSalt :: Int -> FieldName -> Int
$chashWithSalt :: Int -> FieldName -> Int
Hashable, b -> FieldName -> FieldName
NonEmpty FieldName -> FieldName
FieldName -> FieldName -> FieldName
(FieldName -> FieldName -> FieldName)
-> (NonEmpty FieldName -> FieldName)
-> (forall b. Integral b => b -> FieldName -> FieldName)
-> Semigroup FieldName
forall b. Integral b => b -> FieldName -> FieldName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> FieldName -> FieldName
$cstimes :: forall b. Integral b => b -> FieldName -> FieldName
sconcat :: NonEmpty FieldName -> FieldName
$csconcat :: NonEmpty FieldName -> FieldName
<> :: FieldName -> FieldName -> FieldName
$c<> :: FieldName -> FieldName -> FieldName
Semigroup, Value -> Parser [FieldName]
Value -> Parser FieldName
(Value -> Parser FieldName)
-> (Value -> Parser [FieldName]) -> FromJSON FieldName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FieldName]
$cparseJSONList :: Value -> Parser [FieldName]
parseJSON :: Value -> Parser FieldName
$cparseJSON :: Value -> Parser FieldName
FromJSON, [FieldName] -> Encoding
[FieldName] -> Value
FieldName -> Encoding
FieldName -> Value
(FieldName -> Value)
-> (FieldName -> Encoding)
-> ([FieldName] -> Value)
-> ([FieldName] -> Encoding)
-> ToJSON FieldName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FieldName] -> Encoding
$ctoEncodingList :: [FieldName] -> Encoding
toJSONList :: [FieldName] -> Value
$ctoJSONList :: [FieldName] -> Value
toEncoding :: FieldName -> Encoding
$ctoEncoding :: FieldName -> Encoding
toJSON :: FieldName -> Value
$ctoJSON :: FieldName -> Value
ToJSON)

instance Lift FieldName where
  lift :: FieldName -> Q Exp
lift = Text -> Q Exp
liftString (Text -> Q Exp) -> (FieldName -> Text) -> FieldName -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
readName

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: FieldName -> Q (TExp FieldName)
liftTyped = Text -> Q (TExp FieldName)
forall a. IsString a => Text -> Q (TExp a)
liftTypedString (Text -> Q (TExp FieldName))
-> (FieldName -> Text) -> FieldName -> Q (TExp FieldName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
readName
#endif

instance Msg FieldName where
  msg :: FieldName -> Message
msg FieldName {Text
readName :: Text
readName :: FieldName -> Text
readName} = Text -> Message
Message (Text -> Message) -> Text -> Message
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
readName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

instance RenderGQL FieldName where
  renderGQL :: FieldName -> Rendering
renderGQL = Text -> Rendering
fromText (Text -> Rendering)
-> (FieldName -> Text) -> FieldName -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
readName

intercalateName :: FieldName -> [FieldName] -> FieldName
intercalateName :: FieldName -> [FieldName] -> FieldName
intercalateName (FieldName Text
x) = Text -> FieldName
FieldName (Text -> FieldName)
-> ([FieldName] -> Text) -> [FieldName] -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
intercalate Text
x ([Text] -> Text) -> ([FieldName] -> [Text]) -> [FieldName] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldName -> Text) -> [FieldName] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldName -> Text
readName

toFieldName :: TypeName -> FieldName
toFieldName :: TypeName -> FieldName
toFieldName = Text -> FieldName
FieldName (Text -> FieldName) -> (TypeName -> Text) -> TypeName -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
readTypeName

-- TypeName
newtype TypeName = TypeName {TypeName -> Text
readTypeName :: Text}
  deriving
    ((forall x. TypeName -> Rep TypeName x)
-> (forall x. Rep TypeName x -> TypeName) -> Generic TypeName
forall x. Rep TypeName x -> TypeName
forall x. TypeName -> Rep TypeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeName x -> TypeName
$cfrom :: forall x. TypeName -> Rep TypeName x
Generic)
  deriving newtype
    ( Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
(Int -> TypeName -> ShowS)
-> (TypeName -> String) -> ([TypeName] -> ShowS) -> Show TypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeName] -> ShowS
$cshowList :: [TypeName] -> ShowS
show :: TypeName -> String
$cshow :: TypeName -> String
showsPrec :: Int -> TypeName -> ShowS
$cshowsPrec :: Int -> TypeName -> ShowS
Show,
      Eq TypeName
Eq TypeName
-> (TypeName -> TypeName -> Ordering)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> TypeName)
-> (TypeName -> TypeName -> TypeName)
-> Ord TypeName
TypeName -> TypeName -> Bool
TypeName -> TypeName -> Ordering
TypeName -> TypeName -> TypeName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TypeName -> TypeName -> TypeName
$cmin :: TypeName -> TypeName -> TypeName
max :: TypeName -> TypeName -> TypeName
$cmax :: TypeName -> TypeName -> TypeName
>= :: TypeName -> TypeName -> Bool
$c>= :: TypeName -> TypeName -> Bool
> :: TypeName -> TypeName -> Bool
$c> :: TypeName -> TypeName -> Bool
<= :: TypeName -> TypeName -> Bool
$c<= :: TypeName -> TypeName -> Bool
< :: TypeName -> TypeName -> Bool
$c< :: TypeName -> TypeName -> Bool
compare :: TypeName -> TypeName -> Ordering
$ccompare :: TypeName -> TypeName -> Ordering
$cp1Ord :: Eq TypeName
Ord,
      TypeName -> TypeName -> Bool
(TypeName -> TypeName -> Bool)
-> (TypeName -> TypeName -> Bool) -> Eq TypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeName -> TypeName -> Bool
$c/= :: TypeName -> TypeName -> Bool
== :: TypeName -> TypeName -> Bool
$c== :: TypeName -> TypeName -> Bool
Eq,
      String -> TypeName
(String -> TypeName) -> IsString TypeName
forall a. (String -> a) -> IsString a
fromString :: String -> TypeName
$cfromString :: String -> TypeName
IsString,
      Int -> TypeName -> Int
TypeName -> Int
(Int -> TypeName -> Int) -> (TypeName -> Int) -> Hashable TypeName
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TypeName -> Int
$chash :: TypeName -> Int
hashWithSalt :: Int -> TypeName -> Int
$chashWithSalt :: Int -> TypeName -> Int
Hashable,
      b -> TypeName -> TypeName
NonEmpty TypeName -> TypeName
TypeName -> TypeName -> TypeName
(TypeName -> TypeName -> TypeName)
-> (NonEmpty TypeName -> TypeName)
-> (forall b. Integral b => b -> TypeName -> TypeName)
-> Semigroup TypeName
forall b. Integral b => b -> TypeName -> TypeName
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> TypeName -> TypeName
$cstimes :: forall b. Integral b => b -> TypeName -> TypeName
sconcat :: NonEmpty TypeName -> TypeName
$csconcat :: NonEmpty TypeName -> TypeName
<> :: TypeName -> TypeName -> TypeName
$c<> :: TypeName -> TypeName -> TypeName
Semigroup,
      Value -> Parser [TypeName]
Value -> Parser TypeName
(Value -> Parser TypeName)
-> (Value -> Parser [TypeName]) -> FromJSON TypeName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TypeName]
$cparseJSONList :: Value -> Parser [TypeName]
parseJSON :: Value -> Parser TypeName
$cparseJSON :: Value -> Parser TypeName
FromJSON,
      [TypeName] -> Encoding
[TypeName] -> Value
TypeName -> Encoding
TypeName -> Value
(TypeName -> Value)
-> (TypeName -> Encoding)
-> ([TypeName] -> Value)
-> ([TypeName] -> Encoding)
-> ToJSON TypeName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TypeName] -> Encoding
$ctoEncodingList :: [TypeName] -> Encoding
toJSONList :: [TypeName] -> Value
$ctoJSONList :: [TypeName] -> Value
toEncoding :: TypeName -> Encoding
$ctoEncoding :: TypeName -> Encoding
toJSON :: TypeName -> Value
$ctoJSON :: TypeName -> Value
ToJSON
    )

instance Lift TypeName where
  lift :: TypeName -> Q Exp
lift = Text -> Q Exp
liftString (Text -> Q Exp) -> (TypeName -> Text) -> TypeName -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
readTypeName

#if MIN_VERSION_template_haskell(2,16,0)
  liftTyped :: TypeName -> Q (TExp TypeName)
liftTyped = Text -> Q (TExp TypeName)
forall a. IsString a => Text -> Q (TExp a)
liftTypedString (Text -> Q (TExp TypeName))
-> (TypeName -> Text) -> TypeName -> Q (TExp TypeName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
readTypeName
#endif

liftTypedString :: IsString a => Token -> Q (TExp a)
liftTypedString :: Text -> Q (TExp a)
liftTypedString = Q Exp -> Q (TExp a)
forall a. Q Exp -> Q (TExp a)
unsafeTExpCoerce (Q Exp -> Q (TExp a)) -> (Text -> Q Exp) -> Text -> Q (TExp a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Q Exp
stringE (String -> Q Exp) -> (Text -> String) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

liftString :: Token -> ExpQ
liftString :: Text -> Q Exp
liftString = String -> Q Exp
stringE (String -> Q Exp) -> (Text -> String) -> Text -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance Msg TypeName where
  msg :: TypeName -> Message
msg TypeName {Text
readTypeName :: Text
readTypeName :: TypeName -> Text
readTypeName} = Text -> Message
Message (Text -> Message) -> Text -> Message
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
readTypeName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""

instance RenderGQL TypeName where
  renderGQL :: TypeName -> Rendering
renderGQL = Text -> Rendering
fromText (Text -> Rendering) -> (TypeName -> Text) -> TypeName -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
readTypeName

-- Description
type Description = Text

data Position = Position
  { Position -> Int
line :: Int,
    Position -> Int
column :: Int
  }
  deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show, (forall x. Position -> Rep Position x)
-> (forall x. Rep Position x -> Position) -> Generic Position
forall x. Rep Position x -> Position
forall x. Position -> Rep Position x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Position x -> Position
$cfrom :: forall x. Position -> Rep Position x
Generic, Value -> Parser [Position]
Value -> Parser Position
(Value -> Parser Position)
-> (Value -> Parser [Position]) -> FromJSON Position
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Position]
$cparseJSONList :: Value -> Parser [Position]
parseJSON :: Value -> Parser Position
$cparseJSON :: Value -> Parser Position
FromJSON, [Position] -> Encoding
[Position] -> Value
Position -> Encoding
Position -> Value
(Position -> Value)
-> (Position -> Encoding)
-> ([Position] -> Value)
-> ([Position] -> Encoding)
-> ToJSON Position
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Position] -> Encoding
$ctoEncodingList :: [Position] -> Encoding
toJSONList :: [Position] -> Value
$ctoJSONList :: [Position] -> Value
toEncoding :: Position -> Encoding
$ctoEncoding :: Position -> Encoding
toJSON :: Position -> Value
$ctoJSON :: Position -> Value
ToJSON, Position -> Q Exp
Position -> Q (TExp Position)
(Position -> Q Exp)
-> (Position -> Q (TExp Position)) -> Lift Position
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Position -> Q (TExp Position)
$cliftTyped :: Position -> Q (TExp Position)
lift :: Position -> Q Exp
$clift :: Position -> Q Exp
Lift)

instance Ord Position where
  compare :: Position -> Position -> Ordering
compare Position
x Position
y = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Position -> Int
line Position
x) (Position -> Int
line Position
y)

-- Positions 2 Value with same structure
-- but different Positions should be Equal
instance Eq Position where
  Position
_ == :: Position -> Position -> Bool
== Position
_ = Bool
True

data GQLError = GQLError
  { GQLError -> Message
message :: Message,
    GQLError -> [Position]
locations :: [Position]
  }
  deriving (Int -> GQLError -> ShowS
[GQLError] -> ShowS
GQLError -> String
(Int -> GQLError -> ShowS)
-> (GQLError -> String) -> ([GQLError] -> ShowS) -> Show GQLError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GQLError] -> ShowS
$cshowList :: [GQLError] -> ShowS
show :: GQLError -> String
$cshow :: GQLError -> String
showsPrec :: Int -> GQLError -> ShowS
$cshowsPrec :: Int -> GQLError -> ShowS
Show, GQLError -> GQLError -> Bool
(GQLError -> GQLError -> Bool)
-> (GQLError -> GQLError -> Bool) -> Eq GQLError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GQLError -> GQLError -> Bool
$c/= :: GQLError -> GQLError -> Bool
== :: GQLError -> GQLError -> Bool
$c== :: GQLError -> GQLError -> Bool
Eq, (forall x. GQLError -> Rep GQLError x)
-> (forall x. Rep GQLError x -> GQLError) -> Generic GQLError
forall x. Rep GQLError x -> GQLError
forall x. GQLError -> Rep GQLError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GQLError x -> GQLError
$cfrom :: forall x. GQLError -> Rep GQLError x
Generic, Value -> Parser [GQLError]
Value -> Parser GQLError
(Value -> Parser GQLError)
-> (Value -> Parser [GQLError]) -> FromJSON GQLError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GQLError]
$cparseJSONList :: Value -> Parser [GQLError]
parseJSON :: Value -> Parser GQLError
$cparseJSON :: Value -> Parser GQLError
FromJSON, [GQLError] -> Encoding
[GQLError] -> Value
GQLError -> Encoding
GQLError -> Value
(GQLError -> Value)
-> (GQLError -> Encoding)
-> ([GQLError] -> Value)
-> ([GQLError] -> Encoding)
-> ToJSON GQLError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GQLError] -> Encoding
$ctoEncodingList :: [GQLError] -> Encoding
toJSONList :: [GQLError] -> Value
$ctoJSONList :: [GQLError] -> Value
toEncoding :: GQLError -> Encoding
$ctoEncoding :: GQLError -> Encoding
toJSON :: GQLError -> Value
$ctoJSON :: GQLError -> Value
ToJSON)

type GQLErrors = [GQLError]

data OperationType
  = Query
  | Subscription
  | Mutation
  deriving (Int -> OperationType -> ShowS
[OperationType] -> ShowS
OperationType -> String
(Int -> OperationType -> ShowS)
-> (OperationType -> String)
-> ([OperationType] -> ShowS)
-> Show OperationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OperationType] -> ShowS
$cshowList :: [OperationType] -> ShowS
show :: OperationType -> String
$cshow :: OperationType -> String
showsPrec :: Int -> OperationType -> ShowS
$cshowsPrec :: Int -> OperationType -> ShowS
Show, OperationType -> OperationType -> Bool
(OperationType -> OperationType -> Bool)
-> (OperationType -> OperationType -> Bool) -> Eq OperationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationType -> OperationType -> Bool
$c/= :: OperationType -> OperationType -> Bool
== :: OperationType -> OperationType -> Bool
$c== :: OperationType -> OperationType -> Bool
Eq, OperationType -> Q Exp
OperationType -> Q (TExp OperationType)
(OperationType -> Q Exp)
-> (OperationType -> Q (TExp OperationType)) -> Lift OperationType
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: OperationType -> Q (TExp OperationType)
$cliftTyped :: OperationType -> Q (TExp OperationType)
lift :: OperationType -> Q Exp
$clift :: OperationType -> Q Exp
Lift, (forall x. OperationType -> Rep OperationType x)
-> (forall x. Rep OperationType x -> OperationType)
-> Generic OperationType
forall x. Rep OperationType x -> OperationType
forall x. OperationType -> Rep OperationType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OperationType x -> OperationType
$cfrom :: forall x. OperationType -> Rep OperationType x
Generic, Int -> OperationType -> Int
OperationType -> Int
(Int -> OperationType -> Int)
-> (OperationType -> Int) -> Hashable OperationType
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: OperationType -> Int
$chash :: OperationType -> Int
hashWithSalt :: Int -> OperationType -> Int
$chashWithSalt :: Int -> OperationType -> Int
Hashable)

instance RenderGQL OperationType where
  renderGQL :: OperationType -> Rendering
renderGQL = String -> Rendering
forall a. IsString a => String -> a
fromString (String -> Rendering)
-> (OperationType -> String) -> OperationType -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower ShowS -> (OperationType -> String) -> OperationType -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationType -> String
forall b a. (Show a, IsString b) => a -> b
show

instance Msg OperationType where
  msg :: OperationType -> Message
msg OperationType
Query = TypeName -> Message
forall a. Msg a => a -> Message
msg (TypeName
"query" :: TypeName)
  msg OperationType
Mutation = TypeName -> Message
forall a. Msg a => a -> Message
msg (TypeName
"mutation" :: TypeName)
  msg OperationType
Subscription = TypeName -> Message
forall a. Msg a => a -> Message
msg (TypeName
"subscription" :: TypeName)

type QUERY = 'Query

type MUTATION = 'Mutation

type SUBSCRIPTION = 'Subscription

-- Document Reference with its Position
-- Position  only for error messages
-- includes position for debugging, where Ref "a" 1 === Ref "a" 3
--
data Ref name = Ref
  { Ref name -> name
refName :: name,
    Ref name -> Position
refPosition :: Position
  }
  deriving (Int -> Ref name -> ShowS
[Ref name] -> ShowS
Ref name -> String
(Int -> Ref name -> ShowS)
-> (Ref name -> String) -> ([Ref name] -> ShowS) -> Show (Ref name)
forall name. Show name => Int -> Ref name -> ShowS
forall name. Show name => [Ref name] -> ShowS
forall name. Show name => Ref name -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ref name] -> ShowS
$cshowList :: forall name. Show name => [Ref name] -> ShowS
show :: Ref name -> String
$cshow :: forall name. Show name => Ref name -> String
showsPrec :: Int -> Ref name -> ShowS
$cshowsPrec :: forall name. Show name => Int -> Ref name -> ShowS
Show, Ref name -> Q Exp
Ref name -> Q (TExp (Ref name))
(Ref name -> Q Exp)
-> (Ref name -> Q (TExp (Ref name))) -> Lift (Ref name)
forall name. Lift name => Ref name -> Q Exp
forall name. Lift name => Ref name -> Q (TExp (Ref name))
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Ref name -> Q (TExp (Ref name))
$cliftTyped :: forall name. Lift name => Ref name -> Q (TExp (Ref name))
lift :: Ref name -> Q Exp
$clift :: forall name. Lift name => Ref name -> Q Exp
Lift, Ref name -> Ref name -> Bool
(Ref name -> Ref name -> Bool)
-> (Ref name -> Ref name -> Bool) -> Eq (Ref name)
forall name. Eq name => Ref name -> Ref name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ref name -> Ref name -> Bool
$c/= :: forall name. Eq name => Ref name -> Ref name -> Bool
== :: Ref name -> Ref name -> Bool
$c== :: forall name. Eq name => Ref name -> Ref name -> Bool
Eq)

instance Ord name => Ord (Ref name) where
  compare :: Ref name -> Ref name -> Ordering
compare (Ref name
x Position
_) (Ref name
y Position
_) = name -> name -> Ordering
forall a. Ord a => a -> a -> Ordering
compare name
x name
y

anonymousRef :: name -> Ref name
anonymousRef :: name -> Ref name
anonymousRef name
refName = Ref :: forall name. name -> Position -> Ref name
Ref {name
refName :: name
refName :: name
refName, refPosition :: Position
refPosition = Int -> Int -> Position
Position Int
0 Int
0}

isNotSystemTypeName :: TypeName -> Bool
isNotSystemTypeName :: TypeName -> Bool
isNotSystemTypeName =
  ( TypeName -> [TypeName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem`
      [ TypeName
"__Schema",
        TypeName
"__Type",
        TypeName
"__Directive",
        TypeName
"__TypeKind",
        TypeName
"__Field",
        TypeName
"__DirectiveLocation",
        TypeName
"__InputValue",
        TypeName
"__EnumValue",
        TypeName
"String",
        TypeName
"Float",
        TypeName
"Int",
        TypeName
"Boolean",
        TypeName
"ID"
      ]
  )

sysFields :: [FieldName]
sysFields :: [FieldName]
sysFields = [FieldName
"__typename", FieldName
"__schema", FieldName
"__type"]

hsTypeName :: TypeName -> TypeName
hsTypeName :: TypeName -> TypeName
hsTypeName TypeName
"String" = TypeName
"Text"
hsTypeName TypeName
"Boolean" = TypeName
"Bool"
hsTypeName TypeName
name = TypeName
name

toOperationType :: TypeName -> Maybe OperationType
toOperationType :: TypeName -> Maybe OperationType
toOperationType TypeName
"Subscription" = OperationType -> Maybe OperationType
forall a. a -> Maybe a
Just OperationType
Subscription
toOperationType TypeName
"Mutation" = OperationType -> Maybe OperationType
forall a. a -> Maybe a
Just OperationType
Mutation
toOperationType TypeName
"Query" = OperationType -> Maybe OperationType
forall a. a -> Maybe a
Just OperationType
Query
toOperationType TypeName
_ = Maybe OperationType
forall a. Maybe a
Nothing

-- handle reserved Names
isReserved :: FieldName -> Bool
isReserved :: FieldName -> Bool
isReserved FieldName
"case" = Bool
True
isReserved FieldName
"class" = Bool
True
isReserved FieldName
"data" = Bool
True
isReserved FieldName
"default" = Bool
True
isReserved FieldName
"deriving" = Bool
True
isReserved FieldName
"do" = Bool
True
isReserved FieldName
"else" = Bool
True
isReserved FieldName
"foreign" = Bool
True
isReserved FieldName
"if" = Bool
True
isReserved FieldName
"import" = Bool
True
isReserved FieldName
"in" = Bool
True
isReserved FieldName
"infix" = Bool
True
isReserved FieldName
"infixl" = Bool
True
isReserved FieldName
"infixr" = Bool
True
isReserved FieldName
"instance" = Bool
True
isReserved FieldName
"let" = Bool
True
isReserved FieldName
"module" = Bool
True
isReserved FieldName
"newtype" = Bool
True
isReserved FieldName
"of" = Bool
True
isReserved FieldName
"then" = Bool
True
isReserved FieldName
"type" = Bool
True
isReserved FieldName
"where" = Bool
True
isReserved FieldName
"_" = Bool
True
isReserved FieldName
_ = Bool
False
{-# INLINE isReserved #-}

convertToJSONName :: FieldName -> FieldName
convertToJSONName :: FieldName -> FieldName
convertToJSONName (FieldName Text
hsName)
  | Bool -> Bool
not (Text -> Bool
T.null Text
hsName) Bool -> Bool -> Bool
&& FieldName -> Bool
isReserved (Text -> FieldName
FieldName Text
name) Bool -> Bool -> Bool
&& (Text -> Char
T.last Text
hsName Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'') = Text -> FieldName
FieldName Text
name
  | Bool
otherwise = Text -> FieldName
FieldName Text
hsName
  where
    name :: Text
name = Text -> Text
T.init Text
hsName

convertToHaskellName :: FieldName -> FieldName
convertToHaskellName :: FieldName -> FieldName
convertToHaskellName FieldName
name
  | FieldName -> Bool
isReserved FieldName
name = FieldName
name FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
"'"
  | Bool
otherwise = FieldName
name

unitTypeName :: TypeName
unitTypeName :: TypeName
unitTypeName = TypeName
"Unit"

unitFieldName :: FieldName
unitFieldName :: FieldName
unitFieldName = FieldName
"_"