HStringTemplateHelpers 0.0.6 → 0.0.7

raw patch · 2 files changed

+40/−71 lines, 2 filesdep +FileManipPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: FileManip

API changes (from Hackage documentation)

Files

• HStringTemplateHelpers.cabal +2/−2
• Text/StringTemplate/Helpers.hs +38/−69

@@ -1,5 +1,5 @@ Name: HStringTemplateHelpers-Version: 0.0.6+Version: 0.0.7 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, containers, HSH, mtl, safe, strict+Build-Depends: base, HStringTemplate, filepath, directory, containers, HSH, mtl, safe, strict, FileManip Category: Text Build-type: Simple 

@@ -5,9 +5,10 @@  More usage examples can be found by grep -r \"Text.StringTemplate.Helpers\" in happs-tutorial, on hackage.  -}-module Text.StringTemplate.Helpers (-  directoryGroupSafer-  , directoryGroupsSafer+module Text.StringTemplate.Helpers  (+  directoryGroups'+  , directoryGroups+  , directoryGroups2   , dirgroupKeys   , getTemplateGroup   , renderTemplateDirGroup@@ -22,7 +23,7 @@  where -import Text.StringTemplate --hiding (directoryGroup)+import Text.StringTemplate  import Text.StringTemplate.Base import System.Directory import System.FilePath@@ -31,12 +32,12 @@ import Data.List (find) import Data.Char import Control.Monad.Reader-import HSH+import HSH (bracketCD) import qualified Data.Map as M import Text.StringTemplate.Classes import Safe--+import qualified System.FilePath.Find as Find+import System.FilePath {- |  Chooses a template from an STGroup, or errors if not found. @@ -63,9 +64,9 @@ --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+--t :: IO [FilePath]+--t = do (map :: M.Map FilePath (STGroup String)) <- ( directoryGroupsSafer "/home/thartman/testtemplates" )+--       return $ M.keys map   --getST@@ -81,24 +82,34 @@  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 $ do+directoryGroups = directoryGroups' directoryGroup+directoryGroups' :: (FilePath -> IO a) -> FilePath -> IO (M.Map FilePath a)+directoryGroups' f' d = bracketCD d $ do                            subDirs <- findDirectories $ "." -                           -- attempt to make strict, but doesn't make any difference-                           --putStrLn . show . last $ show subDirs                                                       return . M.fromList =<< mapM f subDirs                                  where -    f d = do g <- directoryGroupSafer d+    f d = do g <- f' d              return (d,g)-    -- this seems suspect. Perhaps try using the find module on hackage?  -    -- | wrapper over find \/path\/to\/top\/dir -type d-    findDirectories :: FilePath -> IO [FilePath]-    findDirectories d = runStrings $ render1 [("d",d)] "find $d$ -type d"-      where -        runStrings :: String -> IO [String]-        runStrings = ( return . lines =<< ) . run-+    findDirectories d = Find.find Find.always (Find.fileType Find.==? Find.Directory) d +directoryGroups2 = directoryGroups' directoryGroup2+{- | I think this does the same thing as directoryGroup (modulo IO strictness), +     which uses an applicative idiom that melts my brain. +     Not a direct translation, but it's easier for me to understand when written+     Important change: readFile is strict. If it is left lazy, appkiller.sh causes happstutorial to crash+     when in dynamicTemplateReload mode.+     I think this needs to be fixed in HStringTemplate distribution as well.+-}+directoryGroup2 :: Stringable a => FilePath -> IO (STGroup a)+directoryGroup2 path = do+    fs <- return . ( filter ((".st" ==) . takeExtension) ) =<< getDirectoryContents path+    templates <- mapM g fs+    stmapping <- return . zip (map dropExtension fs) $ templates+    return $ groupStringTemplates stmapping+    -- For a while when debugging a problem in HAppS I thought this had to be+    -- System.IO.Strict.ReadFile, but now I think it makes no difference+    where g f = do contents <- Strict.readFile $ path </> f+                   return . newSTMP $ contents  {- |  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.@@ -121,28 +132,6 @@   let ts = getTemplateGroup dir tdg    in  renderTemplateGroup ts attrs tname ----- | 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 :: FilePath -> IO (String -> StFirst (StringTemplate String) )-directoryGroupSafer path = do -  files <- mapM checkTmplName =<< return . filter isTemplateFile =<< getDirectoryContents path   -  contents <- mapM Strict.readFile $ map (path </>) files -  -- does this make it strict? what's the right way to do it?-  -- mm, the buggy behavior persists.-  --putStrLn . show . last . show $ contents -  let sts = map newSTMP contents-      tnames = map dropExtension files-  return $ groupStringTemplates $ zip tnames sts      -  where -    checkTmplName t = if  ( badTmplVarName . takeBaseName ) t -                            then fail $ "directoryGroupSafer, 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)@@ -150,7 +139,7 @@               mbFoundbadattr  (<$$>) :: (Functor f1, Functor f) => (a -> b) -> f (f1 a) -> f (f1 b)-(<$$>) = fmap . fmap+(<$$>) = (<$>) . (<$>)  badTmplVarName :: String -> Bool badTmplVarName t = or . map (not . isAlpha) $ t@@ -162,29 +151,7 @@ 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" ----{- | -> readTmplTuples = readTmplDef [("readTutTuples error","")]--use ST machinery to store key/val configuration information, eg as a configuration hack or in web apps--}-+-- useful for HAppS, eg for dynamic menus readTmplTuples :: STGroup String -> String -> [(String, String)] readTmplTuples = readTmplDef [("readTutTuples error","")] @@ -197,3 +164,5 @@  safeRead :: (Monad m, Read a) => String -> m a safeRead s = maybe (fail $ "safeRead: " ++ s) return . readMay $ s++