heist 0.13.1.2 → 0.14.0

raw patch · 26 files changed

+1277/−935 lines, 26 filesdep +map-syntaxdep ~basedep ~randomPVP ok

version bump matches the API change (PVP)

Dependencies added: map-syntax

Dependency ranges changed: base, random

API changes (from Hackage documentation)

Files

• .ghci +1/−0
• heist.cabal +9/−7
• src/Heist.hs +86/−79
• src/Heist/Common.hs +64/−21
• src/Heist/Compiled/Internal.hs +78/−80
• src/Heist/Internal/Types.hs +230/−0
• src/Heist/Internal/Types/HeistState.hs +548/−0
• src/Heist/Interpreted/Internal.hs +16/−19
• src/Heist/SpliceAPI.hs +26/−94
• src/Heist/Splices.hs +1/−1
• src/Heist/Splices/Apply.hs +1/−1
• src/Heist/Splices/Bind.hs +1/−1
• src/Heist/Splices/BindStrict.hs +1/−1
• src/Heist/Splices/Cache.hs +1/−1
• src/Heist/Splices/Html.hs +1/−1
• src/Heist/Splices/Json.hs +6/−6
• src/Heist/Splices/Markdown.hs +1/−1
• src/Heist/TemplateDirectory.hs +15/−10
• src/Heist/Types.hs +0/−528
• test/heist-testsuite.cabal +12/−10
• test/suite/Benchmark.hs +23/−21
• test/suite/Heist/Compiled/Tests.hs +95/−2
• test/suite/Heist/Interpreted/Tests.hs +15/−14
• test/suite/Heist/TestCommon.hs +21/−17
• test/suite/Heist/Tests.hs +21/−17
• test/suite/Heist/Tutorial/CompiledSplices.lhs +4/−3

@@ -1,4 +1,5 @@ :set -XOverloadedStrings+:set -XCPP :set -Wall :set -isrc :set -itest/suite

@@ -1,5 +1,5 @@ name:           heist-version:        0.13.1.2+version:        0.14.0 synopsis:       An Haskell template system supporting both HTML5 and XML. description:     Heist is a powerful template system that supports both HTML5 and XML.@@ -117,6 +117,7 @@     Heist,     Heist.Compiled,     Heist.Compiled.LowLevel,+    Heist.Internal.Types,     Heist.Interpreted,     Heist.SpliceAPI,     Heist.Splices,@@ -134,12 +135,12 @@     Data.HeterogeneousEnvironment,     Heist.Common,     Heist.Compiled.Internal,-    Heist.Interpreted.Internal,-    Heist.Types+    Heist.Internal.Types.HeistState,+    Heist.Interpreted.Internal    build-depends:     MonadCatchIO-transformers  >= 0.2.1   && < 0.4,-    aeson                      >= 0.6     && < 0.8,+    aeson                      >= 0.6     && < 0.9,     attoparsec                 >= 0.10    && < 0.13,     base                       >= 4       && < 5,     blaze-builder              >= 0.2     && < 0.4,@@ -152,12 +153,13 @@     errors                     >= 1.4     && < 1.5,     filepath                   >= 1.3     && < 1.4,     hashable                   >= 1.1     && < 1.3,-    mtl                        >= 2.0     && < 2.2,+    map-syntax                 >= 0.2     && < 0.3,+    mtl                        >= 2.0     && < 2.3,     process                    >= 1.1     && < 1.3,     random                     >= 1.0.1.0 && < 1.1,-    text                       >= 0.10    && < 1.2,+    text                       >= 0.10    && < 1.3,     time                       >= 1.1     && < 1.5,-    transformers               >= 0.3     && < 0.4,+    transformers               >= 0.3     && < 0.5,     unordered-containers       >= 0.1.4   && < 0.3,     vector                     >= 0.9     && < 0.11,     xmlhtml                    >= 0.2.3   && < 0.3

@@ -26,6 +26,7 @@   , defaultLoadTimeSplices    -- * Core Heist data types+  , SpliceConfig(..)   , HeistConfig(..)   , TemplateRepo   , TemplateLocation@@ -37,12 +38,29 @@   , RuntimeSplice   , Chunk   , HeistState+  , HeistT++  -- * Lenses (can be used with lens or lens-family)+  , scInterpretedSplices+  , scLoadTimeSplices+  , scCompiledSplices+  , scAttributeSplices+  , scTemplateLocations+  , hcSpliceConfig+  , hcNamespace+  , hcErrorNotBound+  , hcInterpretedSplices+  , hcLoadTimeSplices+  , hcCompiledSplices+  , hcAttributeSplices+  , hcTemplateLocations++  -- * HeistT functions   , templateNames   , compiledTemplateNames   , hasTemplate   , spliceNames   , compiledSpliceNames-  , HeistT   , evalHeistT   , getParamNode   , getContext@@ -56,76 +74,39 @@   , localHS   , getDoc   , getXMLDoc+  , tellSpliceError   , orError--  -- * Splice API   , module Heist.SpliceAPI   ) where ++------------------------------------------------------------------------------ import           Control.Error import           Control.Exception (SomeException) import           Control.Monad.CatchIO import           Control.Monad.State-import           Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.Foldable as F-import qualified Data.HeterogeneousEnvironment   as HE-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as Map+import           Data.ByteString               (ByteString)+import qualified Data.ByteString               as B+import qualified Data.Foldable                 as F+import           Data.HashMap.Strict           (HashMap)+import qualified Data.HashMap.Strict           as Map+import qualified Data.HeterogeneousEnvironment as HE+import           Data.Map.Syntax import           Data.Monoid+import           Data.Text                     (Text)+import qualified Data.Text                     as T import           System.Directory.Tree-import qualified Text.XmlHtml                    as X-+import qualified Text.XmlHtml                  as X+------------------------------------------------------------------------------ import           Heist.Common-import qualified Heist.Compiled.Internal as C-import qualified Heist.Interpreted.Internal as I+import qualified Heist.Compiled.Internal       as C+import qualified Heist.Interpreted.Internal    as I import           Heist.SpliceAPI import           Heist.Splices-import           Heist.Types---type TemplateRepo = HashMap TPath DocumentFile--+import           Heist.Internal.Types --------------------------------------------------------------------------------- | An IO action for getting a template repo from this location.  By not just--- using a directory path here, we support templates loaded from a database,--- retrieved from the network, or anything else you can think of.-type TemplateLocation = EitherT [String] IO TemplateRepo  -data HeistConfig m = HeistConfig-    { hcInterpretedSplices :: Splices (I.Splice m)-        -- ^ Interpreted splices are the splices that Heist has always had.  They-        -- return a list of nodes and are processed at runtime.-    , hcLoadTimeSplices    :: Splices (I.Splice IO)-        -- ^ Load time splices are like interpreted splices because they return a-        -- list of nodes.  But they are like compiled splices because they are-        -- processed once at load time.  All of Heist's built-in splices should be-        -- used as load time splices.-    , hcCompiledSplices    :: Splices (C.Splice m)-        -- ^ Compiled splices return a DList of Chunks and are processed at load-        -- time to generate a runtime monad action that will be used to render the-        -- template.-    , hcAttributeSplices   :: Splices (AttrSplice m)-        -- ^ Attribute splices are bound to attribute names and return a list of-        -- attributes.-    , hcTemplateLocations  :: [TemplateLocation]-        -- ^ A list of all the locations that Heist should get its templates-        -- from.  -    }---instance Monoid (HeistConfig m) where-    mempty = HeistConfig (put mempty) (put mempty) (put mempty) (put mempty) mempty-    mappend (HeistConfig a b c d e) (HeistConfig a' b' c' d' e') =-        HeistConfig (unionWithS const a a')-                    (unionWithS const b b')-                    (unionWithS const c c')-                    (unionWithS const d d')-                    (e `mappend` e')-- ------------------------------------------------------------------------------ -- | The built-in set of splices that you should use in compiled splice mode. -- This list includes everything from 'defaultInterpretedSplices' plus a@@ -133,18 +114,20 @@ -- old content tag, which has now been moved to two separate tags called -- apply-content and bind-content. defaultLoadTimeSplices :: MonadIO m => Splices (I.Splice m)-defaultLoadTimeSplices =+defaultLoadTimeSplices = do     -- To be removed in later versions-    insertS "content" deprecatedContentCheck defaultInterpretedSplices-    +    defaultInterpretedSplices+    "content" #! deprecatedContentCheck  + ------------------------------------------------------------------------------ -- | 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.  If--- you are using interpreted splice mode, then you might also want to bind the--- 'deprecatedContentCheck' splice to the content tag as a load time splice.+-- should include these in the scLoadTimeSplices list in your SpliceConfig.+-- If you are using interpreted splice mode, then you might also want to bind+-- the 'deprecatedContentCheck' splice to the content tag as a load time+-- splice. defaultInterpretedSplices :: MonadIO m => Splices (I.Splice m) defaultInterpretedSplices = do     applyTag ## applyImpl@@ -210,7 +193,7 @@ -- | 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 Html+                        True [] 0 [] Nothing kg False Html "" [] False   ------------------------------------------------------------------------------@@ -235,24 +218,45 @@           -> EitherT [String] IO (HeistState n) initHeist hc = do     keyGen <- lift HE.newKeyGen-    repos <- sequence $ hcTemplateLocations hc+    repos <- sequence $ _scTemplateLocations $ _hcSpliceConfig hc     initHeist' keyGen hc (Map.unions repos)  +------------------------------------------------------------------------------+mkSplicePrefix :: Text -> Text+mkSplicePrefix ns+  | T.null ns = ""+  | otherwise = ns `mappend` ":"+++------------------------------------------------------------------------------ initHeist' :: Monad n            => HE.KeyGen            -> HeistConfig n            -> TemplateRepo            -> EitherT [String] IO (HeistState n)-initHeist' keyGen (HeistConfig i lt c a _) repo = do+initHeist' keyGen (HeistConfig sc ns enn) repo = do     let empty = emptyHS keyGen-    tmap <- preproc keyGen lt repo-    let hs1 = empty { _spliceMap = Map.fromList $ splicesToList i+    let (SpliceConfig i lt c a _) = sc+    tmap <- preproc keyGen lt repo ns+    let prefix = mkSplicePrefix ns+    is <- runHashMap $ mapK (prefix<>) i+    cs <- runHashMap $ mapK (prefix<>) c+    as <- runHashMap $ mapK (prefix<>) a+    let hs1 = empty { _spliceMap = is                     , _templateMap = tmap-                    , _compiledSpliceMap = Map.fromList $ splicesToList c-                    , _attrSpliceMap = Map.fromList $ splicesToList a+                    , _compiledSpliceMap = cs+                    , _attrSpliceMap = as+                    , _splicePrefix = prefix+                    , _errorNotBound = enn                     }-    lift $ C.compileTemplates hs1+    EitherT $ C.compileTemplates hs1+--    liftIO $ when (not $ null $ _spliceErrors hs2) $ do+--        putStrLn "Finished compiling with errors..."+--        mapM_ T.putStrLn $ _spliceErrors hs2+--    case _spliceErrors hs2 of+--      [] -> return hs2+--      es -> left $ map T.unpack es   ------------------------------------------------------------------------------@@ -260,11 +264,14 @@ preproc :: HE.KeyGen         -> Splices (I.Splice IO)         -> TemplateRepo+        -> Text         -> EitherT [String] IO TemplateRepo-preproc keyGen splices templates = do-    let hs = (emptyHS keyGen) { _spliceMap = Map.fromList $ splicesToList splices+preproc keyGen splices templates ns = do+    sm <- runHashMap splices+    let hs = (emptyHS keyGen) { _spliceMap = sm                               , _templateMap = templates-                              , _preprocessingMode = True }+                              , _preprocessingMode = True+                              , _splicePrefix = mkSplicePrefix ns }     let eval a = evalHeistT a (X.TextNode "") hs     tPairs <- lift $ mapM (eval . preprocess) $ Map.toList templates     let bad = lefts tPairs@@ -296,21 +303,21 @@ initHeistWithCacheTag :: MonadIO n                       => HeistConfig n                       -> EitherT [String] IO (HeistState n, CacheTagState)-initHeistWithCacheTag (HeistConfig i lt c a locations) = do+initHeistWithCacheTag (HeistConfig sc ns enn) = do     (ss, cts) <- liftIO mkCacheTag     let tag = "cache"     keyGen <- lift HE.newKeyGen -    repos <- sequence locations+    repos <- sequence $ _scTemplateLocations sc     -- 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) $ Map.unions repos+    rawWithCache <- preproc keyGen (tag ## ss) (Map.unions repos) ns -    let hc' = HeistConfig (insertS tag (cacheImpl cts) i) lt-                          (insertS tag (cacheImplCompiled cts) c)-                          a locations-    hs <- initHeist' keyGen hc' rawWithCache+    let sc' = SpliceConfig (tag #! cacheImpl cts) mempty+                           (tag #! cacheImplCompiled cts) mempty mempty+    let hc = HeistConfig (mappend sc sc') ns enn+    hs <- initHeist' keyGen hc rawWithCache     return (hs, cts) 

@@ -4,28 +4,50 @@  module Heist.Common where -import           Control.Applicative-import           Control.Exception (SomeException)-import           Control.Monad-import qualified Control.Monad.CatchIO as C-import qualified Data.Attoparsec.Text            as AP-import           Data.ByteString (ByteString)-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as BC-import           Data.Hashable-import           Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as Map-import           Data.List-import           Data.Maybe-import           Data.Monoid-import qualified Data.Text                       as T-import           System.FilePath-import           Heist.SpliceAPI-import           Heist.Types-import qualified Text.XmlHtml as X+------------------------------------------------------------------------------+import           Control.Applicative      (Alternative (..), Applicative (..), (<$>))+import           Control.Error+import           Control.Exception        (SomeException)+import qualified Control.Monad.CatchIO    as C+import           Control.Monad            (liftM, mplus)+import qualified Data.Attoparsec.Text     as AP+import           Data.ByteString          (ByteString)+import qualified Data.ByteString          as B+import qualified Data.ByteString.Char8    as BC+import           Data.Hashable            (Hashable)+import           Data.HashMap.Strict      (HashMap)+import qualified Data.HashMap.Strict      as Map+import           Data.List                (isSuffixOf)+import           Data.Map.Syntax+import           Data.Monoid              (Monoid (..), (<>))+import           Data.Text                (Text)+import qualified Data.Text                as T+import           Heist.Internal.Types.HeistState+import           System.FilePath          (pathSeparator)+import qualified Text.XmlHtml             as X+------------------------------------------------------------------------------   ------------------------------------------------------------------------------+runHashMap+    :: (Monad m)+    => Splices s+    -> EitherT [String] m (HashMap T.Text s)+runHashMap ms =+    case runMapSyntax Map.lookup Map.insert ms of+      Left keys -> left $ map (T.unpack . mkMsg) keys+      Right hm -> right $ hm+  where+    mkMsg k = "You tried to bind "<>k<>" more than once!"+++------------------------------------------------------------------------------+runMapNoErrors :: (Eq k, Hashable k) => MapSyntaxM k v a -> HashMap k v+runMapNoErrors = either (const mempty) id .+    runMapSyntax' (\_ new _ -> Just new) Map.lookup Map.insert+++------------------------------------------------------------------------------ -- | If Heist is running in fail fast mode, then this function will throw an -- exception with the second argument as the error message.  Otherwise, the -- first argument will be executed to represent silent failure.@@ -37,15 +59,36 @@ orError silent msg = do     hs <- getHS     if _preprocessingMode hs-      then error $ (maybe "" (++": ") $ _curTemplateFile hs) ++ msg+      then do fullMsg <- heistErrMsg (T.pack msg)+              error $ T.unpack fullMsg       else silent   ------------------------------------------------------------------------------+-- | Prepends the location of the template currently being processed to an+-- error message.+heistErrMsg :: Monad m => Text -> HeistT n m Text+heistErrMsg msg = do+    tf <- getsHS _curTemplateFile+    return $ (maybe "" ((`mappend` ": ") . T.pack) tf) `mappend` msg+++------------------------------------------------------------------------------+-- | Adds an error message to the list of splice processing errors.+tellSpliceError :: Monad m => Text -> HeistT n m ()+tellSpliceError msg = do+    fullMsg <- heistErrMsg msg+    modifyHS (\hs -> hs { _spliceErrors = fullMsg : _spliceErrors hs })+++------------------------------------------------------------------------------ -- | Function for showing a TPath. showTPath :: TPath -> String showTPath = BC.unpack . (`BC.append` ".tpl") . tpathName ++------------------------------------------------------------------------------+-- | Convert a TPath into a ByteString path. tpathName :: TPath -> ByteString tpathName = BC.intercalate "/" . reverse @@ -294,7 +337,7 @@                      -> HeistState n           -- ^ start state                      -> HeistState n bindAttributeSplices ss hs =-    hs { _attrSpliceMap = Map.union (Map.fromList $ splicesToList ss)+    hs { _attrSpliceMap = Map.union (runMapNoErrors ss)                                     (_attrSpliceMap hs) }  

@@ -16,24 +16,24 @@ import           Control.Monad import           Control.Monad.RWS.Strict import           Control.Monad.State.Strict-import qualified Data.Attoparsec.Text            as AP-import           Data.ByteString (ByteString)-import           Data.DList                      (DList)-import qualified Data.DList                      as DL-import qualified Data.HashMap.Strict             as H-import qualified Data.HashSet                    as S-import qualified Data.HeterogeneousEnvironment   as HE+import qualified Data.Attoparsec.Text               as AP+import           Data.ByteString                    (ByteString)+import           Data.DList                         (DList)+import qualified Data.DList                         as DL+import qualified Data.HashMap.Strict                as H+import qualified Data.HashSet                       as S+import qualified Data.HeterogeneousEnvironment      as HE+import           Data.Map.Syntax 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 qualified Text.XmlHtml                    as X-import qualified Text.XmlHtml.HTML.Meta          as X+import           Data.Text                          (Text)+import qualified Data.Text                          as T+import qualified Data.Text.Encoding                 as T+import qualified Data.Vector                        as V+import qualified Text.XmlHtml                       as X+import qualified Text.XmlHtml.HTML.Meta             as X ------------------------------------------------------------------------------ import           Heist.Common-import           Heist.SpliceAPI-import           Heist.Types+import           Heist.Internal.Types.HeistState ------------------------------------------------------------------------------  @@ -122,24 +122,16 @@   --------------------------------------------------------------------------------- | Runs a single splice and returns the builder computation.-runSplice :: (Monad n)-          => X.Node-          -> HeistState n-          -> Splice n-          -> IO [Chunk n]-runSplice node hs splice = do-    !a <- evalHeistT splice node hs-    return $! consolidate a--------------------------------------------------------------------------------- -- | Runs a DocumentFile with the appropriate template context set. runDocumentFile :: Monad n                 => TPath                 -> DocumentFile                 -> Splice n runDocumentFile tpath df = do+    let markup = case dfDoc df of+                   X.XmlDocument _ _ _ -> Xml+                   X.HtmlDocument _ _ _ -> Html+    modifyHS (\hs -> hs { _curMarkup = markup })     addDoctype $ maybeToList $ X.docType $ dfDoc df     modifyHS (setCurTemplateFile curPath .  setCurContext tpath)     res <- runNodeList nodes@@ -152,46 +144,41 @@   -------------------------------------------------------------------------------compileTemplate :: Monad n-                => HeistState n-                -> TPath-                -> DocumentFile-                -> IO [Chunk n]-compileTemplate hs tpath df = do-    let markup = case dfDoc df of-                   X.XmlDocument _ _ _ -> Xml-                   X.HtmlDocument _ _ _ -> Html-        hs' = hs { _curMarkup = markup }-    !chunks <- runSplice nullNode hs' $! runDocumentFile tpath df-    return chunks-  where-    -- This gets overwritten in runDocumentFile-    nullNode = X.TextNode ""+compileTemplate+    :: Monad n+    => TPath+    -> DocumentFile+    -> HeistT n IO [Chunk n]+compileTemplate tpath df = do+    !chunks <- runDocumentFile tpath df+    return $! consolidate chunks   -------------------------------------------------------------------------------compileTemplates :: Monad n => HeistState n -> IO (HeistState n)+compileTemplates+    :: Monad n+    => HeistState n+    -> IO (Either [String] (HeistState n)) compileTemplates hs = do-    ctm <- compileTemplates' hs-    return $! hs { _compiledTemplateMap = ctm }---    let f = flip evalStateT HE.empty . unRT . codeGen---    return $! hs { _compiledTemplateMap = H.map (first f) ctm }+    (tmap, hs') <- runHeistT compileTemplates' (X.TextNode "") hs+    return $ case _spliceErrors hs' of+               [] -> Right $! hs { _compiledTemplateMap = tmap }+               es -> Left $ map T.unpack es   -------------------------------------------------------------------------------compileTemplates' :: Monad n-                  => HeistState n-                  -> IO (H.HashMap TPath ([Chunk n], MIMEType))-compileTemplates' hs = do-    ctm <- foldM runOne H.empty tpathDocfiles-    return $! ctm+compileTemplates'+    :: Monad n+    => HeistT n IO (H.HashMap TPath ([Chunk n], MIMEType))+compileTemplates' = do+    hs <- getHS+    let tpathDocfiles :: [(TPath, DocumentFile)]+        tpathDocfiles = map (\(a,b) -> (a, b))+                            (H.toList $ _templateMap hs)+    foldM runOne H.empty tpathDocfiles   where-    tpathDocfiles :: [(TPath, DocumentFile)]-    tpathDocfiles = map (\(a,b) -> (a, b))-                        (H.toList $ _templateMap hs)-     runOne tmap (tpath, df) = do-        !mHtml <- compileTemplate hs tpath df+        !mHtml <- compileTemplate tpath df         return $! H.insert tpath (mHtml, mimeType $! dfDoc df) tmap  @@ -205,29 +192,29 @@       where         ----------------------------------------------------------------------         go soFar x [] = x : soFar-    +         go soFar (Pure a) ((Pure b) : xs) =             go soFar (Pure $! a `mappend` b) xs-    +         go soFar (RuntimeHtml a) ((RuntimeHtml b) : xs) =             go soFar (RuntimeHtml $! a `mappend` b) xs-    +         go soFar (RuntimeHtml a) ((RuntimeAction b) : xs) =             go soFar (RuntimeHtml $! a >>= \x -> b >> return x) xs-    +         go soFar (RuntimeAction a) ((RuntimeHtml b) : xs) =             go soFar (RuntimeHtml $! a >> b) xs-    +         go soFar (RuntimeAction a) ((RuntimeAction b) : xs) =             go soFar (RuntimeAction $! a >> b) xs-    +         go soFar a (b : xs) = go (a : soFar) b xs-    +         ----------------------------------------------------------------------         boilDown soFar []              = soFar-    +         boilDown soFar ((Pure h) : xs) = boilDown ((Pure $! h) : soFar) xs-    +         boilDown soFar (x : xs) = boilDown (x : soFar) xs  @@ -248,7 +235,16 @@ ------------------------------------------------------------------------------ -- | Looks up a splice in the compiled splice map. lookupSplice :: Text -> HeistT n IO (Maybe (Splice n))-lookupSplice nm = getsHS (H.lookup nm . _compiledSpliceMap)+lookupSplice nm = do+    pre <- getsHS _splicePrefix+    res <- getsHS (H.lookup nm . _compiledSpliceMap)+    canError <- getsHS _errorNotBound+    if isNothing res && T.isPrefixOf pre nm && not (T.null pre)+      then do+          when canError $+            tellSpliceError $ "No splice bound for " `mappend` nm+          return Nothing+      else return res   ------------------------------------------------------------------------------@@ -317,9 +313,9 @@ -- | Given a 'X.Node' in the DOM tree, produces a \"runtime splice\" that will -- generate html at runtime. compileNode :: Monad n => X.Node -> Splice n-compileNode (X.Element nm attrs ch) =-    -- Is this node a splice, or does it merely contain splices?-    lookupSplice nm >>= fromMaybe compileStaticElement+compileNode (X.Element nm attrs ch) = do+    msplice <- lookupSplice nm+    fromMaybe compileStaticElement msplice   where     tag0 = T.append "<" nm     end = T.concat [ "</" , nm , ">"]@@ -429,8 +425,8 @@     DL.concat         [ DL.singleton $! pureTextChunk $! T.concat [" ", k, "=\""]         , v, DL.singleton $! pureTextChunk "\"" ]-     + attrToBuilder :: (Text, Text) -> Builder attrToBuilder (k,v)   | T.null v  = mconcat@@ -538,7 +534,9 @@ bindSplices :: Splices (Splice n)  -- ^ splices to bind             -> HeistState n        -- ^ source state             -> HeistState n-bindSplices ss ts = foldr (uncurry bindSplice) ts $ splicesToList ss+bindSplices ss hs =+    hs { _compiledSpliceMap = H.union (runMapNoErrors ss)+                                      (_compiledSpliceMap hs) }   ------------------------------------------------------------------------------@@ -617,9 +615,9 @@             -- ^ Runtime data needed by the above splices             -> Splice n withSplices splice splices runtimeAction =-    withLocalSplices splices' noSplices splice+    withLocalSplices splices' mempty splice   where-    splices' = mapS ($runtimeAction) splices+    splices' = mapV ($runtimeAction) splices   ------------------------------------------------------------------------------@@ -632,8 +630,8 @@                 -> Splice n manyWithSplices splice splices runtimeAction = do     p <- newEmptyPromise-    let splices' = mapS ($ getPromise p) splices-    chunks <- withLocalSplices splices' noSplices splice+    let splices' = mapV ($ getPromise p) splices+    chunks <- withLocalSplices splices' mempty splice     return $ yieldRuntime $ do         items <- runtimeAction         res <- forM items $ \item -> putPromise p item >> codeGen chunks@@ -651,8 +649,8 @@          -> Splice n manyWith splice splices attrSplices runtimeAction = do     p <- newEmptyPromise-    let splices' = mapS ($ getPromise p) splices-    let attrSplices' = mapS ($ getPromise p) attrSplices+    let splices' = mapV ($ getPromise p) splices+    let attrSplices' = mapV ($ getPromise p) attrSplices     chunks <- withLocalSplices splices' attrSplices' splice     return $ yieldRuntime $ do         items <- runtimeAction@@ -697,7 +695,7 @@ -- | Like deferMap, but only runs the result if a Maybe function of the -- runtime value returns Just.  If it returns Nothing, then no output is -- generated.--- +-- -- This is a good example of how to do more complex flow control with -- promises.  The generalization of this abstraction is too complex to be -- distilled to elegant high-level combinators.  If you need to implement your

@@ -0,0 +1,230 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE UndecidableInstances       #-}++{-|++Internal types and accessors.  There are no guarantees that heist will+preserve backwards compatibility for symbols in this module.  If you use them,+no complaining when your code breaks.++-}++module Heist.Internal.Types+  ( module Heist.Internal.Types.HeistState+  , module Heist.Internal.Types+  ) where++------------------------------------------------------------------------------+import           Control.Applicative+import           Control.Error+import           Data.HashMap.Strict (HashMap)+import           Data.Monoid+import           Data.Text (Text)+------------------------------------------------------------------------------+import qualified Heist.Compiled.Internal       as C+import qualified Heist.Interpreted.Internal    as I+import           Heist.Internal.Types.HeistState+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+type TemplateRepo = HashMap TPath DocumentFile+++------------------------------------------------------------------------------+-- | An IO action for getting a template repo from this location.  By not just+-- using a directory path here, we support templates loaded from a database,+-- retrieved from the network, or anything else you can think of.+type TemplateLocation = EitherT [String] IO TemplateRepo+++------------------------------------------------------------------------------+-- | My lens creation function to avoid a dependency on lens.+lens :: Functor f => (t1 -> t) -> (t1 -> a -> b) -> (t -> f a) -> t1 -> f b+lens sa sbt afb s = sbt s <$> afb (sa s)+++------------------------------------------------------------------------------+-- | The splices and templates Heist will use.  To bind a splice simply+-- include it in the appropriate place here.+data SpliceConfig m = SpliceConfig+    { _scInterpretedSplices :: Splices (I.Splice m)+        -- ^ Interpreted splices are the splices that Heist has always had.+        -- They return a list of nodes and are processed at runtime.+    , _scLoadTimeSplices    :: Splices (I.Splice IO)+        -- ^ Load time splices are like interpreted splices because they+        -- return a list of nodes.  But they are like compiled splices because+        -- they are processed once at load time.  All of Heist's built-in+        -- splices should be used as load time splices.+    , _scCompiledSplices    :: Splices (C.Splice m)+        -- ^ Compiled splices return a DList of Chunks and are processed at+        -- load time to generate a runtime monad action that will be used to+        -- render the template.+    , _scAttributeSplices   :: Splices (AttrSplice m)+        -- ^ Attribute splices are bound to attribute names and return a list+        -- of attributes.+    , _scTemplateLocations  :: [TemplateLocation]+        -- ^ A list of all the locations that Heist should get its templates+        -- from.+    }+++------------------------------------------------------------------------------+-- | :: Simple Lens (SpliceConfig m) (Splices (I.Splice m))+scInterpretedSplices+    :: Functor f+    => (Splices (I.Splice m) -> f (Splices (I.Splice m)))+    -> SpliceConfig m -> f (SpliceConfig m)+scInterpretedSplices = lens _scInterpretedSplices setter+  where+    setter sc v = sc { _scInterpretedSplices = v }+++------------------------------------------------------------------------------+-- | :: Simple Lens (SpliceConfig m) (Splices (I.Splice IO))+scLoadTimeSplices+    :: Functor f+    => (Splices (I.Splice IO) -> f (Splices (I.Splice IO)))+    -> SpliceConfig m -> f (SpliceConfig m)+scLoadTimeSplices = lens _scLoadTimeSplices setter+  where+    setter sc v = sc { _scLoadTimeSplices = v }+++------------------------------------------------------------------------------+-- | :: Simple Lens (SpliceConfig m) (Splices (C.Splice m))+scCompiledSplices+    :: Functor f+    => (Splices (C.Splice m) -> f (Splices (C.Splice m)))+    -> SpliceConfig m -> f (SpliceConfig m)+scCompiledSplices = lens _scCompiledSplices setter+  where+    setter sc v = sc { _scCompiledSplices = v }+++------------------------------------------------------------------------------+-- | :: Simple Lens (SpliceConfig m) (Splices (AttrSplice m))+scAttributeSplices+    :: Functor f+    => (Splices (AttrSplice m) -> f (Splices (AttrSplice m)))+    -> SpliceConfig m -> f (SpliceConfig m)+scAttributeSplices = lens _scAttributeSplices setter+  where+    setter sc v = sc { _scAttributeSplices = v }+++------------------------------------------------------------------------------+-- | :: Simple Lens (SpliceConfig m) [TemplateLocation]+scTemplateLocations+    :: Functor f+    => ([TemplateLocation] -> f [TemplateLocation])+    -> SpliceConfig m -> f (SpliceConfig m)+scTemplateLocations = lens _scTemplateLocations setter+  where+    setter sc v = sc { _scTemplateLocations = v }+++instance Monoid (SpliceConfig m) where+    mempty = SpliceConfig mempty mempty mempty mempty mempty+    mappend (SpliceConfig a1 b1 c1 d1 e1) (SpliceConfig a2 b2 c2 d2 e2) =+      SpliceConfig (mappend a1 a2) (mappend b1 b2) (mappend c1 c2)+                   (mappend d1 d2) (mappend e1 e2)+++data HeistConfig m = HeistConfig+    { _hcSpliceConfig  :: SpliceConfig m+        -- ^ Splices and templates+    , _hcNamespace     :: Text+        -- ^ A namespace to use for all tags that are bound to splices.  Use+        -- empty string for no namespace.+    , _hcErrorNotBound :: Bool+        -- ^ Whether to throw an error when a tag wih the heist namespace does+        -- not correspond to a bound splice.  When not using a namespace, this+        -- flag is ignored.+    }+++------------------------------------------------------------------------------+-- | :: Simple Lens (HeistConfig m) (SpliceConfig m)+hcSpliceConfig+    :: Functor f+    => ((SpliceConfig m) -> f (SpliceConfig m))+    -> HeistConfig m -> f (HeistConfig m)+hcSpliceConfig = lens _hcSpliceConfig setter+  where+    setter hc v = hc { _hcSpliceConfig = v }+++------------------------------------------------------------------------------+-- | :: Simple Lens (HeistConfig m) Text+hcNamespace+    :: Functor f+    => (Text -> f Text)+    -> HeistConfig m -> f (HeistConfig m)+hcNamespace = lens _hcNamespace setter+  where+    setter hc v = hc { _hcNamespace = v }+++------------------------------------------------------------------------------+-- | :: Simple Lens (HeistConfig m) Bool+hcErrorNotBound+    :: Functor f+    => (Bool -> f Bool)+    -> HeistConfig m -> f (HeistConfig m)+hcErrorNotBound = lens _hcErrorNotBound setter+  where+    setter hc v = hc { _hcErrorNotBound = v }+++------------------------------------------------------------------------------+-- | :: Simple Lens (HeistConfig m) (Splices (I.Splice m))+hcInterpretedSplices+    :: Functor f+    => (Splices (I.Splice m) -> f (Splices (I.Splice m)))+    -> HeistConfig m -> f (HeistConfig m)+hcInterpretedSplices = hcSpliceConfig . scInterpretedSplices+++------------------------------------------------------------------------------+-- | :: Simple Lens (HeistConfig m) (Splices (I.Splice IO))+hcLoadTimeSplices+    :: Functor f+    => (Splices (I.Splice IO) -> f (Splices (I.Splice IO)))+    -> HeistConfig m -> f (HeistConfig m)+hcLoadTimeSplices = hcSpliceConfig . scLoadTimeSplices +++------------------------------------------------------------------------------+-- | :: Simple Lens (HeistConfig m) (Splices (C.Splice m))+hcCompiledSplices+    :: Functor f+    => (Splices (C.Splice m) -> f (Splices (C.Splice m)))+    -> HeistConfig m -> f (HeistConfig m)+hcCompiledSplices = hcSpliceConfig . scCompiledSplices +++------------------------------------------------------------------------------+-- | :: Simple Lens (HeistConfig m) (Splices (AttrSplice m))+hcAttributeSplices+    :: Functor f+    => (Splices (AttrSplice m) -> f (Splices (AttrSplice m)))+    -> HeistConfig m -> f (HeistConfig m)+hcAttributeSplices = hcSpliceConfig . scAttributeSplices +++------------------------------------------------------------------------------+-- | :: Simple Lens (HeistConfig m) [TemplateLocation]+hcTemplateLocations+    :: Functor f+    => ([TemplateLocation] -> f [TemplateLocation])+    -> HeistConfig m -> f (HeistConfig m)+hcTemplateLocations = hcSpliceConfig . scTemplateLocations ++

@@ -0,0 +1,548 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE UndecidableInstances       #-}++{-|++This module contains the core Heist data types.++Edward Kmett wrote most of the HeistT monad code and associated instances,+liberating us from the unused writer portion of RWST.++-}++module Heist.Internal.Types.HeistState where++------------------------------------------------------------------------------+import           Blaze.ByteString.Builder+import           Control.Applicative+import           Control.Arrow+import           Control.Monad.CatchIO (MonadCatchIO)+import qualified Control.Monad.CatchIO as C+import           Control.Monad.Cont+#if MIN_VERSION_mtl(2,2,1)+import           Control.Monad.Except          (MonadError (..))+#else+import           Control.Monad.Error           (MonadError (..))+#endif+import           Control.Monad.Reader+import           Control.Monad.State.Strict+import           Data.ByteString.Char8 (ByteString)+import           Data.DList                      (DList)+import qualified Data.HashMap.Strict as H+import           Data.HashMap.Strict (HashMap)+import           Data.HeterogeneousEnvironment   (HeterogeneousEnvironment)+import qualified Data.HeterogeneousEnvironment as HE+import           Data.Map.Syntax+import           Data.Monoid+import           Data.Text (Text)+import qualified Data.Text as T+import           Data.Text.Encoding+import           Data.Typeable+import qualified Text.XmlHtml as X+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | Convenient type alies for splices.+type Splices s = MapSyntax Text s+++------------------------------------------------------------------------------+-- | A 'Template' is a forest of XML nodes.  Here we deviate from the \"single+-- root node\" constraint of well-formed XML because we want to allow+-- templates to contain document fragments that may not have a single root.+type Template = [X.Node]+++------------------------------------------------------------------------------+-- | MIME Type.  The type alias is here to make the API clearer.+type MIMEType = ByteString+++------------------------------------------------------------------------------+-- | Reversed list of directories.  This holds the path to the template+-- currently being processed.+type TPath = [ByteString]+++------------------------------------------------------------------------------+-- | Holds data about templates read from disk.+data DocumentFile = DocumentFile+    { dfDoc  :: X.Document+    , dfFile :: Maybe FilePath+    } deriving ( Eq+#if MIN_VERSION_base(4,7,0)+               , Typeable+#endif+               )+++------------------------------------------------------------------------------+-- | Designates whether a document should be treated as XML or HTML.+data Markup = Xml | Html+++------------------------------------------------------------------------------+-- | Monad used for runtime splice execution.+newtype RuntimeSplice m a = RuntimeSplice {+      unRT :: StateT HeterogeneousEnvironment m a+    } deriving ( Applicative+               , Functor+               , Monad+               , MonadIO+               , MonadState HeterogeneousEnvironment+               , MonadTrans+#if MIN_VERSION_base(4,7,0)+               , Typeable+#endif+               )+++------------------------------------------------------------------------------+instance (Monad m, Monoid a) => Monoid (RuntimeSplice m a) where+    mempty = return mempty++    a `mappend` b = do+        !x <- a+        !y <- b+        return $! x `mappend` y+++------------------------------------------------------------------------------+-- | Opaque type representing pieces of output from compiled splices.+data Chunk m = Pure !ByteString+               -- ^ output known at load time+             | RuntimeHtml !(RuntimeSplice m Builder)+               -- ^ output computed at run time+             | RuntimeAction !(RuntimeSplice m ())+               -- ^ runtime action used only for its side-effect+#if MIN_VERSION_base(4,7,0)+             deriving Typeable+#endif++instance Show (Chunk m) where+    show (Pure _) = "Pure"+    show (RuntimeHtml _) = "RuntimeHtml"+    show (RuntimeAction _) = "RuntimeAction"+++showChunk :: Chunk m -> String+showChunk (Pure b) = T.unpack $ decodeUtf8 b+showChunk (RuntimeHtml _) = "RuntimeHtml"+showChunk (RuntimeAction _) = "RuntimeAction"+++isPureChunk :: Chunk m -> Bool+isPureChunk (Pure _) = True+isPureChunk _ = False+++------------------------------------------------------------------------------+-- | Type alias for attribute splices.  The function parameter is the value of+-- the bound attribute splice.  The return value is a list of attribute+-- key/value pairs that get substituted in the place of the bound attribute.+type AttrSplice m = Text -> RuntimeSplice m [(Text, Text)]+++------------------------------------------------------------------------------+-- | Holds all the state information needed for template processing.  You will+-- build a @HeistState@ using 'initHeist' and any of Heist's @HeistState ->+-- HeistState@ \"filter\" functions.  Then you use the resulting @HeistState@+-- in calls to 'renderTemplate'.+--+-- m is the runtime monad+data HeistState m = HeistState {+    -- | A mapping of splice names to splice actions+      _spliceMap           :: HashMap Text (HeistT m m Template)+    -- | A mapping of template names to templates+    , _templateMap         :: HashMap TPath DocumentFile++    -- | A mapping of splice names to splice actions+    , _compiledSpliceMap   :: HashMap Text (HeistT m IO (DList (Chunk m)))+    -- | A mapping of template names to templates+    --, _compiledTemplateMap :: HashMap TPath (m Builder, MIMEType)+    , _compiledTemplateMap :: !(HashMap TPath ([Chunk m], MIMEType))++    , _attrSpliceMap       :: HashMap Text (AttrSplice m)++    -- | A flag to control splice recursion+    , _recurse             :: Bool+    -- | The path to the template currently being processed.+    , _curContext          :: TPath+    -- | A counter keeping track of the current recursion depth to prevent+    -- infinite loops.+    , _recursionDepth      :: Int+    -- | The doctypes encountered during template processing.+    , _doctypes            :: [X.DocType]+    -- | The full path to the current template's file on disk.+    , _curTemplateFile     :: Maybe FilePath+    -- | A key generator used to produce new unique Promises.+    , _keygen              :: HE.KeyGen++    -- | Flag indicating whether we're in preprocessing mode.  During+    -- preprocessing, errors should stop execution and be reported.  During+    -- template rendering, it's better to skip the errors and render the page.+    , _preprocessingMode   :: Bool++    -- | This is needed because compiled templates are generated with a bunch+    -- of calls to renderFragment rather than a single call to render.+    , _curMarkup           :: Markup++    -- | A prefix for all splices (namespace ++ ":").+    , _splicePrefix        :: Text++    -- | List of errors encountered during splice processing.+    , _spliceErrors        :: [Text]++    -- | Whether to throw an error when a tag wih the heist namespace does not+    -- correspond to a bound splice.  When not using a namespace, this flag is+    -- ignored.+    , _errorNotBound       :: Bool+#if MIN_VERSION_base(4,7,0)+} deriving (Typeable)+#else+}+#endif++#if !MIN_VERSION_base(4,7,0)+-- NOTE: We got rid of the Monoid instance because it is absolutely not safe+-- to combine two compiledTemplateMaps.  All compiled templates must be known+-- at load time and processed in a single call to initHeist/loadTemplates or+-- whatever we end up calling it..++instance (Typeable1 m) => Typeable (HeistState m) where+    typeOf _ = mkTyConApp templateStateTyCon [typeOf1 (undefined :: m ())]++#endif++------------------------------------------------------------------------------+-- | HeistT is the monad transformer used for splice processing.  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 HeistT in a monad+-- stack without needing calls to `lift`.+--+-- @n@ is the runtime monad (the parameter to HeistState).+--+-- @m@ is the monad being run now.  In this case, \"now\" is a variable+-- concept.  The type @HeistT n n@ means that \"now\" is runtime.  The type+-- @HeistT n IO@ means that \"now\" is @IO@, and more importantly it is NOT+-- runtime. In Heist, the rule of thumb is that @IO@ means load time and @n@+-- means runtime.+newtype HeistT n m a = HeistT {+    runHeistT :: X.Node+              -> HeistState n+              -> m (a, HeistState n)+#if MIN_VERSION_base(4,7,0)+} deriving Typeable+#else+}+#endif+++------------------------------------------------------------------------------+-- | Gets the names of all the templates defined in a HeistState.+templateNames :: HeistState m -> [TPath]+templateNames ts = H.keys $ _templateMap ts+++------------------------------------------------------------------------------+-- | Gets the names of all the templates defined in a HeistState.+compiledTemplateNames :: HeistState m -> [TPath]+compiledTemplateNames ts = H.keys $ _compiledTemplateMap ts+++------------------------------------------------------------------------------+-- | Gets the names of all the interpreted splices defined in a HeistState.+spliceNames :: HeistState m -> [Text]+spliceNames ts = H.keys $ _spliceMap ts+++------------------------------------------------------------------------------+-- | Gets the names of all the compiled splices defined in a HeistState.+compiledSpliceNames :: HeistState m -> [Text]+compiledSpliceNames ts = H.keys $ _compiledSpliceMap ts+++#if !MIN_VERSION_base(4,7,0)+------------------------------------------------------------------------------+-- | The Typeable instance is here so Heist can be dynamically executed with+-- Hint.+templateStateTyCon :: TyCon+templateStateTyCon = mkTyCon "Heist.HeistState"+{-# NOINLINE templateStateTyCon #-}+#endif+++------------------------------------------------------------------------------+-- | Evaluates a template monad as a computation in the underlying monad.+evalHeistT :: (Monad m)+           => HeistT n m a+           -> X.Node+           -> HeistState n+           -> m a+evalHeistT m r s = do+    (a, _) <- runHeistT m r s+    return a+{-# INLINE evalHeistT #-}+++------------------------------------------------------------------------------+-- | Functor instance+instance Functor m => Functor (HeistT n m) where+    fmap f (HeistT m) = HeistT $ \r s -> first f <$> m r s+++------------------------------------------------------------------------------+-- | Applicative instance+instance (Monad m, Functor m) => Applicative (HeistT n m) where+    pure = return+    (<*>) = ap+++------------------------------------------------------------------------------+-- | Monad instance+instance Monad m => Monad (HeistT n m) where+    return a = HeistT (\_ s -> return (a, s))+    {-# INLINE return #-}+    HeistT m >>= k = HeistT $ \r s -> do+        (a, s') <- m r s+        runHeistT (k a) r s'+    {-# INLINE (>>=) #-}+++------------------------------------------------------------------------------+-- | MonadIO instance+instance MonadIO m => MonadIO (HeistT n m) where+    liftIO = lift . liftIO+++------------------------------------------------------------------------------+-- | MonadTrans instance+instance MonadTrans (HeistT n) where+    lift m = HeistT $ \_ s -> do+        a <- m+        return (a, s)+++------------------------------------------------------------------------------+-- | MonadCatchIO instance+instance MonadCatchIO m => MonadCatchIO (HeistT n m) where+    catch (HeistT a) h = HeistT $ \r s -> do+       let handler e = runHeistT (h e) r s+       C.catch (a r s) handler+    block (HeistT m) = HeistT $ \r s -> C.block (m r s)+    unblock (HeistT m) = HeistT $ \r s -> C.unblock (m r s)+++------------------------------------------------------------------------------+-- | MonadFix passthrough instance+instance MonadFix m => MonadFix (HeistT n m) where+    mfix f = HeistT $ \r s ->+        mfix $ \ (a, _) -> runHeistT (f a) r s+++------------------------------------------------------------------------------+-- | Alternative passthrough instance+instance (Functor m, MonadPlus m) => Alternative (HeistT n m) where+    empty = mzero+    (<|>) = mplus+++------------------------------------------------------------------------------+-- | MonadPlus passthrough instance+instance MonadPlus m => MonadPlus (HeistT n m) where+    mzero = lift mzero+    m `mplus` n = HeistT $ \r s ->+        runHeistT m r s `mplus` runHeistT n r s+++------------------------------------------------------------------------------+-- | MonadState passthrough instance+instance MonadState s m => MonadState s (HeistT n m) where+    get = lift get+    {-# INLINE get #-}+    put = lift . put+    {-# INLINE put #-}+++------------------------------------------------------------------------------+-- | MonadReader passthrough instance+instance MonadReader r m => MonadReader r (HeistT n m) where+    ask = HeistT $ \_ s -> do+            r <- ask+            return (r,s)+    local f (HeistT m) =+        HeistT $ \r s -> local f (m r s)+++------------------------------------------------------------------------------+-- | Helper for MonadError instance.+_liftCatch+    :: (m (a,HeistState n)+        -> (e -> m (a,HeistState n))+        -> m (a,HeistState n))+    -> HeistT n m a+    -> (e -> HeistT n m a)+    -> HeistT n m a+_liftCatch ce m h =+    HeistT $ \r s ->+        (runHeistT m r s `ce`+        (\e -> runHeistT (h e) r s))+++------------------------------------------------------------------------------+-- | MonadError passthrough instance+instance (MonadError e m) => MonadError e (HeistT n m) where+    throwError = lift . throwError+    catchError = _liftCatch catchError+++------------------------------------------------------------------------------+-- | Helper for MonadCont instance.+_liftCallCC+    :: ((((a,HeistState n) -> m (b, HeistState n))+           -> m (a, HeistState n))+         -> m (a, HeistState n))+    -> ((a -> HeistT n m b) -> HeistT n m a)+    -> HeistT n m a+_liftCallCC ccc f = HeistT $ \r s ->+    ccc $ \c ->+    runHeistT (f (\a -> HeistT $ \_ _ -> c (a, s))) r s+++------------------------------------------------------------------------------+-- | MonadCont passthrough instance+instance (MonadCont m) => MonadCont (HeistT n m) where+    callCC = _liftCallCC callCC+++#if !MIN_VERSION_base(4,7,0)+------------------------------------------------------------------------------+-- | The Typeable instance is here so Heist can be dynamically executed with+-- Hint.+templateMonadTyCon :: TyCon+templateMonadTyCon = mkTyCon "Heist.HeistT"+{-# NOINLINE templateMonadTyCon #-}++instance (Typeable1 m) => Typeable1 (HeistT n m) where+    typeOf1 _ = mkTyConApp templateMonadTyCon [typeOf1 (undefined :: m ())]+#endif+++------------------------------------------------------------------------------+-- Functions for our monad.+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | Gets the node currently being processed.+--+--   > <speech author="Shakespeare">+--   >   To sleep, perchance to dream.+--   > </speech>+--+-- When you call @getParamNode@ inside the code for the @speech@ splice, it+-- returns the Node for the @speech@ tag and its children.  @getParamNode >>=+-- childNodes@ returns a list containing one 'TextNode' containing part of+-- Hamlet's speech.  @liftM (getAttribute \"author\") getParamNode@ would+-- return @Just "Shakespeare"@.+getParamNode :: Monad m => HeistT n m X.Node+getParamNode = HeistT $ curry return+{-# INLINE getParamNode #-}+++------------------------------------------------------------------------------+-- | HeistT's 'local'.+localParamNode :: Monad m+               => (X.Node -> X.Node)+               -> HeistT n m a+               -> HeistT n m a+localParamNode f m = HeistT $ \r s -> runHeistT m (f r) s+{-# INLINE localParamNode #-}+++------------------------------------------------------------------------------+-- | HeistT's 'gets'.+getsHS :: Monad m => (HeistState n -> r) -> HeistT n m r+getsHS f = HeistT $ \_ s -> return (f s, s)+{-# INLINE getsHS #-}+++------------------------------------------------------------------------------+-- | HeistT's 'get'.+getHS :: Monad m => HeistT n m (HeistState n)+getHS = HeistT $ \_ s -> return (s, s)+{-# INLINE getHS #-}+++------------------------------------------------------------------------------+-- | HeistT's 'put'.+putHS :: Monad m => HeistState n -> HeistT n m ()+putHS s = HeistT $ \_ _ -> return ((), s)+{-# INLINE putHS #-}+++------------------------------------------------------------------------------+-- | HeistT's 'modify'.+modifyHS :: Monad m+         => (HeistState n -> HeistState n)+         -> HeistT n m ()+modifyHS f = HeistT $ \_ s -> return ((), f s)+{-# INLINE modifyHS #-}+++------------------------------------------------------------------------------+-- | Restores the HeistState.  This function is almost like putHS except it+-- preserves the current doctypes.  You should use this function instead of+-- @putHS@ 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.+restoreHS :: Monad m => HeistState n -> HeistT n m ()+restoreHS old = modifyHS (\cur -> old { _doctypes = _doctypes cur })+{-# INLINE restoreHS #-}+++------------------------------------------------------------------------------+-- | Abstracts the common pattern of running a HeistT computation with+-- a modified heist state.+localHS :: Monad m+        => (HeistState n -> HeistState n)+        -> HeistT n m a+        -> HeistT n m a+localHS f k = do+    ts <- getHS+    putHS $ f ts+    res <- k+    restoreHS ts+    return res+{-# INLINE localHS #-}+++------------------------------------------------------------------------------+-- | Modifies the recursion depth.+modRecursionDepth :: Monad m => (Int -> Int) -> HeistT n m ()+modRecursionDepth f =+    modifyHS (\st -> st { _recursionDepth = f (_recursionDepth st) })+++------------------------------------------------------------------------------+-- | 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)+++------------------------------------------------------------------------------+isIdent :: AttAST -> Bool+isIdent (Ident _) = True+isIdent _         = False++

@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns               #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE PackageImports             #-}@@ -10,20 +9,19 @@ import           Blaze.ByteString.Builder import           Control.Monad import           Control.Monad.State.Strict-import qualified Data.Attoparsec.Text as AP-import           Data.ByteString (ByteString)-import           Data.List-import qualified Data.HashMap.Strict as Map-import qualified Data.HeterogeneousEnvironment   as HE+import qualified Data.Attoparsec.Text          as AP+import           Data.ByteString               (ByteString)+import qualified Data.HashMap.Strict           as Map+import qualified Data.HeterogeneousEnvironment as HE+import           Data.Map.Syntax import           Data.Maybe-import qualified Data.Text as T-import           Data.Text (Text)-import qualified Text.XmlHtml as X-+import           Data.Text                     (Text)+import qualified Data.Text                     as T+import qualified Text.XmlHtml                  as X ------------------------------------------------------------------------------ import           Heist.Common-import           Heist.SpliceAPI-import           Heist.Types+import           Heist.Internal.Types.HeistState+------------------------------------------------------------------------------   type Splice n = HeistT n n Template@@ -48,9 +46,8 @@ bindSplices :: Splices (Splice n) -- ^ splices to bind             -> HeistState n       -- ^ start state             -> HeistState n-bindSplices ss hs = foldl' (flip id) hs acts-  where-    acts = map (uncurry bindSplice) $ splicesToList ss+bindSplices ss hs =+    hs { _spliceMap = Map.union (runMapNoErrors ss) (_spliceMap hs) }   ------------------------------------------------------------------------------@@ -88,7 +85,7 @@           -> Splices b           -- ^ List of tuples to be bound           -> Splice n-runChildrenWithTrans f = runChildrenWith . mapS f+runChildrenWithTrans f = runChildrenWith . mapV f   ------------------------------------------------------------------------------@@ -288,9 +285,9 @@         ,"<"++(T.unpack $ X.elementTag node)++">.  You"         ,"probably have infinite splice recursion!"         ]-                 + ------------------------------------------------------------------------------ -- | Looks up a template name runs a 'HeistT' computation on it. lookupAndRun :: Monad m@@ -347,7 +344,7 @@             => Splices Text             -> HeistState n             -> HeistState n-bindStrings splices hs = foldr (uncurry bindString) hs $ splicesToList splices+bindStrings splices = bindSplices (mapV textSplice splices)   ------------------------------------------------------------------------------@@ -381,7 +378,7 @@                      => ByteString     -- ^ The name of the template                      -> Splices Text -- ^ Splices to call the template with                      -> HeistT n n Template-callTemplateWithText name splices = callTemplate name $ mapS textSplice splices+callTemplateWithText name splices = callTemplate name $ mapV textSplice splices   ------------------------------------------------------------------------------

@@ -23,90 +23,44 @@  -} -module Heist.SpliceAPI where+module Heist.SpliceAPI+  {-# DEPRECATED "Use Data.Map.Syntax from the map-syntax package instead" #-}+  ( SplicesM+  , Splices+  , noSplices+  , mapS+  , applyS+  , ($$)+  , mapNames+  , prefixSplices+  , namespaceSplices+  , module Data.Map.Syntax+  ) where -import           Control.Applicative-import           Control.Monad.State (State, MonadState, execState, modify)-import           Data.Map (Map)-import qualified Data.Map as M+------------------------------------------------------------------------------+import           Data.Map.Syntax import           Data.Monoid import           Data.Text (Text) import qualified Data.Text as T--+import           Heist.Internal.Types.HeistState (Splices) --------------------------------------------------------------------------------- | A monad providing convenient syntax for defining splices.-newtype SplicesM s a = SplicesM { unSplices :: State (Map Text s) a }-  deriving (Functor, Applicative, Monad, MonadState (Map Text s))  ---------------------------------------------------------------------------------- | Monoid instance does a union of the two maps with the second map--- overwriting any duplicates.-instance Monoid (Splices s) where-  mempty = noSplices-  mappend = unionWithS (\_ b -> b)------------------------------------------------------------------------------------ | Convenient type alias that will probably be used most of the time.-type Splices s = SplicesM s ()------------------------------------------------------------------------------------ | Forces a splice to be added.  If the key already exists, its value is--- overwritten.-(##) :: Text -> s -> Splices s-(##) tag splice = modify $ M.insert tag splice-infixr 0 ##------------------------------------------------------------------------------------ | Tries to add a splice, but if the key already exists, then it throws an--- error message.  This may be useful if name collisions are bad and you want--- to crash when they occur.-(#!) :: Text -> s -> Splices s-(#!) tag splice = modify $ M.insertWithKey err tag splice-  where-    err k _ _ = error $ "Key "++show k++" already exists in the splice map"-infixr 0 #!------------------------------------------------------------------------------------ | Inserts into the map only if the key does not already exist.-(#?) :: Text -> s -> Splices s-(#?) tag splice = modify $ M.insertWith (const id) tag splice-infixr 0 #?+{-# DEPRECATED SplicesM, applyS, ($$)+ "Use functions from the map-syntax package instead" #-} +type SplicesM s a = MapSyntaxM Text s a ---------------------------------------------------------------------------------- | A `Splices` with nothing in it. noSplices :: Splices s-noSplices = return ()------------------------------------------------------------------------------------ | Runs the SplicesM monad, generating a map of splices.-runSplices :: SplicesM s a -> Map Text s-runSplices splices = execState (unSplices splices) M.empty------------------------------------------------------------------------------------ | Constructs an alist representation.-splicesToList :: SplicesM s a -> [(Text, s)]-splicesToList = M.toList . runSplices------------------------------------------------------------------------------------ | Internal helper function for adding a map.-add :: Map Text s -> Splices s-add m = modify (\s -> M.unionWith (\_ b -> b) s m)+noSplices = mempty+{-# DEPRECATED noSplices "Use mempty instead" #-}   ------------------------------------------------------------------------------ -- | Maps a function over all the splices. mapS :: (a -> b) -> Splices a -> Splices b-mapS f ss = add $ M.map f $ runSplices ss +mapS = mapV+{-# DEPRECATED mapS "Use mapV from the map-syntax package instead" #-}   ------------------------------------------------------------------------------@@ -116,24 +70,6 @@   --------------------------------------------------------------------------------- | Inserts a splice into the 'Splices'.-insertS :: Text -> s -> Splices s -> Splices s-insertS = insertWithS const------------------------------------------------------------------------------------ | Inserts a splice with a function combining new value and old value.-insertWithS :: (s -> s -> s) -> Text -> s -> SplicesM s a2 -> SplicesM s ()-insertWithS f k v b = add $ M.insertWith f k v (runSplices b)------------------------------------------------------------------------------------ | Union of `Splices` with a combining function.-unionWithS :: (s -> s -> s) -> SplicesM s a1 -> SplicesM s a2 -> SplicesM s ()-unionWithS f a b = add $ M.unionWith f (runSplices a) (runSplices b)--------------------------------------------------------------------------------- -- | Infix operator for @flip applyS@ ($$) :: Splices (a -> b) -> a -> Splices b ($$) = flip applyS@@ -143,12 +79,8 @@ ------------------------------------------------------------------------------ -- | Maps a function over all the splice names. mapNames :: (Text -> Text) -> Splices a -> Splices a-mapNames f = add . M.mapKeys f . runSplices----- The following two functions are formulated as functions of Splices instead--- of a single splice because they operate on the splice names instead of the--- splices themselves.+mapNames = mapK+{-# DEPRECATED mapNames "Use mapK from the map-syntax package instead" #-}   ------------------------------------------------------------------------------@@ -157,7 +89,7 @@ -- new tag name is the prefix followed by the separator followed by the -- existing name. prefixSplices :: Text -> Text -> Splices a -> Splices a-prefixSplices sep pre = mapNames f+prefixSplices sep pre = mapK f   where     f t = if T.null t then pre else T.concat [pre,sep,t] 

@@ -18,7 +18,7 @@ import           Heist.Splices.Html import           Heist.Splices.Ignore import           Heist.Splices.Markdown-import           Heist.Types+import           Heist.Internal.Types.HeistState  ------------------------------------------------------------------------------ -- | Run the splice contents if given condition is True, make splice disappear

@@ -13,7 +13,7 @@ ------------------------------------------------------------------------------ import           Heist.Common import           Heist.Interpreted.Internal-import           Heist.Types+import           Heist.Internal.Types.HeistState   ------------------------------------------------------------------------------

@@ -10,7 +10,7 @@ import           Heist.Common import           Heist.Interpreted.Internal import           Heist.Splices.Apply-import           Heist.Types+import           Heist.Internal.Types.HeistState  -- | Default name for the bind splice. bindTag :: Text

@@ -11,7 +11,7 @@ import           Heist.Interpreted.Internal import           Heist.Splices.Apply import           Heist.Splices.Bind-import           Heist.Types+import           Heist.Internal.Types.HeistState  -- | Default name for the bind splice. bindStrictTag :: Text

@@ -43,7 +43,7 @@ ------------------------------------------------------------------------------ import qualified Heist.Compiled.Internal as C import           Heist.Interpreted.Internal-import           Heist.Types+import           Heist.Internal.Types.HeistState   ------------------------------------------------------------------------------

@@ -7,7 +7,7 @@  ------------------------------------------------------------------------------ import           Heist.Interpreted.Internal-import           Heist.Types+import           Heist.Internal.Types.HeistState   ------------------------------------------------------------------------------

@@ -11,20 +11,20 @@ import qualified Data.ByteString.Char8       as S import qualified Data.ByteString.Lazy.Char8  as L import qualified Data.HashMap.Strict         as Map+import           Data.Map.Syntax 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 qualified Text.Blaze.Html5            as B import           Text.Blaze.Html5            ((!))+import qualified Text.Blaze.Html5            as B import           Text.Blaze.Renderer.XmlHtml import           Text.XmlHtml ------------------------------------------------------------------------------- import           Heist.Interpreted.Internal-import           Heist.SpliceAPI-import           Heist.Types+import           Heist.Internal.Types.HeistState+------------------------------------------------------------------------------                                   ------------                                  -- public --@@ -208,8 +208,8 @@         "with"     ## varAttrTag v explodeTag         "snippet"  ## varAttrTag v snippetTag         "value"    ## varAttrTag v valueTag-         +     --------------------------------------------------------------------------     goObject obj = do         start <- genericBindings@@ -222,4 +222,4 @@                 T.append "with:" k    ## withValue v explodeTag                 T.append "snippet:" k ## withValue v snippetTag                 T.append "value:" k   ## withValue v valueTag-        in  unionWithS (\a _ -> a) newBindings bindings+        in  bindings >> newBindings

@@ -36,7 +36,7 @@ ------------------------------------------------------------------------------ import           Heist.Common import           Heist.Interpreted.Internal-import           Heist.Types+import           Heist.Internal.Types.HeistState  data PandocMissingException = PandocMissingException    deriving (Typeable)

@@ -37,12 +37,15 @@ ------------------------------------------------------------------------------ -- | Creates and returns a new 'TemplateDirectory' wrapped in an Either for -- error handling.-newTemplateDirectory :: MonadIO n-                     => FilePath-                     -> HeistConfig n-                     -> EitherT [String] IO (TemplateDirectory n)+newTemplateDirectory+    :: MonadIO n+    => FilePath+    -> HeistConfig n+    -- namespaced tag.+    -> EitherT [String] IO (TemplateDirectory n) newTemplateDirectory dir hc = do-    let hc' = hc { hcTemplateLocations = [loadTemplates dir] }+    let sc = (_hcSpliceConfig hc) { _scTemplateLocations = [loadTemplates dir] }+    let hc' = hc { _hcSpliceConfig = sc }     (hs,cts) <- initHeistWithCacheTag hc'     tsMVar <- liftIO $ newMVar hs     ctsMVar <- liftIO $ newMVar cts@@ -52,10 +55,11 @@ ------------------------------------------------------------------------------ -- | Creates and returns a new 'TemplateDirectory', using the monad's fail -- function on error.-newTemplateDirectory' :: MonadIO n-                      => FilePath-                      -> HeistConfig n-                      -> IO (TemplateDirectory n)+newTemplateDirectory'+    :: MonadIO n+    => FilePath+    -> HeistConfig n+    -> IO (TemplateDirectory n) newTemplateDirectory' dir hc = do     res <- runEitherT $ newTemplateDirectory dir hc     either (error . concat) return res@@ -83,7 +87,8 @@                         -> IO (Either String ()) reloadTemplateDirectory (TemplateDirectory p hc tsMVar ctsMVar) = do     ehs <- runEitherT $ do-        initHeistWithCacheTag (hc { hcTemplateLocations = [loadTemplates p] })+        let sc = (_hcSpliceConfig hc) { _scTemplateLocations = [loadTemplates p] }+        initHeistWithCacheTag (hc { _hcSpliceConfig = sc })     leftPass ehs $ \(hs,cts) -> do         modifyMVar_ tsMVar (const $ return hs)         modifyMVar_ ctsMVar (const $ return cts)

@@ -1,528 +0,0 @@-{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE DeriveDataTypeable         #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}--{-|--This module contains the core Heist data types.--Edward Kmett wrote most of the HeistT monad code and associated instances,-liberating us from the unused writer portion of RWST.---}--module Heist.Types where---------------------------------------------------------------------------------import           Blaze.ByteString.Builder-import           Control.Applicative-import           Control.Arrow-import           Control.Monad.CatchIO (MonadCatchIO)-import qualified Control.Monad.CatchIO as C-import           Control.Monad.Cont-import           Control.Monad.Error-import           Control.Monad.Reader-import           Control.Monad.State.Strict-import           Data.ByteString.Char8 (ByteString)-import           Data.DList                      (DList)-import qualified Data.HashMap.Strict as H-import           Data.HashMap.Strict (HashMap)-import           Data.HeterogeneousEnvironment   (HeterogeneousEnvironment)-import qualified Data.HeterogeneousEnvironment as HE-import           Data.Monoid-import           Data.Text (Text)-import qualified Data.Text as T-import           Data.Text.Encoding-import           Data.Typeable-import qualified Text.XmlHtml as X--import Debug.Trace--tr :: Show a => String -> a -> a-tr s x = trace (s++show x) x----------------------------------------------------------------------------------- | A 'Template' is a forest of XML nodes.  Here we deviate from the \"single--- root node\" constraint of well-formed XML because we want to allow--- templates to contain document fragments that may not have a single root.-type Template = [X.Node]------------------------------------------------------------------------------------ | MIME Type.  The type alias is here to make the API clearer.-type MIMEType = ByteString------------------------------------------------------------------------------------ | Reversed list of directories.  This holds the path to the template--- currently being processed.-type TPath = [ByteString]------------------------------------------------------------------------------------ | Holds data about templates read from disk.-data DocumentFile = DocumentFile-    { dfDoc  :: X.Document-    , dfFile :: Maybe FilePath-    } deriving ( Eq-#if MIN_VERSION_base(4,7,0)-               , Typeable-#endif-               )------------------------------------------------------------------------------------ | Designates whether a document should be treated as XML or HTML.-data Markup = Xml | Html------------------------------------------------------------------------------------ | Monad used for runtime splice execution.-newtype RuntimeSplice m a = RuntimeSplice {-      unRT :: StateT HeterogeneousEnvironment m a-    } deriving ( Applicative-               , Functor-               , Monad-               , MonadIO-               , MonadState HeterogeneousEnvironment-               , MonadTrans-#if MIN_VERSION_base(4,7,0)-               , Typeable-#endif-               )----------------------------------------------------------------------------------instance (Monad m, Monoid a) => Monoid (RuntimeSplice m a) where-    mempty = return mempty--    a `mappend` b = do-        !x <- a-        !y <- b-        return $! x `mappend` y------------------------------------------------------------------------------------ | Opaque type representing pieces of output from compiled splices.-data Chunk m = Pure !ByteString-               -- ^ output known at load time-             | RuntimeHtml !(RuntimeSplice m Builder)-               -- ^ output computed at run time-             | RuntimeAction !(RuntimeSplice m ())-               -- ^ runtime action used only for its side-effect-#if MIN_VERSION_base(4,7,0)-             deriving Typeable-#endif--instance Show (Chunk m) where-    show (Pure _) = "Pure"-    show (RuntimeHtml _) = "RuntimeHtml"-    show (RuntimeAction _) = "RuntimeAction"---showChunk :: Chunk m -> String-showChunk (Pure b) = T.unpack $ decodeUtf8 b-showChunk (RuntimeHtml _) = "RuntimeHtml"-showChunk (RuntimeAction _) = "RuntimeAction"---isPureChunk :: Chunk m -> Bool-isPureChunk (Pure _) = True-isPureChunk _ = False------------------------------------------------------------------------------------ | Type alias for attribute splices.  The function parameter is the value of--- the bound attribute splice.  The return value is a list of attribute--- key/value pairs that get substituted in the place of the bound attribute.-type AttrSplice m = Text -> RuntimeSplice m [(Text, Text)]------------------------------------------------------------------------------------ | Holds all the state information needed for template processing.  You will--- build a @HeistState@ using 'initHeist' and any of Heist's @HeistState ->--- HeistState@ \"filter\" functions.  Then you use the resulting @HeistState@--- in calls to 'renderTemplate'.------ m is the runtime monad-data HeistState m = HeistState {-    -- | A mapping of splice names to splice actions-      _spliceMap           :: HashMap Text (HeistT m m Template)-    -- | A mapping of template names to templates-    , _templateMap         :: HashMap TPath DocumentFile--    -- | A mapping of splice names to splice actions-    , _compiledSpliceMap   :: HashMap Text (HeistT m IO (DList (Chunk m)))-    -- | A mapping of template names to templates-    --, _compiledTemplateMap :: HashMap TPath (m Builder, MIMEType)-    , _compiledTemplateMap :: !(HashMap TPath ([Chunk m], MIMEType))--    , _attrSpliceMap       :: HashMap Text (AttrSplice m)--    -- | A flag to control splice recursion-    , _recurse             :: Bool-    -- | The path to the template currently being processed.-    , _curContext          :: TPath-    -- | A counter keeping track of the current recursion depth to prevent-    -- infinite loops.-    , _recursionDepth      :: Int-    -- | The doctypes encountered during template processing.-    , _doctypes            :: [X.DocType]-    -- | The full path to the current template's file on disk.-    , _curTemplateFile     :: Maybe FilePath-    -- | A key generator used to produce new unique Promises.-    , _keygen              :: HE.KeyGen--    -- | Flag indicating whether we're in preprocessing mode.  During-    -- preprocessing, errors should stop execution and be reported.  During-    -- template rendering, it's better to skip the errors and render the page.-    , _preprocessingMode   :: Bool--    -- | This is needed because compiled templates are generated with a bunch-    -- of calls to renderFragment rather than a single call to render.-    , _curMarkup           :: Markup-#if MIN_VERSION_base(4,7,0)-} deriving (Typeable)-#else-}-#endif--#if !MIN_VERSION_base(4,7,0)--- NOTE: We got rid of the Monoid instance because it is absolutely not safe--- to combine two compiledTemplateMaps.  All compiled templates must be known--- at load time and processed in a single call to initHeist/loadTemplates or--- whatever we end up calling it..--instance (Typeable1 m) => Typeable (HeistState m) where-    typeOf _ = mkTyConApp templateStateTyCon [typeOf1 (undefined :: m ())]--#endif----------------------------------------------------------------------------------- | HeistT is the monad transformer used for splice processing.  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 HeistT in a monad--- stack without needing calls to `lift`.------ @n@ is the runtime monad (the parameter to HeistState).------ @m@ is the monad being run now.  In this case, \"now\" is a variable--- concept.  The type @HeistT n n@ means that \"now\" is runtime.  The type--- @HeistT n IO@ means that \"now\" is @IO@, and more importantly it is NOT--- runtime. In Heist, the rule of thumb is that @IO@ means load time and @n@--- means runtime.-newtype HeistT n m a = HeistT {-    runHeistT :: X.Node-              -> HeistState n-              -> m (a, HeistState n)-#if MIN_VERSION_base(4,7,0)-} deriving Typeable-#else-}-#endif------------------------------------------------------------------------------------ | Gets the names of all the templates defined in a HeistState.-templateNames :: HeistState m -> [TPath]-templateNames ts = H.keys $ _templateMap ts------------------------------------------------------------------------------------ | Gets the names of all the templates defined in a HeistState.-compiledTemplateNames :: HeistState m -> [TPath]-compiledTemplateNames ts = H.keys $ _compiledTemplateMap ts------------------------------------------------------------------------------------ | Gets the names of all the interpreted splices defined in a HeistState.-spliceNames :: HeistState m -> [Text]-spliceNames ts = H.keys $ _spliceMap ts------------------------------------------------------------------------------------ | Gets the names of all the compiled splices defined in a HeistState.-compiledSpliceNames :: HeistState m -> [Text]-compiledSpliceNames ts = H.keys $ _compiledSpliceMap ts---#if !MIN_VERSION_base(4,7,0)---------------------------------------------------------------------------------- | The Typeable instance is here so Heist can be dynamically executed with--- Hint.-templateStateTyCon :: TyCon-templateStateTyCon = mkTyCon "Heist.HeistState"-{-# NOINLINE templateStateTyCon #-}-#endif------------------------------------------------------------------------------------ | Evaluates a template monad as a computation in the underlying monad.-evalHeistT :: (Monad m)-           => HeistT n m a-           -> X.Node-           -> HeistState n-           -> m a-evalHeistT m r s = do-    (a, _) <- runHeistT m r s-    return a-{-# INLINE evalHeistT #-}------------------------------------------------------------------------------------ | Functor instance-instance Functor m => Functor (HeistT n m) where-    fmap f (HeistT m) = HeistT $ \r s -> first f <$> m r s------------------------------------------------------------------------------------ | Applicative instance-instance (Monad m, Functor m) => Applicative (HeistT n m) where-    pure = return-    (<*>) = ap------------------------------------------------------------------------------------ | Monad instance-instance Monad m => Monad (HeistT n m) where-    return a = HeistT (\_ s -> return (a, s))-    {-# INLINE return #-}-    HeistT m >>= k = HeistT $ \r s -> do-        (a, s') <- m r s-        runHeistT (k a) r s'-    {-# INLINE (>>=) #-}------------------------------------------------------------------------------------ | MonadIO instance-instance MonadIO m => MonadIO (HeistT n m) where-    liftIO = lift . liftIO------------------------------------------------------------------------------------ | MonadTrans instance-instance MonadTrans (HeistT n) where-    lift m = HeistT $ \_ s -> do-        a <- m-        return (a, s)------------------------------------------------------------------------------------ | MonadCatchIO instance-instance MonadCatchIO m => MonadCatchIO (HeistT n m) where-    catch (HeistT a) h = HeistT $ \r s -> do-       let handler e = runHeistT (h e) r s-       C.catch (a r s) handler-    block (HeistT m) = HeistT $ \r s -> C.block (m r s)-    unblock (HeistT m) = HeistT $ \r s -> C.unblock (m r s)------------------------------------------------------------------------------------ | MonadFix passthrough instance-instance MonadFix m => MonadFix (HeistT n m) where-    mfix f = HeistT $ \r s ->-        mfix $ \ (a, _) -> runHeistT (f a) r s------------------------------------------------------------------------------------ | Alternative passthrough instance-instance (Functor m, MonadPlus m) => Alternative (HeistT n m) where-    empty = mzero-    (<|>) = mplus------------------------------------------------------------------------------------ | MonadPlus passthrough instance-instance MonadPlus m => MonadPlus (HeistT n m) where-    mzero = lift mzero-    m `mplus` n = HeistT $ \r s ->-        runHeistT m r s `mplus` runHeistT n r s------------------------------------------------------------------------------------ | MonadState passthrough instance-instance MonadState s m => MonadState s (HeistT n m) where-    get = lift get-    {-# INLINE get #-}-    put = lift . put-    {-# INLINE put #-}------------------------------------------------------------------------------------ | MonadReader passthrough instance-instance MonadReader r m => MonadReader r (HeistT n m) where-    ask = HeistT $ \_ s -> do-            r <- ask-            return (r,s)-    local f (HeistT m) =-        HeistT $ \r s -> local f (m r s)------------------------------------------------------------------------------------ | Helper for MonadError instance.-liftCatch :: (m (a,HeistState n)-              -> (e -> m (a,HeistState n))-              -> m (a,HeistState n))-          -> HeistT n m a-          -> (e -> HeistT n m a)-          -> HeistT n m a-liftCatch ce m h =-    HeistT $ \r s ->-        (runHeistT m r s `ce`-        (\e -> runHeistT (h e) r s))------------------------------------------------------------------------------------ | MonadError passthrough instance-instance (MonadError e m) => MonadError e (HeistT n m) where-    throwError = lift . throwError-    catchError = liftCatch catchError------------------------------------------------------------------------------------ | Helper for MonadCont instance.-liftCallCC :: ((((a,HeistState n) -> m (b, HeistState n))-                  -> m (a, HeistState n))-                -> m (a, HeistState n))-           -> ((a -> HeistT n m b) -> HeistT n m a)-           -> HeistT n m a-liftCallCC ccc f = HeistT $ \r s ->-    ccc $ \c ->-    runHeistT (f (\a -> HeistT $ \_ _ -> c (a, s))) r s------------------------------------------------------------------------------------ | MonadCont passthrough instance-instance (MonadCont m) => MonadCont (HeistT n m) where-    callCC = liftCallCC callCC---#if !MIN_VERSION_base(4,7,0)---------------------------------------------------------------------------------- | The Typeable instance is here so Heist can be dynamically executed with--- Hint.-templateMonadTyCon :: TyCon-templateMonadTyCon = mkTyCon "Heist.HeistT"-{-# NOINLINE templateMonadTyCon #-}--instance (Typeable1 m) => Typeable1 (HeistT n m) where-    typeOf1 _ = mkTyConApp templateMonadTyCon [typeOf1 (undefined :: m ())]-#endif------------------------------------------------------------------------------------ Functions for our monad.------------------------------------------------------------------------------------------------------------------------------------------------------------------- | Gets the node currently being processed.------   > <speech author="Shakespeare">---   >   To sleep, perchance to dream.---   > </speech>------ When you call @getParamNode@ inside the code for the @speech@ splice, it--- returns the Node for the @speech@ tag and its children.  @getParamNode >>=--- childNodes@ returns a list containing one 'TextNode' containing part of--- Hamlet's speech.  @liftM (getAttribute \"author\") getParamNode@ would--- return @Just "Shakespeare"@.-getParamNode :: Monad m => HeistT n m X.Node-getParamNode = HeistT $ curry return-{-# INLINE getParamNode #-}------------------------------------------------------------------------------------ | HeistT's 'local'.-localParamNode :: Monad m-               => (X.Node -> X.Node)-               -> HeistT n m a-               -> HeistT n m a-localParamNode f m = HeistT $ \r s -> runHeistT m (f r) s-{-# INLINE localParamNode #-}------------------------------------------------------------------------------------ | HeistT's 'gets'.-getsHS :: Monad m => (HeistState n -> r) -> HeistT n m r-getsHS f = HeistT $ \_ s -> return (f s, s)-{-# INLINE getsHS #-}------------------------------------------------------------------------------------ | HeistT's 'get'.-getHS :: Monad m => HeistT n m (HeistState n)-getHS = HeistT $ \_ s -> return (s, s)-{-# INLINE getHS #-}------------------------------------------------------------------------------------ | HeistT's 'put'.-putHS :: Monad m => HeistState n -> HeistT n m ()-putHS s = HeistT $ \_ _ -> return ((), s)-{-# INLINE putHS #-}------------------------------------------------------------------------------------ | HeistT's 'modify'.-modifyHS :: Monad m-         => (HeistState n -> HeistState n)-         -> HeistT n m ()-modifyHS f = HeistT $ \_ s -> return ((), f s)-{-# INLINE modifyHS #-}------------------------------------------------------------------------------------ | Restores the HeistState.  This function is almost like putHS except it--- preserves the current doctypes.  You should use this function instead of--- @putHS@ 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.-restoreHS :: Monad m => HeistState n -> HeistT n m ()-restoreHS old = modifyHS (\cur -> old { _doctypes = _doctypes cur })-{-# INLINE restoreHS #-}------------------------------------------------------------------------------------ | Abstracts the common pattern of running a HeistT computation with--- a modified heist state.-localHS :: Monad m-        => (HeistState n -> HeistState n)-        -> HeistT n m a-        -> HeistT n m a-localHS f k = do-    ts <- getHS-    putHS $ f ts-    res <- k-    restoreHS ts-    return res-{-# INLINE localHS #-}------------------------------------------------------------------------------------ | Modifies the recursion depth.-modRecursionDepth :: Monad m => (Int -> Int) -> HeistT n m ()-modRecursionDepth f =-    modifyHS (\st -> st { _recursionDepth = f (_recursionDepth st) })------------------------------------------------------------------------------------ | 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)----------------------------------------------------------------------------------isIdent :: AttAST -> Bool-isIdent (Ident _) = True-isIdent _         = False--

@@ -14,7 +14,7 @@     test-framework             >= 0.4      && < 0.9,     test-framework-hunit       >= 0.2.7    && < 0.4,     test-framework-quickcheck2 >= 0.2.12.1 && < 0.4,-    aeson                      >= 0.6      && < 0.8,+    aeson                      >= 0.6      && < 0.9,     attoparsec                 >= 0.10     && < 0.13,     base                       >= 4        && < 5,     blaze-builder              >= 0.2      && < 0.4,@@ -27,12 +27,13 @@     errors                     >= 1.4      && < 1.5,     filepath                   >= 1.3      && < 1.4,     hashable                   >= 1.1      && < 1.3,-    mtl                        >= 2.0      && < 2.2,+    lens                       >= 4.3      && < 4.5,+    mtl                        >= 2.0      && < 2.3,     process                    >= 1.1      && < 1.3,     random                     >= 1.0.1.0  && < 1.1,-    text                       >= 0.10     && < 1.2,+    text                       >= 0.10     && < 1.3,     time                       >= 1.1      && < 1.5,-    transformers               >= 0.2      && < 0.4,+    transformers               >= 0.2      && < 0.5,     unordered-containers       >= 0.1.4    && < 0.3,     vector                     >= 0.9      && < 0.11,     xmlhtml                    >= 0.2.3    && < 0.3@@ -48,13 +49,13 @@   build-depends:     MonadCatchIO-transformers >= 0.3     && < 0.4,     HUnit                     >= 1.2     && < 1.3,-    criterion                 >= 0.6     && < 0.9,+    criterion                 >= 1.0     && < 1.1,     test-framework            >= 0.4     && < 0.9,     test-framework-hunit      >= 0.2     && < 0.4,      -- Copied from regular dependencies: -    aeson                      >= 0.6     && < 0.8,+    aeson                      >= 0.6     && < 0.9,     attoparsec                 >= 0.10    && < 0.13,     base                       >= 4       && < 5,     blaze-builder              >= 0.2     && < 0.4,@@ -67,13 +68,14 @@     errors                     >= 1.4     && < 1.5,     filepath                   >= 1.3     && < 1.4,     hashable                   >= 1.1     && < 1.3,-    mtl                        >= 2.0     && < 2.2,+    map-syntax                 >= 0.1     && < 0.3,+    mtl                        >= 2.0     && < 2.3,     process                    >= 1.1     && < 1.3,     random                     >= 1.0.1.0 && < 1.1,-    statistics                 >= 0.11    && < 0.12,-    text                       >= 0.10    && < 1.2,+    statistics                 >= 0.11    && < 0.14,+    text                       >= 0.10    && < 1.3,     time                       >= 1.1     && < 1.5,-    transformers               >= 0.2     && < 0.4,+    transformers               >= 0.2     && < 0.5,     unordered-containers       >= 0.1.4   && < 0.3,     vector                     >= 0.9     && < 0.11,     xmlhtml                    >= 0.2.3   && < 0.3

@@ -5,35 +5,37 @@  ------------------------------------------------------------------------------ import           Blaze.ByteString.Builder-import           Criterion-import           Criterion.Main-import           Criterion.Measurement hiding (getTime) import           Control.Concurrent import           Control.Error-import           Control.Exception (evaluate)+import           Control.Exception        (evaluate) import           Control.Monad-import qualified Data.ByteString as B-import qualified Data.DList as DL+import           Criterion+import           Criterion.Main+import           Criterion.Measurement    hiding (getTime)+import qualified Data.ByteString          as B+import qualified Data.DList               as DL+import           Data.Maybe import           Data.Monoid-import qualified Data.Text as T+import qualified Data.Text                as T import           Data.Text.Encoding import           Data.Time.Clock-import           Data.Maybe-import qualified Text.XmlHtml as X import           System.Environment--import Heist-import Heist.Common-import qualified Heist.Compiled as C-import qualified Heist.Compiled.Internal as CI-import qualified Heist.Interpreted as I-import Heist.TestCommon-import Heist.Types+import qualified Text.XmlHtml             as X+------------------------------------------------------------------------------+import           Heist+import           Heist.Common+import qualified Heist.Compiled           as C+import qualified Heist.Compiled.Internal  as CI+import qualified Heist.Interpreted        as I+import           Heist.TestCommon+import           Heist.Internal.Types+------------------------------------------------------------------------------  loadWithCache baseDir = do     etm <- runEitherT $ do-        let hc = HeistConfig mempty defaultLoadTimeSplices mempty mempty [loadTemplates baseDir]-        initHeistWithCacheTag hc+        let sc = SpliceConfig mempty defaultLoadTimeSplices mempty mempty+                              [loadTemplates baseDir]+        initHeistWithCacheTag $ HeistConfig sc "" False     either (error . unlines) (return . fst) etm  main = do@@ -98,12 +100,12 @@ --        putStrLn "Template rendered correctly"      defaultMain [-         bench (page++"-speed") action+         bench (page++"-speed") (whnfIO action)        ]   testNode =-  X.Element "div" [("foo", "aoeu"), ("bar", "euid")] +  X.Element "div" [("foo", "aoeu"), ("bar", "euid")]     [X.Element "b" [] [X.TextNode "bolded text"]     ,X.TextNode " not bolded"     ,X.Element "a" [("href", "/path/to/page")] [X.TextNode "link"]

@@ -1,13 +1,23 @@+{-# LANGUAGE OverloadedStrings #-}+ module Heist.Compiled.Tests   ( tests   ) where +import           Blaze.ByteString.Builder+import           Control.Error+import           Control.Lens+import           Control.Monad.Trans+import           Data.Map.Syntax+import           Data.Monoid import           Test.Framework (Test) import           Test.Framework.Providers.HUnit import qualified Test.HUnit as H   ------------------------------------------------------------------------------+import           Heist+import           Heist.Compiled import           Heist.Tutorial.CompiledSplices import           Heist.TestCommon @@ -19,6 +29,11 @@ tests :: [Test] tests = [ testCase     "compiled/simple"       simpleCompiledTest         , testCase     "compiled/people"       peopleTest+        , testCase     "compiled/namespace1"    namespaceTest1+        , testCase     "compiled/namespace2"    namespaceTest2+        , testCase     "compiled/namespace3"    namespaceTest3+        , testCase     "compiled/namespace4"    namespaceTest4+        , testCase     "compiled/namespace5"    namespaceTest5         ]  simpleCompiledTest :: IO ()@@ -27,7 +42,7 @@     H.assertEqual "compiled state splice" expected res   where     expected =-      "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" 'http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd'>\n&#10;<html>&#10;3&#10;</html>&#10;"+      mappend doctype "\n&#10;<html>&#10;3&#10;</html>&#10;"  peopleTest :: IO () peopleTest = do@@ -35,5 +50,83 @@     H.assertEqual "people splice" expected res   where     expected =-      "&#10;<p>Doe, John: 42&#32;years old</p>&#10;&#10;<p>Smith, Jane: 21&#32;years old</p>&#10;&#10;"+      mappend doctype "\n&#10;<p>Doe, John: 42&#32;years old</p>&#10;&#10;<p>Smith, Jane: 21&#32;years old</p>&#10;&#10;"++templateHC :: HeistConfig IO+templateHC = HeistConfig sc "" False+  where+    sc = mempty & scLoadTimeSplices .~ defaultLoadTimeSplices+                & scCompiledSplices .~ ("foo" ## return (yieldPureText "aoeu"))+                & scTemplateLocations .~ [loadTemplates "templates"]++namespaceTest1 :: IO ()+namespaceTest1 = do+    res <- runEitherT $ do+        hs <- initHeist templateHC+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test" (Right expected) res+  where+    expected = mappend doctype "\nAlpha\naoeu&#10;Beta\n<h:foo aoeu='htns'>Inside h:foo</h:foo>&#10;End\n"+++namespaceTest2 :: IO ()+namespaceTest2 = do+    res <- runEitherT $ do+        hs <- initHeist $ templateHC & hcErrorNotBound .~ True+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test" (Right expected) res+  where+    expected = mappend doctype "\nAlpha\naoeu&#10;Beta\n<h:foo aoeu='htns'>Inside h:foo</h:foo>&#10;End\n"+++namespaceTest3 :: IO ()+namespaceTest3 = do+    res <- runEitherT $ do+        hs <- initHeist $ templateHC & hcNamespace .~ "h"+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test" (Right expected) res+  where+    expected = mappend doctype "\nAlpha\n<foo aoeu='htns'>Inside foo</foo>&#10;Beta\naoeu&#10;End\n"+++namespaceTest4 :: IO ()+namespaceTest4 = do+    res <- runEitherT $ do+        hs <- initHeist $ templateHC & hcNamespace .~ "h"+                                     & hcErrorNotBound .~ True+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test" (Right expected) res+  where+    expected = mappend doctype "\nAlpha\n<foo aoeu='htns'>Inside foo</foo>&#10;Beta\naoeu&#10;End\n"+++namespaceTest5 :: IO ()+namespaceTest5 = do+    res <- runEitherT $ do+        hs <- initHeist $ templateHC & hcNamespace .~ "h"+                                     & hcCompiledSplices .~ mempty+                                     & hcErrorNotBound .~ True+        runner <- noteT ["Error rendering"] $ hoistMaybe $+                    renderTemplate hs "namespaces"+        b <- lift $ fst runner+        return $ toByteString b++    H.assertEqual "namespace test" (Left ["templates/namespaces.tpl: No splice bound for h:foo"]) res+ 

@@ -14,20 +14,21 @@ import           Control.Error 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.HashMap.Strict as Map+import           Data.ByteString.Char8                (ByteString)+import qualified Data.ByteString.Char8                as B+import qualified Data.ByteString.Lazy.Char8           as L+import qualified Data.HashMap.Strict                  as Map+import           Data.Map.Syntax import           Data.Maybe import           Data.Monoid-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import           Data.Text (Text)+import           Data.Text                            (Text)+import qualified Data.Text                            as T+import qualified Data.Text.Encoding                   as T import           System.IO.Unsafe-import           Test.Framework (Test)+import           Test.Framework                       (Test) import           Test.Framework.Providers.HUnit import           Test.Framework.Providers.QuickCheck2-import qualified Test.HUnit as H+import qualified Test.HUnit                           as H import           Test.QuickCheck import           Test.QuickCheck.Monadic @@ -41,9 +42,9 @@ import           Heist.Splices.Json import           Heist.Splices.Markdown import           Heist.TestCommon-import           Heist.Types-import qualified Text.XmlHtml        as X-import qualified Text.XmlHtml.Cursor as X+import           Heist.Internal.Types+import qualified Text.XmlHtml                         as X+import qualified Text.XmlHtml.Cursor                  as X   ------------------------------------------------------------------------------@@ -117,7 +118,7 @@ hasTemplateTest :: H.Assertion hasTemplateTest = do     ets <- loadIO "templates" mempty mempty mempty mempty-    let tm = either (error "Error loading templates") _templateMap ets+    let tm = either (error . unlines) _templateMap ets     hs <- loadEmpty mempty mempty mempty mempty     let hs's = setTemplates tm hs     H.assertBool "hasTemplate hs's" (hasTemplate "index" hs's)@@ -138,7 +139,7 @@     ets <- loadIO "templates" mempty mempty mempty mempty     either (error "Error loading templates")            (\ts -> do let tm = _templateMap ts-                      H.assertEqual "loadTest size" 37 $ Map.size tm+                      H.assertEqual "loadTest size" 38 $ Map.size tm            ) ets  

@@ -4,18 +4,19 @@ import           Blaze.ByteString.Builder import           Control.Error import           Control.Monad.Trans-import           Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as B+import           Data.ByteString.Char8      (ByteString)+import qualified Data.ByteString.Char8      as B+import           Data.Map.Syntax import           Data.Maybe import           Data.Monoid   ------------------------------------------------------------------------------ import           Heist-import qualified Heist.Compiled as C-import qualified Heist.Interpreted as I+import qualified Heist.Compiled             as C+import qualified Heist.Interpreted          as I import qualified Heist.Interpreted.Internal as I-import qualified Text.XmlHtml        as X+import qualified Text.XmlHtml               as X   ------------------------------------------------------------------------------@@ -34,9 +35,10 @@       -> Splices (AttrSplice m)       -> IO (Either [String] (HeistState m)) loadT baseDir a b c d = runEitherT $ do-    let hc = HeistConfig (defaultInterpretedSplices `mappend` a)-                         (defaultLoadTimeSplices `mappend` b) c d [loadTemplates baseDir]-    initHeist hc+    let sc = SpliceConfig (defaultInterpretedSplices `mappend` a)+                          (defaultLoadTimeSplices `mappend` b) c d+                          [loadTemplates baseDir]+    initHeist $ HeistConfig sc "" False   ------------------------------------------------------------------------------@@ -47,18 +49,20 @@        -> Splices (AttrSplice IO)        -> IO (Either [String] (HeistState IO)) loadIO baseDir a b c d = runEitherT $ do-    let hc = HeistConfig (defaultInterpretedSplices `mappend` a)-                         (defaultLoadTimeSplices `mappend` b) c d [loadTemplates baseDir]-    initHeist hc+    let sc = SpliceConfig (defaultInterpretedSplices >> a)+                          (defaultLoadTimeSplices >> b) c d+                          [loadTemplates baseDir]+    initHeist $ HeistConfig sc "" False   ------------------------------------------------------------------------------ loadHS :: FilePath -> IO (HeistState IO) loadHS baseDir = do     etm <- runEitherT $ do-        let hc = HeistConfig defaultInterpretedSplices-                             defaultLoadTimeSplices mempty mempty [loadTemplates baseDir]-        initHeist hc+        let sc = SpliceConfig defaultInterpretedSplices+                              defaultLoadTimeSplices mempty mempty+                              [loadTemplates baseDir]+        initHeist $ HeistConfig sc "" False     either (error . concat) return etm  @@ -68,9 +72,9 @@           -> Splices (AttrSplice IO)           -> IO (HeistState IO) loadEmpty a b c d = do-    let hc = HeistConfig (defaultInterpretedSplices `mappend` a)-                         (defaultLoadTimeSplices `mappend` b) c d mempty-    res <- runEitherT $ initHeist hc+    let sc = SpliceConfig (defaultInterpretedSplices `mappend` a)+                          (defaultLoadTimeSplices `mappend` b) c d mempty+    res <- runEitherT $ initHeist $ HeistConfig sc "" False     either (error . concat) return res  

@@ -7,25 +7,26 @@ ------------------------------------------------------------------------------ import           Blaze.ByteString.Builder import           Control.Monad.State-import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Char8           as B import           Data.List+import           Data.Map.Syntax import           Data.Maybe import           Data.Monoid-import qualified Data.Text as T-import           Test.Framework (Test)+import qualified Data.Text                       as T+import           Test.Framework                  (Test) import           Test.Framework.Providers.HUnit-import qualified Test.HUnit as H+import qualified Test.HUnit                      as H   ------------------------------------------------------------------------------ import           Heist-import qualified Heist.Compiled as C-import           Heist.Tutorial.AttributeSplices-import           Heist.Tutorial.CompiledSplices-import qualified Heist.Interpreted as I+import qualified Heist.Compiled                  as C+import qualified Heist.Interpreted               as I import           Heist.Splices.Cache import           Heist.Splices.Html import           Heist.TemplateDirectory+import           Heist.Tutorial.AttributeSplices+import           Heist.Tutorial.CompiledSplices  import           Heist.TestCommon @@ -34,8 +35,8 @@         , testCase     "attrsplice/autocheck"  attrSpliceTest         , testCase     "tdirCache"             tdirCacheTest         , testCase     "headMerge"             headMergeTest-        , testCase     "bindApplyInteraction"  bindApplyInteractionTest -        , testCase     "backslashHandling"     backslashHandlingTest +        , testCase     "bindApplyInteraction"  bindApplyInteractionTest+        , testCase     "backslashHandling"     backslashHandlingTest         ]  @@ -79,8 +80,8 @@   where     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;"+    expected3 = mappend doctype "\n<input type=\"checkbox\" value=\"foo\" checked />&#10;<input type=\"checkbox\" value=\"bar\" />&#10;"+    expected4 = mappend doctype "\n<input type=\"checkbox\" value=\"foo\" />&#10;<input type=\"checkbox\" value=\"bar\" checked />&#10;"  fooSplice :: I.Splice (StateT Int IO) fooSplice = do@@ -92,9 +93,10 @@ tdirCacheTest = do     let rSplices = ("foosplice" ## fooSplice)         dSplices = ("foosplice" ## stateSplice)-        hc = HeistConfig rSplices mempty dSplices mempty mempty+        sc = SpliceConfig rSplices mempty dSplices mempty mempty+        hc = HeistConfig sc "" False     td <- newTemplateDirectory' "templates" hc-            +     [a,b,c,d] <- evalStateT (testInterpreted td) 5     H.assertBool "interpreted doesn't cache" $ a == b     H.assertBool "interpreted doesn't clear" $ b /= c@@ -149,7 +151,8 @@       (toByteString mres)   where     expected = B.intercalate "\n"-      ["<html><head>\n<link href='wrapper-link' />\n"+      [doctype+      ,"<html><head>\n<link href='wrapper-link' />\n"       ,"<link href='nav-link' />\n\n<link href='index-link' />"       ,"</head>\n\n<body>\n\n<div>nav bar</div>\n\n\n"       ,"<div>index page</div>\n\n</body>\n</html>&#10;&#10;"@@ -166,7 +169,8 @@     H.assertEqual "interpreted failure" iExpected iOut   where     cExpected = B.intercalate "\n"-      ["&#10;This is a test."+      [doctype+      ,"&#10;This is a test."       ,"===bind content===&#10;Another test line."       ,"apply content&#10;Last test line."       ,"&#10;"@@ -192,6 +196,6 @@     iOut <- iRender hs "backslash"     H.assertEqual "interpreted failure" iExpected iOut   where-    cExpected = "<foo regex='abc\\d+\\\\e'></foo>&#10;"+    cExpected = mappend doctype "\n<foo regex='abc\\d+\\\\e'></foo>&#10;"     iExpected = "<foo regex='abc\\d+\\\\e'></foo>\n" 

@@ -28,6 +28,7 @@ > import           Heist.Tutorial.Imports  > import           Control.Applicative+> import           Data.Map.Syntax > import qualified Data.Text as T > import           Data.Text.Encoding > import qualified Heist.Compiled.LowLevel as C@@ -113,9 +114,9 @@ >      -> IO (HeistState n) > load baseDir splices = do >     tmap <- runEitherT $ do->         let hc = HeistConfig mempty defaultLoadTimeSplices splices mempty->                              [loadTemplates baseDir]->         initHeist hc+>         let sc = SpliceConfig mempty defaultLoadTimeSplices splices mempty+>                               [loadTemplates baseDir]+>         initHeist $ HeistConfig sc "" False >     either (error . concat) return tmap  Here's a function demonstrating all of this in action.