{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.CodeGen.QuasiQuoter
  ( raw,
  )
where

import qualified Data.Text as T
import Language.Haskell.TH.Quote
import Relude hiding (ByteString)

notSupported :: Text -> a
notSupported :: forall a. Text -> a
notSupported 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"

-- | QuasiQuoter to insert multiple lines of text in Haskell
raw :: QuasiQuoter
raw :: QuasiQuoter
raw =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = \String
txt -> [|T.pack txt|],
      quotePat :: String -> Q Pat
quotePat = Text -> String -> Q Pat
forall a. Text -> a
notSupported Text
"Patterns",
      quoteType :: String -> Q Type
quoteType = Text -> String -> Q Type
forall a. Text -> a
notSupported Text
"Types",
      quoteDec :: String -> Q [Dec]
quoteDec = Text -> String -> Q [Dec]
forall a. Text -> a
notSupported Text
"Declarations"
    }