heist 0.5.0.1 → 0.5.1.0

raw patch · 16 files changed

+408/−76 lines, 16 filesdep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: time

API changes (from Hackage documentation)

Files

• .ghci +0/−2
• heist.cabal +6/−1
• src/Text/Templating/Heist.hs +20/−8
• src/Text/Templating/Heist/Internal.hs +73/−12
• src/Text/Templating/Heist/Splices.hs +3/−0
• src/Text/Templating/Heist/Splices/Apply.hs +27/−19
• src/Text/Templating/Heist/Splices/Bind.hs +5/−3
• src/Text/Templating/Heist/Splices/Cache.hs +143/−0
• src/Text/Templating/Heist/Splices/Html.hs +47/−0
• src/Text/Templating/Heist/Splices/Ignore.hs +0/−2
• src/Text/Templating/Heist/Splices/Markdown.hs +1/−1
• src/Text/Templating/Heist/Splices/Static.hs +0/−2
• src/Text/Templating/Heist/Types.hs +26/−20
• test/.ghci +0/−1
• test/heist-testsuite.cabal +3/−1
• test/suite/Text/Templating/Heist/Tests.hs +54/−4

@@ -2,5 +2,3 @@ :set -Wall :set -isrc :set -itest/suite-:set -hide-package mtl-:set -hide-package MonadCatchIO-mtl

@@ -1,5 +1,5 @@ name:           heist-version:        0.5.0.1+version:        0.5.1.0 synopsis:       An xhtml templating system description:    An xhtml templating system license:        BSD3@@ -68,6 +68,8 @@     Text.Templating.Heist.Splices,     Text.Templating.Heist.Splices.Apply,     Text.Templating.Heist.Splices.Bind,+    Text.Templating.Heist.Splices.Cache,+    Text.Templating.Heist.Splices.Html,     Text.Templating.Heist.Splices.Ignore,     Text.Templating.Heist.Splices.Markdown,     Text.Templating.Heist.Splices.Static,@@ -92,6 +94,7 @@     process,     random,     text >= 0.10 && < 0.12,+    time >= 1.1 && < 1.3,     transformers,     xmlhtml == 0.1.* @@ -100,6 +103,8 @@                  -fno-warn-unused-do-bind   else     ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2++  Extensions: OverloadedStrings   source-repository head

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}  {-| @@ -22,6 +22,7 @@   @getUser :: MyAppMonad (Maybe Text)@ that gets the current user.   You can implement this functionality with a 'Splice' as follows: +  > import             Blaze.ByteString.Builder   > import             Data.ByteString.Char8 (ByteString)   > import qualified   Data.ByteString.Char8 as B   > import             Data.Text (Text)@@ -30,19 +31,19 @@   >   > import             Text.Templating.Heist   >-  > link :: Text -> Text -> Node+  > link :: Text -> Text -> X.Node   > link target text = X.Element "a" [("href", target)] [X.TextNode text]   >-  > loginLink :: Node+  > loginLink :: X.Node   > loginLink = link "/login" "Login"   >-  > logoutLink :: Text -> Node+  > logoutLink :: Text -> X.Node   > logoutLink user = link "/logout" (T.append "Logout " user)   >   > loginLogoutSplice :: Splice MyAppMonad   > loginLogoutSplice = do   >     user <- lift getUser-  >     return $ [maybe loginLink logoutLink user]+  >     return [maybe loginLink logoutLink user]   >    Next, you need to bind that splice to a tag.  Heist stores information@@ -53,10 +54,10 @@   >   > main = do   >     ets <- loadTemplates "templates" $-  >            foldr (uncurry bindSplice) emptyTemplateState mySplices+  >            bindSplices mySplices (emptyTemplateState "templates")   >     let ts = either error id ets   >     t <- runMyAppMonad $ renderTemplate ts "index"-  >     print $ maybe "Page not found" id t+  >     print $ maybe "Page not found" (toByteString . fst) t    Here we build up our 'TemplateState' by starting with emptyTemplateState and   applying bindSplice for all the splices we want to add.  Then we pass this@@ -103,6 +104,7 @@   , putTS   , modifyTS   , restoreTS+  , localTS      -- * Functions for running splices and templates   , evalTemplate@@ -112,6 +114,15 @@   , bindStrings   , bindString +    -- * Functions for creating splices+  , textSplice+  , runChildren+  , runChildrenWith+  , runChildrenWithTrans+  , runChildrenWithTemplates+  , runChildrenWithText+  , mapSplices+     -- * Misc functions   , getDoc   , getXMLDoc@@ -130,7 +141,8 @@ -- | The default set of built-in splices. defaultSpliceMap :: MonadIO m => FilePath -> SpliceMap m defaultSpliceMap templatePath = Map.fromList-    [(applyTag, applyImpl)+    [(htmlTag, htmlImpl)+    ,(applyTag, applyImpl)     ,(bindTag, bindImpl)     ,(ignoreTag, ignoreImpl)     ,(markdownTag, markdownSplice templatePath)

@@ -1,5 +1,4 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -8,6 +7,7 @@ ------------------------------------------------------------------------------ import             Blaze.ByteString.Builder import             Control.Applicative+import             Control.Arrow import             Control.Exception (SomeException) import             Control.Monad import             Control.Monad.CatchIO@@ -94,6 +94,70 @@   ------------------------------------------------------------------------------+-- | Converts 'Text' to a splice returning a single 'TextNode'.+textSplice :: (Monad m) => Text -> Splice m+textSplice = return . (:[]) . X.TextNode+++------------------------------------------------------------------------------+-- | Runs the parameter node's children and returns the resulting node list.+-- By itself this function is a simple passthrough splice that makes the+-- spliced node disappear.  In combination with locally bound splices, this+-- function makes it easier to pass the desired view into your splices.+runChildren :: Monad m => Splice m+runChildren = runNodeList . X.childNodes =<< getParamNode+++------------------------------------------------------------------------------+-- | Binds a list of splices before using the children of the spliced node as+-- a view.+runChildrenWith :: (Monad m)+                => [(Text, Splice m)]+                -- ^ List of splices to bind before running the param nodes.+                -> Splice m+                -- ^ Returns the passed in view.+runChildrenWith splices = localTS (bindSplices splices) runChildren+++------------------------------------------------------------------------------+-- | 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+          -> [(Text, b)]+          -- ^ List of tuples to be bound+          -> Splice m+runChildrenWithTrans f = runChildrenWith . map (second f)+++------------------------------------------------------------------------------+-- | Like runChildrenWith but using constant templates rather than dynamic+-- splices.+runChildrenWithTemplates :: (Monad m) => [(Text, Template)] -> Splice m+runChildrenWithTemplates = runChildrenWithTrans return+++------------------------------------------------------------------------------+-- | Like runChildrenWith but using literal text rather than dynamic splices.+runChildrenWithText :: (Monad m) => [(Text, Text)] -> Splice m+runChildrenWithText = runChildrenWithTrans textSplice+++------------------------------------------------------------------------------+-- | Maps a splice generating function over a list and concatenates the+-- results.+mapSplices :: (Monad m)+        => (a -> Splice m)+        -- ^ Splice generating function+        -> [a]+        -- ^ List of items to generate splices for+        -> Splice m+        -- ^ The result of all splices concatenated together.+mapSplices f vs = liftM concat $ mapM f vs+++------------------------------------------------------------------------------ -- | Convenience function for looking up a splice. lookupSplice :: Monad m =>                 Text@@ -168,7 +232,8 @@   where (name:p) = case splitTemplatePath nameStr of                        [] -> [""]                        ps -> ps-        path = p ++ (_curContext ts)+        ctx = if B.isPrefixOf "/" nameStr then [] else _curContext ts+        path = p ++ ctx         f = if '/' `BC.elem` nameStr                 then singleLookup                 else traversePath@@ -250,9 +315,9 @@     newAtts <- mapM attSubst at     let n = X.Element nm newAtts ch     s <- liftM (lookupSplice nm) getTS-    maybe (runChildren newAtts) (recurseSplice n) s+    maybe (runKids newAtts) (recurseSplice n) s   where-    runChildren newAtts = do+    runKids newAtts = do         newKids <- runNodeList ch         return [X.Element nm newAtts newKids] runNode n                    = return [n]@@ -304,7 +369,7 @@   --------------------------------------------------------------------------------- | Get's the attribute value.  If the splice's result list contains non-text+-- | Gets the attribute value.  If the splice's result list contains non-text -- nodes, this will translate them into text nodes with nodeText and -- concatenate them together. --@@ -334,7 +399,7 @@ ------------------------------------------------------------------------------ -- | Performs splice processing on a list of nodes. runNodeList :: Monad m => [X.Node] -> Splice m-runNodeList nodes = liftM concat $ sequence (map runNode nodes)+runNodeList = mapSplices runNode   ------------------------------------------------------------------------------@@ -380,12 +445,8 @@             => ByteString             -> TemplateMonad m (Maybe Template) evalTemplate name = lookupAndRun name-    (\(t,ctx) -> do-        ts <- getTS-        putTS (ts {_curContext = ctx})-        res <- runNodeList $ X.docContent t-        restoreTS ts-        return $ Just res)+    (\(t,ctx) -> localTS (\ts -> ts {_curContext = ctx})+                         (liftM Just $ runNodeList $ X.docContent t))   ------------------------------------------------------------------------------

@@ -1,6 +1,7 @@ module Text.Templating.Heist.Splices   ( module Text.Templating.Heist.Splices.Apply   , module Text.Templating.Heist.Splices.Bind+  , module Text.Templating.Heist.Splices.Html   , module Text.Templating.Heist.Splices.Ignore   , module Text.Templating.Heist.Splices.Markdown   , module Text.Templating.Heist.Splices.Static@@ -8,6 +9,8 @@  import Text.Templating.Heist.Splices.Apply import Text.Templating.Heist.Splices.Bind+import Text.Templating.Heist.Splices.Cache+import Text.Templating.Heist.Splices.Html import Text.Templating.Heist.Splices.Ignore import Text.Templating.Heist.Splices.Markdown import Text.Templating.Heist.Splices.Static

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- module Text.Templating.Heist.Splices.Apply where  ------------------------------------------------------------------------------@@ -26,28 +24,38 @@   ------------------------------------------------------------------------------+-- | Raw core of apply functionality.  This is abstracted for use in other+-- places like an enhanced (from the original) bind+rawApply calledNodes newContext paramNodes = do+    st <- getTS  -- Can't use localTS here because the modifier is not pure+    processedParams <- runNodeList paramNodes+    modifyTS (bindSplice "content" $ return processedParams)+    setContext newContext+    result <- runNodeList calledNodes+    restoreTS st+    return result+++------------------------------------------------------------------------------+-- | Applies a template as if the supplied nodes were the children of the+-- <apply> tag.+applyNodes :: Monad m => Template -> Text -> Splice m+applyNodes nodes template = do+    st <- getTS+    maybe (return []) -- TODO: error handling+          (\(t,ctx) -> do+              addDoctype $ maybeToList $ X.docType t+              rawApply (X.docContent t) ctx nodes)+          (lookupTemplate (T.encodeUtf8 template) st)+++------------------------------------------------------------------------------ -- | Implementation of the apply splice. applyImpl :: Monad m => Splice m applyImpl = do     node <- getParamNode     case X.getAttribute applyAttr node of         Nothing   -> return [] -- TODO: error handling-        Just attr -> do-            st <- getTS-            maybe (return []) -- TODO: error handling-                  (\(t,ctx) -> do-                      addDoctype $ maybeToList $ X.docType t-                      processedChildren <- runNodeList $ X.childNodes node-                      modifyTS (bindSplice "content" $-                                return processedChildren)-                      setContext ctx-                      result <- runNodeList $ X.docContent t-                      restoreTS st-                      return result)-                  (lookupTemplate (T.encodeUtf8 attr)-                                  (st {_curContext = nextCtx attr st}))-  where nextCtx name st-            | T.isPrefixOf "/" name = []-            | otherwise             = _curContext st+        Just template -> applyNodes (X.childNodes node) template  

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- module Text.Templating.Heist.Splices.Bind where  ------------------------------------------------------------------------------@@ -8,6 +6,7 @@  ------------------------------------------------------------------------------ import           Text.Templating.Heist.Internal+import           Text.Templating.Heist.Splices.Apply import           Text.Templating.Heist.Types  -- | Default name for the bind splice.@@ -32,6 +31,9 @@     return []    where-    add node nm = modifyTS $ bindSplice nm (return $ X.childNodes node)+    add node nm = modifyTS $ bindSplice nm $ do+        caller <- getParamNode+        ctx <- getContext+        rawApply (X.childNodes node) ctx (X.childNodes caller)  

@@ -0,0 +1,143 @@+module Text.Templating.Heist.Splices.Cache+  ( CacheTagState+  , mkCacheTag+  , clearCacheTagState+  ) where++------------------------------------------------------------------------------+import           Control.Concurrent+import           Control.Monad+import           Control.Monad.Trans+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+import           Data.Text.Read+import           Data.Time.Clock+import           System.Random+import           Text.XmlHtml.Cursor+import           Text.XmlHtml hiding (Node)+++------------------------------------------------------------------------------+import           Text.Templating.Heist.Internal+import           Text.Templating.Heist.Types+++cacheTagName :: Text+cacheTagName = "cache"++------------------------------------------------------------------------------+-- | State for storing cache tag information+newtype CacheTagState = CTS (MVar (Map Text (UTCTime, Template)))+++------------------------------------------------------------------------------+-- | Clears the cache tag state.+clearCacheTagState :: CacheTagState -> IO ()+clearCacheTagState (CTS cacheMVar) =+    modifyMVar_ cacheMVar (const $ return Map.empty)+++------------------------------------------------------------------------------+-- | Converts a TTL string into an integer number of seconds.+parseTTL :: Text -> Int+parseTTL s = value * multiplier+  where+    value = either (const 0) fst $ decimal s+    multiplier = case T.last s of+        's' -> 1+        'm' -> 60+        'h' -> 3600+        '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+-- splice is referenced.+--+-- Use the ttl attribute to set the amount of time between reloads.  The ttl+-- value should be a positive integer followed by a single character+-- specifying the units.  Valid units are seconds, minutes, hours, days, and+-- weeks.  If the ttl string is invalid or the ttl attribute is not specified,+-- the cache is never refreshed unless explicitly cleared with+-- clearCacheTagState.+cacheImpl :: (MonadIO m)+           => CacheTagState+           -> TemplateMonad m Template+cacheImpl (CTS mv) = do+    tree <- getParamNode+    let i = fromJust $ getAttribute "id" tree+        ttl = maybe 0 parseTTL $ getAttribute "ttl" tree+    mp <- liftIO $ readMVar mv++    (mp',ns) <- do+                   curTime <- liftIO getCurrentTime+                   let mbn = Map.lookup i mp+                       reload = do+                           nodes' <- runNodeList $ childNodes tree+                           return $! (Map.insert i (curTime,nodes') mp, nodes')+                   case mbn of+                       Nothing -> reload+                       (Just (lastUpdate,n)) -> do+                           if ttl > 0 &&+                              diffUTCTime curTime lastUpdate > fromIntegral ttl+                             then reload+                             else do+                                 stopRecursion+                                 return $! (mp,n)++    liftIO $ modifyMVar_ mv (const $ return mp')++    return ns+++------------------------------------------------------------------------------+-- | 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)++  where+    generateId :: IO Int+    generateId = getStdRandom random++    assignIds setref = mapM f+        where+          f node = g $ fromNode node++          getId = do+              i  <- liftM (T.pack . show) generateId+              st <- readIORef setref+              if Set.member i st+                then getId+                else do+                    writeIORef setref $ Set.insert i st+                    return $ T.append "cache-id-" i++          g curs = do+              let node = current curs+              curs' <- if tagName node == Just cacheTagName+                         then do+                             i <- getId+                             return $ modifyNode (setAttribute "id" i) curs+                         else return curs+              let mbc = nextDF curs'+              maybe (return $ topNode curs') g mbc++++

@@ -0,0 +1,47 @@+module Text.Templating.Heist.Splices.Html where++------------------------------------------------------------------------------+import           Data.List+import           Data.Maybe+import           Data.Text (Text)+import qualified Text.XmlHtml as X++------------------------------------------------------------------------------+import           Text.Templating.Heist.Internal+import           Text.Templating.Heist.Types+++------------------------------------------------------------------------------+-- | Name for the html splice.+htmlTag :: Text+htmlTag = "html"+++------------------------------------------------------------------------------+-- | The html splice runs all children and then traverses the returned node+-- forest removing all head nodes.  Then it merges them all and prepends it to+-- the html tag's child list.+htmlImpl :: Monad m => Splice m+htmlImpl = do+    node <- getParamNode+    children <- runNodeList $ X.childNodes node+    let (heads, mnode) = extractHeads $ node { X.elementChildren = children }+        new (X.Element t a c) = X.Element t a $+            X.Element "head" [] (nub heads) : c+        new n = n+    return [maybe node new mnode]++------------------------------------------------------------------------------+-- | Extracts all heads from a node tree.+extractHeads :: X.Node+             -- ^ The root (html) node+             -> ([X.Node], Maybe X.Node)+             -- ^ A tuple of a list of head nodes and the original tree with+             --   heads removed.+extractHeads (X.Element t a c)+  | t == "head" = (c, Nothing)+  | otherwise   = (concat heads, Just $ X.Element t a (catMaybes mcs))+  where+    (heads, mcs) = unzip $ map extractHeads c+extractHeads n = ([], Just n)+

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- module Text.Templating.Heist.Splices.Ignore where  ------------------------------------------------------------------------------

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable #-}  module Text.Templating.Heist.Splices.Markdown where 

@@ -1,5 +1,3 @@-{-# LANGUAGE OverloadedStrings #-}- module Text.Templating.Heist.Splices.Static   ( StaticTagState   , bindStaticTag

@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-}@@ -23,6 +22,7 @@  ------------------------------------------------------------------------------ import             Control.Applicative+import             Control.Arrow import             Control.Monad.Cont import             Control.Monad.Error import             Control.Monad.Reader@@ -154,12 +154,7 @@     (a, _) <- runTemplateMonad m r s     return a ---------------------------------------------------------------------------------- | Helper function for the functor instance-first :: (a -> b) -> (a, c) -> (b, c)-first f (a,b) = (f a, b) - ------------------------------------------------------------------------------ -- | Functor instance instance Functor m => Functor (TemplateMonad m) where@@ -299,9 +294,9 @@ -- -- When you call @getParamNode@ inside the code for the @speech@ splice, it -- returns the Node for the @speech@ tag and its children.  @getParamNode >>=--- getChildren@ returns a list containing one 'Text' node containing part of--- Hamlet's speech.  @getParamNode >>= getAttribute \"author\"@ would return--- @Just "Shakespeare"@.+-- childNodes@ returns a list containing one 'TextNode' containing part of+-- Hamlet's speech.  @liftM (getAttribute \"author\") getParamNode@ would+-- return @Just "Shakespeare"@. getParamNode :: Monad m => TemplateMonad m X.Node getParamNode = TemplateMonad $ \r s -> return (r,s) @@ -342,15 +337,26 @@   --------------------------------------------------------------------------------- | Restores the components of TemplateState that can get modified in--- template calls.  You should use this function instead of @putTS@ to restore--- an old state.  Thas was needed because doctypes needs to be in a "global--- scope" as opposed to the template call "local scope" of state items such--- as recursionDepth, curContext, and spliceMap.+-- | Restores the TemplateState.  This function is almost like putTS except it+-- preserves the current doctypes.  You should use this function instead of+-- @putTS@ to restore an old state.  This was needed because doctypes needs to+-- be in a "global scope" as opposed to the template call "local scope" of+-- state items such as recursionDepth, curContext, and spliceMap. restoreTS :: Monad m => TemplateState m -> TemplateMonad m ()-restoreTS ts1 =-    modifyTS (\ts2 -> ts2-        { _recursionDepth = _recursionDepth ts1-        , _curContext = _curContext ts1-        , _spliceMap = _spliceMap ts1-        })+restoreTS old = modifyTS (\cur -> old { _doctypes = _doctypes cur })+++------------------------------------------------------------------------------+-- | Abstracts the common pattern of running a TemplateMonad computation with+-- a modified template state.+localTS :: Monad m+        => (TemplateState m -> TemplateState m)+        -> TemplateMonad m a+        -> TemplateMonad m a+localTS f k = do+    ts <- getTS+    putTS $ f ts+    res <- k+    restoreTS ts+    return res+

@@ -2,5 +2,4 @@ :set -Wall :set -i../src :set -isuite-:set -hide-package mtl :set -hide-package MonadCatchIO-mtl

@@ -21,14 +21,16 @@      filepath,      xmlhtml == 0.1.*,      HUnit >= 1.2 && < 2,-     monads-fd,+     mtl >= 2,      random,      MonadCatchIO-transformers >= 0.2.1 && < 0.3,      test-framework >= 0.3.1 && <0.4,      test-framework-hunit >= 0.2.5 && < 0.3,      test-framework-quickcheck2 >= 0.2.6 && < 0.3,      text >= 0.10 && < 0.12,+     time,      transformers          ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded+   Extensions: OverloadedStrings 

@@ -1,6 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE TypeSynonymInstances       #-}+{-# LANGUAGE NoMonomorphismRestriction  #-} {-# OPTIONS_GHC -fno-warn-orphans       #-}  module Text.Templating.Heist.Tests@@ -55,9 +56,14 @@         , testCase     "heist/attributeSubstitution" attrSubstTest         , testCase     "heist/bindAttribute"         bindAttrTest         , testCase     "heist/markdown"              markdownTest+        , testCase     "heist/title_expansion"       titleExpansion+        , testCase     "heist/textarea_expansion"    textareaExpansion+        , testCase     "heist/div_expansion"         divExpansion+        , testCase     "heist/bind_param"            bindParam         , testCase     "heist/markdownText"          markdownTextTest         , testCase     "heist/apply"                 applyTest         , testCase     "heist/ignore"                ignoreTest+        , testCase     "heist/lookupTemplateContext" lookupTemplateTest         ]  @@ -131,7 +137,7 @@     ets <- loadT "templates"     either (error "Error loading templates")            (\ts -> do let tm = _templateMap ts-                      H.assertBool "loadTest size" $ Map.size tm == 17+                      H.assertBool "loadTest size" $ Map.size tm == 21            ) ets  @@ -218,20 +224,51 @@ ------------------------------------------------------------------------------ -- | Markdown test on a file markdownTest :: H.Assertion-markdownTest = do+markdownTest = renderTest "markdown" htmlExpected+++-- | Render a template and assert that it matches an expected result+renderTest  :: ByteString   -- ^ template name+            -> ByteString   -- ^ expected result+            -> H.Assertion+renderTest templateName expectedResult = do     ets <- loadT "templates"     let ts = either (error "Error loading templates") id ets -    check ts htmlExpected+    check ts expectedResult    where     check ts str = do-        Just (doc, mime) <- renderTemplate ts "markdown"+        Just (doc, _) <- renderTemplate ts templateName         let result = B.filter (/= '\n') (toByteString doc)         H.assertEqual ("Should match " ++ (show str)) str result   ------------------------------------------------------------------------------+-- | Expansion of a bound name inside a title-tag+titleExpansion :: H.Assertion+titleExpansion = renderTest "title_expansion" "<title>foo</title>"+++------------------------------------------------------------------------------+-- | Expansion of a bound name inside a textarea-tag+textareaExpansion :: H.Assertion+textareaExpansion = renderTest "textarea_expansion" "<textarea>foo</textarea>"+++------------------------------------------------------------------------------+-- | Expansion of a bound name inside a div-tag+divExpansion :: H.Assertion+divExpansion = renderTest "div_expansion" "<div>foo</div>"+++------------------------------------------------------------------------------+-- | Handling of <content> and bound parameters in a bonud tag.+bindParam :: H.Assertion+bindParam = renderTest "bind_param" "<li>Hi there world</li>"+++------------------------------------------------------------------------------ -- | Markdown test on supplied text markdownTextTest :: H.Assertion markdownTextTest = do@@ -261,6 +298,19 @@         (X.Element "ignore" [("tag", "ignorable")]            [X.TextNode "This should be ignored"]) es     H.assertEqual "<ignore> tag" [] res+++--localTSTest :: H.Assertion+--localTSTest = do+--    let es = (emptyTemplateState ".") :: TemplateState IO++lookupTemplateTest = do+    ts <- loadTS "templates"+    let k = do+            setContext ["foo"]+            getsTS $ lookupTemplate "/user/menu"+    res <- runTemplateMonad k (X.TextNode "") ts+    H.assertBool "lookup context test" $ isJust $ fst res   ------------------------------------------------------------------------------