diff --git a/heist.cabal b/heist.cabal --- a/heist.cabal +++ b/heist.cabal @@ -1,5 +1,5 @@ name: heist -version: 0.14.1.3 +version: 0.14.1.4 synopsis: An Haskell template system supporting both HTML5 and XML. description: Heist is a powerful template system that supports both HTML5 and XML. diff --git a/src/Heist/Compiled/Internal.hs b/src/Heist/Compiled/Internal.hs --- a/src/Heist/Compiled/Internal.hs +++ b/src/Heist/Compiled/Internal.hs @@ -133,7 +133,8 @@ X.XmlDocument _ _ _ -> Xml X.HtmlDocument _ _ _ -> Html modifyHS (\hs -> hs { _curMarkup = markup }) - addDoctype $ maybeToList $ X.docType $ dfDoc df + let inDoctype = X.docType $ dfDoc df + addDoctype $ maybeToList inDoctype modifyHS (setCurTemplateFile curPath . setCurContext tpath) res <- runNodeList nodes dt <- getsHS (listToMaybe . _doctypes) @@ -195,6 +196,7 @@ foldM runOne H.empty tpathDocfiles where runOne tmap (tpath, df) = do + modifyHS (\hs -> hs { _doctypes = []}) !mHtml <- compileTemplate tpath df return $! H.insert tpath (mHtml, mimeType $! dfDoc df) tmap diff --git a/src/Heist/Internal/Types/HeistState.hs b/src/Heist/Internal/Types/HeistState.hs --- a/src/Heist/Internal/Types/HeistState.hs +++ b/src/Heist/Internal/Types/HeistState.hs @@ -76,7 +76,7 @@ data DocumentFile = DocumentFile { dfDoc :: X.Document , dfFile :: Maybe FilePath - } deriving ( Eq + } deriving ( Eq, Show #if MIN_VERSION_base(4,7,0) , Typeable #endif diff --git a/test/suite/Heist/Compiled/Tests.hs b/test/suite/Heist/Compiled/Tests.hs --- a/test/suite/Heist/Compiled/Tests.hs +++ b/test/suite/Heist/Compiled/Tests.hs @@ -1,15 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} -module Heist.Compiled.Tests - ( tests - ) where +module Heist.Compiled.Tests where import Blaze.ByteString.Builder import Control.Error import Control.Lens import Control.Monad.Trans +import Data.ByteString (ByteString) import Data.Map.Syntax import Data.Monoid +import Data.Text.Encoding import Test.Framework (Test) import Test.Framework.Providers.HUnit import qualified Test.HUnit as H @@ -29,8 +29,8 @@ -- with ".." in the tag path (which doesn't currently work). tests :: [Test] -tests = [ testCase "compiled/simple" simpleCompiledTest - , testCase "compiled/people" peopleTest +tests = [ testCase "compiled/simple" simpleCompiledTest + , testCase "compiled/people" peopleTest , testCase "compiled/namespace1" namespaceTest1 , testCase "compiled/namespace2" namespaceTest2 , testCase "compiled/namespace3" namespaceTest3 @@ -39,6 +39,7 @@ , testCase "compiled/no-ns-splices" noNsSplices , testCase "compiled/nsbind" nsBindTest , testCase "compiled/nsbinderr" nsBindErrorTest + , testCase "compiled/doctype" doctypeTest ] simpleCompiledTest :: IO () @@ -55,7 +56,7 @@ H.assertEqual "people splice" expected res where expected = - mappend doctype "\n

Doe, John: 42 years old

Smith, Jane: 21 years old

" + "

Doe, John: 42 years old

Smith, Jane: 21 years old

" templateHC :: HeistConfig IO templateHC = HeistConfig sc "" False @@ -64,6 +65,23 @@ & scCompiledSplices .~ ("foo" ## return (yieldPureText "aoeu")) & scTemplateLocations .~ [loadTemplates "templates"] +genericTest :: String -> ByteString -> ByteString -> IO () +genericTest nm template expected = do + res <- runEitherT $ do + hs <- initHeist templateHC + runner <- noteT ["Error rendering"] $ hoistMaybe $ + renderTemplate hs template + b <- lift $ fst runner + return $ toByteString b + + H.assertEqual nm (Right expected) res + +doctypeTest :: IO () +doctypeTest = genericTest "doctype test" "rss" expected + where + expected = encodeUtf8 + "http://www.devalot.com/ " + namespaceTest1 :: IO () namespaceTest1 = do res <- runEitherT $ do @@ -73,9 +91,9 @@ b <- lift $ fst runner return $ toByteString b - H.assertEqual "namespace test" (Right expected) res + H.assertEqual "namespace test 1" (Right expected) res where - expected = mappend doctype "\nAlpha\naoeu Beta\nInside h:foo End\n" + expected = "Alpha\naoeu Beta\nInside h:foo End\n" namespaceTest2 :: IO () @@ -87,9 +105,9 @@ b <- lift $ fst runner return $ toByteString b - H.assertEqual "namespace test" (Right expected) res + H.assertEqual "namespace test 2" (Right expected) res where - expected = mappend doctype "\nAlpha\naoeu Beta\nInside h:foo End\n" + expected = "Alpha\naoeu Beta\nInside h:foo End\n" namespaceTest3 :: IO () @@ -101,9 +119,9 @@ b <- lift $ fst runner return $ toByteString b - H.assertEqual "namespace test" (Right expected) res + H.assertEqual "namespace test 3" (Right expected) res where - expected = mappend doctype "\nAlpha\nInside foo Beta\naoeu End\n" + expected = "Alpha\nInside foo Beta\naoeu End\n" namespaceTest4 :: IO () @@ -116,9 +134,9 @@ b <- lift $ fst runner return $ toByteString b - H.assertEqual "namespace test" (Right expected) res + H.assertEqual "namespace test 4" (Right expected) res where - expected = mappend doctype "\nAlpha\nInside foo Beta\naoeu End\n" + expected = "Alpha\nInside foo Beta\naoeu End\n" namespaceTest5 :: IO () @@ -132,7 +150,7 @@ b <- lift $ fst runner return $ toByteString b - H.assertEqual "namespace test" (Left ["templates/namespaces.tpl: No splice bound for h:foo"]) res + H.assertEqual "namespace test 5" (Left ["templates/namespaces.tpl: No splice bound for h:foo"]) res ------------------------------------------------------------------------------ -- | The templates-no-ns directory should have no tags beginning with h: so @@ -146,7 +164,7 @@ b <- lift $ fst runner return $ toByteString b - H.assertEqual "namespace test" (Left [noNamespaceSplicesMsg "h:"]) res + H.assertEqual "noNsSplices" (Left [noNamespaceSplicesMsg "h:"]) res where hc = HeistConfig sc "h" True sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices diff --git a/test/suite/Heist/Tests.hs b/test/suite/Heist/Tests.hs --- a/test/suite/Heist/Tests.hs +++ b/test/suite/Heist/Tests.hs @@ -81,8 +81,8 @@ where expected1 = "\n\n" expected2 = "\n\n" - expected3 = mappend doctype "\n " - expected4 = mappend doctype "\n " + expected3 = " " + expected4 = " " fooSplice :: I.Splice (StateT Int IO) fooSplice = do @@ -152,8 +152,7 @@ (toByteString mres) where expected = B.intercalate "\n" - [doctype - ,"\n\n" + ["\n\n" ,"\n\n" ,"\n\n\n\n
nav bar
\n\n\n" ,"
index page
\n\n\n " @@ -170,8 +169,7 @@ H.assertEqual "interpreted failure" iExpected iOut where cExpected = B.intercalate "\n" - [doctype - ," This is a test." + [" This is a test." ,"===bind content=== Another test line." ,"apply content Last test line." ," " @@ -197,6 +195,6 @@ iOut <- iRender hs "backslash" H.assertEqual "interpreted failure" iExpected iOut where - cExpected = mappend doctype "\n " + cExpected = " " iExpected = "\n" diff --git a/test/suite/Heist/Tutorial/CompiledSplices.lhs b/test/suite/Heist/Tutorial/CompiledSplices.lhs --- a/test/suite/Heist/Tutorial/CompiledSplices.lhs +++ b/test/suite/Heist/Tutorial/CompiledSplices.lhs @@ -30,10 +30,6 @@ > import Control.Applicative > import Control.Lens > import Data.Map.Syntax -> import qualified Data.Text as T -> import Data.Text.Encoding -> import qualified Heist.Compiled.LowLevel as C -> import Text.XmlHtml As a review, normal (interpreted) Heist splices are defined like this.