heist 0.10.1 → 0.10.2

raw patch · 7 files changed

+119/−86 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• heist.cabal +1/−1
• src/Heist.hs +69/−28
• src/Heist/Interpreted.hs +1/−0
• src/Heist/Interpreted/Internal.hs +21/−12
• test/suite/Heist/Interpreted/Tests.hs +13/−32
• test/suite/Heist/TestCommon.hs +10/−5
• test/suite/Heist/Tests.hs +4/−8

@@ -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.

@@ -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) 

@@ -52,6 +52,7 @@   , lookupSplice   , bindSplice   , bindSplices+  , bindAttributeSplices    -- * Functions for creating splices   , textSplice

@@ -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)  

@@ -201,14 +201,12 @@         H.assertEqual str expected $ toByteString $ resDoc      out1 = B.unlines-        [doctype-        ,"<mytag flag>Empty attribute</mytag>"+        ["<mytag flag>Empty attribute</mytag>"         ,"<mytag flag='abc${foo}'>No ident capture</mytag>"         ,"<div id='pre_meaning_of_everything_post'></div>"         ]     out2 = B.unlines-        [doctype-        ,"<mytag flag>Empty attribute</mytag>"+        ["<mytag flag>Empty attribute</mytag>"         ,"<mytag flag='abc${foo}'>No ident capture</mytag>"         ,"<div id='pre__post'></div>"         ]@@ -232,10 +230,8 @@  ------------------------------------------------------------------------------ markdownHtmlExpected :: ByteString-markdownHtmlExpected = B.concat-    [ doctype-    , "<div class='markdown'><p>This <em>is</em> a test.</p></div>"-    ]+markdownHtmlExpected =+    "<div class='markdown'><p>This <em>is</em> a test.</p></div>"  ------------------------------------------------------------------------------ -- | Markdown test on a file@@ -250,11 +246,9 @@     renderTest "json_snippet" jsonExpected2    where-    jsonExpected1 = B.concat [ doctype-                             , "<i>&lt;b&gt;ok&lt;/b&gt;</i><i>1</i>"+    jsonExpected1 = B.concat [ "<i>&lt;b&gt;ok&lt;/b&gt;</i><i>1</i>"                              , "<i></i><i>false</i><i>foo</i>" ]-    jsonExpected2 = B.concat-        [doctype, "<i><b>ok</b></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>"   @@ -263,9 +257,7 @@ jsonObjectTest = do     renderTest "json_object" jsonExpected   where-    jsonExpected = B.concat-        [ doctype-        , "<i>1</i><i><b>ok</b></i>12quuxquux1<b>ok</b>" ]+    jsonExpected = "<i>1</i><i><b>ok</b></i>12quuxquux1<b>ok</b>"   ------------------------------------------------------------------------------@@ -305,10 +297,7 @@ titleExpansion :: H.Assertion titleExpansion = renderTest "title_expansion" expected   where-    expected = B.concat-        [ doctype-        , "<title>foo</title>"-        ]+    expected = "<title>foo</title>"   ------------------------------------------------------------------------------@@ -325,24 +314,20 @@ divExpansion :: H.Assertion divExpansion = renderTest "div_expansion" expected   where-    expected = B.concat-        [ doctype-        , "<div>foo</div>"-        ]+    expected = "<div>foo</div>"   ------------------------------------------------------------------------------ -- | Handling of <content> and bound parameters in a bound tag. bindParam :: H.Assertion-bindParam = renderTest "bind_param" $-    B.concat [doctype, "<li>Hi there world</li>"]+bindParam = renderTest "bind_param" "<li>Hi there world</li>"   ------------------------------------------------------------------------------ -- | Handling of <content> and bound parameters in a bound tag. attrSpliceContext :: H.Assertion-attrSpliceContext = renderTest "attrsubtest2" $-    B.append doctype "<a href='asdf'>link</a><a href='before$after'>foo</a>"+attrSpliceContext = renderTest "attrsubtest2"+    "<a href='asdf'>link</a><a href='before$after'>foo</a>"   ------------------------------------------------------------------------------@@ -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))   ------------------------------------------------------------------------------

@@ -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 

@@ -76,8 +76,8 @@     H.assertEqual "compiled bar" expected4       (toByteString builder2)   where-    expected1 = doctype `B.append` "\n<input type='checkbox' value='foo' checked />\n<input type='checkbox' value='bar' />\n"-    expected2 = doctype `B.append` "\n<input type='checkbox' value='foo' />\n<input type='checkbox' value='bar' checked />\n"+    expected1 = "<input type='checkbox' value='foo' checked />\n<input type='checkbox' value='bar' />\n"+    expected2 = "<input type='checkbox' value='foo' />\n<input type='checkbox' value='bar' checked />\n"     expected3 = "<input type=\"checkbox\" value=\"foo\" checked />&#10;<input type=\"checkbox\" value=\"bar\" />&#10;"     expected4 = "<input type=\"checkbox\" value=\"foo\" />&#10;<input type=\"checkbox\" value=\"bar\" checked />&#10;" @@ -171,8 +171,7 @@       ,"&#10;"       ]     iExpected = B.unlines-      [doctype-      ,"&#10;This is a test."+      ["&#10;This is a test."       ,"===bind content==="       ,"Another test line."       ,"apply content"@@ -193,8 +192,5 @@     H.assertEqual "interpreted failure" iExpected iOut   where     cExpected = "<foo regex='d+\\d'></foo>&#10;"-    iExpected = B.unlines-      [doctype-      ,"<foo regex='d+\\d'></foo>"-      ]+    iExpected = "<foo regex='d+\\d'></foo>\n"