heist 0.7.0.1 → 0.8.0

raw patch · 16 files changed

+530/−359 lines, 16 filesdep +aesondep +blaze-htmldep +unordered-containersdep ~xmlhtmlPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, blaze-html, unordered-containers, vector

Dependency ranges changed: xmlhtml

API changes (from Hackage documentation)

Files

• .ghci +1/−0
• heist.cabal +19/−10
• src/Text/Templating/Heist.hs +5/−19
• src/Text/Templating/Heist/Internal.hs +48/−24
• src/Text/Templating/Heist/Splices.hs +0/−2
• src/Text/Templating/Heist/Splices/Cache.hs +18/−18
• src/Text/Templating/Heist/Splices/Json.hs +222/−0
• src/Text/Templating/Heist/Splices/Markdown.hs +10/−0
• src/Text/Templating/Heist/Splices/Static.hs +0/−114
• src/Text/Templating/Heist/TemplateDirectory.hs +7/−6
• src/Text/Templating/Heist/Types.hs +106/−119
• test/heist-testsuite.cabal +18/−13
• test/suite/Text/Templating/Heist/Tests.hs +73/−34
• test/templates/json.tpl +1/−0
• test/templates/json_object.tpl +1/−0
• test/templates/json_snippet.tpl +1/−0

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

@@ -1,5 +1,5 @@ name:           heist-version:        0.7.0.1+version:        0.8.0 synopsis:       An (x)html templating system description:    An (x)html templating system license:        BSD3@@ -48,6 +48,9 @@   test/templates/foo/b.tpl,   test/templates/index.tpl,   test/templates/ioc.tpl,+  test/templates/json.tpl,+  test/templates/json_object.tpl,+  test/templates/json_snippet.tpl,   test/templates/markdown.tpl,   test/templates/noroot.tpl,   test/templates/page.tpl,@@ -72,8 +75,8 @@     Text.Templating.Heist.Splices.Cache,     Text.Templating.Heist.Splices.Html,     Text.Templating.Heist.Splices.Ignore,+    Text.Templating.Heist.Splices.Json,     Text.Templating.Heist.Splices.Markdown,-    Text.Templating.Heist.Splices.Static,     Text.Templating.Heist.TemplateDirectory    other-modules:@@ -81,28 +84,34 @@     Text.Templating.Heist.Types    build-depends:-    attoparsec >= 0.10 && < 0.11,-    base >= 4 && < 5,-    blaze-builder >= 0.2 && <0.4,+    aeson                     >= 0.6   && < 0.7,+    attoparsec                >= 0.10  && < 0.11,+    base                      >= 4     && < 5,+    blaze-builder             >= 0.2   && < 0.4,+    blaze-html                >= 0.4   && < 0.5,     bytestring,-    containers >= 0.2 && < 0.5,+    containers                >= 0.2   && < 0.5,     directory,     directory-tree,     filepath,     MonadCatchIO-transformers >= 0.2.1 && < 0.3,-    mtl >= 2.0 && < 2.1,+    mtl                       >= 2.0   && < 2.1,     process,     random,-    text >= 0.10 && < 0.12,-    time >= 1.1 && < 1.5,+    text                      >= 0.10  && < 0.12,+    time                      >= 1.1   && < 1.5,     transformers,-    xmlhtml == 0.1.*+    xmlhtml                   >= 0.1.6 && < 0.2,+    unordered-containers      >= 0.1.4 && < 0.3,+    vector                    >= 0.9   && < 0.10    if impl(ghc >= 6.12.0)     ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2                  -fno-warn-unused-do-bind   else     ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2++  ghc-prof-options:    -prof -auto-all    Extensions:     GeneralizedNewtypeDeriving,

@@ -54,12 +54,12 @@   >   > main = do   >     ets <- loadTemplates "templates" $-  >            bindSplices mySplices emptyHeistState+  >            bindSplices mySplices defaultHeistState   >     let ts = either error id ets   >     t <- runMyAppMonad $ renderTemplate ts "index"   >     print $ maybe "Page not found" (toByteString . fst) t -  Here we build up our 'HeistState' by starting with emptyHeistState and+  Here we build up our 'HeistState' by starting with defaultHeistState and   applying bindSplice for all the splices we want to add.  Then we pass this   to loadTemplates our final 'HeistState' wrapped in an Either to handle   errors.  Then we use this 'HeistState' to render our templates.@@ -72,17 +72,15 @@     Template   , MIMEType   , Splice-  , TemplateMonad   , HeistT   , HeistState-  , TemplateState+  , evalHeistT   , templateNames   , spliceNames      -- * Functions and declarations on HeistState values   , addTemplate   , addXMLTemplate-  , emptyTemplateState   , defaultHeistState   , bindSplice   , bindSplices@@ -135,13 +133,10 @@   , getDoc   , getXMLDoc   , mkCacheTag--    -- * Temporary functions-  , useOldAttributeSyntax   ) where  import           Control.Monad.Trans-import qualified Data.Map as Map+import qualified Data.HashMap.Strict as Map import           Text.Templating.Heist.Internal import           Text.Templating.Heist.Splices import           Text.Templating.Heist.Types@@ -165,16 +160,7 @@ defaultHeistState :: MonadIO m => HeistState m defaultHeistState =     HeistState (defaultSpliceMap) Map.empty True [] 0-               return return return [] Nothing False---{-# DEPRECATED emptyTemplateState "NOTICE: The name TemplateState is changing to HeistState.  Use defaultHeistState instead of emptyTemplateState." #-}---------------------------------------------------------------------------------- | 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 => HeistState m-emptyTemplateState = defaultHeistState+               return return return [] Nothing   -- $hookDoc

@@ -1,13 +1,15 @@+{-# LANGUAGE BangPatterns               #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE PackageImports             #-}+{-# LANGUAGE ScopedTypeVariables        #-}  module Text.Templating.Heist.Internal where  ------------------------------------------------------------------------------ import             Blaze.ByteString.Builder import             Control.Applicative-import             Control.Arrow+import             Control.Arrow hiding (loop) import             Control.Exception (SomeException) import             Control.Monad import             Control.Monad.CatchIO@@ -19,7 +21,7 @@ import             Data.Either import qualified   Data.Foldable as F import             Data.List-import qualified   Data.Map as Map+import qualified   Data.HashMap.Strict as Map import             Data.Maybe import             Data.Monoid import qualified   Data.Text as T@@ -162,6 +164,7 @@         -> Splice m         -- ^ The result of all splices concatenated together. mapSplices f vs = liftM concat $ mapM f vs+{-# INLINE mapSplices #-}   ------------------------------------------------------------------------------@@ -171,6 +174,7 @@              -> HeistState m              -> Maybe (Splice m) lookupSplice nm ts = Map.lookup nm $ _spliceMap ts+{-# INLINE lookupSplice #-}   ------------------------------------------------------------------------------@@ -366,11 +370,10 @@ -- appropriate substitution. parseAtt :: (Monad m) => Text -> HeistT m Text parseAtt bs = do-    oldSyntax <- getsTS _oldAttributeSyntax-    let ast = case AP.feed (AP.parse (attParser oldSyntax) bs) "" of-            (AP.Fail _ _ _) -> []-            (AP.Done _ res) -> res-            (AP.Partial _)  -> []+    let ast = case AP.feed (AP.parse attParser bs) "" of+                (AP.Done _ res) -> res+                (AP.Fail _ _ _) -> []+                (AP.Partial _)  -> []     chunks <- mapM cvt ast     return $ T.concat chunks   where@@ -382,26 +385,42 @@ ------------------------------------------------------------------------------ -- | AST to hold attribute parsing structure.  This is necessary because -- attoparsec doesn't support parsers running in another monad.-data AttAST = Literal Text |-              Ident   Text-    deriving (Show)+data AttAST = Literal Text+            | Ident   Text+  deriving (Show)   ------------------------------------------------------------------------------ -- | Parser for attribute variable substitution.-attParser :: Bool -> AP.Parser [AttAST]-attParser oldSyntax = AP.many1 (identParser <|> litParser)+attParser :: AP.Parser [AttAST]+attParser = liftM ($! []) (loop id)   where-    escChar = (AP.char '\\' *> AP.anyChar) <|>-              AP.satisfy (AP.notInClass "\\$")-    litParser = Literal <$> (T.pack <$> AP.many1 escChar)-    identParser = if oldSyntax then oldParser else newParser-    oldParser = AP.string "$(" *>-        (Ident <$> AP.takeWhile (/=')')) <* AP.string ")"-    newParser = AP.string "${" *>-        (Ident <$> AP.takeWhile (/='}')) <* AP.string "}"+    append !dl !x = dl . (x:) +    loop !dl = go id+      where+        finish subDL = let !txt = T.concat $! subDL []+                           lit  = Literal $! T.concat $! subDL []+                       in return $! if T.null txt+                                      then dl+                                      else append dl lit +        go !subDL = (gobbleText >>= go . append subDL)+                    <|> (AP.endOfInput *> finish subDL)+                    <|> (escChar >>= go . append subDL)+                    <|> (do+                            idp <- identParser+                            dl' <- finish subDL+                            loop $! append dl' idp)++    gobbleText = AP.takeWhile1 (AP.notInClass "\\$")++    escChar = AP.char '\\' *> (T.singleton <$> AP.anyChar)++    identParser = AP.char '$' *> (ident <|> return (Literal "$"))+    ident = (AP.char '{' *> (Ident <$> AP.takeWhile (/='}')) <* AP.string "}")++ ------------------------------------------------------------------------------ -- | Gets the attribute value.  If the splice's result list contains non-text -- nodes, this will translate them into text nodes with nodeText and@@ -434,6 +453,7 @@ -- | Performs splice processing on a list of nodes. runNodeList :: Monad m => [X.Node] -> Splice m runNodeList = mapSplices runNode+{-# INLINE runNodeList #-}   ------------------------------------------------------------------------------@@ -593,7 +613,7 @@                => HeistState m                -> ByteString                -> m (Maybe (Builder, MIMEType))-renderTemplate ts name = evalTemplateMonad tpl (X.TextNode "") ts+renderTemplate ts name = evalHeistT tpl (X.TextNode "") ts   where tpl = do mt <- evalWithHooksInternal name                  case mt of                     Nothing  -> return Nothing@@ -713,7 +733,11 @@ addTemplatePathPrefix :: ByteString -> HeistState m -> HeistState m addTemplatePathPrefix dir ts   | B.null dir = ts-  | otherwise  = ts { _templateMap = Map.mapKeys f $ _templateMap ts }+  | otherwise  = ts { _templateMap = Map.fromList $+                                     map (\(x,y) -> (f x, y)) $+                                     Map.toList $+                                     _templateMap ts+                    }   where     f ps = ps++splitTemplatePath dir 

@@ -5,7 +5,6 @@   , module Text.Templating.Heist.Splices.Html   , module Text.Templating.Heist.Splices.Ignore   , module Text.Templating.Heist.Splices.Markdown-  , module Text.Templating.Heist.Splices.Static   ) where  import Text.Templating.Heist.Splices.Apply@@ -14,5 +13,4 @@ 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,3 +1,13 @@+-- | 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. module Text.Templating.Heist.Splices.Cache   ( CacheTagState   , mkCacheTag@@ -9,9 +19,9 @@ import           Control.Monad import           Control.Monad.Trans import           Data.IORef-import qualified Data.Map as Map-import           Data.Map (Map)-import qualified Data.Set as Set+import qualified Data.HashMap.Strict as H+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashSet as Set import           Data.Text (Text) import qualified Data.Text as T import           Data.Text.Read@@ -33,14 +43,14 @@  ------------------------------------------------------------------------------ -- | State for storing cache tag information-newtype CacheTagState = CTS (MVar (Map Text (UTCTime, Template)))+newtype CacheTagState = CTS (MVar (HashMap Text (UTCTime, Template)))   ------------------------------------------------------------------------------ -- | Clears the cache tag state. clearCacheTagState :: CacheTagState -> IO () clearCacheTagState (CTS cacheMVar) =-    modifyMVar_ cacheMVar (const $ return Map.empty)+    modifyMVar_ cacheMVar (const $ return H.empty)   ------------------------------------------------------------------------------@@ -58,16 +68,6 @@         _   -> 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            -> HeistT m Template@@ -82,10 +82,10 @@      (mp',ns) <- do                    cur <- liftIO getCurrentTime-                   let mbn = Map.lookup i mp+                   let mbn = H.lookup i mp                        reload = do                            nodes' <- runNodeList $ childNodes tree-                           return $! (Map.insert i (cur,nodes') mp, nodes')+                           return $! (H.insert i (cur,nodes') mp, nodes')                    case mbn of                        Nothing -> reload                        (Just (lastUpdate,n)) -> do@@ -110,7 +110,7 @@            => IO (HeistState m -> HeistState m, CacheTagState) mkCacheTag = do     sr <- newIORef $ Set.empty-    mv <- liftM CTS $ newMVar Map.empty+    mv <- liftM CTS $ newMVar H.empty      return $ ( addOnLoadHook (assignIds sr) .                -- The cache tag allows the ttl attribute.

@@ -0,0 +1,222 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE OverloadedStrings #-}++module Text.Templating.Heist.Splices.Json (+  bindJson+) where++------------------------------------------------------------------------------+import           Control.Monad.Reader+import           Data.Aeson+import           Data.Attoparsec.Number+import qualified Data.ByteString.Char8       as S+import qualified Data.ByteString.Lazy.Char8  as L+import qualified Data.HashMap.Strict         as Map+import           Data.Maybe+import           Data.Text                   (Text)+import qualified Data.Text                   as T+import qualified Data.Text.Encoding          as T+import qualified Data.Vector                 as V+import           Text.Templating.Heist+import qualified Text.Blaze.Html5            as B+import           Text.Blaze.Html5            ((!))+import           Text.Blaze.Renderer.XmlHtml+import           Text.XmlHtml+------------------------------------------------------------------------------++                                 ------------+                                 -- public --+                                 ------------++------------------------------------------------------------------------------+-- | This splice binds convenience tags for the given JSON (or+-- JSON-convertible) value and runs the tag's child nodes using the new+-- bindings.+--+-- /Tags bound when you pass in an object/+--+-- Tags bound for an object looking like this:+--+-- > { "k_1": v_1, ..., "k_N": v_N }+--+-- @\<value:{k_i}\>@    -- treats v_i as text+-- @\<snippet:{k_i}\>@  -- treats v_i as HTML+-- @\<with:{k_i}\>@     -- explodes v_i and runs its children+--+-- @\<value var=\"foo.bar.baz\"\/>@ -- walks the JSON tree to find+-- \"foo.bar.baz\", and interprets it as a string+-- @\<snippet var=\"foo.bar.baz\"\/\>@+-- @\<with var=\"foo.bar.baz\"\>...\<with\>@+--+-- /Tags bound when you pass in anything else/+--+-- @\<value\/\>@    --  the given JSON value, as a string+-- @\<snippet\/\>@  --  the given JSON value, parsed and spliced in as HTML+--+bindJson :: (ToJSON a, Monad m) => a -> Splice m+bindJson = runReaderT explodeTag . toJSON+++                                 -------------+                                 -- private --+                                 -------------++------------------------------------------------------------------------------+errorMessage :: String -> [Node]+errorMessage s = renderHtmlNodes $+                     B.strong ! B.customAttribute "class" "error" $+                     B.toHtml s+++------------------------------------------------------------------------------+type JsonMonad m a = ReaderT Value (HeistT m) a+++------------------------------------------------------------------------------+withValue :: (Monad m) => Value -> JsonMonad m a -> HeistT m a+withValue = flip runReaderT+++------------------------------------------------------------------------------+boolToText :: Bool -> Text+boolToText b = if b then "true" else "false"+++------------------------------------------------------------------------------+numToText :: Number -> Text+numToText = T.decodeUtf8 . S.concat . L.toChunks . encode+++------------------------------------------------------------------------------+findExpr :: Text -> Value -> Maybe Value+findExpr t = go (T.split (=='.') t)+  where+    go [] !value     = Just value+    go (x:xs) !value = findIn value >>= go xs+      where+        findIn (Object obj) = Map.lookup x obj+        findIn _            = Nothing+++------------------------------------------------------------------------------+asHtml :: Monad m => Text -> m [Node]+asHtml t =+    case (parseHTML "" $ T.encodeUtf8 t) of+      Left e  -> return $ errorMessage $+                 "Template error turning JSON into HTML: " ++ e+      Right d -> return $! docContent d+++------------------------------------------------------------------------------+snippetTag :: Monad m => JsonMonad m [Node]+snippetTag = ask >>= snip+  where+    txt t = lift $ asHtml t++    snip Null       = txt ""+    snip (Bool b)   = txt $ boolToText b+    snip (Number n) = txt $ numToText n+    snip (String t) = txt t+    snip _          = lift $ do+        node <- getParamNode+        return $ errorMessage $ concat [+                     "error processing tag <"+                   , T.unpack $ fromMaybe "???" $ tagName node+                   , ">: can't interpret JSON arrays or objects as HTML."+                   ]+++------------------------------------------------------------------------------+valueTag :: Monad m => JsonMonad m [Node]+valueTag = ask >>= go+  where+    go Null       = txt ""+    go (Bool b)   = txt $ boolToText b+    go (Number n) = txt $ numToText n+    go (String t) = txt t+    go _          = lift $ do+        node <- getParamNode+        return $ errorMessage $ concat [+                     "error processing tag <"+                   , T.unpack $ fromMaybe "???" $ tagName node+                   , ">: can't interpret JSON arrays or objects as text."+                   ]+++    txt t = return [TextNode t]+++------------------------------------------------------------------------------+explodeTag :: (Monad m) => JsonMonad m [Node]+explodeTag = ask >>= go+  where+    --------------------------------------------------------------------------+    go Null       = goText ""+    go (Bool b)   = goText $ boolToText b+    go (Number n) = goText $ numToText n+    go (String t) = goText t+    go (Array a)  = goArray a+    go (Object o) = goObject o++    --------------------------------------------------------------------------+    goText t = lift $ runChildrenWith [ ("value"   , return [TextNode t])+                                      , ("snippet" , asHtml t           )+                                      ]++    --------------------------------------------------------------------------+    goArray :: (Monad m) => V.Vector Value -> JsonMonad m [Node]+    goArray a = do+        lift stopRecursion+        dl <- V.foldM f id a+        return $! dl []+      where+        f dl jsonValue = do+            tags <- go jsonValue+            return $! dl . (tags ++)++    --------------------------------------------------------------------------+    -- search the param node for attribute \"var=expr\", search the given JSON+    -- object for the expression, and if it's found run the JsonMonad action m+    -- using the restricted JSON object.+    varAttrTag :: (Monad m) => Value -> (JsonMonad m [Node]) -> Splice m+    varAttrTag v m = do+        node <- getParamNode+        maybe (noVar node) (hasVar node) $ getAttribute "var" node+      where+        noVar node = return $ errorMessage $+                     concat [ "expression error: no var attribute in <"+                            , T.unpack $ fromMaybe "???" $ tagName node+                            , "> tag"+                            ]++        hasVar node expr = maybe (return $ errorMessage $+                                  concat [+                                    "expression error: can't find \""+                                  , T.unpack expr+                                  , "\" in JSON object (<"+                                  , T.unpack $ fromMaybe "???" $ tagName node+                                  , "> tag)"+                                  ])+                                 (runReaderT m)+                                 (findExpr expr v)++    --------------------------------------------------------------------------+    genericBindings :: Monad m => JsonMonad m [(Text, Splice m)]+    genericBindings = ask >>= \v -> return [ ("with",    varAttrTag v explodeTag)+                                           , ("snippet", varAttrTag v snippetTag)+                                           , ("value",   varAttrTag v valueTag  )+                                           ]++    --------------------------------------------------------------------------+    goObject obj = do+        start <- genericBindings+        let bindings = Map.foldlWithKey' bindKvp start obj+        lift $ runChildrenWith bindings++    --------------------------------------------------------------------------+    bindKvp bindings k v =+        let newBindings = [ (T.append "with:" k   , withValue v explodeTag)+                          , (T.append "snippet:" k, withValue v snippetTag)+                          , (T.append "value:" k  , withValue v valueTag  )+                          ]+        in  newBindings ++ bindings

@@ -1,5 +1,15 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-| The \"markdown\" splice formats markdown content as HTML and inserts+it into the document. +If the file attribute is present the contents of the tag is ignored and+the file specified is converted to HTML.++Otherwise the non-markup children of the tag are processed as markdown+and converted to HTML.++This splice requires that the \"pandoc\" executable is in your path.+-} module Text.Templating.Heist.Splices.Markdown where  ------------------------------------------------------------------------------

@@ -1,114 +0,0 @@-module Text.Templating.Heist.Splices.Static-{-# DEPRECATED "This will go away in the future.  Use the cache splice instead." #-}-  ( StaticTagState-  , bindStaticTag-  , clearStaticTagCache-  ) 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           System.Random-import           Text.XmlHtml.Cursor-import           Text.XmlHtml hiding (Node)----------------------------------------------------------------------------------import           Text.Templating.Heist.Internal-import           Text.Templating.Heist.Types------------------------------------------------------------------------------------ | State for storing static tag information-newtype StaticTagState = STS (MVar (Map Text Template))------------------------------------------------------------------------------------ | Clears the static tag state.-clearStaticTagCache :: StaticTagState -> IO ()-clearStaticTagCache (STS staticMVar) =-    modifyMVar_ staticMVar (const $ return Map.empty)------------------------------------------------------------------------------------ | The \"static\" splice ensures that its contents are evaluated once and--- then cached.  The cached contents are returned every time the splice is--- referenced.-staticImpl :: (MonadIO m)-           => StaticTagState-           -> HeistT m Template-staticImpl (STS mv) = do-    tree <- getParamNode-    let i = fromJust $ getAttribute "id" tree--    mp <- liftIO $ readMVar mv--    (mp',ns) <- do-                   let mbn = Map.lookup i mp-                   case mbn of-                       Nothing -> do-                           nodes' <- runNodeList $ childNodes tree-                           return $! (Map.insert i nodes' mp, nodes')-                       (Just n) -> do-                           stopRecursion-                           return $! (mp,n)--    liftIO $ modifyMVar_ mv (const $ return mp')--    return ns------------------------------------------------------------------------------------ | Modifies a HeistState to include a \"static\" tag.  The static tag is--- not bound automatically with the other default Heist tags.  This is because--- this function also returns StaticTagState, so the user will be able to--- clear it with the 'clearStaticTagCache' function.-bindStaticTag :: MonadIO m-              => HeistState m-              -> IO (HeistState m, StaticTagState)-bindStaticTag ts = do-    sr <- newIORef $ Set.empty-    mv <- liftM STS $ newMVar Map.empty--    return $ (addOnLoadHook (assignIds sr) $-                bindSplice "static" (staticImpl mv) ts,-              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 i--          g curs = do-              let node = current curs-              curs' <- if tagName node == Just "static"-                         then do-                             i <- getId-                             return $ modifyNode (setAttribute "id" i) curs-                         else return curs-              let mbc = nextDF curs'-              maybe (return $ topNode curs') g mbc----

@@ -19,7 +19,7 @@ import           Control.Monad import           Control.Monad.Trans import           Text.Templating.Heist-import           Text.Templating.Heist.Splices.Static+import           Text.Templating.Heist.Splices.Cache   ------------------------------------------------------------------------------@@ -29,7 +29,7 @@         FilePath         (HeistState m)         (MVar (HeistState m))-        StaticTagState+        CacheTagState   ------------------------------------------------------------------------------@@ -40,11 +40,12 @@                      -> HeistState m                      -> n (Either String (TemplateDirectory m)) newTemplateDirectory dir templateState = liftIO $ do-    (origTs,sts) <- bindStaticTag templateState+    (modTs,cts) <- mkCacheTag+    let origTs = modTs templateState     ets <- loadTemplates dir origTs     leftPass ets $ \ts -> do         tsMVar <- newMVar $ ts-        return $ TemplateDirectory dir origTs tsMVar sts+        return $ TemplateDirectory dir origTs tsMVar cts   ------------------------------------------------------------------------------@@ -70,8 +71,8 @@ reloadTemplateDirectory :: (MonadIO m, MonadIO n)                         => TemplateDirectory m                         -> n (Either String ())-reloadTemplateDirectory (TemplateDirectory p origTs tsMVar sts) = liftIO $ do-    clearStaticTagCache sts+reloadTemplateDirectory (TemplateDirectory p origTs tsMVar cts) = liftIO $ do+    clearCacheTagState cts     ets <- loadTemplates p origTs     leftPass ets $ \ts -> modifyMVar_ tsMVar (const $ return ts) 

@@ -7,13 +7,13 @@  {-| -This module contains the core Heist data types.  TemplateMonad intentionally+This module contains the core Heist data types.  HeistT intentionally does not expose any of its functionality via MonadState or MonadReader functions.  We define passthrough instances for the most common types of-monads.  These instances allow the user to use TemplateMonad in a monad stack+monads.  These instances allow the user to use HeistT in a monad stack without needing calls to `lift`. -Edward Kmett wrote most of the TemplateMonad code and associated instances,+Edward Kmett wrote most of the HeistT code and associated instances, liberating us from the unused writer portion of RWST.  -}@@ -29,8 +29,8 @@ import             Control.Monad.Reader import             Control.Monad.State import             Data.ByteString.Char8 (ByteString)-import qualified   Data.Map as Map-import             Data.Map (Map)+import qualified   Data.HashMap.Strict as H+import             Data.HashMap.Strict (HashMap) import             Data.Monoid import             Data.Text (Text) import             Data.Typeable@@ -63,17 +63,17 @@  ------------------------------------------------------------------------------ -- | All documents representing templates are stored in a map.-type TemplateMap = Map TPath DocumentFile+type TemplateMap = HashMap TPath DocumentFile   --------------------------------------------------------------------------------- | A Splice is a TemplateMonad computation that returns a 'Template'.-type Splice m = TemplateMonad m Template+-- | A Splice is a HeistT computation that returns a 'Template'.+type Splice m = HeistT m Template   ------------------------------------------------------------------------------ -- | SpliceMap associates a name and a Splice.-type SpliceMap m = Map Text (Splice m)+type SpliceMap m = HashMap Text (Splice m)   ------------------------------------------------------------------------------@@ -103,54 +103,30 @@     , _doctypes        :: [X.DocType]     -- | The full path to the current template's file on disk.     , _curTemplateFile :: Maybe FilePath-    -- | Temporary flag for backwards compatibility with the old attribute-    -- syntax for splices.-    , _oldAttributeSyntax :: Bool }  -{-# DEPRECATED TemplateState "NOTICE: The name TemplateState is changing to HeistState.  Use HeistState instead of TemplateState." #-} --------------------------------------------------------------------------------- | Holds all the state information needed for template processing.  You will--- build a @HeistState@ using any of Heist's @HeistState m -> HeistState m@--- \"filter\" functions.  Then you use the resulting @HeistState@ in calls to--- @renderTemplate@.-type TemplateState = HeistState---{-# DEPRECATED useOldAttributeSyntax "NOTICE: This function is only here temporarily to ease the transition in attribute syntax.  It will be removed in the next major release.  Update your templates!" #-}---------------------------------------------------------------------------------- | Sets compatibility mode that uses the old $() syntax for splices in--- attributes.  The old syntax conflicts with the ubiquitous jquery function.--- The new syntax is ${}.  This compatibility mode will be removed in the next--- major release.------ See https://github.com/snapframework/heist/issues/12 for the discussion.-useOldAttributeSyntax :: HeistState m -> HeistState m-useOldAttributeSyntax ts = ts { _oldAttributeSyntax = True }--------------------------------------------------------------------------------- -- | Gets the names of all the templates defined in a HeistState. templateNames :: HeistState m -> [TPath]-templateNames ts = Map.keys $ _templateMap ts+templateNames ts = H.keys $ _templateMap ts   ------------------------------------------------------------------------------ -- | Gets the names of all the splices defined in a HeistState. spliceNames :: HeistState m -> [Text]-spliceNames ts = Map.keys $ _spliceMap ts+spliceNames ts = H.keys $ _spliceMap ts   ------------------------------------------------------------------------------ instance (Monad m) => Monoid (HeistState m) where-    mempty = HeistState Map.empty Map.empty True [] 0-                           return return return [] Nothing False+    mempty = HeistState H.empty H.empty True [] 0+                           return return return [] Nothing -    (HeistState s1 t1 r1 _ d1 o1 b1 a1 dt1 ctf1 oas1) `mappend`-        (HeistState s2 t2 r2 c2 d2 o2 b2 a2 dt2 ctf2 oas2) =+    (HeistState s1 t1 r1 _ d1 o1 b1 a1 dt1 ctf1) `mappend`+        (HeistState s2 t2 r2 c2 d2 o2 b2 a2 dt2 ctf2) =         HeistState s t r c2 d (o1 >=> o2) (b1 >=> b2) (a1 >=> a2)-            (dt1 `mappend` dt2) ctf (oas1 || oas2)+            (dt1 `mappend` dt2) ctf       where         s = s1 `mappend` s2         t = t1 `mappend` t2@@ -177,114 +153,117 @@     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--- the inner monad.-newtype TemplateMonad m a = TemplateMonad {-    runTemplateMonad :: X.Node-                     -> HeistState m-                     -> m (a, HeistState m)+-- | HeistT is the monad used for 'Splice' processing.  HeistT provides+-- \"passthrough\" instances for many of the monads you might use in the inner+-- monad.+newtype HeistT m a = HeistT {+    runHeistT :: X.Node+              -> HeistState m+              -> m (a, HeistState m) }-type HeistT = TemplateMonad   ------------------------------------------------------------------------------ -- | Evaluates a template monad as a computation in the underlying monad.-evalTemplateMonad :: Monad m-                  => TemplateMonad m a-                  -> X.Node-                  -> HeistState m-                  -> m a-evalTemplateMonad m r s = do-    (a, _) <- runTemplateMonad m r s+evalHeistT :: Monad m+           => HeistT m a+           -> X.Node+           -> HeistState m+           -> m a+evalHeistT m r s = do+    (a, _) <- runHeistT m r s     return a+{-# INLINE evalHeistT #-}   ------------------------------------------------------------------------------ -- | Functor instance-instance Functor m => Functor (TemplateMonad m) where-    fmap f (TemplateMonad m) = TemplateMonad $ \r s -> first f <$> m r s+instance Functor m => Functor (HeistT m) where+    fmap f (HeistT m) = HeistT $ \r s -> first f <$> m r s   ------------------------------------------------------------------------------ -- | Applicative instance-instance (Monad m, Functor m) => Applicative (TemplateMonad m) where+instance (Monad m, Functor m) => Applicative (HeistT m) where     pure = return     (<*>) = ap   ------------------------------------------------------------------------------ -- | Monad instance-instance Monad m => Monad (TemplateMonad m) where-    return a = TemplateMonad (\_ s -> return (a, s))-    TemplateMonad m >>= k = TemplateMonad $ \r s -> do+instance Monad m => Monad (HeistT m) where+    return a = HeistT (\_ s -> return (a, s))+    {-# INLINE return #-}+    HeistT m >>= k = HeistT $ \r s -> do         (a, s') <- m r s-        runTemplateMonad (k a) r s'+        runHeistT (k a) r s'+    {-# INLINE (>>=) #-}   ------------------------------------------------------------------------------ -- | MonadIO instance-instance MonadIO m => MonadIO (TemplateMonad m) where+instance MonadIO m => MonadIO (HeistT m) where     liftIO = lift . liftIO   ------------------------------------------------------------------------------ -- | MonadTrans instance-instance MonadTrans TemplateMonad where-    lift m = TemplateMonad $ \_ s -> do+instance MonadTrans HeistT where+    lift m = HeistT $ \_ 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+instance MonadCatchIO m => MonadCatchIO (HeistT m) where+    catch (HeistT a) h = HeistT $ \r s -> do+       let handler e = runHeistT (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)+    block (HeistT m) = HeistT $ \r s -> block (m r s)+    unblock (HeistT m) = HeistT $ \r s -> unblock (m r s)   ------------------------------------------------------------------------------ -- | MonadFix passthrough instance-instance MonadFix m => MonadFix (TemplateMonad m) where-    mfix f = TemplateMonad $ \r s ->-        mfix $ \ (a, _) -> runTemplateMonad (f a) r s+instance MonadFix m => MonadFix (HeistT m) where+    mfix f = HeistT $ \r s ->+        mfix $ \ (a, _) -> runHeistT (f a) r s   ------------------------------------------------------------------------------ -- | Alternative passthrough instance-instance (Functor m, MonadPlus m) => Alternative (TemplateMonad m) where+instance (Functor m, MonadPlus m) => Alternative (HeistT m) where     empty = mzero     (<|>) = mplus   ------------------------------------------------------------------------------ -- | MonadPlus passthrough instance-instance MonadPlus m => MonadPlus (TemplateMonad m) where+instance MonadPlus m => MonadPlus (HeistT m) where     mzero = lift mzero-    m `mplus` n = TemplateMonad $ \r s ->-        runTemplateMonad m r s `mplus` runTemplateMonad n r s+    m `mplus` n = HeistT $ \r s ->+        runHeistT m r s `mplus` runHeistT n r s   ------------------------------------------------------------------------------ -- | MonadState passthrough instance-instance MonadState s m => MonadState s (TemplateMonad m) where+instance MonadState s m => MonadState s (HeistT m) where     get = lift get+    {-# INLINE get #-}     put = lift . put+    {-# INLINE put #-}   ------------------------------------------------------------------------------ -- | MonadReader passthrough instance-instance MonadReader r m => MonadReader r (TemplateMonad m) where-    ask = TemplateMonad $ \_ s -> do+instance MonadReader r m => MonadReader r (HeistT m) where+    ask = HeistT $ \_ s -> do             r <- ask             return (r,s)-    local f (TemplateMonad m) =-        TemplateMonad $ \r s -> local f (m r s)+    local f (HeistT m) =+        HeistT $ \r s -> local f (m r s)   ------------------------------------------------------------------------------@@ -292,18 +271,18 @@ liftCatch :: (m (a,HeistState m)               -> (e -> m (a,HeistState m))               -> m (a,HeistState m))-          -> TemplateMonad m a-          -> (e -> TemplateMonad m a)-          -> TemplateMonad m a+          -> HeistT m a+          -> (e -> HeistT m a)+          -> HeistT m a liftCatch ce m h =-    TemplateMonad $ \r s ->-        (runTemplateMonad m r s `ce`-        (\e -> runTemplateMonad (h e) r s))+    HeistT $ \r s ->+        (runHeistT m r s `ce`+        (\e -> runHeistT (h e) r s))   ------------------------------------------------------------------------------ -- | MonadError passthrough instance-instance (MonadError e m) => MonadError e (TemplateMonad m) where+instance (MonadError e m) => MonadError e (HeistT m) where     throwError = lift . throwError     catchError = liftCatch catchError @@ -313,16 +292,16 @@ liftCallCC :: ((((a,HeistState m) -> m (b, HeistState m))                   -> m (a, HeistState m))                 -> m (a, HeistState m))-           -> ((a -> TemplateMonad m b) -> TemplateMonad m a)-           -> TemplateMonad m a-liftCallCC ccc f = TemplateMonad $ \r s ->+           -> ((a -> HeistT m b) -> HeistT m a)+           -> HeistT m a+liftCallCC ccc f = HeistT $ \r s ->     ccc $ \c ->-    runTemplateMonad (f (\a -> TemplateMonad $ \_ _ -> c (a, s))) r s+    runHeistT (f (\a -> HeistT $ \_ _ -> c (a, s))) r s   ------------------------------------------------------------------------------ -- | MonadCont passthrough instance-instance (MonadCont m) => MonadCont (TemplateMonad m) where+instance (MonadCont m) => MonadCont (HeistT m) where     callCC = liftCallCC callCC  @@ -330,10 +309,10 @@ -- | The Typeable instance is here so Heist can be dynamically executed with -- Hint. templateMonadTyCon :: TyCon-templateMonadTyCon = mkTyCon "Text.Templating.Heist.TemplateMonad"+templateMonadTyCon = mkTyCon "Text.Templating.Heist.HeistT" {-# NOINLINE templateMonadTyCon #-} -instance (Typeable1 m) => Typeable1 (TemplateMonad m) where+instance (Typeable1 m) => Typeable1 (HeistT m) where     typeOf1 _ = mkTyConApp templateMonadTyCon [typeOf1 (undefined :: m ())]  @@ -354,43 +333,49 @@ -- 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)+getParamNode :: Monad m => HeistT m X.Node+getParamNode = HeistT $ \r s -> return (r,s)+{-# INLINE getParamNode #-}   --------------------------------------------------------------------------------- | TemplateMonad's 'local'.+-- | HeistT's 'local'. localParamNode :: Monad m                => (X.Node -> X.Node)-               -> TemplateMonad m a-               -> TemplateMonad m a-localParamNode f m = TemplateMonad $ \r s -> runTemplateMonad m (f r) s+               -> HeistT m a+               -> HeistT m a+localParamNode f m = HeistT $ \r s -> runHeistT m (f r) s+{-# INLINE localParamNode #-}   --------------------------------------------------------------------------------- | TemplateMonad's 'gets'.-getsTS :: Monad m => (HeistState m -> r) -> TemplateMonad m r-getsTS f = TemplateMonad $ \_ s -> return (f s, s)+-- | HeistT's 'gets'.+getsTS :: Monad m => (HeistState m -> r) -> HeistT m r+getsTS f = HeistT $ \_ s -> return (f s, s)+{-# INLINE getsTS #-}   --------------------------------------------------------------------------------- | TemplateMonad's 'get'.-getTS :: Monad m => TemplateMonad m (HeistState m)-getTS = TemplateMonad $ \_ s -> return (s, s)+-- | HeistT's 'get'.+getTS :: Monad m => HeistT m (HeistState m)+getTS = HeistT $ \_ s -> return (s, s)+{-# INLINE getTS #-}   --------------------------------------------------------------------------------- | TemplateMonad's 'put'.-putTS :: Monad m => HeistState m -> TemplateMonad m ()-putTS s = TemplateMonad $ \_ _ -> return ((), s)+-- | HeistT's 'put'.+putTS :: Monad m => HeistState m -> HeistT m ()+putTS s = HeistT $ \_ _ -> return ((), s)+{-# INLINE putTS #-}   --------------------------------------------------------------------------------- | TemplateMonad's 'modify'.+-- | HeistT's 'modify'. modifyTS :: Monad m                     => (HeistState m -> HeistState m)-                    -> TemplateMonad m ()-modifyTS f = TemplateMonad $ \_ s -> return ((), f s)+                    -> HeistT m ()+modifyTS f = HeistT $ \_ s -> return ((), f s)+{-# INLINE modifyTS #-}   ------------------------------------------------------------------------------@@ -399,21 +384,23 @@ -- @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 => HeistState m -> TemplateMonad m ()+restoreTS :: Monad m => HeistState m -> HeistT m () restoreTS old = modifyTS (\cur -> old { _doctypes = _doctypes cur })+{-# INLINE restoreTS #-}   --------------------------------------------------------------------------------- | Abstracts the common pattern of running a TemplateMonad computation with+-- | Abstracts the common pattern of running a HeistT computation with -- a modified heist state. localTS :: Monad m         => (HeistState m -> HeistState m)-        -> TemplateMonad m a-        -> TemplateMonad m a+        -> HeistT m a+        -> HeistT m a localTS f k = do     ts <- getTS     putTS $ f ts     res <- k     restoreTS ts     return res+{-# INLINE localTS #-} 

@@ -8,28 +8,33 @@   main-is:         TestSuite.hs    build-depends:-    QuickCheck >= 2,-    attoparsec >= 0.10 && < 0.11,-    base >= 4 && < 5,-    blaze-builder >= 0.2 && <0.4,+    QuickCheck                 >= 2,+    aeson                      >= 0.4   && < 0.7,+    attoparsec                 >= 0.10  && < 0.11,+    base                       >= 4     && < 5,+    blaze-builder              >= 0.2   && < 0.4,+    blaze-html                 >= 0.4   && < 0.5,     bytestring,     containers,     directory,     directory-tree,     process,     filepath,-    xmlhtml == 0.1.*,-    HUnit >= 1.2 && < 2,-    mtl >= 2,+    xmlhtml                    >= 0.1.6 && < 0.2,+    HUnit                      >= 1.2   && < 2,+    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,+    MonadCatchIO-transformers  >= 0.2.1 && < 0.3,+    test-framework             >= 0.3.1 && < 0.6,+    test-framework-hunit       >= 0.2.5 && < 0.3,     test-framework-quickcheck2 >= 0.2.6 && < 0.3,-    text >= 0.10 && < 0.12,+    text                       >= 0.10  && < 0.12,     time,-    transformers-    +    transformers,+    unordered-containers       >= 0.1.4 && < 0.3,+    vector                     >= 0.9   && < 0.10++   ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded   Extensions: OverloadedStrings 

@@ -1,7 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE TypeSynonymInstances       #-}-{-# LANGUAGE NoMonomorphismRestriction  #-} {-# OPTIONS_GHC -fno-warn-orphans       #-}  module Text.Templating.Heist.Tests@@ -12,10 +12,11 @@ ------------------------------------------------------------------------------ import           Blaze.ByteString.Builder import           Control.Monad.State+import           Data.Aeson import           Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L-import qualified Data.Map as Map+import qualified Data.HashMap.Strict as Map import           Data.Maybe import           Data.Monoid import qualified Data.Text as T@@ -36,6 +37,7 @@ import           Text.Templating.Heist.Types import           Text.Templating.Heist.Splices.Apply import           Text.Templating.Heist.Splices.Ignore+import           Text.Templating.Heist.Splices.Json import           Text.Templating.Heist.Splices.Markdown import qualified Text.XmlHtml        as X import qualified Text.XmlHtml.Cursor as X@@ -65,6 +67,8 @@         , testCase     "heist/ignore"                ignoreTest         , testCase     "heist/lookupTemplateContext" lookupTemplateTest         , testCase     "heist/attrSpliceContext"     attrSpliceContext+        , testCase     "heist/json/values"           jsonValueTest+        , testCase     "heist/json/object"           jsonObjectTest         ]  @@ -77,9 +81,9 @@         let template = buildBindTemplate bind         let result   = buildResult bind -        spliceResult <- run $ evalTemplateMonad (runNodeList template)-                                                (X.TextNode "")-                                                emptyTemplateState+        spliceResult <- run $ evalHeistT (runNodeList template)+                                         (X.TextNode "")+                                         defaultHeistState         assert $ result == spliceResult  @@ -99,7 +103,7 @@ 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 = defaultHeistState :: HeistState IO   ------------------------------------------------------------------------------@@ -111,7 +115,7 @@     H.assertEqual "splice touched" 0 $ Map.size (_spliceMap ts)    where-    ts = addTemplate "aoeu" [] Nothing (mempty::TemplateState IO)+    ts = addTemplate "aoeu" [] Nothing (mempty::HeistState IO)   ------------------------------------------------------------------------------@@ -119,7 +123,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 defaultHeistState :: HeistState IO     H.assertBool "hasTemplate ts" (hasTemplate "index" ts)  @@ -138,7 +142,7 @@     ets <- loadT "templates"     either (error "Error loading templates")            (\ts -> do let tm = _templateMap ts-                      H.assertBool "loadTest size" $ Map.size tm == 23+                      H.assertBool "loadTest size" $ Map.size tm == 26            ) ets  @@ -147,7 +151,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 defaultHeistState :: HeistState IO     let f  = g ts      f isNothing "abc/def/xyz"@@ -228,6 +232,27 @@ markdownTest = renderTest "markdown" htmlExpected  +------------------------------------------------------------------------------+jsonValueTest :: H.Assertion+jsonValueTest = do+    renderTest "json" jsonExpected1+    renderTest "json_snippet" jsonExpected2++  where+    jsonExpected1 = B.concat [ "<i>&lt;b&gt;ok&lt;/b&gt;</i><i>1</i>"+                             , "<i></i><i>false</i><i>foo</i>" ]+    jsonExpected2 = "<i><b>ok</b></i><i>1</i><i></i><i>false</i><i>foo</i>"+++------------------------------------------------------------------------------+jsonObjectTest :: H.Assertion+jsonObjectTest = do+    renderTest "json_object" jsonExpected+  where+    jsonExpected = B.concat [ "<i>1</i><i><b>ok</b></i>12quuxquux1<b>ok</b>" ]+++------------------------------------------------------------------------------ -- | Render a template and assert that it matches an expected result renderTest  :: ByteString   -- ^ template name             -> ByteString   -- ^ expected result@@ -239,7 +264,21 @@     check ts expectedResult    where-    check ts str = do+    bind txt = bindJson v+      where+        v :: Value+        v = fromJust $ decode txt++    check ts0 str = do+        let ts = bindSplices [+                      ("json", bind "[\"<b>ok</b>\", 1, null, false, \"foo\"]")+                    , ("jsonObject",+                       bind $ mconcat [+                                 "{\"foo\": 1, \"bar\": \"<b>ok</b>\", "+                                , "\"baz\": { \"baz1\": 1, \"baz2\": 2 }, "+                                , "\"quux\": \"quux\" }"+                                ])+                    ] ts0         Just (doc, _) <- renderTemplate ts templateName         let result = B.filter (/= '\n') (toByteString doc)         H.assertEqual ("Should match " ++ (show str)) str result@@ -264,24 +303,24 @@   --------------------------------------------------------------------------------- | Handling of <content> and bound parameters in a bonud tag.+-- | Handling of <content> and bound parameters in a bound tag. bindParam :: H.Assertion bindParam = renderTest "bind_param" "<li>Hi there world</li>"   --------------------------------------------------------------------------------- | Handling of <content> and bound parameters in a bonud tag.+-- | Handling of <content> and bound parameters in a bound tag. attrSpliceContext :: H.Assertion-attrSpliceContext = renderTest "attrsubtest2" "<a href='asdf'>link</a>"+attrSpliceContext = renderTest "attrsubtest2" "<a href='asdf'>link</a><a href='before$after'>foo</a>"   ------------------------------------------------------------------------------ -- | Markdown test on supplied text markdownTextTest :: H.Assertion markdownTextTest = do-    result <- evalTemplateMonad markdownSplice-                                (X.TextNode "This *is* a test.")-                                emptyTemplateState+    result <- evalHeistT markdownSplice+                         (X.TextNode "This *is* a test.")+                         defaultHeistState     H.assertEqual "Markdown text" htmlExpected        (B.filter (/= '\n') $ toByteString $         X.render (X.HtmlDocument X.UTF8 Nothing result))@@ -290,8 +329,8 @@ ------------------------------------------------------------------------------ applyTest :: H.Assertion applyTest = do-    let es = emptyTemplateState :: TemplateState IO-    res <- evalTemplateMonad applyImpl+    let es = defaultHeistState :: HeistState IO+    res <- evalHeistT applyImpl         (X.Element "apply" [("template", "nonexistant")] []) es      H.assertEqual "apply nothing" [] res@@ -300,8 +339,8 @@ ------------------------------------------------------------------------------ ignoreTest :: H.Assertion ignoreTest = do-    let es = emptyTemplateState :: TemplateState IO-    res <- evalTemplateMonad ignoreImpl+    let es = defaultHeistState :: HeistState IO+    res <- evalHeistT ignoreImpl         (X.Element "ignore" [("tag", "ignorable")]            [X.TextNode "This should be ignored"]) es     H.assertEqual "<ignore> tag" [] res@@ -309,14 +348,14 @@  --localTSTest :: H.Assertion --localTSTest = do---    let es = emptyTemplateState :: TemplateState IO+--    let es = defaultHeistState :: HeistState IO  lookupTemplateTest = do     ts <- loadTS "templates"     let k = do             setContext ["foo"]             getsTS $ lookupTemplate "/user/menu"-    res <- runTemplateMonad k (X.TextNode "") ts+    res <- runHeistT k (X.TextNode "") ts     H.assertBool "lookup context test" $ isJust $ fst res  @@ -329,14 +368,14 @@   -------------------------------------------------------------------------------loadT :: String -> IO (Either String (TemplateState IO))-loadT s = loadTemplates s emptyTemplateState+loadT :: String -> IO (Either String (HeistState IO))+loadT s = loadTemplates s defaultHeistState   -------------------------------------------------------------------------------loadTS :: FilePath -> IO (TemplateState IO)+loadTS :: FilePath -> IO (HeistState IO) loadTS baseDir = do-    etm <- loadTemplates baseDir emptyTemplateState+    etm <- loadTemplates baseDir defaultHeistState     return $ either error id etm  @@ -348,7 +387,7 @@  testTemplateEval tname = do     ts <- loadTS "templates"-    evalTemplateMonad (evalWithHooks tname) (X.TextNode "") ts+    evalHeistT (evalWithHooks tname) (X.TextNode "") ts   ------------------------------------------------------------------------------@@ -500,8 +539,8 @@     , L.unpack $ L.concat $ map formatNode $ buildResult b     , "Splice result:"     , L.unpack $ L.concat $ map formatNode $ unsafePerformIO $-        evalTemplateMonad (runNodeList $ buildBindTemplate b)-                          (X.TextNode "") emptyTemplateState+        evalHeistT (runNodeList $ buildBindTemplate b)+                          (X.TextNode "") defaultHeistState     , "Template:"     , L.unpack $ L.concat $ map formatNode $ buildBindTemplate b     ]@@ -576,13 +615,13 @@ ------------------------------------------------------------------------------ calcResult :: (MonadIO m) => Apply -> m [X.Node] calcResult apply@(Apply name _ callee _ _) =-    evalTemplateMonad (runNodeList $ buildApplyCaller apply)+    evalHeistT (runNodeList $ buildApplyCaller apply)         (X.TextNode "") ts    where ts = setTemplates (Map.singleton [T.encodeUtf8 $ unName name]                           (DocumentFile (X.HtmlDocument X.UTF8 Nothing callee)                                         Nothing))-                          emptyTemplateState+                          defaultHeistState   @@ -599,9 +638,9 @@ preRun = hookG "Inserted on preRun" postRun = hookG "Inserted on postRun" -ts :: IO (Either String (TemplateState IO))+ts :: IO (Either String (HeistState IO)) ts = loadTemplates "test/templates" $-    foldr ($) (emptyTemplateState ".")+    foldr ($) (defaultHeistState ".")     [setOnLoadHook onLoad     ,setPreRunHook preRun     ,setPostRunHook postRun

@@ -0,0 +1,1 @@+<json><i><value/></i></json>

@@ -0,0 +1,1 @@+<jsonObject><i><value:foo/></i><i><snippet:bar/></i><with:baz><value:baz1/><value:baz2/></with:baz><with:quux><value/></with:quux><with var="quux"><value/></with><value var="baz.baz1"/><snippet var="bar"/></jsonObject>

@@ -0,0 +1,1 @@+<json><i><snippet/></i></json>