{-# LANGUAGE DeriveDataTypeable, QuasiQuotes #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.StringTemplate.QQ
-- Copyright   :  (c) Sterling Clover 2009
-- License     :  BSD 3 Clause
-- Maintainer  :  s.clover@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- This module provides stmp, a quasi-quoter for StringTemplate expressions.
-- Quoted templates are guaranteed syntactically well-formed at compile time,
-- and antiquotation (of identifiers only) is provided by backticks.
-- Usage: @ let var = [0,1,2] in toString [$stmp|($\`var\`; separator = ', '$)|] === \"(0, 1, 2)\"@
-----------------------------------------------------------------------------

module Text.StringTemplate.QQ (stmp) where

import qualified Language.Haskell.TH as TH
import Language.Haskell.TH.Quote
import Text.StringTemplate.Base
import qualified Data.Set as S

quoteTmplExp :: String -> TH.ExpQ
quoteTmplPat :: String -> TH.PatQ

stmp :: QuasiQuoter
stmp :: QuasiQuoter
stmp = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter {quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteTmplExp, quotePat :: String -> Q Pat
quotePat = String -> Q Pat
quoteTmplPat}

quoteTmplPat :: String -> Q Pat
quoteTmplPat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"Cannot apply stmp quasiquoter in patterns"
quoteTmplExp :: String -> Q Exp
quoteTmplExp String
s = Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return Exp
tmpl
  where
    vars :: [String]
vars = case (Char, Char)
-> String -> Either ParseError ([String], [String], [String])
parseSTMPNames (Char
'$',Char
'$') String
s of
             Right ([String]
xs,[String]
_,[String]
_) -> [String]
xs
             Left  ParseError
err -> String -> [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
    base :: Exp
base  = Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE (String -> Name
TH.mkName String
"Text.StringTemplate.newSTMP")) (Lit -> Exp
TH.LitE (String -> Lit
TH.StringL String
s))
    tmpl :: Exp
tmpl  = (String -> Exp -> Exp) -> Exp -> Set String -> Exp
forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr String -> Exp -> Exp
addAttrib Exp
base (Set String -> Exp) -> Set String -> Exp
forall a b. (a -> b) -> a -> b
$ [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
vars
    addAttrib :: String -> Exp -> Exp
addAttrib String
var = Exp -> Exp -> Exp
TH.AppE
        (Exp -> Exp -> Exp
TH.AppE (Exp -> Exp -> Exp
TH.AppE (Name -> Exp
TH.VarE (String -> Name
TH.mkName String
"Text.StringTemplate.setAttribute"))
                          (Lit -> Exp
TH.LitE (String -> Lit
TH.StringL (Char
'`' Char -> String -> String
forall a. a -> [a] -> [a]
: String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"`"))))
                 (Name -> Exp
TH.VarE (String -> Name
TH.mkName  String
var)))