Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix outstanding issues for 0.10.2

Added a new function for binding attribute splices.
Since the built-in splices should not be run as load time splices in
interpreted mode, we now export a list of default interpreted splices.
Split into two load time splice processing steps because the cache tag setup
splice does have to run at load time even in interpreted mode.
  • Loading branch information...
commit 934eff7c78d22d20a377a6185e0232dc032d95bf 1 parent 70e0cf5
@mightybyte mightybyte authored
View
2  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.
View
97 src/Heist.hs
@@ -20,6 +20,7 @@ module Heist
, addTemplatePathPrefix
, initHeist
, initHeistWithCacheTag
+ , defaultInterpretedSplices
, defaultLoadTimeSplices
-- * Core Heist data types
@@ -75,6 +76,8 @@ import Heist.Splices
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 @@ data HeistConfig m = HeistConfig
, 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 @@ instance Monoid (HeistConfig m) where
-- 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 @@ defaultLoadTimeSplices =
-- | 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 @@ loadTemplates dir = do
-- 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 @@ addTemplatePathPrefix dir ts
------------------------------------------------------------------------------
+-- | 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 @@ addTemplatePathPrefix dir ts
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 }
- eval a = evalHeistT a (X.TextNode "") hs0
- tPairs <- lift $ mapM (eval . preprocess) $ Map.toList rawTemplates
- 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 :: MonadIO n
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)
View
1  src/Heist/Interpreted.hs
@@ -52,6 +52,7 @@ module Heist.Interpreted
, lookupSplice
, bindSplice
, bindSplices
+ , bindAttributeSplices
-- * Functions for creating splices
, textSplice
View
33 src/Heist/Interpreted/Internal.hs
@@ -48,7 +48,7 @@ bindSplice :: Text -- ^ tag name
-> 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 @@ bindSplice n v ts = ts {_spliceMap = Map.insert n v (_spliceMap ts)}
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 @@ runChildrenWithText = runChildrenWithTrans textSplice
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 @@ lookupAndRun :: Monad m
-> ((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 @@ evalTemplate :: Monad n
=> 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 @@ evalWithDoctypes :: Monad n
-> 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 @@ bindStrings :: Monad n
=> [(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 @@ renderTemplate :: Monad n
=> 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 @@ renderWithArgs :: Monad n
-> HeistState n
-> ByteString
-> n (Maybe (Builder, MIMEType))
-renderWithArgs args ts = renderTemplate (bindStrings args ts)
+renderWithArgs args hs = renderTemplate (bindStrings args hs)
View
15 test/suite/Heist/TestCommon.hs
@@ -3,6 +3,7 @@ module Heist.TestCommon where
------------------------------------------------------------------------------
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 @@ doctype = B.concat
, "'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 @@ loadT :: Monad m
-> 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 @@ loadIO :: FilePath
-> 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 :: FilePath -> IO (HeistState IO)
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 @@ loadEmpty :: [(Text, I.Splice IO)]
-> [(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
Please sign in to comment.
Something went wrong with that request. Please try again.