diff --git a/HStringTemplateHelpers.cabal b/HStringTemplateHelpers.cabal --- a/HStringTemplateHelpers.cabal +++ b/HStringTemplateHelpers.cabal @@ -1,5 +1,5 @@ Name: HStringTemplateHelpers -Version: 0.0.2 +Version: 0.0.3 License: GPL License-file: gpl.txt Description: Convenience functions and instances for HStringTemplate. I will deprecate this package if its contents are integrated into HStringTemplate. @@ -9,7 +9,7 @@ Stability: Beta Copyright: Copyright (c) 2006-2008 Thomas Hartman Exposed-Modules: Text.StringTemplate.Helpers -Build-Depends: base, HStringTemplate, filepath, directory +Build-Depends: base, HStringTemplate, filepath, directory, containers, HSH, mtl, safe Category: Text Build-type: Simple diff --git a/Text/StringTemplate/Helpers.hs b/Text/StringTemplate/Helpers.hs --- a/Text/StringTemplate/Helpers.hs +++ b/Text/StringTemplate/Helpers.hs @@ -1,47 +1,111 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, NoMonomorphismRestriction, + ScopedTypeVariables, UndecidableInstances #-} +{- | +Functions I found useful for doing webapps with HStringTemplate. + +More usage examples can be found by grep -r \"Text.StringTemplate.Helpers\" in happs-tutorial, on hackage. +-} module Text.StringTemplate.Helpers ( directoryGroupSafer + , directoryGroupsSafer + , dirgroupKeys + , lookupDirgroup , renderTemplateGroup , render1 + , STDirGroups + , readTmplDef + , readTmplM + , readTmplTuples ) where -import Text.StringTemplate hiding (directoryGroup) +import Text.StringTemplate --hiding (directoryGroup) +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 +{- | +Chooses a template from an STGroup, or errors if not found. +Render that template using attrs. --- Chooses a template from an STGroup, or errors if not found. --- Renders that template uses attrs, and gives the string. --- if you don't clean and a template k/v pair is repeated, it appears twice. --- Possibly this should be a fix inside StringTemplate. Tell sclv? --- what is the expected StringTemplate behavior according to the original program? ---clean = nubBy (\(a1,b1) (a2,b2) -> a1 == a2) . sortBy (\(a1,b1) (a2,b2) -> a1 `compare` a2) --- but then again, why should a key be repeated twice? maybe showing a repeat is a good thing --- as it indicates buggy behavior --- The ToSElem type is probably either String or [String] ---renderTemplateGroup :: (ToSElem a) => STGroup String -> [(String, a)] -> [Char] -> String -renderTemplateGroup :: STGroup String -> [(String, String)] -> [Char] -> String +If a template k/v pair is repeated, it appears twice. (Perhaps a clue to buggy behavior?) + +Repeated keys could be eliminated by running clean: + +> clean = nubBy (\(a1,b1) (a2,b2) -> a1 == a2) . sortBy (\(a1,b1) (a2,b2) -> a1 `compare` a2) + +The ToSElem type is probably either String or [String] +-} +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 + +-- can this be done for Bytestrings? Below doesn't work, need an instance for (ToSElem B.ByteString) +--renderTemplateGroupB :: STGroup String -> [(String, B.ByteString)] -> [Char] -> String +--renderTemplateGroupB = 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) + +{- | +calculate a map of directory groups from a top-level directory + +Each directory gives rise to its own groups. + +Groups are independent; groups from higher in the directory structure do not have access to groups lower. + +The top group has key \".\" (mnemonic, current directory), other groups have key names of subdirectories, including the starting ., eg \".\/templates\/path\/to/\subdir\" +-} +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) + +{- | +The STGroup can't be shown in a useful way because it's a function type, but you can at least show the directories via Data.Map.keys. +-} +dirgroupKeys :: (Stringable a) => STDirGroups a -> [FilePath] +dirgroupKeys = M.keys + +lookupDirgroup :: (Stringable a) => FilePath -> STDirGroups a -> Maybe (STGroup a) +lookupDirgroup d = M.lookup d + +-- | calculate the STGroup for a given directory, filtering out files that are probably errors (eg emacs backups) 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 (=='#') {-naughty emacs backup character-} ) - . filter ( (".st" ==) . takeExtension ) + =<< 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 ) {-filename doesn't contain naughty emacs backup character-} + + setManyAttribSafer attrs st = let mbFoundbadattr = find badTmplVarName . map fst $ attrs in maybe (setManyAttrib attrs st) @@ -51,8 +115,56 @@ (<$$>) :: (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 [("name","Bill")] "Hi, my name is $name$" +> render1 attribs tmpl = render . setManyAttrib attribs . newSTMP $ tmpl +-} render1 :: [(String,String)] -> String -> String render1 attribs tmpl = render . setManyAttrib attribs . newSTMP $ tmpl + + +--type StringTemplateReader a = ReaderT (StringTemplate a) + + +--t :: (Stringable a, Monad m) => ReaderT (StringTemplate a) m a +--renderArrg :: String -> ReaderT (StringTemplate String) IO (StringTemplate String) +renderArrg name = do + (e :: StringTemplate String) <- return . newSTMP $ "aaarg, $name$" + named <- local $ setAttribute "name" name + return named + + +--t2 :: IO String +--t2 = renderArrg "Matey" + +-- | wrapper over find \/path\/to\/top\/dir -type d +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 = readTmplDef [("readTutTuples error","")] + +use ST machinery to store key/val configuration information, eg as a configuration hack or in web apps +-} + +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