{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# 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)

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
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"

gqlExpression :: ByteString -> Q Exp
gqlExpression :: ByteString -> Q Exp
gqlExpression ByteString
queryText = case GQLRequest -> Eventless ExecutableDocument
parseRequest GQLRequest
request of
  Failure GQLErrors
errors -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (GQLErrors -> String
renderGQLErrors GQLErrors
errors)
  Success {ExecutableDocument
result :: forall events a. Result events a -> a
result :: ExecutableDocument
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, 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
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 VALID)
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 VALID
result :: Schema VALID
result :: forall events a. Result events a -> a
result, GQLErrors
warnings :: GQLErrors
warnings :: forall events a. Result events a -> 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|]