module Text.StringTemplate.Helpers (
directoryGroupSafer
, renderTemplateGroup
, render1
)
where
import Text.StringTemplate hiding (directoryGroup)
import System.Directory
import System.FilePath
import Control.Applicative
import Data.List (find)
import Data.Char
renderTemplateGroup :: STGroup String -> [(String, String)] -> [Char] -> String
renderTemplateGroup gr attrs tmpl =
maybe ( "template not found: " ++ tmpl )
( toString . setManyAttribSafer attrs )
( getStringTemplate tmpl gr )
directoryGroupSafer :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroupSafer path = groupStringTemplates <$>
(fmap <$> zip . (map dropExtension)
<*> mapM (newSTMP <$$> (readFile . (path </>)))
=<< mapM checkTmplName
=<< return . filter (not . or . map (=='#') )
. filter ( (".st" ==) . takeExtension )
=<< getDirectoryContents path)
where checkTmplName t = if ( badTmplVarName . takeBaseName ) t
then fail $ "safeDirectoryGroup, bad template name: " ++ t
else return t
setManyAttribSafer attrs st =
let mbFoundbadattr = find badTmplVarName . map fst $ attrs
in maybe (setManyAttrib attrs st)
(\mbA -> newSTMP . ("setManyAttribSafer, bad template atr: "++) $ mbA)
mbFoundbadattr
(<$$>) :: (Functor f1, Functor f) => (a -> b) -> f (f1 a) -> f (f1 b)
(<$$>) x y = ((<$>) . (<$>)) x y
badTmplVarName t = or . map (not . isAlpha) $ t
render1 :: [(String,String)] -> String -> String
render1 attribs tmpl = render . setManyAttrib attribs . newSTMP $ tmpl