{-# 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 :: forall ann. Text -> [Text] -> Doc ann
parametrizedType Text
tName [Text]
typeParameters = forall ann. [Doc ann] -> Doc ann
hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ Text
tName forall a. a -> [a] -> [a]
: [Text]
typeParameters

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

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

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

renderType :: TypeDoc n -> Doc n
renderType :: forall n. 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 forall ann. [Doc ann] -> Doc ann
tupled [Doc n
doc] else Doc n
doc

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

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

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

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

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

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

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