heist 0.5.3 → 0.6.0

raw patch · 11 files changed

+241/−154 lines, 11 filesdep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers

API changes (from Hackage documentation)

Files

• README.SNAP.md +7/−21
• README.md +4/−4
• heist.cabal +2/−2
• src/Text/Templating/Heist.hs +14/−10
• src/Text/Templating/Heist/Internal.hs +91/−63
• src/Text/Templating/Heist/Splices/Apply.hs +3/−3
• src/Text/Templating/Heist/Splices/Cache.hs +24/−15
• src/Text/Templating/Heist/Splices/Markdown.hs +19/−5
• src/Text/Templating/Heist/Splices/Static.hs +2/−1
• src/Text/Templating/Heist/Types.hs +47/−14
• test/suite/Text/Templating/Heist/Tests.hs +28/−16

@@ -16,16 +16,16 @@    * a sensible and clean monad for web programming -  * an xml-based templating system for generating HTML based on-    [expat](http://expat.sourceforge.net/) (via-    [hexpat](http://hackage.haskell.org/package/hexpat)) that allows you to-    bind Haskell functionality to XML tags without getting PHP-style tag soup-    all over your pants+  * an xml-based templating system for generating HTML that allows you to bind+    Haskell functionality to XML tags without getting PHP-style tag soup all+    over your pants -Snap currently only runs on Unix platforms; it has been tested on Linux and Mac-OSX Snow Leopard.+  * a "snaplet" system for building web sites from composable pieces. +Snap is currently only officially supported on Unix platforms; it has been+tested on Linux and Mac OSX Snow Leopard, and is reported to work on Windows. + Snap Philosophy --------------- @@ -40,17 +40,3 @@   * Excellent documentation    * Robustness and high test coverage---Snap Roadmap---------------Where are we going?--1. First prerelease: HTTP server, monad, template system--2. Second prerelease: component system with a collection of useful stock-modules (called "Snaplets") for things like user and session management,-caching, an administrative interface, etc.--3. Third prerelease: where we figure out what to do about data access

@@ -1,9 +1,9 @@ # Heist -Heist, part of the [Snap Framework](http://www.snapframework.com/), is a -Haskell library for xhtml templating. It uses simple XML tags to bind values-to your templates in a straightforward way. For example, if you were to put-the following in a template:+Heist, part of the [Snap Framework](http://www.snapframework.com/), is a+Haskell library for xml/html templating. It uses simple XML tags to bind+values to your templates in a straightforward way. For example, if you were to+put the following in a template:      <bind tag="message">some text</bind>     <p><message/></p>

@@ -1,5 +1,5 @@ name:           heist-version:        0.5.3+version:        0.6.0 synopsis:       An xhtml templating system description:    An xhtml templating system license:        BSD3@@ -86,7 +86,7 @@     base >= 4 && < 5,     blaze-builder >= 0.2 && <0.4,     bytestring,-    containers,+    containers >= 0.2 && < 0.5,     directory,     directory-tree,     filepath,

@@ -13,7 +13,7 @@   of as functions that transform a node into a list of nodes.  Heist then   substitutes the resulting list of nodes into your template in place of the   input node.  'Splice' is implemented as a type synonym @type Splice m =-  TemplateMonad m [Node]@, and 'TemplateMonad' has a function 'getParamNode'+  HeistT m [Node]@, and 'HeistT' has a function 'getParamNode'   that lets you get the input node.    Suppose you have a place on your page where you want to display a link with@@ -73,7 +73,10 @@   , MIMEType   , Splice   , TemplateMonad+  , HeistT   , TemplateState+  , templateNames+  , spliceNames      -- * Functions and declarations on TemplateState values   , addTemplate@@ -93,11 +96,12 @@   , addPreRunHook   , addPostRunHook -    -- * TemplateMonad functions+    -- * HeistT functions   , stopRecursion   , getParamNode   , runNodeList   , getContext+  , getTemplateFilePath    , localParamNode   , getsTS@@ -127,7 +131,7 @@     -- * Misc functions   , getDoc   , getXMLDoc-  , bindStaticTag+  , mkCacheTag    ) where @@ -140,12 +144,12 @@  ------------------------------------------------------------------------------ -- | The default set of built-in splices.-defaultSpliceMap :: MonadIO m => FilePath -> SpliceMap m-defaultSpliceMap templatePath = Map.fromList+defaultSpliceMap :: MonadIO m => SpliceMap m+defaultSpliceMap = Map.fromList     [(applyTag, applyImpl)     ,(bindTag, bindImpl)     ,(ignoreTag, ignoreImpl)-    ,(markdownTag, markdownSplice templatePath)+    ,(markdownTag, markdownSplice)     ]  @@ -153,10 +157,10 @@ -- | An empty template state, with Heist's default splices (@\<apply\>@, -- @\<bind\>@, @\<ignore\>@, and @\<markdown\>@) mapped.  The static tag is -- not mapped here because it must be mapped manually in your application.-emptyTemplateState :: MonadIO m => FilePath -> TemplateState m-emptyTemplateState templatePath =-    TemplateState (defaultSpliceMap templatePath) Map.empty-                  True [] 0 return return return []+emptyTemplateState :: MonadIO m => TemplateState m+emptyTemplateState =+    TemplateState (defaultSpliceMap) Map.empty True [] 0+                  return return return [] Nothing   -- $hookDoc

@@ -35,7 +35,7 @@  ------------------------------------------------------------------------------ -- | Mappends a doctype to the state.-addDoctype :: Monad m => [X.DocType] -> TemplateMonad m ()+addDoctype :: Monad m => [X.DocType] -> HeistT m () addDoctype dt = do     modifyTS (\s -> s { _doctypes = _doctypes s `mappend` dt }) @@ -94,6 +94,13 @@   ------------------------------------------------------------------------------+-- | Sets the current template file.+setCurTemplateFile :: Monad m+                   => Maybe FilePath -> TemplateState m -> TemplateState m+setCurTemplateFile fp ts = ts { _curTemplateFile = fp }+++------------------------------------------------------------------------------ -- | Converts 'Text' to a splice returning a single 'TextNode'. textSplice :: (Monad m) => Text -> Splice m textSplice t = return [X.TextNode t]@@ -120,8 +127,8 @@   --------------------------------------------------------------------------------- | Wrapper around runChildrenWith that applies a transformation function to the--- second item in each of the tuples before calling runChildrenWith.+-- | Wrapper around runChildrenWith that applies a transformation function to+-- the second item in each of the tuples before calling runChildrenWith. runChildrenWithTrans :: (Monad m)           => (b -> Splice m)           -- ^ Splice generating function@@ -195,7 +202,7 @@ singleLookup :: TemplateMap              -> TPath              -> ByteString-             -> Maybe (X.Document, TPath)+             -> Maybe (DocumentFile, TPath) singleLookup tm path name = fmap (\a -> (a,path)) $ Map.lookup (name:path) tm  @@ -205,7 +212,7 @@ traversePath :: TemplateMap              -> TPath              -> ByteString-             -> Maybe (X.Document, TPath)+             -> Maybe (DocumentFile, TPath) traversePath tm [] name = fmap (\a -> (a,[])) (Map.lookup [name] tm) traversePath tm path name =     singleLookup tm path name `mplus`@@ -226,7 +233,7 @@ lookupTemplate :: Monad m =>                   ByteString                -> TemplateState m-               -> Maybe (X.Document, TPath)+               -> Maybe (DocumentFile, TPath) lookupTemplate nameStr ts =     f (_templateMap ts) path name   where (name:p) = case splitTemplatePath nameStr of@@ -249,7 +256,7 @@ -- | Adds a template to the template state. insertTemplate :: Monad m =>                TPath-            -> X.Document+            -> DocumentFile             -> TemplateState m             -> TemplateState m insertTemplate p t st =@@ -258,24 +265,38 @@  ------------------------------------------------------------------------------ -- | Adds an HTML format template to the template state.-addTemplate :: Monad m =>-               ByteString+addTemplate :: Monad m+            => ByteString+            -- ^ Path that the template will be referenced by             -> Template+            -- ^ The template's DOM nodes+            -> Maybe FilePath+            -- ^ An optional path to the actual file on disk where the+            -- template is stored             -> TemplateState m             -> TemplateState m-addTemplate n t st = insertTemplate (splitTemplatePath n)-                                    (X.HtmlDocument X.UTF8 Nothing t) st+addTemplate n t mfp st =+    insertTemplate (splitTemplatePath n) doc st+  where+    doc = DocumentFile (X.HtmlDocument X.UTF8 Nothing t) mfp   ------------------------------------------------------------------------------ -- | Adds an XML format template to the template state.-addXMLTemplate :: Monad m =>-                  ByteString+addXMLTemplate :: Monad m+               => ByteString+               -- ^ Path that the template will be referenced by                -> Template+               -- ^ The template's DOM nodes+               -> Maybe FilePath+               -- ^ An optional path to the actual file on disk where the+               -- template is stored                -> TemplateState m                -> TemplateState m-addXMLTemplate n t st = insertTemplate (splitTemplatePath n)-                                       (X.XmlDocument X.UTF8 Nothing t) st+addXMLTemplate n t mfp st =+    insertTemplate (splitTemplatePath n) doc st+  where+    doc = DocumentFile (X.XmlDocument X.UTF8 Nothing t) mfp   ------------------------------------------------------------------------------@@ -292,23 +313,31 @@ -- splice will result in a list of nodes @L@.  Normally @foo@ will recursively -- scan @L@ for splices and run them.  If @foo@ calls @stopRecursion@, @L@ -- will be included in the output verbatim without running any splices.-stopRecursion :: Monad m => TemplateMonad m ()+stopRecursion :: Monad m => HeistT m () stopRecursion = modifyTS (\st -> st { _recurse = False })   ------------------------------------------------------------------------------ -- | Sets the current context-setContext :: Monad m => TPath -> TemplateMonad m ()+setContext :: Monad m => TPath -> HeistT m () setContext c = modifyTS (\st -> st { _curContext = c })   ------------------------------------------------------------------------------ -- | Gets the current context-getContext :: Monad m => TemplateMonad m TPath+getContext :: Monad m => HeistT m TPath getContext = getsTS _curContext   ------------------------------------------------------------------------------+-- | Gets the full path to the file holding the template currently being+-- processed.  Returns Nothing if the template is not associated with a file+-- on disk or if there is no template being processed.+getTemplateFilePath :: Monad m => HeistT m (Maybe FilePath)+getTemplateFilePath = getsTS _curTemplateFile+++------------------------------------------------------------------------------ -- | Performs splice processing on a single node. runNode :: Monad m => X.Node -> Splice m runNode (X.Element nm at ch) = do@@ -326,7 +355,7 @@ ------------------------------------------------------------------------------ -- | Helper function for substituting a parsed attribute into an attribute -- tuple.-attSubst :: (Monad m) => (t, Text) -> TemplateMonad m (t, Text)+attSubst :: (Monad m) => (t, Text) -> HeistT m (t, Text) attSubst (n,v) = do     v' <- parseAtt v     return (n,v')@@ -335,7 +364,7 @@ ------------------------------------------------------------------------------ -- | Parses an attribute for any identifier expressions and performs -- appropriate substitution.-parseAtt :: (Monad m) => Text -> TemplateMonad m Text+parseAtt :: (Monad m) => Text -> HeistT m Text parseAtt bs = do     let ast = case AP.feed (AP.parse attParser bs) "" of             (AP.Fail _ _ _) -> []@@ -390,7 +419,7 @@ -- it would be for the former user to accept that -- \"some \<b\>text\<\/b\> foobar\" is being rendered as \"some \" because -- it's \"more intuitive\".-getAttributeSplice :: Monad m => Text -> TemplateMonad m Text+getAttributeSplice :: Monad m => Text -> HeistT m Text getAttributeSplice name = do     s <- liftM (lookupSplice name) getTS     nodes <- maybe (return []) id s@@ -422,37 +451,39 @@                 return res         else return result   where-    modRecursionDepth :: Monad m => (Int -> Int) -> TemplateMonad m ()+    modRecursionDepth :: Monad m => (Int -> Int) -> HeistT m ()     modRecursionDepth f =         modifyTS (\st -> st { _recursionDepth = f (_recursionDepth st) })   --------------------------------------------------------------------------------- | Looks up a template name runs a TemplateMonad computation on it.+-- | Looks up a template name runs a 'HeistT' computation on it. lookupAndRun :: Monad m              => ByteString-             -> ((X.Document, TPath) -> TemplateMonad m (Maybe a))-             -> TemplateMonad m (Maybe a)+             -> ((DocumentFile, TPath) -> HeistT m (Maybe a))+             -> HeistT m (Maybe a) lookupAndRun name k = do     ts <- getTS-    maybe (return Nothing) k-          (lookupTemplate name ts)+    let mt = lookupTemplate name ts+    let curPath = join $ fmap (dfFile . fst) mt+    modifyTS (setCurTemplateFile curPath)+    maybe (return Nothing) k mt   ------------------------------------------------------------------------------ -- | Looks up a template name evaluates it by calling runNodeList. evalTemplate :: Monad m             => ByteString-            -> TemplateMonad m (Maybe Template)+            -> HeistT m (Maybe Template) evalTemplate name = lookupAndRun name     (\(t,ctx) -> localTS (\ts -> ts {_curContext = ctx})-                         (liftM Just $ runNodeList $ X.docContent t))+                         (liftM Just $ runNodeList $ X.docContent $ dfDoc t))   --------------------------------------------------------------------------------- | Sets the document type of a 'X.Document' based on the 'TemplateMonad'+-- | Sets the document type of a 'X.Document' based on the 'HeistT' -- value.-fixDocType :: Monad m => X.Document -> TemplateMonad m X.Document+fixDocType :: Monad m => X.Document -> HeistT m X.Document fixDocType d = do     dts <- getsTS _doctypes     return $ d { X.docType = listToMaybe dts }@@ -464,16 +495,16 @@ -- top level. evalWithHooksInternal :: Monad m                       => ByteString-                      -> TemplateMonad m (Maybe X.Document)+                      -> HeistT m (Maybe X.Document) evalWithHooksInternal name = lookupAndRun name $ \(t,ctx) -> do-    addDoctype $ maybeToList $ X.docType t+    addDoctype $ maybeToList $ X.docType $ dfDoc t     ts <- getTS-    nodes <- lift $ _preRunHook ts $ X.docContent t+    nodes <- lift $ _preRunHook ts $ X.docContent $ dfDoc t     putTS (ts {_curContext = ctx})     res <- runNodeList nodes     restoreTS ts     newNodes <- lift (_postRunHook ts res)-    newDoc   <- fixDocType $ t { X.docContent = newNodes }+    newDoc   <- fixDocType $ (dfDoc t) { X.docContent = newNodes }     return (Just newDoc)  @@ -482,7 +513,7 @@ -- executes pre- and post-run hooks and adds the doctype. evalWithHooks :: Monad m             => ByteString-            -> TemplateMonad m (Maybe Template)+            -> HeistT m (Maybe Template) evalWithHooks name = liftM (liftM X.docContent) (evalWithHooksInternal name)  @@ -513,7 +544,7 @@              => ByteString     -- ^ The name of the template              -> [(Text, Text)] -- ^ Association list of                                -- (name,value) parameter pairs-             -> TemplateMonad m (Maybe Template)+             -> HeistT m (Maybe Template) callTemplate name params = do     modifyTS $ bindStrings params     evalTemplate name@@ -575,40 +606,34 @@  ------------------------------------------------------------------------------ -- | Reads an HTML or XML template from disk.-getDocWith :: ParserFun -> String -> IO (Either String X.Document)+getDocWith :: ParserFun -> String -> IO (Either String DocumentFile) getDocWith parser f = do     bs <- catch (liftM Right $ B.readFile f)                 (\(e::SomeException) -> return $ Left $ show e) -    let d = either Left (parser f) bs-    return $ mapLeft (\s -> f ++ " " ++ s) d+    let eitherDoc = either Left (parser f) bs+    return $ either (\s -> Left $ f ++ " " ++ s)+                    (\d -> Right $ DocumentFile d (Just f)) eitherDoc   ------------------------------------------------------------------------------ -- | Reads an HTML template from disk.-getDoc :: String -> IO (Either String X.Document)+getDoc :: String -> IO (Either String DocumentFile) getDoc = getDocWith X.parseHTML   ------------------------------------------------------------------------------ -- | Reads an XML template from disk.-getXMLDoc :: String -> IO (Either String X.Document)+getXMLDoc :: String -> IO (Either String DocumentFile) getXMLDoc = getDocWith X.parseHTML   -------------------------------------------------------------------------------mapLeft :: (a -> b) -> Either a c -> Either b c-mapLeft g = either (Left . g) Right-mapRight :: (b -> c) -> Either a b -> Either a c-mapRight g = either Left (Right . g)--------------------------------------------------------------------------------- -- | Loads a template with the specified path and filename.  The -- template is only loaded if it has a ".tpl" or ".xtpl" extension. loadTemplate :: String -- ^ path of the template root              -> String -- ^ full file path (includes the template root)-             -> IO [Either String (TPath, X.Document)] --TemplateMap+             -> IO [Either String (TPath, DocumentFile)] --TemplateMap loadTemplate templateRoot fname     | isHTMLTemplate = do         c <- getDoc fname@@ -642,19 +667,19 @@   --------------------------------------------------------------------------------- | Reversed list of directories.  This holds the path to the template+-- | Runs a template modifying function on a DocumentFile. runHook :: Monad m => (Template -> m Template)-        -> X.Document-        -> m X.Document+        -> DocumentFile+        -> m DocumentFile runHook f t = do-    n <- f $ X.docContent t-    return $ t { X.docContent = n }+    n <- f $ X.docContent $ dfDoc t+    return $ t { dfDoc = (dfDoc t) { X.docContent = n } }   --------------------------------------------------------------------------------- | Runs the onLoad hook on the template and returns the `TemplateState`+-- | Runs the onLoad hook on the template and returns the 'TemplateState' -- with the result inserted.-loadHook :: Monad m => TemplateState m -> (TPath, X.Document)+loadHook :: Monad m => TemplateState m -> (TPath, DocumentFile)          -> IO (TemplateState m) loadHook ts (tp, t) = do     t' <- runHook (_onLoadHook ts) t@@ -662,11 +687,14 @@   --------------------------------------------------------------------------------- | -addTemplatePathPrefix :: ByteString-                      -> TemplateState m -> TemplateState m-addTemplatePathPrefix dir ts =-    ts { _templateMap = Map.mapKeys f $ _templateMap ts }+-- | Adds a path prefix to all the templates in the 'TemplateState'.  If you+-- want to add multiple levels of directories, separate them with slashes as+-- in "foo/bar".  Using an empty string as a path prefix will leave the+-- 'TemplateState' unchanged.+addTemplatePathPrefix :: ByteString -> TemplateState m -> TemplateState m+addTemplatePathPrefix dir ts+  | B.null dir = ts+  | otherwise  = ts { _templateMap = Map.mapKeys f $ _templateMap ts }   where-    f ps = ps ++ [dir]+    f ps = ps++splitTemplatePath dir 

@@ -29,7 +29,7 @@          => [X.Node]          -> TPath          -> [X.Node]-         -> TemplateMonad m Template+         -> HeistT m Template rawApply calledNodes newContext paramNodes = do     st <- getTS  -- Can't use localTS here because the modifier is not pure     processedParams <- runNodeList paramNodes@@ -48,8 +48,8 @@     st <- getTS     maybe (return []) -- TODO: error handling           (\(t,ctx) -> do-              addDoctype $ maybeToList $ X.docType t-              rawApply (X.docContent t) ctx nodes)+              addDoctype $ maybeToList $ X.docType $ dfDoc t+              rawApply (X.docContent $ dfDoc t) ctx nodes)           (lookupTemplate (T.encodeUtf8 template) st)  

@@ -11,7 +11,6 @@ import           Data.IORef import qualified Data.Map as Map import           Data.Map (Map)-import           Data.Maybe import qualified Data.Set as Set import           Data.Text (Text) import qualified Data.Text as T@@ -27,9 +26,11 @@ import           Text.Templating.Heist.Types  +------------------------------------------------------------------------------ cacheTagName :: Text cacheTagName = "cache" + ------------------------------------------------------------------------------ -- | State for storing cache tag information newtype CacheTagState = CTS (MVar (Map Text (UTCTime, Template)))@@ -55,7 +56,7 @@         'd' -> 86400         'w' -> 604800         _   -> 0-        + ------------------------------------------------------------------------------ -- | The \"cache\" splice ensures that its contents are cached and only -- evaluated periodically.  The cached contents are returned every time the@@ -69,24 +70,27 @@ -- clearCacheTagState. cacheImpl :: (MonadIO m)            => CacheTagState-           -> TemplateMonad m Template+           -> HeistT m Template cacheImpl (CTS mv) = do     tree <- getParamNode-    let i = fromJust $ getAttribute "id" tree+    let err = error $ unwords ["cacheImpl is bound to a tag"+                              ,"that didn't get an id attribute."+                              ," This should never happen."]+    let i = maybe err id $ getAttribute "id" tree         ttl = maybe 0 parseTTL $ getAttribute "ttl" tree     mp <- liftIO $ readMVar mv      (mp',ns) <- do-                   curTime <- liftIO getCurrentTime+                   cur <- liftIO getCurrentTime                    let mbn = Map.lookup i mp                        reload = do                            nodes' <- runNodeList $ childNodes tree-                           return $! (Map.insert i (curTime,nodes') mp, nodes')+                           return $! (Map.insert i (cur,nodes') mp, nodes')                    case mbn of                        Nothing -> reload                        (Just (lastUpdate,n)) -> do-                           if ttl > 0 &&-                              diffUTCTime curTime lastUpdate > fromIntegral ttl+                           if ttl > 0 && tagName tree == Just cacheTagName &&+                              diffUTCTime cur lastUpdate > fromIntegral ttl                              then reload                              else do                                  stopRecursion@@ -98,18 +102,22 @@   --------------------------------------------------------------------------------- | Modifies a TemplateState to include a \"cache\" tag.  The cache tag is--- not bound automatically with the other default Heist tags.  This is because--- this function also returns CacheTagState, so the user will be able to--- clear it with the 'clearCacheTagState' function.+-- | Returns a function that modifies a TemplateState to include a \"cache\"+-- tag.  The cache tag is not bound automatically with the other default Heist+-- tags.  This is because this function also returns CacheTagState, so the+-- user will be able to clear it with the 'clearCacheTagState' function. mkCacheTag :: MonadIO m            => IO (TemplateState m -> TemplateState m, CacheTagState) mkCacheTag = do     sr <- newIORef $ Set.empty     mv <- liftM CTS $ newMVar Map.empty -    return $ (addOnLoadHook (assignIds sr) .-              bindSplice cacheTagName (cacheImpl mv), mv)+    return $ ( addOnLoadHook (assignIds sr) .+               -- The cache tag allows the ttl attribute.+               bindSplice cacheTagName (cacheImpl mv) .+               -- Like the old static tag...does not allow ttl+               bindSplice "static" (cacheImpl mv)+             , mv)    where     generateId :: IO Int@@ -130,7 +138,8 @@            g curs = do               let node = current curs-              curs' <- if tagName node == Just cacheTagName+              curs' <- if tagName node == Just cacheTagName ||+                          tagName node == Just "static"                          then do                              i <- getId                              return $ modifyNode (setAttribute "id" i) curs

@@ -25,6 +25,7 @@ import           Text.XmlHtml  ------------------------------------------------------------------------------+import           Text.Templating.Heist.Internal import           Text.Templating.Heist.Types  data PandocMissingException = PandocMissingException@@ -47,6 +48,16 @@ instance Exception MarkdownException  +data NoMarkdownFileException = NoMarkdownFileException+    deriving (Typeable)++instance Show NoMarkdownFileException where+    show NoMarkdownFileException =+        "Markdown error: no file or template in context" +++        " during processing of markdown tag"++instance Exception NoMarkdownFileException where+ ------------------------------------------------------------------------------ -- | Default name for the markdown splice. markdownTag :: Text@@ -54,8 +65,9 @@  ------------------------------------------------------------------------------ -- | Implementation of the markdown splice.-markdownSplice :: MonadIO m => FilePath -> Splice m-markdownSplice templatePath = do+markdownSplice :: MonadIO m => Splice m+markdownSplice = do+    templateDir <- liftM (fmap takeDirectory) getTemplateFilePath     pdMD <- liftIO $ findExecutable "pandoc"      when (isNothing pdMD) $ liftIO $ throwIO PandocMissingException@@ -64,7 +76,9 @@     (source,markup) <- liftIO $         case getAttribute "file" tree of             Just f  -> do-                m <- pandoc (fromJust pdMD) templatePath $ T.unpack f+                m <- maybe (liftIO $ throwIO NoMarkdownFileException )+                           (\tp -> pandoc (fromJust pdMD) tp $ T.unpack f)+                           templateDir                 return (T.unpack f,m)             Nothing -> do                 m <- pandocBS (fromJust pdMD) $ T.encodeUtf8 $ nodeText tree@@ -78,7 +92,7 @@   pandoc :: FilePath -> FilePath -> FilePath -> IO ByteString-pandoc pandocPath templatePath inputFile = do+pandoc pandocPath templateDir inputFile = do     (ex, sout, serr) <- readProcessWithExitCode' pandocPath args ""      when (isFail ex) $ throw $ MarkdownException serr@@ -90,7 +104,7 @@     isFail ExitSuccess = False     isFail _           = True -    args = [ "-S", "--no-wrap", templatePath </> inputFile ]+    args = [ "-S", "--no-wrap", templateDir </> inputFile ]   pandocBS :: FilePath -> ByteString -> IO ByteString

@@ -1,4 +1,5 @@ module Text.Templating.Heist.Splices.Static+{-# DEPRECATED "This will go away in the future.  Use the cache splice instead." #-}   ( StaticTagState   , bindStaticTag   , clearStaticTagCache@@ -43,7 +44,7 @@ -- referenced. staticImpl :: (MonadIO m)            => StaticTagState-           -> TemplateMonad m Template+           -> HeistT m Template staticImpl (STS mv) = do     tree <- getParamNode     let i = fromJust $ getAttribute "id" tree

@@ -23,6 +23,7 @@ ------------------------------------------------------------------------------ import             Control.Applicative import             Control.Arrow+import             Control.Monad.CatchIO import             Control.Monad.Cont import             Control.Monad.Error import             Control.Monad.Reader@@ -55,9 +56,14 @@ type TPath = [ByteString]  +data DocumentFile = DocumentFile+    { dfDoc  :: X.Document+    , dfFile :: Maybe FilePath+    } deriving (Eq)+ ------------------------------------------------------------------------------ -- | All documents representing templates are stored in a map.-type TemplateMap = Map TPath X.Document+type TemplateMap = Map TPath DocumentFile   ------------------------------------------------------------------------------@@ -77,41 +83,56 @@ -- @TemplateState@ in calls to @renderTemplate@. data TemplateState m = TemplateState {     -- | A mapping of splice names to splice actions-      _spliceMap      :: SpliceMap m+      _spliceMap       :: SpliceMap m     -- | A mapping of template names to templates-    , _templateMap    :: TemplateMap+    , _templateMap     :: TemplateMap     -- | A flag to control splice recursion-    , _recurse        :: Bool+    , _recurse         :: Bool     -- | The path to the template currently being processed.-    , _curContext     :: TPath+    , _curContext      :: TPath     -- | A counter keeping track of the current recursion depth to prevent     -- infinite loops.-    , _recursionDepth :: Int+    , _recursionDepth  :: Int     -- | A hook run on all templates at load time.-    , _onLoadHook     :: Template -> IO Template+    , _onLoadHook      :: Template -> IO Template     -- | A hook run on all templates just before they are rendered.-    , _preRunHook     :: Template -> m Template+    , _preRunHook      :: Template -> m Template     -- | A hook run on all templates just after they are rendered.-    , _postRunHook    :: Template -> m Template+    , _postRunHook     :: Template -> m Template     -- | The doctypes encountered during template processing.-    , _doctypes       :: [X.DocType]+    , _doctypes        :: [X.DocType]+    -- | The full path to the current template's file on disk.+    , _curTemplateFile :: Maybe FilePath }   ------------------------------------------------------------------------------+-- | Gets the names of all the templates defined in a TemplateState.+templateNames :: TemplateState m -> [TPath]+templateNames ts = Map.keys $ _templateMap ts+++------------------------------------------------------------------------------+-- | Gets the names of all the splices defined in a TemplateState.+spliceNames :: TemplateState m -> [Text]+spliceNames ts = Map.keys $ _spliceMap ts+++------------------------------------------------------------------------------ instance (Monad m) => Monoid (TemplateState m) where     mempty = TemplateState Map.empty Map.empty True [] 0-                           return return return []+                           return return return [] Nothing -    (TemplateState s1 t1 r1 _ d1 o1 b1 a1 dt1) `mappend`-        (TemplateState s2 t2 r2 c2 d2 o2 b2 a2 dt2) =+    (TemplateState s1 t1 r1 _ d1 o1 b1 a1 dt1 ctf1) `mappend`+        (TemplateState s2 t2 r2 c2 d2 o2 b2 a2 dt2 ctf2) =         TemplateState s t r c2 d (o1 >=> o2) (b1 >=> b2) (a1 >=> a2)-            (dt1 `mappend` dt2)+            (dt1 `mappend` dt2) ctf       where         s = s1 `mappend` s2         t = t1 `mappend` t2         r = r1 && r2         d = max d1 d2+        ctf = getLast $ Last ctf1 `mappend` Last ctf2   ------------------------------------------------------------------------------@@ -132,6 +153,7 @@     typeOf _ = mkTyConApp templateStateTyCon [typeOf1 (undefined :: m ())]  +{-# DEPRECATED TemplateMonad "NOTICE: The name TemplateMonad is being phased out in favor of the more appropriate HeistT.  Change your code now to prevent breakage in the future!" #-} ------------------------------------------------------------------------------ -- | TemplateMonad is the monad used for 'Splice' processing.  TemplateMonad -- provides \"passthrough\" instances for many of the monads you might use in@@ -141,6 +163,7 @@                      -> TemplateState m                      -> m (a, TemplateState m) }+type HeistT = TemplateMonad   ------------------------------------------------------------------------------@@ -189,6 +212,16 @@     lift m = TemplateMonad $ \_ s -> do         a <- m         return (a, s)+++------------------------------------------------------------------------------+-- | MonadCatchIO instance+instance MonadCatchIO m => MonadCatchIO (TemplateMonad m) where+    catch (TemplateMonad a) h = TemplateMonad $ \r s -> do+       let handler e = runTemplateMonad (h e) r s+       catch (a r s) handler+    block (TemplateMonad m) = TemplateMonad $ \r s -> block (m r s)+    unblock (TemplateMonad m) = TemplateMonad $ \r s -> unblock (m r s)   ------------------------------------------------------------------------------

@@ -78,7 +78,7 @@          spliceResult <- run $ evalTemplateMonad (runNodeList template)                                                 (X.TextNode "")-                                                (emptyTemplateState ".")+                                                emptyTemplateState         assert $ result == spliceResult  @@ -98,19 +98,19 @@ monoidTest = do     H.assertBool "left monoid identity" $ mempty `mappend` es == es     H.assertBool "right monoid identity" $ es `mappend` mempty == es-  where es = (emptyTemplateState ".") :: TemplateState IO+  where es = emptyTemplateState :: TemplateState IO   ------------------------------------------------------------------------------ addTest :: IO () addTest = do     H.assertEqual "lookup test" (Just []) $-        fmap (X.docContent . fst) $ lookupTemplate "aoeu" ts+        fmap (X.docContent . dfDoc . fst) $ lookupTemplate "aoeu" ts      H.assertEqual "splice touched" 0 $ Map.size (_spliceMap ts)    where-    ts = addTemplate "aoeu" [] (mempty::TemplateState IO)+    ts = addTemplate "aoeu" [] Nothing (mempty::TemplateState IO)   ------------------------------------------------------------------------------@@ -118,7 +118,7 @@ hasTemplateTest = do     ets <- loadT "templates"     let tm = either (error "Error loading templates") _templateMap ets-    let ts = setTemplates tm (emptyTemplateState ".") :: TemplateState IO+    let ts = setTemplates tm emptyTemplateState :: TemplateState IO     H.assertBool "hasTemplate ts" (hasTemplate "index" ts)  @@ -146,7 +146,7 @@ fsLoadTest = do     ets <- loadT "templates"     let tm = either (error "Error loading templates") _templateMap ets-    let ts = setTemplates tm (emptyTemplateState ".") :: TemplateState IO+    let ts = setTemplates tm emptyTemplateState :: TemplateState IO     let f  = g ts      f isNothing "abc/def/xyz"@@ -272,9 +272,9 @@ -- | Markdown test on supplied text markdownTextTest :: H.Assertion markdownTextTest = do-    result <- evalTemplateMonad (markdownSplice ".")+    result <- evalTemplateMonad markdownSplice                                 (X.TextNode "This *is* a test.")-                                (emptyTemplateState ".")+                                emptyTemplateState     H.assertEqual "Markdown text" htmlExpected        (B.filter (/= '\n') $ toByteString $         X.render (X.HtmlDocument X.UTF8 Nothing result))@@ -283,7 +283,7 @@ ------------------------------------------------------------------------------ applyTest :: H.Assertion applyTest = do-    let es = (emptyTemplateState ".") :: TemplateState IO+    let es = emptyTemplateState :: TemplateState IO     res <- evalTemplateMonad applyImpl         (X.Element "apply" [("template", "nonexistant")] []) es @@ -293,7 +293,7 @@ ------------------------------------------------------------------------------ ignoreTest :: H.Assertion ignoreTest = do-    let es = (emptyTemplateState ".") :: TemplateState IO+    let es = emptyTemplateState :: TemplateState IO     res <- evalTemplateMonad ignoreImpl         (X.Element "ignore" [("tag", "ignorable")]            [X.TextNode "This should be ignored"]) es@@ -302,7 +302,7 @@  --localTSTest :: H.Assertion --localTSTest = do---    let es = (emptyTemplateState ".") :: TemplateState IO+--    let es = emptyTemplateState :: TemplateState IO  lookupTemplateTest = do     ts <- loadTS "templates"@@ -323,16 +323,27 @@  ------------------------------------------------------------------------------ loadT :: String -> IO (Either String (TemplateState IO))-loadT s = loadTemplates s (emptyTemplateState s)+loadT s = loadTemplates s emptyTemplateState   ------------------------------------------------------------------------------ loadTS :: FilePath -> IO (TemplateState IO) loadTS baseDir = do-    etm <- loadTemplates baseDir $ emptyTemplateState baseDir+    etm <- loadTemplates baseDir emptyTemplateState     return $ either error id etm  +testTemplate tname = do+    ts <- loadTS "templates"+    Just (resDoc, _) <- renderTemplate ts tname+    return $ toByteString resDoc+++testTemplateEval tname = do+    ts <- loadTS "templates"+    evalTemplateMonad (evalWithHooks tname) (X.TextNode "") ts++ ------------------------------------------------------------------------------ identStartChar :: [Char] identStartChar = ['a'..'z']@@ -483,7 +494,7 @@     , "Splice result:"     , L.unpack $ L.concat $ map formatNode $ unsafePerformIO $         evalTemplateMonad (runNodeList $ buildBindTemplate b)-                          (X.TextNode "") (emptyTemplateState ".")+                          (X.TextNode "") emptyTemplateState     , "Template:"     , L.unpack $ L.concat $ map formatNode $ buildBindTemplate b     ]@@ -562,8 +573,9 @@         (X.TextNode "") ts    where ts = setTemplates (Map.singleton [T.encodeUtf8 $ unName name]-                          (X.HtmlDocument X.UTF8 Nothing callee))-                          (emptyTemplateState ".")+                          (DocumentFile (X.HtmlDocument X.UTF8 Nothing callee)+                                        Nothing))+                          emptyTemplateState