{-# 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 :: 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
"=>"

-- TODO: fill namespace options
defineTypeOptions :: Text -> TypeKind -> Doc n
defineTypeOptions :: forall n. Text -> TypeKind -> Doc n
defineTypeOptions Text
tName TypeKind
kind = Doc n
""

renderGQLType :: ServerTypeDefinition -> Doc n
renderGQLType :: forall n. 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"
    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
gql forall a. Semigroup a => a -> a -> a
<> [forall {ann}. Doc ann
options]))
  where
    options :: Doc n
options = forall n. Text -> TypeKind -> Doc n
defineTypeOptions 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
        { 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" 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)]

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