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