{-# 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 :: Text -> a notSupported 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" gql :: QuasiQuoter gql :: QuasiQuoter gql = QuasiQuoter :: (String -> Q Exp) -> (String -> Q Pat) -> (String -> Q Type) -> (String -> Q [Dec]) -> QuasiQuoter QuasiQuoter { quoteExp :: String -> Q Exp quoteExp = ByteString -> Q Exp gqlExpression (ByteString -> Q Exp) -> (String -> ByteString) -> String -> Q Exp forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ByteString pack, quotePat :: String -> Q Pat quotePat = Text -> String -> Q Pat forall a. Text -> a notSupported Text "Patterns", quoteType :: String -> Q Type quoteType = Text -> String -> Q Type forall a. Text -> a notSupported Text "Types", quoteDec :: String -> Q [Dec] quoteDec = Text -> String -> Q [Dec] 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 -> String -> Q Exp forall (m :: * -> *) a. MonadFail m => String -> m a fail (NonEmpty GQLError -> String 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 Q () -> Q Exp -> Q Exp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> [|(result, query)|] where query :: String query = ByteString -> String unpack ByteString queryText request :: GQLRequest request = GQLRequest :: Maybe FieldName -> Text -> Maybe Value -> GQLRequest GQLRequest { query :: Text query = ByteString -> Text fromLBS ByteString queryText, operationName :: Maybe FieldName operationName = Maybe FieldName forall a. Maybe a Nothing, variables :: Maybe Value variables = Maybe Value forall a. Maybe a Nothing } dsl :: QuasiQuoter dsl :: QuasiQuoter dsl = QuasiQuoter :: (String -> Q Exp) -> (String -> Q Pat) -> (String -> Q Type) -> (String -> Q [Dec]) -> QuasiQuoter QuasiQuoter { quoteExp :: String -> Q Exp quoteExp = ByteString -> Q Exp dslExpression (ByteString -> Q Exp) -> (String -> ByteString) -> String -> Q Exp forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ByteString pack, quotePat :: String -> Q Pat quotePat = Text -> String -> Q Pat forall a. Text -> a notSupported Text "Patterns", quoteType :: String -> Q Type quoteType = Text -> String -> Q Type forall a. Text -> a notSupported Text "Types", quoteDec :: String -> Q [Dec] quoteDec = Text -> String -> Q [Dec] 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 -> String -> Q Exp forall (m :: * -> *) a. MonadFail m => String -> m a fail (NonEmpty GQLError -> String 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 Q () -> Q Exp -> Q Exp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> [|result|]