diff --git a/heist.cabal b/heist.cabal --- a/heist.cabal +++ b/heist.cabal @@ -1,5 +1,5 @@ name: heist -version: 0.10.1 +version: 0.10.2 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.hs b/src/Heist.hs --- a/src/Heist.hs +++ b/src/Heist.hs @@ -20,6 +20,7 @@ , addTemplatePathPrefix , initHeist , initHeistWithCacheTag + , defaultInterpretedSplices , defaultLoadTimeSplices -- * Core Heist data types @@ -75,6 +76,8 @@ import Heist.Types +type TemplateRepo = HashMap TPath DocumentFile + data HeistConfig m = HeistConfig { hcInterpretedSplices :: [(Text, I.Splice m)] -- ^ Interpreted splices are the splices that Heist has always had. They @@ -91,7 +94,7 @@ , hcAttributeSplices :: [(Text, AttrSplice m)] -- ^ Attribute splices are bound to attribute names and return a list of -- attributes. - , hcTemplates :: HashMap TPath DocumentFile + , hcTemplates :: TemplateRepo -- ^ Templates returned from the 'loadTemplates' function. } @@ -112,11 +115,20 @@ -- should include these in the hcLoadTimeSplices list in your HeistConfig. defaultLoadTimeSplices :: MonadIO m => [(Text, (I.Splice m))] defaultLoadTimeSplices = + ("content", deprecatedContentCheck) -- To be removed in later versions + : defaultInterpretedSplices + + +------------------------------------------------------------------------------ +-- | The built-in set of static splices. All the splices that used to be +-- enabled by default are included here. To get the normal Heist behavior you +-- should include these in the hcLoadTimeSplices list in your HeistConfig. +defaultInterpretedSplices :: MonadIO m => [(Text, (I.Splice m))] +defaultInterpretedSplices = [ (applyTag, applyImpl) , (bindTag, bindImpl) , (ignoreTag, ignoreImpl) , (markdownTag, markdownSplice) - , ("content", deprecatedContentCheck) -- To be removed in later versions ] @@ -124,7 +136,7 @@ -- | Loads templates from disk. This function returns just a template map so -- you can load multiple directories and combine the maps before initializing -- your HeistState. -loadTemplates :: FilePath -> EitherT [String] IO (HashMap TPath DocumentFile) +loadTemplates :: FilePath -> EitherT [String] IO TemplateRepo loadTemplates dir = do d <- lift $ readDirectoryWith (loadTemplate dir) dir let tlist = F.fold (free d) @@ -139,9 +151,7 @@ -- you want to add multiple levels of directories, separate them with slashes -- as in "foo/bar". Using an empty string as a path prefix will leave the -- map unchanged. -addTemplatePathPrefix :: ByteString - -> HashMap TPath DocumentFile - -> HashMap TPath DocumentFile +addTemplatePathPrefix :: ByteString -> TemplateRepo -> TemplateRepo addTemplatePathPrefix dir ts | B.null dir = ts | otherwise = Map.fromList $ @@ -152,6 +162,13 @@ ------------------------------------------------------------------------------ +-- | Creates an empty HeistState. +emptyHS :: HE.KeyGen -> HeistState m +emptyHS kg = HeistState Map.empty Map.empty Map.empty Map.empty + Map.empty True [] 0 [] Nothing kg False + + +------------------------------------------------------------------------------ -- | This is the main Heist initialization function. You pass in a map of all -- templates and all of your splices and it constructs and returns a -- HeistState. @@ -171,37 +188,54 @@ initHeist :: Monad n => HeistConfig n -> EitherT [String] IO (HeistState n) -initHeist (HeistConfig i lt c a rawTemplates) = do +initHeist hc = do keyGen <- lift HE.newKeyGen - let empty = HeistState Map.empty Map.empty Map.empty Map.empty - Map.empty True [] 0 [] Nothing keyGen False - hs0 = empty { _spliceMap = Map.fromList lt - , _templateMap = rawTemplates - , _preprocessingMode = True } - tPairs <- lift $ evalHeistT - (mapM preprocess $ Map.toList rawTemplates) (X.TextNode "") hs0 - let bad = lefts tPairs - tmap = Map.fromList $ rights tPairs - hs1 = empty { _spliceMap = Map.fromList i + initHeist' keyGen hc + + +initHeist' :: Monad n + => HE.KeyGen + -> HeistConfig n + -> EitherT [String] IO (HeistState n) +initHeist' keyGen (HeistConfig i lt c a rawTemplates) = do + let empty = emptyHS keyGen + tmap <- preproc keyGen lt rawTemplates + let hs1 = empty { _spliceMap = Map.fromList i , _templateMap = tmap , _compiledSpliceMap = Map.fromList c , _attrSpliceMap = Map.fromList a } + lift $ C.compileTemplates hs1 + + +------------------------------------------------------------------------------ +-- | Runs preprocess on a TemplateRepo and returns the modified templates. +preproc :: HE.KeyGen + -> [(Text, I.Splice IO)] + -> TemplateRepo + -> EitherT [String] IO TemplateRepo +preproc keyGen splices templates = do + let hs = (emptyHS keyGen) { _spliceMap = Map.fromList splices + , _templateMap = templates + , _preprocessingMode = True } + let eval a = evalHeistT a (X.TextNode "") hs + tPairs <- lift $ mapM (eval . preprocess) $ Map.toList templates + let bad = lefts tPairs if not (null bad) then left bad - else lift $ C.compileTemplates hs1 + else right $ Map.fromList $ rights tPairs ------------------------------------------------------------------------------ --- | +-- | Processes a single template, running load time splices. preprocess :: (TPath, DocumentFile) -> HeistT IO IO (Either String (TPath, DocumentFile)) preprocess (tpath, docFile) = do - let tname = tpathName tpath - !emdoc <- try $ I.evalWithDoctypes tname - :: HeistT IO IO (Either SomeException (Maybe X.Document)) - let f !doc = (tpath, docFile { dfDoc = doc }) - return $! either (Left . show) (Right . maybe die f) emdoc + let tname = tpathName tpath + !emdoc <- try $ I.evalWithDoctypes tname + :: HeistT IO IO (Either SomeException (Maybe X.Document)) + let f !doc = (tpath, docFile { dfDoc = doc }) + return $! either (Left . show) (Right . maybe die f) emdoc where die = error "Preprocess didn't succeed! This should never happen." @@ -218,10 +252,17 @@ initHeistWithCacheTag (HeistConfig i lt c a rawTemplates) = do (ss, cts) <- liftIO mkCacheTag let tag = "cache" - hc' = HeistConfig ((tag, cacheImpl cts) : i) - ((tag, ss) : lt) + keyGen <- lift HE.newKeyGen + + -- We have to do one preprocessing pass with the cache setup splice. This + -- has to happen for both interpreted and compiled templates, so we do it + -- here by itself because interpreted templates don't get the same load + -- time splices as compiled templates. + rawWithCache <- preproc keyGen [(tag, ss)] rawTemplates + + let hc' = HeistConfig ((tag, cacheImpl cts) : i) lt ((tag, cacheImplCompiled cts) : c) - a rawTemplates - hs <- initHeist hc' + a rawWithCache + hs <- initHeist' keyGen hc' return (hs, cts) diff --git a/src/Heist/Interpreted.hs b/src/Heist/Interpreted.hs --- a/src/Heist/Interpreted.hs +++ b/src/Heist/Interpreted.hs @@ -52,6 +52,7 @@ , lookupSplice , bindSplice , bindSplices + , bindAttributeSplices -- * Functions for creating splices , textSplice diff --git a/src/Heist/Interpreted/Internal.hs b/src/Heist/Interpreted/Internal.hs --- a/src/Heist/Interpreted/Internal.hs +++ b/src/Heist/Interpreted/Internal.hs @@ -48,7 +48,7 @@ -> Splice n -- ^ splice action -> HeistState n -- ^ source state -> HeistState n -bindSplice n v ts = ts {_spliceMap = Map.insert n v (_spliceMap ts)} +bindSplice n v hs = hs {_spliceMap = Map.insert n v (_spliceMap hs)} ------------------------------------------------------------------------------ @@ -56,12 +56,21 @@ bindSplices :: [(Text, Splice n)] -- ^ splices to bind -> HeistState n -- ^ start state -> HeistState n -bindSplices ss ts = foldl' (flip id) ts acts +bindSplices ss hs = foldl' (flip id) hs acts where acts = map (uncurry bindSplice) ss ------------------------------------------------------------------------------ +-- | Binds a set of new splice declarations within a 'HeistState'. +bindAttributeSplices :: [(Text, AttrSplice n)] -- ^ splices to bind + -> HeistState n -- ^ start state + -> HeistState n +bindAttributeSplices ss hs = + hs { _attrSpliceMap = Map.union (Map.fromList ss) (_attrSpliceMap hs) } + + +------------------------------------------------------------------------------ -- | Converts 'Text' to a splice returning a single 'TextNode'. textSplice :: Monad n => Text -> Splice n textSplice t = return [X.TextNode t] @@ -117,7 +126,7 @@ lookupSplice :: Text -> HeistState n -> Maybe (Splice n) -lookupSplice nm ts = Map.lookup nm $ _spliceMap ts +lookupSplice nm hs = Map.lookup nm $ _spliceMap hs {-# INLINE lookupSplice #-} @@ -317,8 +326,8 @@ -> ((DocumentFile, TPath) -> HeistT n m (Maybe a)) -> HeistT n m (Maybe a) lookupAndRun name k = do - ts <- getHS - let mt = lookupTemplate name ts _templateMap + hs <- getHS + let mt = lookupTemplate name hs _templateMap let curPath = join $ fmap (dfFile . fst) mt modifyHS (setCurTemplateFile curPath) maybe (return Nothing) k mt @@ -330,7 +339,7 @@ => ByteString -> HeistT n n (Maybe Template) evalTemplate name = lookupAndRun name - (\(t,ctx) -> localHS (\ts -> ts {_curContext = ctx}) + (\(t,ctx) -> localHS (\hs -> hs {_curContext = ctx}) (liftM Just $ runNodeList $ X.docContent $ dfDoc t)) @@ -351,11 +360,11 @@ -> HeistT n n (Maybe X.Document) evalWithDoctypes name = lookupAndRun name $ \(t,ctx) -> do addDoctype $ maybeToList $ X.docType $ dfDoc t - ts <- getHS + hs <- getHS let nodes = X.docContent $ dfDoc t - putHS (ts {_curContext = ctx}) + putHS (hs {_curContext = ctx}) newNodes <- runNodeList nodes - restoreHS ts + restoreHS hs newDoc <- fixDocType $ (dfDoc t) { X.docContent = newNodes } return (Just newDoc) @@ -366,7 +375,7 @@ => [(Text, Text)] -> HeistState n -> HeistState n -bindStrings pairs ts = foldr (uncurry bindString) ts pairs +bindStrings pairs hs = foldr (uncurry bindString) hs pairs ------------------------------------------------------------------------------ @@ -417,7 +426,7 @@ => HeistState n -> ByteString -> n (Maybe (Builder, MIMEType)) -renderTemplate ts name = evalHeistT tpl (X.TextNode "") ts +renderTemplate hs name = evalHeistT tpl (X.TextNode "") hs where tpl = do mt <- evalWithDoctypes name case mt of Nothing -> return Nothing @@ -434,6 +443,6 @@ -> HeistState n -> ByteString -> n (Maybe (Builder, MIMEType)) -renderWithArgs args ts = renderTemplate (bindStrings args ts) +renderWithArgs args hs = renderTemplate (bindStrings args hs) diff --git a/test/suite/Heist/Interpreted/Tests.hs b/test/suite/Heist/Interpreted/Tests.hs --- a/test/suite/Heist/Interpreted/Tests.hs +++ b/test/suite/Heist/Interpreted/Tests.hs @@ -201,14 +201,12 @@ H.assertEqual str expected $ toByteString $ resDoc out1 = B.unlines - [doctype - ,"Empty attribute" + ["Empty attribute" ,"No ident capture" ,"
" ] out2 = B.unlines - [doctype - ,"Empty attribute" + ["Empty attribute" ,"No ident capture" ,"
" ] @@ -232,10 +230,8 @@ ------------------------------------------------------------------------------ markdownHtmlExpected :: ByteString -markdownHtmlExpected = B.concat - [ doctype - , "

This is a test.

" - ] +markdownHtmlExpected = + "

This is a test.

" ------------------------------------------------------------------------------ -- | Markdown test on a file @@ -250,11 +246,9 @@ renderTest "json_snippet" jsonExpected2 where - jsonExpected1 = B.concat [ doctype - , "<b>ok</b>1" + jsonExpected1 = B.concat [ "<b>ok</b>1" , "falsefoo" ] - jsonExpected2 = B.concat - [doctype, "ok1falsefoo"] + jsonExpected2 = "ok1falsefoo" @@ -263,9 +257,7 @@ jsonObjectTest = do renderTest "json_object" jsonExpected where - jsonExpected = B.concat - [ doctype - , "1ok12quuxquux1ok" ] + jsonExpected = "1ok12quuxquux1ok" ------------------------------------------------------------------------------ @@ -305,10 +297,7 @@ titleExpansion :: H.Assertion titleExpansion = renderTest "title_expansion" expected where - expected = B.concat - [ doctype - , "foo" - ] + expected = "foo" ------------------------------------------------------------------------------ @@ -325,24 +314,20 @@ divExpansion :: H.Assertion divExpansion = renderTest "div_expansion" expected where - expected = B.concat - [ doctype - , "
foo
" - ] + expected = "
foo
" ------------------------------------------------------------------------------ -- | Handling of and bound parameters in a bound tag. bindParam :: H.Assertion -bindParam = renderTest "bind_param" $ - B.concat [doctype, "
  • Hi there world
    • "] +bindParam = renderTest "bind_param" "
  • Hi there world
    • " ------------------------------------------------------------------------------ -- | Handling of and bound parameters in a bound tag. attrSpliceContext :: H.Assertion -attrSpliceContext = renderTest "attrsubtest2" $ - B.append doctype "linkfoo" +attrSpliceContext = renderTest "attrsubtest2" + "linkfoo" ------------------------------------------------------------------------------ @@ -355,11 +340,7 @@ hs H.assertEqual "Markdown text" markdownHtmlExpected (B.filter (/= '\n') $ toByteString $ - X.render (X.HtmlDocument X.UTF8 (Just dt) result)) - where - dt = X.DocType "html" (X.Public "-//W3C//DTD XHTML 1.0 Strict//EN" - "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd") - X.NoInternalSubset + X.render (X.HtmlDocument X.UTF8 Nothing result)) ------------------------------------------------------------------------------ diff --git a/test/suite/Heist/TestCommon.hs b/test/suite/Heist/TestCommon.hs --- a/test/suite/Heist/TestCommon.hs +++ b/test/suite/Heist/TestCommon.hs @@ -3,6 +3,7 @@ ------------------------------------------------------------------------------ import Blaze.ByteString.Builder import Control.Error +import Control.Monad.Trans import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.HashMap.Strict as Map @@ -26,7 +27,7 @@ , "'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>" ] -loadT :: Monad m +loadT :: MonadIO m => FilePath -> [(Text, I.Splice m)] -> [(Text, I.Splice IO)] @@ -35,7 +36,8 @@ -> IO (Either [String] (HeistState m)) loadT baseDir a b c d = runEitherT $ do ts <- loadTemplates baseDir - let hc = HeistConfig a (defaultLoadTimeSplices ++ b) c d ts + let hc = HeistConfig (defaultInterpretedSplices ++ a) + (defaultLoadTimeSplices ++ b) c d ts initHeist hc @@ -48,7 +50,8 @@ -> IO (Either [String] (HeistState IO)) loadIO baseDir a b c d = runEitherT $ do ts <- loadTemplates baseDir - let hc = HeistConfig a (defaultLoadTimeSplices ++ b) c d ts + let hc = HeistConfig (defaultInterpretedSplices ++ a) + (defaultLoadTimeSplices ++ b) c d ts initHeist hc @@ -57,7 +60,8 @@ loadHS baseDir = do etm <- runEitherT $ do templates <- loadTemplates baseDir - let hc = HeistConfig [] defaultLoadTimeSplices [] [] templates + let hc = HeistConfig defaultInterpretedSplices + defaultLoadTimeSplices [] [] templates initHeist hc either (error . concat) return etm @@ -68,7 +72,8 @@ -> [(Text, AttrSplice IO)] -> IO (HeistState IO) loadEmpty a b c d = do - let hc = HeistConfig a (defaultLoadTimeSplices ++ b) c d Map.empty + let hc = HeistConfig (defaultInterpretedSplices ++ a) + (defaultLoadTimeSplices ++ b) c d Map.empty res <- runEitherT $ initHeist hc either (error . concat) return res 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 @@ -76,8 +76,8 @@ H.assertEqual "compiled bar" expected4 (toByteString builder2) where - expected1 = doctype `B.append` "\n\n\n" - expected2 = doctype `B.append` "\n\n\n" + expected1 = "\n\n" + expected2 = "\n\n" expected3 = " " expected4 = " " @@ -171,8 +171,7 @@ ," " ] iExpected = B.unlines - [doctype - ," This is a test." + [" This is a test." ,"===bind content===" ,"Another test line." ,"apply content" @@ -193,8 +192,5 @@ H.assertEqual "interpreted failure" iExpected iOut where cExpected = " " - iExpected = B.unlines - [doctype - ,"" - ] + iExpected = "\n"