{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Schema.DSL (dsl) where import Data.ByteString.Lazy.Char8 ( ByteString, pack, ) import Data.Morpheus.Error ( gqlWarnings, renderGQLErrors, ) import Data.Morpheus.Ext.Result ( Result (..), ) import Data.Morpheus.Parsing.Document.TypeSystem ( parseSchema, ) import Language.Haskell.TH import Language.Haskell.TH.Quote import Relude hiding (ByteString) dsl :: QuasiQuoter dsl :: QuasiQuoter dsl = QuasiQuoter { quoteExp :: String -> Q Exp quoteExp = ByteString -> Q Exp dslExpression forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> ByteString pack, 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 = forall {a}. Text -> a notHandled Text "Declarations" } 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" dslExpression :: ByteString -> Q Exp dslExpression :: ByteString -> Q Exp dslExpression ByteString doc = case ByteString -> GQLResult (Schema CONST) parseSchema ByteString doc of Failure NonEmpty GQLError errors -> forall (m :: * -> *) a. MonadFail m => String -> m a fail (NonEmpty GQLError -> String renderGQLErrors NonEmpty GQLError errors) Success {Schema CONST result :: forall err a. Result err a -> a result :: Schema CONST 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|]