HStringTemplateHelpers 0.0.2 → 0.0.3

raw patch · 2 files changed

+129/−17 lines, 2 filesdep +HSHdep +containersdep +mtlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HSH, containers, mtl, safe

API changes (from Hackage documentation)

Files

• HStringTemplateHelpers.cabal +2/−2
• Text/StringTemplate/Helpers.hs +127/−15

@@ -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 

@@ -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