{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# 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.Parsing.Document.TypeSystem ( parseSchema, ) import Data.Morpheus.Types.Internal.Resolving ( Result (..), ) import Language.Haskell.TH import Language.Haskell.TH.Quote import Relude hiding (ByteString) 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 notHandled Text "Patterns", quoteType :: String -> Q Type quoteType = Text -> String -> Q Type forall a. Text -> a notHandled Text "Types", quoteDec :: String -> Q [Dec] quoteDec = Text -> String -> Q [Dec] forall a. Text -> a notHandled Text "Declarations" } 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" dslExpression :: ByteString -> Q Exp dslExpression :: ByteString -> Q Exp dslExpression ByteString doc = case ByteString -> Eventless (Schema CONST) parseSchema ByteString doc of Failure GQLErrors errors -> String -> Q Exp forall (m :: * -> *) a. MonadFail m => String -> m a fail (GQLErrors -> String renderGQLErrors GQLErrors errors) Success {Schema CONST result :: forall events a. Result events a -> a result :: Schema CONST result, GQLErrors warnings :: forall events a. Result events a -> GQLErrors warnings :: GQLErrors warnings} -> GQLErrors -> Q () gqlWarnings GQLErrors warnings Q () -> Q Exp -> Q Exp forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> [|result|]