TemplateHaskellによる文字列生成埋め込みDSL ref: http://qiita.com/ykst/items/a7ae5af1bb41b64dc31e

file1.hs

> [s|foo[=]|] "bar"
"foobar"
> [s|int [=] = [=];|] "x" "1"
"int x = 1;"
> [s|var xs = [= show (take 4 [1..]) =]|] 
"var xs = [1,2,3,4]"

file2.txt

$ cabal install haskell-src-meta

SExpr.hs

{-# LANGUAGE TemplateHaskell, DeriveDataTypeable #-}
module Language.SExpr (s) where
import Language.Haskell.TH
import Language.Haskell.TH.Quote
import qualified Language.Haskell.Meta.Parse as MP (parseExp)
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Text.Parsec
import Text.Parsec.Combinator (manyTill)
import Text.Parsec.String (Parser)
import Control.Applicative hiding ((<|>), many, optionMaybe, optional)

data SExpr = SList [SItem]
data SItem = SString String | SExp String | SVar

sExprP :: Parser SExpr
sExprP = SList <$> many sItemP
    where
    sItemP :: Parser SItem
    sItemP =
        SString <$> many1 (noneOf "[" <|> try (char '[' <* notFollowedBy (char '=')))
        <|> (string "[=" >>
            (SVar <$ char ']'
            <|> SExp <$> (manyTill anyChar (try (string "=]")))))

parseSExpr :: FilePath -> String -> SExpr
parseSExpr path = either (error . show) id . parse (sExprP <* eof) path

buildExp :: SExpr -> Q Exp
buildExp (SList items) =
    mapM toExpM items >>= pure . unzip >>= \(names, exps) ->
    lamE (map varP $ catMaybes names) (foldr appE [|""|] exps)

toExpM :: SItem -> Q (Maybe Name, Q Exp)
toExpM item = case item of
    SString str -> pure (Nothing, [| (++) str |])
    SExp command -> pure (Nothing, [| (++) $(either undefined pure (MP.parseExp command))  |])
    SVar -> newName "x" >>= \name -> pure (Just name, [| (++) $(varE name) |])

showLoc :: Loc -> String
showLoc loc = intercalate ":" [loc_filename loc, show line, show col]
    where (line, col) = loc_start loc

s :: QuasiQuoter
s = QuasiQuoter {
    quoteExp = (\input -> location >>= \loc -> buildExp (parseSExpr (showLoc loc) input)),
    quotePat = undefined,
    quoteType = undefined,
    quoteDec = undefined
}