{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.CodeGen.Printing.GQLType
( renderGQLType,
)
where
import Data.Morpheus.CodeGen.Internal.AST
( GQLTypeDefinition (..),
Kind (..),
ServerTypeDefinition (..),
TypeKind,
)
import Data.Morpheus.CodeGen.Printing.Terms
( optional,
parametrizedType,
)
import Data.Text.Prettyprint.Doc
( (<+>),
Doc,
Pretty (pretty),
indent,
line,
tupled,
vsep,
)
import Relude hiding (optional, show)
import Prelude (show)
renderTypeableConstraints :: [Text] -> Doc n
renderTypeableConstraints :: [Text] -> Doc n
renderTypeableConstraints [Text]
xs = [Doc n] -> Doc n
forall ann. [Doc ann] -> Doc ann
tupled ((Text -> Doc n) -> [Text] -> [Doc n]
forall a b. (a -> b) -> [a] -> [b]
map ((Doc n
"Typeable" Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+>) (Doc n -> Doc n) -> (Text -> Doc n) -> Text -> Doc n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc n
forall a ann. Pretty a => a -> Doc ann
pretty) [Text]
xs) Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"=>"
defineTypeOptions :: Text -> TypeKind -> Doc n
defineTypeOptions :: Text -> TypeKind -> Doc n
defineTypeOptions Text
tName TypeKind
kind = Doc n
""
renderGQLType :: ServerTypeDefinition -> Doc n
renderGQLType :: ServerTypeDefinition -> Doc n
renderGQLType ServerTypeDefinition {Text
tName :: ServerTypeDefinition -> Text
tName :: Text
tName, [Text]
typeParameters :: ServerTypeDefinition -> [Text]
typeParameters :: [Text]
typeParameters, TypeKind
tKind :: ServerTypeDefinition -> TypeKind
tKind :: TypeKind
tKind, Maybe GQLTypeDefinition
gql :: ServerTypeDefinition -> Maybe GQLTypeDefinition
gql :: Maybe GQLTypeDefinition
gql} =
Doc n
"instance"
Doc n -> Doc n -> Doc n
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Doc n) -> [Text] -> Doc n
forall a n. ([a] -> Doc n) -> [a] -> Doc n
optional [Text] -> Doc n
forall n. [Text] -> Doc n
renderTypeableConstraints [Text]
typeParameters
Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"GQLType"
Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
forall ann. Doc ann
typeHead
Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"where"
Doc n -> Doc n -> Doc n
forall a. Semigroup a => a -> a -> a
<> Doc n
forall ann. Doc ann
line
Doc n -> Doc n -> Doc n
forall a. Semigroup a => a -> a -> a
<> Int -> Doc n -> Doc n
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc n] -> Doc n
forall ann. [Doc ann] -> Doc ann
vsep (Doc n -> Maybe GQLTypeDefinition -> [Doc n]
forall n. Doc n -> Maybe GQLTypeDefinition -> [Doc n]
renderMethods Doc n
forall ann. Doc ann
typeHead Maybe GQLTypeDefinition
gql [Doc n] -> [Doc n] -> [Doc n]
forall a. Semigroup a => a -> a -> a
<> [Doc n
forall ann. Doc ann
options]))
where
options :: Doc n
options = Text -> TypeKind -> Doc n
forall n. Text -> TypeKind -> Doc n
defineTypeOptions Text
tName TypeKind
tKind
typeHead :: Doc ann
typeHead =
if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
typeParameters
then Text -> [Text] -> Doc ann
forall ann. Text -> [Text] -> Doc ann
parametrizedType Text
tName [Text]
typeParameters
else [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled (Doc ann -> [Doc ann]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc ann -> [Doc ann]) -> Doc ann -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Doc ann
forall ann. Text -> [Text] -> Doc ann
parametrizedType Text
tName [Text]
typeParameters)
renderGQLType ServerTypeDefinition
_ = Doc n
""
renderMethods :: Doc n -> Maybe GQLTypeDefinition -> [Doc n]
renderMethods :: Doc n -> Maybe GQLTypeDefinition -> [Doc n]
renderMethods Doc n
_ Maybe GQLTypeDefinition
Nothing = []
renderMethods
Doc n
typeHead
( Just
GQLTypeDefinition
{ Maybe Text
gqlTypeDescription :: GQLTypeDefinition -> Maybe Text
gqlTypeDescription :: Maybe Text
gqlTypeDescription,
Map Text Text
gqlTypeDescriptions :: GQLTypeDefinition -> Map Text Text
gqlTypeDescriptions :: Map Text Text
gqlTypeDescriptions,
Kind
gqlKind :: GQLTypeDefinition -> Kind
gqlKind :: Kind
gqlKind
}
) =
[Doc n
"type KIND" Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
typeHead Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"=" Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Kind -> Doc n
forall n. Kind -> Doc n
renderKind Kind
gqlKind]
[Doc n] -> [Doc n] -> [Doc n]
forall a. Semigroup a => a -> a -> a
<> [Doc n
"description _ =" Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc n
forall a ann. Pretty a => a -> Doc ann
pretty (Maybe Text -> String
forall a. Show a => a -> String
show Maybe Text
gqlTypeDescription) | Bool -> Bool
not (Maybe Text -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe Text
gqlTypeDescription)]
[Doc n] -> [Doc n] -> [Doc n]
forall a. Semigroup a => a -> a -> a
<> [Doc n
"getDescriptions _ =" Doc n -> Doc n -> Doc n
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc n
forall a ann. Pretty a => a -> Doc ann
pretty (Map Text Text -> String
forall a. Show a => a -> String
show Map Text Text
gqlTypeDescriptions) | Bool -> Bool
not (Map Text Text -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Text
gqlTypeDescriptions)]
renderKind :: Kind -> Doc n
renderKind :: Kind -> Doc n
renderKind Kind
Type = Doc n
"TYPE"
renderKind Kind
Scalar = Doc n
"SCALAR"