{-# LANGUAGE RankNTypes, ScopedTypeVariables, Safe #-} {- | Module : Language.Haskell.TH.Quote Description : Quasi-quoting support for Template Haskell Template Haskell supports quasiquoting, which permits users to construct program fragments by directly writing concrete syntax. A quasiquoter is essentially a function with takes a string to a Template Haskell AST. This module defines the 'QuasiQuoter' datatype, which specifies a quasiquoter @q@ which can be invoked using the syntax @[q| ... string to parse ... |]@ when the @QuasiQuotes@ language extension is enabled, and some utility functions for manipulating quasiquoters. Nota bene: this package does not define any parsers, that is up to you. -} module Language.Haskell.TH.Quote( QuasiQuoter(..), quoteFile, -- * For backwards compatibility dataToQa, dataToExpQ, dataToPatQ ) where import Language.Haskell.TH.Syntax import Prelude -- | The 'QuasiQuoter' type, a value @q@ of this type can be used -- in the syntax @[q| ... string to parse ...|]@. In fact, for -- convenience, a 'QuasiQuoter' actually defines multiple quasiquoters -- to be used in different splice contexts; if you are only interested -- in defining a quasiquoter to be used for expressions, you would -- define a 'QuasiQuoter' with only 'quoteExp', and leave the other -- fields stubbed out with errors. data QuasiQuoter = QuasiQuoter { -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@ QuasiQuoter -> String -> Q Exp quoteExp :: String -> Q Exp, -- | Quasi-quoter for patterns, invoked by quotes like @f $[q|...] = rhs@ QuasiQuoter -> String -> Q Pat quotePat :: String -> Q Pat, -- | Quasi-quoter for types, invoked by quotes like @f :: $[q|...]@ QuasiQuoter -> String -> Q Type quoteType :: String -> Q Type, -- | Quasi-quoter for declarations, invoked by top-level quotes QuasiQuoter -> String -> Q [Dec] quoteDec :: String -> Q [Dec] } -- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read -- the data out of a file. For example, suppose @asmq@ is an -- assembly-language quoter, so that you can write [asmq| ld r1, r2 |] -- as an expression. Then if you define @asmq_f = quoteFile asmq@, then -- the quote [asmq_f|foo.s|] will take input from file @"foo.s"@ instead -- of the inline text 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 = forall a. (String -> Q a) -> String -> Q a get String -> Q Exp qe, quotePat :: String -> Q Pat quotePat = forall a. (String -> Q a) -> String -> Q a get String -> Q Pat qp, quoteType :: String -> Q Type quoteType = forall a. (String -> Q a) -> String -> Q a get String -> Q Type qt, quoteDec :: String -> Q [Dec] quoteDec = 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 { String file_cts <- forall a. IO a -> Q a runIO (String -> IO String readFile String file_name) ; String -> Q () addDependentFile String file_name ; String -> Q a old_quoter String file_cts }