{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.CodeGen.Server.Printing.TH
  ( compileDocument,
    gqlDocument,
  )
where

import Data.ByteString.Lazy.Char8 (ByteString, pack)
import Data.Morpheus.CodeGen.Server.Internal.AST
  ( CodeGenConfig (..),
    ServerDeclaration (..),
  )
import Data.Morpheus.CodeGen.Server.Interpreting.Transform
  ( parseServerTypeDefinitions,
  )
import Data.Morpheus.CodeGen.TH
  ( PrintDec (..),
  )
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Relude hiding (ByteString, Type)

gqlDocument :: QuasiQuoter
gqlDocument :: QuasiQuoter
gqlDocument = CodeGenConfig -> QuasiQuoter
mkQuasiQuoter CodeGenConfig {namespace :: Bool
namespace = Bool
False}

mkQuasiQuoter :: CodeGenConfig -> QuasiQuoter
mkQuasiQuoter :: CodeGenConfig -> QuasiQuoter
mkQuasiQuoter CodeGenConfig
ctx =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = forall {a}. Text -> a
notHandled Text
"Expressions",
      quotePat :: String -> Q Pat
quotePat = forall {a}. Text -> a
notHandled Text
"Patterns",
      quoteType :: String -> Q Type
quoteType = forall {a}. Text -> a
notHandled Text
"Types",
      quoteDec :: String -> Q [Dec]
quoteDec = CodeGenConfig -> ByteString -> Q [Dec]
compileDocument CodeGenConfig
ctx forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack
    }
  where
    notHandled :: Text -> a
notHandled Text
things =
      forall a t. (HasCallStack, IsText t) => t -> a
error forall a b. (a -> b) -> a -> b
$ Text
things forall a. Semigroup a => a -> a -> a
<> Text
" are not supported by the GraphQL QuasiQuoter"

compileDocument :: CodeGenConfig -> ByteString -> Q [Dec]
compileDocument :: CodeGenConfig -> ByteString -> Q [Dec]
compileDocument CodeGenConfig
config =
  forall (m :: * -> *).
CodeGenMonad m =>
CodeGenConfig -> ByteString -> m ([ServerDeclaration], Flags)
parseServerTypeDefinitions CodeGenConfig
config
    forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ServerDeclaration -> Q [Dec]
printServerDec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst

printServerDec :: ServerDeclaration -> Q [Dec]
printServerDec :: ServerDeclaration -> Q [Dec]
printServerDec (InterfaceType InterfaceDefinition
interface) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. PrintDec a => a -> Q Dec
printDec InterfaceDefinition
interface
printServerDec ScalarType {} = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
printServerDec (DataType CodeGenType
dataType) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. PrintDec a => a -> Q Dec
printDec CodeGenType
dataType
printServerDec (GQLTypeInstance Kind
_ TypeClassInstance ServerMethod
gql) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. PrintDec a => a -> Q Dec
printDec TypeClassInstance ServerMethod
gql
printServerDec (GQLDirectiveInstance TypeClassInstance ServerMethod
dir) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. PrintDec a => a -> Q Dec
printDec TypeClassInstance ServerMethod
dir