{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.TH.Compile
( compileDocument,
gqlDocument,
)
where
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Morpheus.CodeGen
( parseServerTypeDefinitions,
)
import Data.Morpheus.CodeGen.Internal.AST
( CodeGenConfig (..),
)
import Data.Morpheus.Server.TH.Declare
( runDeclare,
)
import Language.Haskell.TH
import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Relude hiding (ByteString)
gqlDocument :: QuasiQuoter
gqlDocument :: QuasiQuoter
gqlDocument = CodeGenConfig -> QuasiQuoter
mkQuasiQuoter CodeGenConfig :: Bool -> CodeGenConfig
CodeGenConfig {namespace :: Bool
namespace = Bool
False}
mkQuasiQuoter :: CodeGenConfig -> QuasiQuoter
mkQuasiQuoter :: CodeGenConfig -> QuasiQuoter
mkQuasiQuoter CodeGenConfig
ctx =
QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = Text -> String -> Q Exp
forall a. Text -> a
notHandled Text
"Expressions",
quotePat :: String -> Q Pat
quotePat = Text -> String -> Q Pat
forall a. Text -> a
notHandled Text
"Patterns",
quoteType :: String -> Q Type
quoteType = Text -> String -> Q Type
forall a. Text -> a
notHandled Text
"Types",
quoteDec :: String -> Q [Dec]
quoteDec = CodeGenConfig -> ByteString -> Q [Dec]
compileDocument CodeGenConfig
ctx (ByteString -> Q [Dec])
-> (String -> ByteString) -> String -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
LB.pack
}
where
notHandled :: Text -> a
notHandled Text
things =
Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
things Text -> Text -> Text
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
ctx = CodeGenConfig -> ByteString -> Q [ServerTypeDefinition]
forall (m :: * -> *).
CodeGenMonad m =>
CodeGenConfig -> ByteString -> m [ServerTypeDefinition]
parseServerTypeDefinitions CodeGenConfig
ctx (ByteString -> Q [ServerTypeDefinition])
-> ([ServerTypeDefinition] -> Q [Dec]) -> ByteString -> Q [Dec]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CodeGenConfig -> [ServerTypeDefinition] -> Q [Dec]
forall a. Declare a => CodeGenConfig -> a -> Q [Dec]
runDeclare CodeGenConfig
ctx