{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.CodeGen.Printing.Terms
  ( renderExtension,
    renderWrapped,
    label,
    parametrizedType,
    TypeDoc (..),
    appendType,
    optional,
    renderImport,
    renderType,
    renderName,
  )
where

import Data.Morpheus.CodeGen.Internal.AST
  ( TypeName,
    TypeWrapper (..),
    unpackName,
  )
import qualified Data.Text as T
import Data.Text.Prettyprint.Doc
  ( (<+>),
    Doc,
    hsep,
    list,
    pretty,
    tupled,
  )
import Relude hiding (optional)

parametrizedType :: Text -> [Text] -> Doc ann
parametrizedType :: Text -> [Text] -> Doc ann
parametrizedType Text
tName [Text]
typeParameters = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Text] -> [Doc ann]) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> a -> b
$ Text
tName Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
typeParameters

-- TODO: this should be done in transformer
renderName :: TypeName -> Doc ann
renderName :: TypeName -> Doc ann
renderName = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (TypeName -> String) -> TypeName -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (TypeName -> Text) -> TypeName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> Text
forall (t :: NAME). Name t -> Text
unpackName

renderExtension :: Text -> Doc ann
renderExtension :: Text -> Doc ann
renderExtension Text
name = Doc ann
"{-#" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"LANGUAGE" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
name Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"#-}"

data TypeDoc n = TypeDoc
  { TypeDoc n -> Bool
isComplex :: Bool,
    TypeDoc n -> Doc n
unDoc :: Doc n
  }

renderType :: TypeDoc n -> Doc n
renderType :: TypeDoc n -> Doc n
renderType TypeDoc {Bool
isComplex :: Bool
isComplex :: forall n. TypeDoc n -> Bool
isComplex, unDoc :: forall n. TypeDoc n -> Doc n
unDoc = Doc n
doc} = if Bool
isComplex then [Doc n] -> Doc n
forall ann. [Doc ann] -> Doc ann
tupled [Doc n
doc] else Doc n
doc

appendType :: TypeName -> TypeDoc n -> TypeDoc n
appendType :: TypeName -> TypeDoc n -> TypeDoc n
appendType TypeName
t1 TypeDoc n
tyDoc = Bool -> Doc n -> TypeDoc n
forall n. Bool -> Doc n -> TypeDoc n
TypeDoc Bool
True (Doc n -> TypeDoc n) -> Doc n -> TypeDoc n
forall a b. (a -> b) -> a -> b
$ TypeName -> Doc n
forall ann. TypeName -> Doc ann
renderName TypeName
t1 Doc n -> Doc n -> Doc n
forall a. Semigroup a => a -> a -> a
<> Doc n
" " Doc n -> Doc n -> Doc n
forall a. Semigroup a => a -> a -> a
<> TypeDoc n -> Doc n
forall n. TypeDoc n -> Doc n
renderType TypeDoc n
tyDoc

renderMaybe :: Bool -> TypeDoc n -> TypeDoc n
renderMaybe :: Bool -> TypeDoc n -> TypeDoc n
renderMaybe Bool
True = TypeDoc n -> TypeDoc n
forall a. a -> a
id
renderMaybe Bool
False = TypeName -> TypeDoc n -> TypeDoc n
forall n. TypeName -> TypeDoc n -> TypeDoc n
appendType TypeName
"Maybe"

renderList :: TypeDoc n -> TypeDoc n
renderList :: TypeDoc n -> TypeDoc n
renderList = Bool -> Doc n -> TypeDoc n
forall n. Bool -> Doc n -> TypeDoc n
TypeDoc Bool
False (Doc n -> TypeDoc n)
-> (TypeDoc n -> Doc n) -> TypeDoc n -> TypeDoc n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc n] -> Doc n
forall ann. [Doc ann] -> Doc ann
list ([Doc n] -> Doc n) -> (TypeDoc n -> [Doc n]) -> TypeDoc n -> Doc n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc n -> [Doc n]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc n -> [Doc n]) -> (TypeDoc n -> Doc n) -> TypeDoc n -> [Doc n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDoc n -> Doc n
forall n. TypeDoc n -> Doc n
unDoc

renderWrapped :: TypeWrapper -> TypeDoc n -> TypeDoc n
renderWrapped :: TypeWrapper -> TypeDoc n -> TypeDoc n
renderWrapped (TypeList TypeWrapper
wrapper Bool
notNull) = Bool -> TypeDoc n -> TypeDoc n
forall n. Bool -> TypeDoc n -> TypeDoc n
renderMaybe Bool
notNull (TypeDoc n -> TypeDoc n)
-> (TypeDoc n -> TypeDoc n) -> TypeDoc n -> TypeDoc n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeDoc n -> TypeDoc n
forall n. TypeDoc n -> TypeDoc n
renderList (TypeDoc n -> TypeDoc n)
-> (TypeDoc n -> TypeDoc n) -> TypeDoc n -> TypeDoc n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeWrapper -> TypeDoc n -> TypeDoc n
forall n. TypeWrapper -> TypeDoc n -> TypeDoc n
renderWrapped TypeWrapper
wrapper
renderWrapped (BaseType Bool
notNull) = Bool -> TypeDoc n -> TypeDoc n
forall n. Bool -> TypeDoc n -> TypeDoc n
renderMaybe Bool
notNull

label :: Text -> Doc ann
label :: Text -> Doc ann
label Text
typeName = Doc ann
"---- GQL " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
typeName Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" -------------------------------\n"

optional :: ([a] -> Doc n) -> [a] -> Doc n
optional :: ([a] -> Doc n) -> [a] -> Doc n
optional [a] -> Doc n
_ [] = Doc n
""
optional [a] -> Doc n
f [a]
xs = Doc n
" " Doc n -> Doc n -> Doc n
forall a. Semigroup a => a -> a -> a
<> [a] -> Doc n
f [a]
xs

renderImport :: (Text, [Text]) -> Doc ann
renderImport :: (Text, [Text]) -> Doc ann
renderImport (Text
src, [Text]
ls) =
  Doc ann
"import" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
src
    Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ([Text] -> Doc ann) -> [Text] -> Doc ann
forall a n. ([a] -> Doc n) -> [a] -> Doc n
optional ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
tupled ([Doc ann] -> Doc ann)
-> ([Text] -> [Doc ann]) -> [Text] -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc ann) -> [Text] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) [Text]
ls