{-# 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|]