QuasiQuote with arguments

Question

I want to write a quotation in Haskell. name argument needs to be passed into gen function to generate a declaration.

quote ::  String -> QuasiQuoter
quote name = QuasiQuoter {
       quoteExp = undefined,
       quotePat = undefined,
       quoteType = undefined,
       quoteDec = \jsonStr -> gen name (getValue str)
     }

However, it seems that I cannot use the quotation like this

[quote "Hello"| from x to y |]

Since Haskell does not allow quote declarations and quotations to be in the same file which is annoying, what can I do to pass a argument from out side into the quotation?

Answer 1

You have two options:

1. Switch over to using splices $(...),
2. Encode your parameter to the quasi-quoter in the input string.

With splice syntax your example would look like:

quote :: String -> String -> Q [Dec]
quote name jsonStr = gen name (getValue jsonStr)

and invoking it looks like: $(quote "Hello" "from x to y")

To demonstrate option 2, here is a simple quoter which surrounds a literal string with a character:

import Language.Haskell.TH (litE, stringL)
import Language.Haskell.TH.Quote

surround :: QuasiQuoter
surround = QuasiQuoter
  { quoteExp  = litE . stringL . (\(c:s) -> [c] ++ s ++ [c])
  , quotePat  = undefined
  , quoteType = undefined
  , quoteDec  = undefined
  }

-- in another file:
main = print [surround|_some text|] -- prints "_some text_"

The first character of the input string is interpreted as the bracket character to use. In effect we have passed a Char parameter to a function of type Char -> QuasiQuoter.

For more complex parameters or multiple parameters you will have to create your own syntax and parser to decode them.

Update: Here is a slightly more complex example where the invocation [foo| var xyz|] treats var as the name of a variable and xyz as a literal string:

-- [foo| var xyz|]   is translated to:   var ++ "xyz"

foo :: QuasiQuoter
foo = QuasiQuoter
  { quoteExp  = go
  , quotePat  = undefined
  , quoteType = undefined
  , quoteDec  = undefined
  }
  where go str = infixE (Just $ varE (mkName var))
                        (varE $ mkName "++")
                        (Just $ litE (stringL arg1))
          where (var:arg1:_) = words str