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

module Data.Morpheus.CodeGen.Printing.GQLType
  ( renderGQLType,
  )
where

import Data.Morpheus.CodeGen.Internal.AST
  ( GQLTypeDefinition (..),
    Kind (..),
    ServerDirectiveUsage (..),
    ServerTypeDefinition (..),
    TypeKind,
  )
import Data.Morpheus.CodeGen.Printing.Terms
  ( optional,
    parametrizedType,
  )
import Prettyprinter
import Relude hiding (optional, show)
import Prelude (show)

renderTypeableConstraints :: [Text] -> Doc n
renderTypeableConstraints :: forall n. [Text] -> Doc n
renderTypeableConstraints [Text]
xs = forall ann. [Doc ann] -> Doc ann
tupled (forall a b. (a -> b) -> [a] -> [b]
map ((Doc n
"Typeable" forall ann. Doc ann -> Doc ann -> Doc ann
<+>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty) [Text]
xs) forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"=>"

defineTypeOptions :: Bool -> Text -> TypeKind -> Doc n
defineTypeOptions :: forall n. Bool -> Text -> TypeKind -> Doc n
defineTypeOptions Bool
namespaces Text
tName TypeKind
kind
  | Bool
namespaces = Doc n
"typeOptions _ = dropNamespaceOptions " forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Text
tName forall a. Semigroup a => a -> a -> a
<> Doc n
" (" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show TypeKind
kind) forall a. Semigroup a => a -> a -> a
<> Doc n
")"
  | Bool
otherwise = Doc n
"typeOptions _ options = options"

renderGQLType :: ServerTypeDefinition -> Doc n
renderGQLType :: forall n. ServerTypeDefinition -> Doc n
renderGQLType ServerTypeDefinition {[Text]
[ServerConstructorDefinition]
[DerivingClass]
Maybe GQLTypeDefinition
Text
TypeKind
typeGQLType :: ServerTypeDefinition -> Maybe GQLTypeDefinition
derives :: ServerTypeDefinition -> [DerivingClass]
tKind :: ServerTypeDefinition -> TypeKind
tCons :: ServerTypeDefinition -> [ServerConstructorDefinition]
typeParameters :: ServerTypeDefinition -> [Text]
tName :: ServerTypeDefinition -> Text
typeGQLType :: Maybe GQLTypeDefinition
derives :: [DerivingClass]
tKind :: TypeKind
tCons :: [ServerConstructorDefinition]
typeParameters :: [Text]
tName :: Text
..} =
  Doc n
"instance"
    forall a. Semigroup a => a -> a -> a
<> forall a n. ([a] -> Doc n) -> [a] -> Doc n
optional forall n. [Text] -> Doc n
renderTypeableConstraints [Text]
typeParameters
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"GQLType"
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall {ann}. Doc ann
typeHead
    forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"where"
      forall a. Semigroup a => a -> a -> a
<> forall {ann}. Doc ann
line
      forall a. Semigroup a => a -> a -> a
<> forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (forall ann. [Doc ann] -> Doc ann
vsep (forall n. Doc n -> Maybe GQLTypeDefinition -> [Doc n]
renderMethods forall {ann}. Doc ann
typeHead Maybe GQLTypeDefinition
typeGQLType forall a. Semigroup a => a -> a -> a
<> [forall {ann}. Doc ann
options]))
  where
    options :: Doc n
options = forall n. Bool -> Text -> TypeKind -> Doc n
defineTypeOptions Bool
False Text
tName TypeKind
tKind
    typeHead :: Doc ann
typeHead =
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
typeParameters
        then forall ann. Text -> [Text] -> Doc ann
parametrizedType Text
tName [Text]
typeParameters
        else forall ann. [Doc ann] -> Doc ann
tupled (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall ann. Text -> [Text] -> Doc ann
parametrizedType Text
tName [Text]
typeParameters)
renderGQLType ServerTypeDefinition
_ = Doc n
""

renderMethods :: Doc n -> Maybe GQLTypeDefinition -> [Doc n]
renderMethods :: forall n. Doc n -> Maybe GQLTypeDefinition -> [Doc n]
renderMethods Doc n
_ Maybe GQLTypeDefinition
Nothing = []
renderMethods
  Doc n
typeHead
  (Just GQLTypeDefinition {[ServerDirectiveUsage]
Maybe Text
Map Text Text
Map Text (Value CONST)
Kind
gqlTypeDefaultValues :: GQLTypeDefinition -> Map Text (Value CONST)
gqlTypeDirectiveUses :: GQLTypeDefinition -> [ServerDirectiveUsage]
gqlTypeDescriptions :: GQLTypeDefinition -> Map Text Text
gqlTypeDescription :: GQLTypeDefinition -> Maybe Text
gqlKind :: GQLTypeDefinition -> Kind
gqlTypeDefaultValues :: Map Text (Value CONST)
gqlTypeDirectiveUses :: [ServerDirectiveUsage]
gqlTypeDescriptions :: Map Text Text
gqlTypeDescription :: Maybe Text
gqlKind :: Kind
..}) =
    [Doc n
"type KIND" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
typeHead forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc n
"=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall n. Kind -> Doc n
renderKind Kind
gqlKind]
      forall a. Semigroup a => a -> a -> a
<> [Doc n
"description _ =" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show Maybe Text
gqlTypeDescription) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe Text
gqlTypeDescription)]
      forall a. Semigroup a => a -> a -> a
<> [Doc n
"getDescriptions _ =" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show Map Text Text
gqlTypeDescriptions) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Text
gqlTypeDescriptions)]
      forall a. Semigroup a => a -> a -> a
<> [Doc n
"directives _=" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall n. [ServerDirectiveUsage] -> Doc n
renderDirectiveUsages [ServerDirectiveUsage]
gqlTypeDirectiveUses | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ServerDirectiveUsage]
gqlTypeDirectiveUses)]

renderDirectiveUsages :: [ServerDirectiveUsage] -> Doc n
renderDirectiveUsages :: forall n. [ServerDirectiveUsage] -> Doc n
renderDirectiveUsages = forall ann. Doc ann -> Doc ann
align forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. [Doc ann] -> Doc ann
vsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate Doc n
" <>" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. ServerDirectiveUsage -> Doc n
renderDirectiveUsage

renderDirectiveUsage :: ServerDirectiveUsage -> Doc n
renderDirectiveUsage :: forall n. ServerDirectiveUsage -> Doc n
renderDirectiveUsage (TypeDirectiveUsage TypeValue
value) = Doc n
"typeDirective" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeValue
value
renderDirectiveUsage (FieldDirectiveUsage FieldName
place TypeValue
value) = Doc n
"fieldDirective" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show FieldName
place) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeValue
value
renderDirectiveUsage (EnumDirectiveUsage TypeName
place TypeValue
value) = Doc n
"enumDirective" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show TypeName
place) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty TypeValue
value

renderKind :: Kind -> Doc n
renderKind :: forall n. Kind -> Doc n
renderKind Kind
Type = Doc n
"TYPE"
renderKind Kind
Scalar = Doc n
"SCALAR"