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

-- TODO: fill namespace options
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"