{-# OPTIONS_GHC -Wno-deprecations #-}

module AirGQL.Raw (raw) where

import Protolude (pure, (.))
import Protolude.Error (error)

import Language.Haskell.TH (Exp (LitE), Lit (StringL))
import Language.Haskell.TH.Quote (
  QuasiQuoter (QuasiQuoter, quoteDec, quoteExp, quotePat, quoteType),
 )


raw :: QuasiQuoter
raw :: QuasiQuoter
raw =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = Exp -> Q Exp
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Exp -> Q Exp) -> (String -> Exp) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lit -> Exp
LitE (Lit -> Exp) -> (String -> Lit) -> String -> Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
StringL
    , quotePat :: String -> Q Pat
quotePat = \String
_ ->
        Text -> Q Pat
forall a. HasCallStack => Text -> a
error
          Text
"Illegal raw string QuasiQuote \
          \(allowed as expression only, used as a pattern)"
    , quoteType :: String -> Q Type
quoteType = \String
_ ->
        Text -> Q Type
forall a. HasCallStack => Text -> a
error
          Text
"Illegal raw string QuasiQuote \
          \(allowed as expression only, used as a type)"
    , quoteDec :: String -> Q [Dec]
quoteDec = \String
_ ->
        Text -> Q [Dec]
forall a. HasCallStack => Text -> a
error
          Text
"Illegal raw string QuasiQuote \
          \(allowed as expression only, used as a declaration)"
    }