{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
module Data.Morpheus.Rendering.RenderGQL
( RenderGQL(..)
, renderGraphQLDocument
, renderWrapped
)
where
import Data.ByteString.Lazy.Char8 ( ByteString )
import Data.Semigroup ( (<>) )
import Data.Text ( Text
, intercalate
)
import qualified Data.Text.Lazy as LT
( fromStrict )
import Data.Text.Lazy.Encoding ( encodeUtf8 )
import Data.Morpheus.Types.Internal.AST
( FieldDefinition(..)
, InputFieldsDefinition(..)
, TypeContent(..)
, TypeDefinition(..)
, Schema
, DataTypeWrapper(..)
, Key
, TypeRef(..)
, TypeWrapper(..)
, allDataTypes
, createInputUnionFields
, fieldVisibility
, isDefaultTypeName
, toGQLWrapper
, DataEnumValue(..)
, convertToJSONName
, ArgumentsDefinition(..)
, Name
, FieldsDefinition(..)
, unsafeFromFields
)
import Data.Morpheus.Types.Internal.Operation
( Listable(..)
)
renderGraphQLDocument :: Schema -> ByteString
renderGraphQLDocument lib =
encodeUtf8 $ LT.fromStrict $ intercalate "\n\n" $ map render visibleTypes
where
visibleTypes = filter (not . isDefaultTypeName . typeName) (allDataTypes lib)
class RenderGQL a where
render :: a -> Key
instance RenderGQL TypeDefinition where
render TypeDefinition { typeName, typeContent } = __render typeContent
where
__render DataInterface { interfaceFields } = "interface " <> typeName <> render interfaceFields
__render DataScalar{} = "scalar " <> typeName
__render (DataEnum tags) = "enum " <> typeName <> renderObject render tags
__render (DataUnion members) =
"union "
<> typeName
<> " =\n "
<> intercalate ("\n" <> renderIndent <> "| ") members
__render (DataInputObject fields ) = "input " <> typeName <> render fields
__render (DataInputUnion members) = "input " <> typeName <> render fieldsDef
where
fieldsDef = unsafeFromFields fields
fields = createInputUnionFields typeName (fmap fst members)
__render DataObject {objectFields} = "type " <> typeName <> render objectFields
ignoreHidden :: [FieldDefinition] -> [FieldDefinition]
ignoreHidden = filter fieldVisibility
instance RenderGQL FieldsDefinition where
render = renderObject render . ignoreHidden . toList
instance RenderGQL InputFieldsDefinition where
render = renderObject render . ignoreHidden . toList
instance RenderGQL FieldDefinition where
render FieldDefinition { fieldName, fieldType, fieldArgs } =
convertToJSONName fieldName <> render fieldArgs <> ": " <> render fieldType
instance RenderGQL ArgumentsDefinition where
render NoArguments = ""
render arguments = "(" <> intercalate ", " (map render $ toList arguments) <> ")"
instance RenderGQL DataEnumValue where
render DataEnumValue { enumName } = enumName
instance RenderGQL TypeRef where
render TypeRef { typeConName, typeWrappers } = renderWrapped typeConName typeWrappers
instance RenderGQL Key where
render = id
renderWrapped :: RenderGQL a => a -> [TypeWrapper] -> Name
renderWrapped x wrappers = showGQLWrapper (toGQLWrapper wrappers)
where
showGQLWrapper [] = render x
showGQLWrapper (ListType:xs) = "[" <> showGQLWrapper xs <> "]"
showGQLWrapper (NonNullType:xs) = showGQLWrapper xs <> "!"
renderIndent :: Text
renderIndent = " "
renderObject :: (a -> Text) -> [a] -> Text
renderObject f list =
" { \n " <> intercalate ("\n" <> renderIndent) (map f list) <> "\n}"