There's a proposal for adding a proper Haskell QuasiQuoter as part of template-haskell. Until then, as others have noted your best option is the haskell-src-meta package, but be aware that this uses a separate parser.



On Sat, Aug 24, 2013 at 11:36 AM, TP <paratribulations@free.fr> wrote:
Hi everybody,

I continue to learn and test Template Haskell (one more time thanks to John
Lato for his post at:

http://www.mail-archive.com/haskell-cafe@haskell.org/msg106696.html

that made me understand a lot of things).

I have a question about the way Template Haskell is working. Why Template
Haskell does not propose something similar to Python (or bash) exec() or
eval(), i.e. does not offer the possibility to take a (quoted) string in
input, to make abstract syntax in output (to be executed later in a splice
$()).
For example, in Python, to make an affectation 'a="a"' programatically, I
can simply do (at runtime; even if I am here only concerned with what
Template Haskell could do, i.e. at compile time):
> def f(s): return '%s = \'%s\'' % (s,s)
> exec(f("a"))
> a
'a'

With Template Haskell, I am compelled to make a function returning the
abstract syntax corresponding to variable declaration:

ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s)

(see complete example in Post Scriptum).
This works fine, but it is less direct. I am sure that the Template Haskell
approach has many advantages, but I am unable to list them. I think it is
important to have the reasons in mind. Could you help me?

Thanks in advance,

TP


PS: the complete Haskell example:

-----------------------------------
module MakeVard where
import Language.Haskell.TH

makeVard :: Monad m => String -> m [Dec]
-- Equivalent to "%s = \"%s\""
makeVard s = return [ ValD (VarP $ mkName s) (NormalB $ LitE $ StringL s) []
]
-----------------------------------

tested by

-----------------------------------
{-# LANGUAGE TemplateHaskell #-}
import MakeVard

$(makeVard "a")

main = do

print a
-----------------------------------

resulting in
$ runghc -ddump-splices test.hs
test_makeVar.hs:1:1: Splicing declarations
    makeVard "a"
  ======>
    test_makeVar.hs:4:3-14
    a = "a"
"a"


_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe