{-# LANGUAGE DeriveDataTypeable, QuasiQuotes #-}
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 {quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
quoteTmplExp, quotePat :: String -> Q Pat
quotePat = String -> Q Pat
quoteTmplPat}
quoteTmplPat :: String -> Q Pat
quoteTmplPat = forall a. HasCallStack => String -> a
error String
"Cannot apply stmp quasiquoter in patterns"
quoteTmplExp :: String -> Q Exp
quoteTmplExp String
s = 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 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ 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 = forall a b. (a -> b -> b) -> b -> Set a -> b
S.foldr String -> Exp -> Exp
addAttrib Exp
base forall a b. (a -> b) -> a -> b
$ 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
'`' forall a. a -> [a] -> [a]
: String
var forall a. [a] -> [a] -> [a]
++ String
"`"))))
(Name -> Exp
TH.VarE (String -> Name
TH.mkName String
var)))