module Text.StringTemplate.Helpers (
directoryGroupSafer
, directoryGroupsSafer
, dirgroupKeys
, lookupDirgroup
, renderTemplateGroup
, render1
, STDirGroups
, readTmplDef
, readTmplM
, readTmplTuples
)
where
import Text.StringTemplate
import Text.StringTemplate.Base
import System.Directory
import System.FilePath
import Control.Applicative
import Data.List (find)
import Data.Char
import Control.Monad.Reader
import HSH
import qualified Data.Map as M
import Text.StringTemplate.Classes
import Safe
renderTemplateGroup :: (ToSElem a) => STGroup String -> [(String, a)] -> [Char] -> String
renderTemplateGroup gr attrs tmpl =
maybe ( "template not found: " ++ tmpl )
( toString . setManyAttribSafer attrs )
( getStringTemplate tmpl gr )
renderTemplateGroupS :: STGroup String -> [(String, String)] -> [Char] -> String
renderTemplateGroupS = renderTemplateGroup
t :: IO [FilePath]
t = do (map :: M.Map FilePath (STGroup String)) <- ( directoryGroupsSafer "/home/thartman/testtemplates" )
return $ M.keys map
--getST
type STDirGroups a = M.Map FilePath (STGroup a)
directoryGroupsSafer :: (Stringable a) => FilePath -> IO (STDirGroups a)
directoryGroupsSafer d = bracketCD d $ (return . M.fromList =<< ) . ( mapM f =<< ) . findDirectories $ "."
where f d = do g <- directoryGroupSafer d
return (d,g)
dirgroupKeys :: (Stringable a) => STDirGroups a -> [FilePath]
dirgroupKeys = M.keys
lookupDirgroup :: (Stringable a) => FilePath -> STDirGroups a -> Maybe (STGroup a)
lookupDirgroup d = M.lookup d
directoryGroupSafer :: (Stringable a) => FilePath -> IO (STGroup a)
directoryGroupSafer path = groupStringTemplates <$>
(fmap <$> zip . (map dropExtension)
<*> mapM (newSTMP <$$> (readFile . (path </>)))
=<< mapM checkTmplName
=<< return . filter isTemplateFile
=<< getDirectoryContents path)
where checkTmplName t = if ( badTmplVarName . takeBaseName ) t
then fail $ "safeDirectoryGroup, bad template name: " ++ t
else return t
isTemplateFile f = ( (".st" ==) . takeExtension $ f )
&& (not . or . map (=='#') $ f )
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 :: String -> Bool
badTmplVarName t = or . map (not . isAlpha) $ t
render1 :: [(String,String)] -> String -> String
render1 attribs tmpl = render . setManyAttrib attribs . newSTMP $ tmpl
renderArrg name = do
(e :: StringTemplate String) <- return . newSTMP $ "aaarg, $name$"
named <- local $ setAttribute "name" name
return named
findDirectories :: FilePath -> IO [FilePath]
findDirectories d = runStrings $ render1 [("d",d)] "find $d$ -type d"
runS :: String -> IO String
runS = run
runStrings :: String -> IO [String]
runStrings = ( return . lines =<< ) . run
readTmplTuples :: STGroup String -> String -> [(String, String)]
readTmplTuples = readTmplDef [("readTutTuples error","")]
readTmplDef :: (Read b) => b -> STGroup String -> FilePath -> b
readTmplDef def ts f = either (const def) id ( readTmplM ts f :: Read a => Either String a)
readTmplM :: (Monad m, Read a) => STGroup String -> FilePath -> m a
readTmplM ts file = safeRead . renderTemplateGroup ts ([] :: [(String,String)] ) . concatMap escapequote $ file
where escapequote char = if char=='"' then "\\\"" else [char]
safeRead :: (Monad m, Read a) => String -> m a
safeRead s = maybe (fail $ "safeRead: " ++ s) return . readMay $ s