{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.QuasiQuoter ( gql, gqlExpression, dsl, dslExpression, ) where import Data.ByteString.Lazy.Char8 ( ByteString, pack, unpack, ) import Data.Morpheus.Error ( gqlWarnings, renderGQLErrors, ) import Data.Morpheus.Ext.Result ( Result (..), ) import Data.Morpheus.Internal.Utils ( fromLBS, ) import Data.Morpheus.Parser ( parseRequest, parseSchema, ) import Data.Morpheus.Types.IO (GQLRequest (..)) import Language.Haskell.TH import Language.Haskell.TH.Quote import Relude hiding (ByteString) notSupported :: Text -> a notSupported :: forall a. Text -> a notSupported 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" gql :: QuasiQuoter gql :: QuasiQuoter gql = QuasiQuoter { quoteExp :: [Char] -> Q Exp quoteExp = ByteString -> Q Exp gqlExpression forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> ByteString pack, quotePat :: [Char] -> Q Pat quotePat = forall a. Text -> a notSupported Text "Patterns", quoteType :: [Char] -> Q Type quoteType = forall a. Text -> a notSupported Text "Types", quoteDec :: [Char] -> Q [Dec] quoteDec = forall a. Text -> a notSupported Text "Declarations" } gqlExpression :: ByteString -> Q Exp gqlExpression :: ByteString -> Q Exp gqlExpression ByteString queryText = case GQLRequest -> GQLResult ExecutableDocument parseRequest GQLRequest request of Failure NonEmpty GQLError errors -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail (NonEmpty GQLError -> [Char] renderGQLErrors NonEmpty GQLError errors) Success {ExecutableDocument result :: forall err a. Result err a -> a result :: ExecutableDocument result, [GQLError] warnings :: forall err a. Result err a -> [err] warnings :: [GQLError] warnings} -> [GQLError] -> Q () gqlWarnings [GQLError] warnings forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> [|(result, query)|] where query :: [Char] query = ByteString -> [Char] unpack ByteString queryText request :: GQLRequest request = GQLRequest { query :: Text query = ByteString -> Text fromLBS ByteString queryText, operationName :: Maybe FieldName operationName = forall a. Maybe a Nothing, variables :: Maybe Value variables = forall a. Maybe a Nothing } dsl :: QuasiQuoter dsl :: QuasiQuoter dsl = QuasiQuoter { quoteExp :: [Char] -> Q Exp quoteExp = ByteString -> Q Exp dslExpression forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> ByteString pack, quotePat :: [Char] -> Q Pat quotePat = forall a. Text -> a notSupported Text "Patterns", quoteType :: [Char] -> Q Type quoteType = forall a. Text -> a notSupported Text "Types", quoteDec :: [Char] -> Q [Dec] quoteDec = forall a. Text -> a notSupported Text "Declarations" } dslExpression :: ByteString -> Q Exp dslExpression :: ByteString -> Q Exp dslExpression ByteString doc = case ByteString -> GQLResult (Schema VALID) parseSchema ByteString doc of Failure NonEmpty GQLError errors -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail (NonEmpty GQLError -> [Char] renderGQLErrors NonEmpty GQLError errors) Success {Schema VALID result :: Schema VALID result :: forall err a. Result err a -> a result, [GQLError] warnings :: [GQLError] warnings :: forall err a. Result err a -> [err] warnings} -> [GQLError] -> Q () gqlWarnings [GQLError] warnings forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> [|result|]