{-# LANGUAGE Safe #-}
module Language.Haskell.TH.Quote
( QuasiQuoter(..)
, quoteFile
, namedDefaultQuasiQuoter
, defaultQuasiQuoter
, dataToQa, dataToExpQ, dataToPatQ
) where
import GHC.Boot.TH.Syntax
import GHC.Boot.TH.Quote
import Language.Haskell.TH.Syntax (dataToQa, dataToExpQ, dataToPatQ)
quoteFile :: QuasiQuoter -> QuasiQuoter
quoteFile :: QuasiQuoter -> QuasiQuoter
quoteFile (QuasiQuoter { quoteExp :: QuasiQuoter -> String -> Q Exp
quoteExp = String -> Q Exp
qe, quotePat :: QuasiQuoter -> String -> Q Pat
quotePat = String -> Q Pat
qp, quoteType :: QuasiQuoter -> String -> Q Type
quoteType = String -> Q Type
qt, quoteDec :: QuasiQuoter -> String -> Q [Dec]
quoteDec = String -> Q [Dec]
qd })
= QuasiQuoter { quoteExp :: String -> Q Exp
quoteExp = (String -> Q Exp) -> String -> Q Exp
forall a. (String -> Q a) -> String -> Q a
get String -> Q Exp
qe, quotePat :: String -> Q Pat
quotePat = (String -> Q Pat) -> String -> Q Pat
forall a. (String -> Q a) -> String -> Q a
get String -> Q Pat
qp, quoteType :: String -> Q Type
quoteType = (String -> Q Type) -> String -> Q Type
forall a. (String -> Q a) -> String -> Q a
get String -> Q Type
qt, quoteDec :: String -> Q [Dec]
quoteDec = (String -> Q [Dec]) -> String -> Q [Dec]
forall a. (String -> Q a) -> String -> Q a
get String -> Q [Dec]
qd }
where
get :: (String -> Q a) -> String -> Q a
get :: forall a. (String -> Q a) -> String -> Q a
get String -> Q a
old_quoter String
file_name = do { file_cts <- IO String -> Q String
forall a. IO a -> Q a
runIO (String -> IO String
readFile String
file_name)
; addDependentFile file_name
; old_quoter file_cts }
namedDefaultQuasiQuoter :: String -> QuasiQuoter
namedDefaultQuasiQuoter :: String -> QuasiQuoter
namedDefaultQuasiQuoter String
name = QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = String -> String -> Q Exp
forall {m :: * -> *} {p} {a}. MonadFail m => String -> p -> m a
f String
"use in expression contexts."
, quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall {m :: * -> *} {p} {a}. MonadFail m => String -> p -> m a
f String
"use in pattern contexts."
, quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall {m :: * -> *} {p} {a}. MonadFail m => String -> p -> m a
f String
"use in types."
, quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall {m :: * -> *} {p} {a}. MonadFail m => String -> p -> m a
f String
"creating declarations."
}
where
f :: String -> p -> m a
f String
m p
_ = String -> m a
forall a. HasCallStack => String -> m a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"The " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" quasiquoter is not for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m
defaultQuasiQuoter :: QuasiQuoter
defaultQuasiQuoter :: QuasiQuoter
defaultQuasiQuoter = QuasiQuoter
{ quoteExp :: String -> Q Exp
quoteExp = String -> String -> Q Exp
forall {m :: * -> *} {p} {a}. MonadFail m => String -> p -> m a
f String
"use in expression contexts."
, quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall {m :: * -> *} {p} {a}. MonadFail m => String -> p -> m a
f String
"use in pattern contexts."
, quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall {m :: * -> *} {p} {a}. MonadFail m => String -> p -> m a
f String
"use in types."
, quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall {m :: * -> *} {p} {a}. MonadFail m => String -> p -> m a
f String
"creating declarations."
}
where
f :: String -> p -> m a
f String
m p
_ = String -> m a
forall a. HasCallStack => String -> m a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"This quasiquoter is not for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m