module FFICXX.Generate.QQ.Verbatim where

import Language.Haskell.TH.Lib
  ( litE,
    stringL,
  )
import Language.Haskell.TH.Quote
  ( QuasiQuoter (..),
    quoteDec,
    quoteExp,
    quotePat,
    quoteType,
  )

verbatim :: QuasiQuoter
verbatim :: QuasiQuoter
verbatim =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = Lit -> Q Exp
forall (m :: * -> *). Quote m => Lit -> m Exp
litE (Lit -> Q Exp) -> (String -> Lit) -> String -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Lit
stringL,
      quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined,
      quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined,
      quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
      --           , quotePat = litP . stringP
    }