heist 0.12.0 → 0.13.0

raw patch · 19 files changed

+467/−482 lines, 19 filesdep ~xmlhtmlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: xmlhtml

API changes (from Hackage documentation)

Files

• heist.cabal +4/−2
• src/Heist.hs +35/−31
• src/Heist/Common.hs +14/−7
• src/Heist/Compiled.hs +11/−32
• src/Heist/Compiled/Internal.hs +98/−285
• src/Heist/Compiled/LowLevel.hs +20/−0
• src/Heist/Interpreted/Internal.hs +16/−29
• src/Heist/SpliceAPI.hs +163/−0
• src/Heist/Splices.hs +4/−3
• src/Heist/Splices/Json.hs +15/−13
• src/Heist/Splices/Markdown.hs +0/−1
• src/Heist/Types.hs +5/−5
• test/heist-testsuite.cabal +3/−2
• test/suite/Benchmark.hs +2/−1
• test/suite/Heist/Compiled/Tests.hs +2/−1
• test/suite/Heist/Interpreted/Tests.hs +24/−24
• test/suite/Heist/TestCommon.hs +19/−20
• test/suite/Heist/Tests.hs +7/−6
• test/suite/Heist/Tutorial/CompiledSplices.lhs +25/−20

@@ -1,5 +1,5 @@ name:           heist-version:        0.12.0+version:        0.13.0 synopsis:       An Haskell template system supporting both HTML5 and XML. description:     Heist is a powerful template system that supports both HTML5 and XML.@@ -116,7 +116,9 @@   exposed-modules:     Heist,     Heist.Compiled,+    Heist.Compiled.LowLevel,     Heist.Interpreted,+    Heist.SpliceAPI,     Heist.Splices,     Heist.Splices.Apply,     Heist.Splices.Bind,@@ -158,7 +160,7 @@     transformers               >= 0.3     && < 0.4,     unordered-containers       >= 0.1.4   && < 0.3,     vector                     >= 0.9     && < 0.11,-    xmlhtml                    >= 0.2.1   && < 0.3+    xmlhtml                    >= 0.2.3   && < 0.3    if impl(ghc >= 6.12.0)     ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

@@ -36,7 +36,7 @@   , AttrSplice   , RuntimeSplice   , Chunk-  , HeistState(..)+  , HeistState   , templateNames   , compiledTemplateNames   , hasTemplate@@ -57,12 +57,15 @@   , getDoc   , getXMLDoc   , orError++  -- * Splice API+  , module Heist.SpliceAPI   ) where  import           Control.Error import           Control.Exception (SomeException) import           Control.Monad.CatchIO-import           Control.Monad.Trans+import           Control.Monad.State import           Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.Foldable as F@@ -70,13 +73,13 @@ import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as Map import           Data.Monoid-import           Data.Text                       (Text) import           System.Directory.Tree import qualified Text.XmlHtml                    as X  import           Heist.Common import qualified Heist.Compiled.Internal as C import qualified Heist.Interpreted.Internal as I+import           Heist.SpliceAPI import           Heist.Splices import           Heist.Types @@ -92,19 +95,19 @@   data HeistConfig m = HeistConfig-    { hcInterpretedSplices :: [(Text, I.Splice m)]+    { 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    :: [(Text, I.Splice IO)]+    , 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    :: [(Text, C.Splice m)]+    , 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   :: [(Text, AttrSplice m)]+    , hcAttributeSplices   :: Splices (AttrSplice m)         -- ^ Attribute splices are bound to attribute names and return a list of         -- attributes.     , hcTemplateLocations  :: [TemplateLocation]@@ -114,12 +117,12 @@   instance Monoid (HeistConfig m) where-    mempty = HeistConfig [] [] [] [] mempty+    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 (a `mappend` a')-                    (b `mappend` b')-                    (c `mappend` c')-                    (d `mappend` d')+        HeistConfig (unionWithS const a a')+                    (unionWithS const b b')+                    (unionWithS const c c')+                    (unionWithS const d d')                     (e `mappend` e')  @@ -129,10 +132,11 @@ -- splice for the content tag that errors out when it sees any instance of the -- old content tag, which has now been moved to two separate tags called -- apply-content and bind-content.-defaultLoadTimeSplices :: MonadIO m => [(Text, (I.Splice m))]+defaultLoadTimeSplices :: MonadIO m => Splices (I.Splice m) defaultLoadTimeSplices =-    ("content", deprecatedContentCheck) -- To be removed in later versions-    : defaultInterpretedSplices+    -- To be removed in later versions+    insertS "content" deprecatedContentCheck defaultInterpretedSplices+       ------------------------------------------------------------------------------@@ -141,15 +145,15 @@ -- 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.-defaultInterpretedSplices :: MonadIO m => [(Text, (I.Splice m))]-defaultInterpretedSplices =-    [ (applyTag, applyImpl)-    , (bindTag, bindImpl)-    , (ignoreTag, ignoreImpl)-    , (markdownTag, markdownSplice)-    ]+defaultInterpretedSplices :: MonadIO m => Splices (I.Splice m)+defaultInterpretedSplices = do+    applyTag ## applyImpl+    bindTag ## bindImpl+    ignoreTag ## ignoreImpl+    markdownTag ## markdownSplice  + allErrors :: [Either String (TPath, v)]           -> EitherT [String] IO (HashMap TPath v) allErrors tlist =@@ -240,13 +244,13 @@            -> HeistConfig n            -> TemplateRepo            -> EitherT [String] IO (HeistState n)-initHeist' keyGen (HeistConfig i lt c a locations) repo = do+initHeist' keyGen (HeistConfig i lt c a _) repo = do     let empty = emptyHS keyGen     tmap <- preproc keyGen lt repo-    let hs1 = empty { _spliceMap = Map.fromList i+    let hs1 = empty { _spliceMap = Map.fromList $ splicesToList i                     , _templateMap = tmap-                    , _compiledSpliceMap = Map.fromList c-                    , _attrSpliceMap = Map.fromList a+                    , _compiledSpliceMap = Map.fromList $ splicesToList c+                    , _attrSpliceMap = Map.fromList $ splicesToList a                     }     lift $ C.compileTemplates hs1 @@ -254,11 +258,11 @@ ------------------------------------------------------------------------------ -- | Runs preprocess on a TemplateRepo and returns the modified templates. preproc :: HE.KeyGen-        -> [(Text, I.Splice IO)]+        -> Splices (I.Splice IO)         -> TemplateRepo         -> EitherT [String] IO TemplateRepo preproc keyGen splices templates = do-    let hs = (emptyHS keyGen) { _spliceMap = Map.fromList splices+    let hs = (emptyHS keyGen) { _spliceMap = Map.fromList $ splicesToList splices                               , _templateMap = templates                               , _preprocessingMode = True }     let eval a = evalHeistT a (X.TextNode "") hs@@ -302,10 +306,10 @@     -- 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 -    let hc' = HeistConfig ((tag, cacheImpl cts) : i) lt-                          ((tag, cacheImplCompiled cts) : c)+    let hc' = HeistConfig (insertS tag (cacheImpl cts) i) lt+                          (insertS tag (cacheImplCompiled cts) c)                           a locations     hs <- initHeist' keyGen hc' rawWithCache     return (hs, cts)

@@ -7,12 +7,11 @@ import           Control.Applicative import           Control.Exception (SomeException) import           Control.Monad-import           Control.Monad.CatchIO+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.Either import           Data.Hashable import           Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as Map@@ -20,8 +19,8 @@ import           Data.Maybe import           Data.Monoid import qualified Data.Text                       as T-import           Prelude hiding (catch) import           System.FilePath+import           Heist.SpliceAPI import           Heist.Types import qualified Text.XmlHtml as X @@ -239,7 +238,7 @@ -- | Reads an HTML or XML template from disk. getDocWith :: ParserFun -> String -> IO (Either String DocumentFile) getDocWith parser f = do-    bs <- catch (liftM Right $ B.readFile f)+    bs <- C.catch (liftM Right $ B.readFile f)                 (\(e::SomeException) -> return $ Left $ show e)      let eitherDoc = either Left (parser f) bs@@ -291,10 +290,18 @@  ------------------------------------------------------------------------------ -- | Binds a set of new splice declarations within a 'HeistState'.-bindAttributeSplices :: [(T.Text, AttrSplice n)] -- ^ splices to bind-                     -> HeistState n             -- ^ start state+bindAttributeSplices :: Splices (AttrSplice n) -- ^ splices to bind+                     -> HeistState n           -- ^ start state                      -> HeistState n bindAttributeSplices ss hs =-    hs { _attrSpliceMap = Map.union (Map.fromList ss) (_attrSpliceMap hs) }+    hs { _attrSpliceMap = Map.union (Map.fromList $ splicesToList ss)+                                    (_attrSpliceMap hs) }+++------------------------------------------------------------------------------+-- | Mappends a doctype to the state.+addDoctype :: Monad m => [X.DocType] -> HeistT n m ()+addDoctype dt = do+    modifyHS (\s -> s { _doctypes = _doctypes s `mappend` dt })  

@@ -21,33 +21,17 @@   , runChildren    -- * Functions for manipulating lists of compiled splices-  , mapSnd-  , applySnd-  , prefixSplices-  , namespaceSplices-  , textSplices-  , htmlSplices-  , pureSplices   , textSplice-  , htmlSplice+  , nodeSplice   , pureSplice-  , repromise-  , repromiseMay-  , repromise'-  , repromiseMay'-  , defer+   , deferMany+  , deferMap+  , mayDeferMap+  , bindLater   , withSplices   , manyWithSplices-  , withPureSplices--  -- * Old compiled splice API-  , mapPromises-  , promiseChildren-  , promiseChildrenWith-  , promiseChildrenWithTrans-  , promiseChildrenWithText-  , promiseChildrenWithNodes+  , withLocalSplices    -- * Constructing Chunks   -- $yieldOverview@@ -56,15 +40,7 @@   , yieldRuntimeEffect   , yieldPureText   , yieldRuntimeText-  , withLocalSplices -  -- * Lower level promise functions-  , Promise-  , newEmptyPromise-  , getPromise-  , putPromise-  , adjustPromise-   -- * Running nodes and splices   , runNodeList   , runNode@@ -79,5 +55,8 @@ -- $yieldOverview -- The internals of the Chunk data type are deliberately not exported because -- we want to hide the underlying implementation as much as possible.  The--- @yield...@ functions give you lower lever construction of Chunks and DLists--- of Chunks.+-- @yield...@ functions give you lower level construction of DLists of Chunks.+--+-- Most of the time you will use these functions composed with return to+-- generate a Splice.  But we decided not to include the return in these+-- functions to allow you to work with the DLists purely.

@@ -28,11 +28,11 @@ import qualified Data.Text                       as T import qualified Data.Text.Encoding              as T import qualified Data.Vector                     as V-import           Prelude                         hiding (catch) import qualified Text.XmlHtml                    as X import qualified Text.XmlHtml.HTML.Meta          as X ------------------------------------------------------------------------------ import           Heist.Common+import           Heist.SpliceAPI import           Heist.Types ------------------------------------------------------------------------------ @@ -61,87 +61,6 @@ {-# INLINE runChildren #-}  ---------------------------------------------------------------------------------- | Takes a promise function and a runtime action returning a list of items--- that fit in the promise and returns a Splice that executes the promise--- function for each item and concatenates the results.------ This function works nicely with the 'promiseChildrenWith' family of--- functions, much like the combination of 'mapSplices' and 'runChildrenWith'--- for interpreted splices.-mapPromises :: Monad n-            => (Promise a -> HeistT n IO (RuntimeSplice n Builder))-            -- ^ Use 'promiseChildrenWith' or a variant to create this-            -- function.-            -> RuntimeSplice n [a]-            -- ^ Runtime computation returning a list of items-            -> Splice n-mapPromises f getList = do-    singlePromise <- newEmptyPromise-    runSingle <- f singlePromise-    return $ yieldRuntime $ do-        list <- getList-        htmls <- forM list $ \item ->-            putPromise singlePromise item >> runSingle-        return $ mconcat htmls------------------------------------------------------------------------------------ | Returns a runtime computation that simply renders the node's children.-promiseChildren :: Monad n => HeistT n IO (RuntimeSplice n Builder)-promiseChildren = liftM codeGen runChildren-{-# INLINE promiseChildren #-}------------------------------------------------------------------------------------ | Binds a list of Builder splices before using the children of the spliced--- node as a view.-promiseChildrenWith :: (Monad n)-                    => [(Text, a -> Builder)]-                    -> Promise a-                    -> HeistT n IO (RuntimeSplice n Builder)-promiseChildrenWith splices prom =-    localHS (bindSplices splices') promiseChildren-  where-    fieldSplice p f = return $ yieldRuntime $ liftM f $ getPromise p-    splices' = map (second (fieldSplice prom)) splices------------------------------------------------------------------------------------ | Wrapper that composes a transformation function with the second item in--- each of the tuples before calling promiseChildren.-promiseChildrenWithTrans :: Monad n-                         => (b -> Builder)-                         -> [(Text, a -> b)]-                         -> Promise a-                         -> HeistT n IO (RuntimeSplice n Builder)-promiseChildrenWithTrans f = promiseChildrenWith . map (second (f .))------------------------------------------------------------------------------------ | Binds a list of Text splices before using the children of the spliced--- node as a view.-promiseChildrenWithText :: (Monad n)-                        => [(Text, a -> Text)]-                        -> Promise a-                        -> HeistT n IO (RuntimeSplice n Builder)-promiseChildrenWithText = promiseChildrenWithTrans fromText------------------------------------------------------------------------------------ | Binds a list of Node splices before using the children of the spliced--- node as a view.  Note that this will slow down page generation because the--- nodes generated by the splices must be traversed and rendered into a--- ByteString at runtime.-promiseChildrenWithNodes :: (Monad n)-                         => [(Text, a -> [X.Node])]-                         -> Promise a-                         -> HeistT n IO (RuntimeSplice n Builder)-promiseChildrenWithNodes ss p = do-    markup <- getsHS _curMarkup-    promiseChildrenWithTrans (renderFragment markup) ss p-- renderFragment :: Markup -> [X.Node] -> Builder renderFragment markup ns =     case markup of@@ -210,7 +129,7 @@           -> Splice n           -> IO [Chunk n] runSplice node hs splice = do-    (!a,_) <- runHeistT splice node hs+    !a <- evalHeistT splice node hs     return $! consolidate a  @@ -221,8 +140,12 @@                 -> DocumentFile                 -> Splice n runDocumentFile tpath df = do+    addDoctype $ maybeToList $ X.docType $ dfDoc df     modifyHS (setCurTemplateFile curPath .  setCurContext tpath)-    runNodeList nodes+    res <- runNodeList nodes+    dt <- getsHS (listToMaybe . _doctypes)+    let enc = X.docEncoding $ dfDoc df+    return $! (yieldPure (X.renderDocType enc dt) `mappend` res)   where     curPath     = dfFile df     nodes       = X.docContent $! dfDoc df@@ -482,7 +405,9 @@ -- | Performs splice processing on a list of attributes.  This is useful in -- situations where you need to stop recursion, but still run splice -- processing on the node's attributes.-runAttributes :: Monad n => [(Text, Text)] -> HeistT n IO [DList (Chunk n)]+runAttributes :: Monad n+              => [(Text, Text)] -- ^ List of attributes+              -> HeistT n IO [DList (Chunk n)] runAttributes = mapM parseAtt  @@ -491,7 +416,8 @@ -- situations where you need to stop recursion, but still run splice -- processing on the node's attributes. runAttributesRaw :: Monad n-                 => [(Text, Text)]+                 -- Note that this parameter should not be changed to Splices+                 => [(Text, Text)] -- ^ List of attributes                  -> HeistT n IO (RuntimeSplice n [(Text, Text)]) runAttributesRaw attrs = do     arrs <- mapM parseAtt2 attrs@@ -609,18 +535,18 @@  ------------------------------------------------------------------------------ -- | Binds a list of compiled splices.  This function should not be exported.-bindSplices :: [(Text, Splice n)]  -- ^ splices to bind+bindSplices :: Splices (Splice n)  -- ^ splices to bind             -> HeistState n        -- ^ source state             -> HeistState n-bindSplices ss ts = foldr (uncurry bindSplice) ts ss+bindSplices ss ts = foldr (uncurry bindSplice) ts $ splicesToList ss   ------------------------------------------------------------------------------ -- | Adds a list of compiled splices to the splice map.  This function is -- useful because it allows compiled splices to bind other compiled splices -- during load-time splice processing.-withLocalSplices :: [(Text, Splice n)]-                 -> [(Text, AttrSplice n)]+withLocalSplices :: Splices (Splice n)+                 -> Splices (AttrSplice n)                  -> HeistT n IO a                  -> HeistT n IO a withLocalSplices ss as = localHS (bindSplices ss . bindAttributeSplices as)@@ -656,165 +582,75 @@   --------------------------------------------------------------------------------- Functions for manipulating lists of compiled splices------------------------------------------------------------------------------------------------------------------------------------------------------------------- | Helper function for transforming the second element of each of a list of--- tuples.-mapSnd :: (b -> c) -> [(d, b)] -> [(d, c)]-mapSnd = map . second------------------------------------------------------------------------------------ | The type signature says it all.-applySnd :: a -> [(d, a -> b)] -> [(d, b)]-applySnd a = mapSnd ($a)------------------------------------------------------------------------------------ | Adds a prefix to the tag names for a list of splices.  If the existing--- tag name is empty, then the new tag name is just the prefix.  Otherwise the--- new tag name is the prefix followed by the separator followed by the--- existing name.-prefixSplices :: Text -> Text -> [(Text, a)] -> [(Text, a)]-prefixSplices sep pre = map f-  where-    f (t,v) = if T.null t then (pre,v) else (T.concat [pre,sep,t], v)------------------------------------------------------------------------------------ | 'prefixSplices' specialized to use a colon as separator in the style of--- XML namespaces.-namespaceSplices :: Text -> [(Text, a)] -> [(Text, a)]-namespaceSplices = prefixSplices ":"------------------------------------------------------------------------------------ | Converts pure text splices to pure Builder splices.-textSplices :: [(Text, a -> Text)] -> [(Text, a -> Builder)]-textSplices = mapSnd textSplice--------------------------------------------------------------------------------- -- | Converts a pure text splice function to a pure Builder splice function. textSplice :: (a -> Text) -> a -> Builder textSplice f = fromText . f  ---------------------------------------------------------------------------------- | Converts pure Node splices to pure Builder splices.-htmlSplices :: [(Text, a -> [X.Node])] -> [(Text, a -> Builder)]-htmlSplices = mapSnd htmlSplice+                               ---------------+                               -- New Stuff --+                               ---------------   ------------------------------------------------------------------------------ -- | Converts a pure Node splice function to a pure Builder splice function.-htmlSplice :: (a -> [X.Node]) -> a -> Builder-htmlSplice f = X.renderHtmlFragment X.UTF8 . f------------------------------------------------------------------------------------ | Converts pure Builder splices into monadic splice functions of a--- 'Promise'.-pureSplices :: Monad n => [(d, a -> Builder)] -> [(d, Promise a -> Splice n)]-pureSplices = mapSnd pureSplice+nodeSplice :: (a -> [X.Node]) -> a -> Builder+nodeSplice f = X.renderHtmlFragment X.UTF8 . f   ------------------------------------------------------------------------------ -- | Converts a pure Builder splice function into a monadic splice function--- that takes a 'Promise'.-pureSplice :: Monad n => (a -> Builder) -> Promise a -> Splice n-pureSplice f p = do-    return $ yieldRuntime $ do-        a <- getPromise p-        return $ f a------------------------------------------------------------------------------------ | Change the promise type of a splice function.-repromise' :: Monad n-           => (a -> RuntimeSplice n b)-           -> (Promise b -> Splice n)-           -> Promise a -> Splice n-repromise' f pf p = do-    p2 <- newEmptyPromise-    let action = yieldRuntimeEffect $ do-            a <- getPromise p-            putPromise p2 =<< f a-    res <- pf p2-    return $ action `mappend` res------------------------------------------------------------------------------------ | Repromise a list of splices.-repromise :: Monad n-          => (a -> RuntimeSplice n b)-          -> [(d, Promise b -> Splice n)]-          -> [(d, Promise a -> Splice n)]-repromise f = mapSnd (repromise' f)------------------------------------------------------------------------------------ | Change the promise type of a splice function with a function that might--- fail.  If a Nothing is encountered, then the splice will generate no--- output.-repromiseMay' :: Monad n-              => (a -> RuntimeSplice n (Maybe b))-              -> (Promise b -> Splice n)-              -> Promise a -> Splice n-repromiseMay' f pf p = do-    p2 <- newEmptyPromise-    action <- pf p2-    return $ yieldRuntime $ do-        a <- getPromise p-        mb <- f a-        case mb of-          Nothing -> return mempty-          Just b -> do-            putPromise p2 b-            codeGen action+-- of a RuntimeSplice.+pureSplice :: Monad n => (a -> Builder) -> RuntimeSplice n a -> Splice n+pureSplice f n = return $ yieldRuntime (return . f =<< n)   --------------------------------------------------------------------------------- | repromiseMay' for a list of splices.-repromiseMay :: Monad n-             => (a -> RuntimeSplice n (Maybe b))-             -> [(d, Promise b -> Splice n)]-             -> [(d, Promise a -> Splice n)]-repromiseMay f = mapSnd (repromiseMay' f)+-- | Runs a splice, but first binds splices given by splice functions that+-- need some runtime data.+withSplices :: Monad n+            => Splice n+            -- ^ Splice to be run+            -> Splices (RuntimeSplice n a -> Splice n)+            -- ^ Splices to be bound first+            -> RuntimeSplice n a+            -- ^ Runtime data needed by the above splices+            -> Splice n+withSplices splice splices runtimeAction =+    withLocalSplices splices' noSplices splice+  where+    splices' = mapS ($runtimeAction) splices   --------------------------------------------------------------------------------- | Allows you to use deferred Promises in a compiled splice.  It takes care--- of the boilerplate of creating and storing data in a promise to be used at--- load time when compiled splices are processed.  This function is similar to--- mapPromises but runs on a single value instead of a list.-defer :: Monad n-      => (Promise a -> Splice n)-      -> RuntimeSplice n a-      -> Splice n-defer f getItem = do-    promise <- newEmptyPromise-    chunks <- f promise+-- | Like withSplices, but evaluates the splice repeatedly for each element in+-- a list generated at runtime.+manyWithSplices :: Monad n+                => Splice n+                -> Splices (RuntimeSplice n a -> Splice n)+                -> RuntimeSplice n [a]+                -> Splice n+manyWithSplices splice splices runtimeAction = do+    p <- newEmptyPromise+    let splices' = mapS ($ getPromise p) splices+    chunks <- withLocalSplices splices' noSplices splice     return $ yieldRuntime $ do-        item <- getItem-        putPromise promise item-        codeGen chunks+        items <- runtimeAction+        res <- forM items $ \item -> putPromise p item >> codeGen chunks+        return $ mconcat res   --------------------------------------------------------------------------------- | Takes a promise function and a runtime action returning a list of items--- that fit in the promise and returns a Splice that executes the promise--- function for each item and concatenates the results.+-- | Similar to 'mapSplices' in interpreted mode.  Gets a runtime list of+-- items and applies a compiled runtime splice function to each element of the+-- list. deferMany :: Monad n-          => (Promise a -> Splice n)+          => (RuntimeSplice n a -> Splice n)           -> RuntimeSplice n [a]           -> Splice n deferMany f getItems = do     promise <- newEmptyPromise-    chunks <- f promise+    chunks <- f $ getPromise promise     return $ yieldRuntime $ do         items <- getItems         res <- forM items $ \item -> do@@ -824,76 +660,53 @@   --------------------------------------------------------------------------------- | Another useful way of combining groups of splices.--- FIXME - We probably need to export this---applyDeferred :: Monad n---              => RuntimeSplice n a---              -> [(Text, Promise a -> Splice n)]---              -> [(Text, Splice n)]---applyDeferred m = applySnd m . mapSnd defer------------------------------------------------------------------------------------ | This is kind of the opposite of defer.  Not sure what to name it yet.--- FIXME - This is a really common pattern, so I think we do want to expose it---deferred :: (Monad n)---         => (t -> RuntimeSplice n Builder)---         -> Promise t---         -> Splice n---deferred f p = return $ yieldRuntime $ f =<< getPromise p------------------------------------------------------------------------------------ | Runs a splice computation with a list of splices that are functions of--- runtime data.-withSplices :: Monad n-            => Splice n-            -> [(Text, Promise a -> Splice n)]-            -> RuntimeSplice n a-            -> Splice n-withSplices splice splices runtimeAction = do-    p <- newEmptyPromise-    let splices' = mapSnd ($p) splices-    chunks <- withLocalSplices splices' [] splice-    let fillPromise = yieldRuntimeEffect $ putPromise p =<< runtimeAction-    return $ fillPromise `mappend` chunks+-- | Saves the results of a runtme computation in a 'Promise' so they don't+-- get recalculated if used more than once.+deferMap :: Monad n+         => (a -> RuntimeSplice n b)+         -> (RuntimeSplice n b -> Splice n)+         -> RuntimeSplice n a -> Splice n+deferMap f pf n = do+    p2 <- newEmptyPromise+    let action = yieldRuntimeEffect $ putPromise p2 =<< f =<< n+    res <- pf $ getPromise p2+    return $ action `mappend` res   --------------------------------------------------------------------------------- | Gets a list of items at runtime, then for each item it runs the splice--- with the list of splices bound.  There is no pure variant of this function--- because the desired behavior can only be achieved as a function of a--- Promise.-manyWithSplices :: Monad n-                => Splice n-                -- ^ Splice to run for each of the items in the runtime list.-                -- You'll frequently use 'runChildren' here.-                -> [(Text, Promise a -> Splice n)]-                -- ^ List of splices to bind-                -> RuntimeSplice n [a]-                -- ^ Runtime action returning a list of items to render.-                -> Splice n-manyWithSplices splice splices runtimeAction = do-    p <- newEmptyPromise-    let splices' = mapSnd ($p) splices-    chunks <- withLocalSplices splices' [] splice+-- | 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+-- own special flow control, then you should use functions from the+-- `Heist.Compiled.LowLevel` module similarly to how it is done in the+-- implementation of this function.+mayDeferMap :: Monad n+            => (a -> RuntimeSplice n (Maybe b))+            -> (RuntimeSplice n b -> Splice n)+            -> RuntimeSplice n a -> Splice n+mayDeferMap f pf n = do+    p2 <- newEmptyPromise+    action <- pf $ getPromise p2     return $ yieldRuntime $ do-        items <- runtimeAction-        res <- forM items $ \item -> putPromise p item >> codeGen chunks-        return $ mconcat res+        mb <- f =<< n+        case mb of+          Nothing -> return mempty+          Just b -> do+            putPromise p2 b+            codeGen action   --------------------------------------------------------------------------------- | Like 'withSplices', but works for \"pure\" splices that don't operate in--- the HeistT monad.-withPureSplices :: Monad n-                => Splice n-                -> [(Text, a -> Builder)]-                -> RuntimeSplice n a-                -> Splice n-withPureSplices splice splices action = do-    let fieldSplice g = return $ yieldRuntime $ liftM g action-    let splices' = map (second fieldSplice) splices-    withLocalSplices splices' [] splice+-- | Converts an RuntimeSplice into a Splice, given a helper function that+-- generates a Builder.+bindLater :: (Monad n)+          => (a -> RuntimeSplice n Builder)+          -> RuntimeSplice n a+          -> Splice n+bindLater f p = return $ yieldRuntime $ f =<< p  

@@ -0,0 +1,20 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TypeSynonymInstances       #-}++module Heist.Compiled.LowLevel+  (+  -- * Lower level promise functions+    Promise+  , newEmptyPromise+  , getPromise+  , putPromise+  , adjustPromise++  ) where++import           Heist.Compiled.Internal

@@ -8,7 +8,6 @@  ------------------------------------------------------------------------------ import           Blaze.ByteString.Builder-import           Control.Arrow hiding (loop) import           Control.Monad import           Control.Monad.State.Strict import qualified Data.Attoparsec.Text as AP@@ -17,14 +16,13 @@ import qualified Data.HashMap.Strict as Map import qualified Data.HeterogeneousEnvironment   as HE import           Data.Maybe-import           Data.Monoid import qualified Data.Text as T import           Data.Text (Text)-import           Prelude hiding (catch) import qualified Text.XmlHtml as X  ------------------------------------------------------------------------------ import           Heist.Common+import           Heist.SpliceAPI import           Heist.Types  @@ -32,13 +30,6 @@   --------------------------------------------------------------------------------- | Mappends a doctype to the state.-addDoctype :: Monad m => [X.DocType] -> HeistT n m ()-addDoctype dt = do-    modifyHS (\s -> s { _doctypes = _doctypes s `mappend` dt })--------------------------------------------------------------------------------- -- HeistState functions ------------------------------------------------------------------------------ @@ -54,12 +45,12 @@  ------------------------------------------------------------------------------ -- | Binds a set of new splice declarations within a 'HeistState'.-bindSplices :: [(Text, Splice n)] -- ^ splices to bind+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) ss+    acts = map (uncurry bindSplice) $ splicesToList ss   ------------------------------------------------------------------------------@@ -81,7 +72,7 @@ -- | Binds a list of splices before using the children of the spliced node as -- a view. runChildrenWith :: (Monad n)-                => [(Text, Splice n)]+                => Splices (Splice n)                 -- ^ List of splices to bind before running the param nodes.                 -> Splice n                 -- ^ Returns the passed in view.@@ -94,22 +85,22 @@ runChildrenWithTrans :: (Monad n)           => (b -> Splice n)           -- ^ Splice generating function-          -> [(Text, b)]+          -> Splices b           -- ^ List of tuples to be bound           -> Splice n-runChildrenWithTrans f = runChildrenWith . map (second f)+runChildrenWithTrans f = runChildrenWith . mapS f   ------------------------------------------------------------------------------ -- | Like runChildrenWith but using constant templates rather than dynamic -- splices.-runChildrenWithTemplates :: (Monad n) => [(Text, Template)] -> Splice n+runChildrenWithTemplates :: (Monad n) => Splices Template -> Splice n runChildrenWithTemplates = runChildrenWithTrans return   ------------------------------------------------------------------------------ -- | Like runChildrenWith but using literal text rather than dynamic splices.-runChildrenWithText :: (Monad n) => [(Text, Text)] -> Splice n+runChildrenWithText :: (Monad n) => Splices Text -> Splice n runChildrenWithText = runChildrenWithTrans textSplice  @@ -353,10 +344,10 @@ ------------------------------------------------------------------------------ -- | Binds a list of constant string splices. bindStrings :: Monad n-            => [(Text, Text)]+            => Splices Text             -> HeistState n             -> HeistState n-bindStrings pairs hs = foldr (uncurry bindString) hs pairs+bindStrings splices hs = foldr (uncurry bindString) hs $ splicesToList splices   ------------------------------------------------------------------------------@@ -376,11 +367,10 @@ -- returns an empty list. callTemplate :: Monad n              => ByteString         -- ^ The name of the template-             -> [(Text, Splice n)] -- ^ Association list of-                                   -- (name,value) parameter pairs+             -> Splices (Splice n) -- ^ Splices to call the template with              -> HeistT n n Template-callTemplate name params = do-    modifyHS $ bindSplices params+callTemplate name splices = do+    modifyHS $ bindSplices splices     liftM (maybe [] id) $ evalTemplate name  @@ -389,12 +379,9 @@ -- splices. callTemplateWithText :: Monad n                      => ByteString     -- ^ The name of the template-                     -> [(Text, Text)] -- ^ Association list of-                                       -- (name,value) parameter pairs+                     -> Splices Text -- ^ Splices to call the template with                      -> HeistT n n Template-callTemplateWithText name params = do-    modifyHS $ bindStrings params-    liftM (maybe [] id) $ evalTemplate name+callTemplateWithText name splices = callTemplate name $ mapS textSplice splices   ------------------------------------------------------------------------------@@ -420,7 +407,7 @@ -- using bindString, bindStrings, or bindSplice to set up the arguments to the -- template. renderWithArgs :: Monad n-               => [(Text, Text)]+               => Splices Text                -> HeistState n                -> ByteString                -> n (Maybe (Builder, MIMEType))

@@ -0,0 +1,163 @@+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoMonomorphismRestriction  #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE TypeSynonymInstances       #-}++{-|++An API implementing a convenient syntax for defining and manipulating splices.+This module was born from the observation that a list of tuples is+semantically ambiguous about how duplicate keys should be handled.+Additionally, the syntax is inherently rather cumbersome and difficult to work+with.  This API takes advantage of do notation to provide a very light syntax+for defining splices while at the same time eliminating the semantic ambiguity+of alists.++Here's how you can define splices:++> mySplices :: Splices Text+> mySplices = do+>   "firstName" ## "John"+>   "lastName"  ## "Smith"++-}++module Heist.SpliceAPI where++import           Control.Monad.State+import           Data.Map (Map)+import qualified Data.Map as M+import           Data.Monoid+import           Data.Text (Text)+import qualified Data.Text as T+++------------------------------------------------------------------------------+-- | A monad providing convenient syntax for defining splices.+newtype SplicesM s a = SplicesM { unSplices :: State (Map Text s) a }+  deriving (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 #?+++------------------------------------------------------------------------------+-- | A `Splices` with nothing in it.+noSplices :: Splices s+noSplices = put M.empty+++------------------------------------------------------------------------------+-- | 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+++------------------------------------------------------------------------------+-- | Maps a function over all the splices.+mapS :: (a -> b) -> Splices a -> Splices b+mapS f ss = put $ M.map f $ runSplices ss +++------------------------------------------------------------------------------+-- | Applies an argument to a splice function.+applyS :: a -> Splices (a -> b) -> Splices b+applyS a = mapS ($a)+++------------------------------------------------------------------------------+-- | 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 = put $ 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 = put $ M.unionWith f (runSplices a) (runSplices b)+++------------------------------------------------------------------------------+-- | Infix operator for @flip applyS@+($$) :: Splices (a -> b) -> a -> Splices b+($$) = flip applyS+infixr 0 $$+++------------------------------------------------------------------------------+-- | Maps a function over all the splice names.+mapNames :: (Text -> Text) -> Splices a -> Splices a+mapNames f = put . 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.+++------------------------------------------------------------------------------+-- | Adds a prefix to the tag names for a list of splices.  If the existing+-- tag name is empty, then the new tag name is just the prefix.  Otherwise the+-- 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+  where+    f t = if T.null t then pre else T.concat [pre,sep,t]+++------------------------------------------------------------------------------+-- | 'prefixSplices' specialized to use a colon as separator in the style of+-- XML namespaces.+namespaceSplices :: Text -> Splices a -> Splices a+namespaceSplices = prefixSplices ":"+

@@ -18,6 +18,7 @@ import           Heist.Splices.Html import           Heist.Splices.Ignore import           Heist.Splices.Markdown+import           Heist.Types  ------------------------------------------------------------------------------ -- | Run the splice contents if given condition is True, make splice disappear@@ -34,12 +35,12 @@ -- function to determine whether the node's children should be rendered. ifCSplice :: Monad m           => (t -> Bool)-          -> C.Promise t+          -> RuntimeSplice m t           -> C.Splice m-ifCSplice predicate prom = do+ifCSplice predicate runtime = do     chunks <- C.runChildren     return $ C.yieldRuntime $ do-        a <- C.getPromise prom+        a <- runtime         if predicate a           then             C.codeGen chunks

@@ -24,6 +24,7 @@ ------------------------------------------------------------------------------  import           Heist.Interpreted.Internal+import           Heist.SpliceAPI import           Heist.Types                                   ------------@@ -161,9 +162,9 @@     go (Object o) = goObject o      ---------------------------------------------------------------------------    goText t = lift $ runChildrenWith [ ("value"   , return [TextNode t])-                                      , ("snippet" , asHtml t           )-                                      ]+    goText t = lift $ runChildrenWith $ do+        "value"   ## return [TextNode t]+        "snippet" ## asHtml t      --------------------------------------------------------------------------     goArray :: (Monad n) => V.Vector Value -> JsonMonad n n [Node]@@ -203,11 +204,12 @@                                  (findExpr expr v)      ---------------------------------------------------------------------------    genericBindings :: Monad n => JsonMonad n n [(Text, Splice n)]-    genericBindings = ask >>= \v -> return [ ("with",    varAttrTag v explodeTag)-                                           , ("snippet", varAttrTag v snippetTag)-                                           , ("value",   varAttrTag v valueTag  )-                                           ]+    genericBindings :: Monad n => JsonMonad n n (Splices (Splice n))+    genericBindings = ask >>= \v -> return $ do+        "with"     ## varAttrTag v explodeTag+        "snippet"  ## varAttrTag v snippetTag+        "value"    ## varAttrTag v valueTag+              --------------------------------------------------------------------------     goObject obj = do@@ -217,8 +219,8 @@      --------------------------------------------------------------------------     bindKvp bindings k v =-        let newBindings = [ (T.append "with:" k   , withValue v explodeTag)-                          , (T.append "snippet:" k, withValue v snippetTag)-                          , (T.append "value:" k  , withValue v valueTag  )-                          ]-        in  newBindings ++ bindings+        let newBindings = do+                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

@@ -26,7 +26,6 @@ import           Control.Monad.CatchIO import           Control.Monad.Trans import           Data.Typeable-import           Prelude hiding (catch) import           System.Directory import           System.Exit import           System.FilePath.Posix

@@ -21,7 +21,8 @@ import           Blaze.ByteString.Builder import           Control.Applicative import           Control.Arrow-import           Control.Monad.CatchIO+import           Control.Monad.CatchIO (MonadCatchIO)+import qualified Control.Monad.CatchIO as C import           Control.Monad.Cont import           Control.Monad.Error import           Control.Monad.Reader@@ -37,7 +38,6 @@ import qualified Data.Text as T import           Data.Text.Encoding import           Data.Typeable-import           Prelude hiding (catch) import qualified Text.XmlHtml as X  import Debug.Trace@@ -295,9 +295,9 @@ instance MonadCatchIO m => MonadCatchIO (HeistT n m) where     catch (HeistT a) h = HeistT $ \r s -> do        let handler e = runHeistT (h e) r s-       catch (a r s) handler-    block (HeistT m) = HeistT $ \r s -> block (m r s)-    unblock (HeistT m) = HeistT $ \r s -> unblock (m 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)   ------------------------------------------------------------------------------

@@ -35,7 +35,7 @@     transformers               >= 0.2     && < 0.4,     unordered-containers       >= 0.1.4   && < 0.3,     vector                     >= 0.9     && < 0.11,-    xmlhtml                    >= 0.2.1   && < 0.3+    xmlhtml                    >= 0.2.3   && < 0.3     ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded@@ -70,12 +70,13 @@     mtl                        >= 2.0     && < 2.2,     process                    >= 1.1     && < 1.2,     random                     >= 1.0.1.0 && < 1.1,+    statistics                               < 0.10.4,     text                       >= 0.10    && < 0.12,     time                       >= 1.1     && < 1.5,     transformers               >= 0.2     && < 0.4,     unordered-containers       >= 0.1.4   && < 0.3,     vector                     >= 0.9     && < 0.11,-    xmlhtml                    >= 0.2.1   && < 0.3+    xmlhtml                    >= 0.2.3   && < 0.3    ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded                -fno-warn-unused-do-bind -rtsopts

@@ -14,6 +14,7 @@ import           Control.Monad import qualified Data.ByteString as B import qualified Data.DList as DL+import           Data.Monoid import qualified Data.Text as T import           Data.Text.Encoding import           Data.Time.Clock@@ -31,7 +32,7 @@  loadWithCache baseDir = do     etm <- runEitherT $ do-        let hc = HeistConfig [] defaultLoadTimeSplices [] [] [loadTemplates baseDir]+        let hc = HeistConfig mempty defaultLoadTimeSplices mempty mempty [loadTemplates baseDir]         initHeistWithCacheTag hc     either (error . unlines) (return . fst) etm 

@@ -9,6 +9,7 @@  ------------------------------------------------------------------------------ import           Heist.Tutorial.CompiledSplices+import           Heist.TestCommon  -- NOTE: We can't test compiled templates on the templates directory as it -- stands today because that directory contains some error conditions such as@@ -26,7 +27,7 @@     H.assertEqual "compiled state splice" expected res   where     expected =-      "&#10;<html>&#10;3&#10;</html>&#10;"+      "<!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;"  peopleTest :: IO () peopleTest = do

@@ -85,7 +85,7 @@         let result   = buildResult bind          spliceResult <- run $ do-            hs <- loadEmpty defaultLoadTimeSplices [] [] []+            hs <- loadEmpty defaultLoadTimeSplices mempty mempty mempty             evalHeistT (runNodeList template)                        (X.TextNode "") hs @@ -106,7 +106,7 @@ ------------------------------------------------------------------------------ addTest :: IO () addTest = do-    es <- loadEmpty [] [] [] []+    es <- loadEmpty mempty mempty mempty mempty     let hs = addTemplate "aoeu" [] Nothing es     H.assertEqual "lookup test" (Just []) $         fmap (X.docContent . dfDoc . fst) $@@ -116,9 +116,9 @@ ------------------------------------------------------------------------------ hasTemplateTest :: H.Assertion hasTemplateTest = do-    ets <- loadIO "templates" [] [] [] []+    ets <- loadIO "templates" mempty mempty mempty mempty     let tm = either (error "Error loading templates") _templateMap ets-    hs <- loadEmpty [] [] [] []+    hs <- loadEmpty mempty mempty mempty mempty     let hs's = setTemplates tm hs     H.assertBool "hasTemplate hs's" (hasTemplate "index" hs's) @@ -135,7 +135,7 @@ ------------------------------------------------------------------------------ loadTest :: H.Assertion loadTest = do-    ets <- loadIO "templates" [] [] [] []+    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@@ -145,9 +145,9 @@ ------------------------------------------------------------------------------ fsLoadTest :: H.Assertion fsLoadTest = do-    ets <- loadIO "templates" [] [] [] []+    ets <- loadIO "templates" mempty mempty mempty mempty     let tm = either (error "Error loading templates") _templateMap ets-    es <- loadEmpty [] [] [] []+    es <- loadEmpty mempty mempty mempty mempty     let hs = setTemplates tm es     let f  = g hs @@ -163,7 +163,7 @@ ------------------------------------------------------------------------------ renderNoNameTest :: H.Assertion renderNoNameTest = do-    ets <- loadT "templates" [] [] [] []+    ets <- loadT "templates" mempty mempty mempty mempty     either (error "Error loading templates")            (\ts -> do t <- renderTemplate ts ""                       H.assertBool "renderNoName" $ isNothing t@@ -173,7 +173,7 @@ ------------------------------------------------------------------------------ doctypeTest :: H.Assertion doctypeTest = do-    ets <- loadT "templates" [] [] [] []+    ets <- loadT "templates" mempty mempty mempty mempty     let ts = either (error "Error loading templates") id ets     Just (indexDoc, _) <- renderTemplate ts "index"     H.assertEqual "index doctype test" indexRes $ toByteString $ indexDoc@@ -188,14 +188,14 @@ ------------------------------------------------------------------------------ attrSubstTest :: H.Assertion attrSubstTest = do-    ets <- loadT "templates" [] [] [] []+    ets <- loadT "templates" mempty mempty mempty mempty     let ts = either (error "Error loading templates") id ets     check "attr subst 1" (bindSplices splices ts) out1     check "attr subst 2" ts out2    where-    splices = defaultLoadTimeSplices ++-        [("foo", return [X.TextNode "meaning_of_everything"])]+    splices = defaultLoadTimeSplices `mappend`+        ("foo" ## return [X.TextNode "meaning_of_everything"])      check str ts expected = do         Just (resDoc, _) <- renderTemplate ts "attrs"@@ -216,7 +216,7 @@ ------------------------------------------------------------------------------ bindAttrTest :: H.Assertion bindAttrTest = do-    ets <- loadT "templates" [] [] [] []+    ets <- loadT "templates" mempty mempty mempty mempty     let ts = either (error "Error loading templates") id ets     check ts "<div id=\'zzzzz\'" @@ -267,7 +267,7 @@             -> ByteString   -- ^ expected result             -> H.Assertion renderTest templateName expectedResult = do-    ets <- loadT "templates" [] [] [] []+    ets <- loadT "templates" mempty mempty mempty mempty     let ts = either (error "Error loading templates") id ets      check ts expectedResult@@ -279,15 +279,15 @@         v = fromJust $ decode txt      check ts0 str = do-        let ts = bindSplices [-                      ("json", bind "[\"<b>ok</b>\", 1, null, false, \"foo\"]")-                    , ("jsonObject",-                       bind $ mconcat [+        let splices = do+                "json" ## bind "[\"<b>ok</b>\", 1, null, false, \"foo\"]"+                "jsonObject" ##+                       (bind $ mconcat [                                  "{\"foo\": 1, \"bar\": \"<b>ok</b>\", "                                 , "\"baz\": { \"baz1\": 1, \"baz2\": 2 }, "                                 , "\"quux\": \"quux\" }"                                 ])-                    ] ts0+        let ts = bindSplices splices ts0         Just (doc, _) <- renderTemplate ts templateName         let result = B.filter (/= '\n') (toByteString doc)         H.assertEqual ("Should match " ++ (show str)) str result@@ -335,7 +335,7 @@ -- | Markdown test on supplied text markdownTextTest :: H.Assertion markdownTextTest = do-    hs <- loadEmpty [] [] [] []+    hs <- loadEmpty mempty mempty mempty mempty     result <- evalHeistT markdownSplice                          (X.TextNode "This *is* a test.")                          hs@@ -347,7 +347,7 @@ ------------------------------------------------------------------------------ applyTest :: H.Assertion applyTest = do-    es <- loadEmpty [] [] [] []+    es <- loadEmpty mempty mempty mempty mempty     res <- evalHeistT applyImpl         (X.Element "apply" [("template", "nonexistant")] []) es @@ -357,7 +357,7 @@ ------------------------------------------------------------------------------ ignoreTest :: H.Assertion ignoreTest = do-    es <- loadEmpty [] [] [] []+    es <- loadEmpty mempty mempty mempty mempty     res <- evalHeistT ignoreImpl         (X.Element "ignore" [("tag", "ignorable")]           [X.TextNode "This should be ignored"]) es@@ -518,7 +518,7 @@     , L.unpack $ L.concat $ map formatNode $ buildResult b     , "Splice result:"     , L.unpack $ L.concat $ map formatNode $ unsafePerformIO $ do-        hs <- loadEmpty [] [] [] []+        hs <- loadEmpty mempty mempty mempty mempty         evalHeistT (runNodeList $ buildBindTemplate b)                           (X.TextNode "") hs     , "Template:"@@ -595,7 +595,7 @@ ------------------------------------------------------------------------------ calcResult :: Apply -> IO [X.Node] calcResult apply@(Apply name _ callee _ _) = do-    hs <- loadEmpty defaultLoadTimeSplices [] [] []+    hs <- loadEmpty defaultLoadTimeSplices mempty mempty mempty     let hs' = setTemplates (Map.singleton [T.encodeUtf8 $ unName name]                            (DocumentFile (X.HtmlDocument X.UTF8 Nothing callee)                                          Nothing)) hs

@@ -8,7 +8,6 @@ import qualified Data.ByteString.Char8 as B import           Data.Maybe import           Data.Monoid-import           Data.Text (Text)   ------------------------------------------------------------------------------@@ -29,27 +28,27 @@  loadT :: MonadIO m       => FilePath-      -> [(Text, I.Splice m)]-      -> [(Text, I.Splice IO)]-      -> [(Text, C.Splice m)]-      -> [(Text, AttrSplice m)]+      -> Splices (I.Splice m)+      -> Splices (I.Splice IO)+      -> Splices (C.Splice m)+      -> Splices (AttrSplice m)       -> IO (Either [String] (HeistState m)) loadT baseDir a b c d = runEitherT $ do-    let hc = HeistConfig (defaultInterpretedSplices ++ a)-                         (defaultLoadTimeSplices ++ b) c d [loadTemplates baseDir]+    let hc = HeistConfig (defaultInterpretedSplices `mappend` a)+                         (defaultLoadTimeSplices `mappend` b) c d [loadTemplates baseDir]     initHeist hc   ------------------------------------------------------------------------------ loadIO :: FilePath-       -> [(Text, I.Splice IO)]-       -> [(Text, I.Splice IO)]-       -> [(Text, C.Splice IO)]-       -> [(Text, AttrSplice IO)]+       -> Splices (I.Splice IO)+       -> Splices (I.Splice IO)+       -> Splices (C.Splice IO)+       -> Splices (AttrSplice IO)        -> IO (Either [String] (HeistState IO)) loadIO baseDir a b c d = runEitherT $ do-    let hc = HeistConfig (defaultInterpretedSplices ++ a)-                         (defaultLoadTimeSplices ++ b) c d [loadTemplates baseDir]+    let hc = HeistConfig (defaultInterpretedSplices `mappend` a)+                         (defaultLoadTimeSplices `mappend` b) c d [loadTemplates baseDir]     initHeist hc  @@ -58,19 +57,19 @@ loadHS baseDir = do     etm <- runEitherT $ do         let hc = HeistConfig defaultInterpretedSplices-                             defaultLoadTimeSplices [] [] [loadTemplates baseDir]+                             defaultLoadTimeSplices mempty mempty [loadTemplates baseDir]         initHeist hc     either (error . concat) return etm  -loadEmpty :: [(Text, I.Splice IO)]-          -> [(Text, I.Splice IO)]-          -> [(Text, C.Splice IO)]-          -> [(Text, AttrSplice IO)]+loadEmpty :: Splices (I.Splice IO)+          -> Splices (I.Splice IO)+          -> Splices (C.Splice IO)+          -> Splices (AttrSplice IO)           -> IO (HeistState IO) loadEmpty a b c d = do-    let hc = HeistConfig (defaultInterpretedSplices ++ a)-                         (defaultLoadTimeSplices ++ b) c d mempty+    let hc = HeistConfig (defaultInterpretedSplices `mappend` a)+                         (defaultLoadTimeSplices `mappend` b) c d mempty     res <- runEitherT $ initHeist hc     either (error . concat) return res 

@@ -43,7 +43,7 @@ -- | Tests that load fails correctly on errors. loadErrorsTest :: H.Assertion loadErrorsTest = do-    ets <- loadIO "templates-bad" [] [] [] []+    ets <- loadIO "templates-bad" mempty mempty mempty mempty     either (H.assertEqual "load errors test" expected . sort)            (const $ H.assertFailure "No failure when loading templates-bad")            ets@@ -58,7 +58,8 @@  attrSpliceTest :: IO () attrSpliceTest = do-    ehs <- loadT "templates" [] [] [] [("autocheck", lift . autocheckedSplice)]+    ehs <- loadT "templates" mempty mempty mempty+                 ("autocheck" ## lift . autocheckedSplice)     let hs = either (error . show) id ehs         runtime = fromJust $ C.renderTemplate hs "attr_splice" @@ -89,9 +90,9 @@  tdirCacheTest :: IO () tdirCacheTest = do-    let rSplices = [ ("foosplice", fooSplice) ]-        dSplices = [ ("foosplice", stateSplice) ]-        hc = HeistConfig rSplices [] dSplices [] mempty+    let rSplices = ("foosplice" ## fooSplice)+        dSplices = ("foosplice" ## stateSplice)+        hc = HeistConfig rSplices mempty dSplices mempty mempty     td <- newTemplateDirectory' "templates" hc                  [a,b,c,d] <- evalStateT (testInterpreted td) 5@@ -140,7 +141,7 @@  headMergeTest :: IO () headMergeTest = do-    ehs <- loadT "templates" [] [(htmlTag, htmlImpl)] [] []+    ehs <- loadT "templates" mempty (htmlTag ## htmlImpl) mempty mempty     let hs = either (error . show) id ehs         runtime = fromJust $ C.renderTemplate hs "head_merge/index"     mres <- fst runtime

@@ -27,6 +27,12 @@ > import qualified Heist.Compiled as C > import           Heist.Tutorial.Imports +> import           Control.Applicative+> import qualified Data.Text as T+> import           Data.Text.Encoding+> import qualified Heist.Compiled.LowLevel as C+> import           Text.XmlHtml+ As a review, normal (interpreted) Heist splices are defined like this.  < type Splice m = HeistT m m [Node]@@ -103,11 +109,11 @@  > load :: MonadIO n >      => FilePath->      -> [(Text, C.Splice n)]+>      -> Splices (C.Splice n) >      -> IO (HeistState n) > load baseDir splices = do >     tmap <- runEitherT $ do->         let hc = HeistConfig [] defaultLoadTimeSplices splices []+>         let hc = HeistConfig mempty defaultLoadTimeSplices splices mempty >                              [loadTemplates baseDir] >         initHeist hc >     either (error . concat) return tmap@@ -117,7 +123,7 @@ > runWithStateSplice :: FilePath >                    -> IO ByteString > runWithStateSplice baseDir = do->     hs <- load baseDir [ ("div", stateSplice) ]+>     hs <- load baseDir ("div" ## stateSplice) >     let runtime = fromJust $ C.renderTemplate hs "index" >     builder <- evalStateT (fst runtime) 2 >     return $ toByteString builder@@ -139,19 +145,17 @@ >     , pAge       :: Int >     } > -> personSplice :: (Monad n)->              => C.Promise Person->              -> HeistT n IO (RuntimeSplice n Builder)-> personSplice = C.promiseChildrenWithText->     [ ("firstName", pFirstName)->     , ("lastName", pLastName)->     , ("age", pack . show . pAge)->     ]+> personSplices :: Monad n+>              => Splices (RuntimeSplice n Person -> C.Splice n)+> personSplices = mapS (C.pureSplice . C.textSplice) $ do+>     "firstName" ## pFirstName+>     "lastName" ## pLastName+>     "age" ## pack . show . pAge >  > peopleSplice :: (Monad n) >              => RuntimeSplice n [Person] >              -> C.Splice n-> peopleSplice getPeople = C.mapPromises personSplice getPeople+> peopleSplice = C.manyWithSplices C.runChildren personSplices >  > allPeopleSplice :: C.Splice (StateT [Person] IO) > allPeopleSplice = peopleSplice (lift get)@@ -159,7 +163,7 @@ > personListTest :: FilePath >                -> IO ByteString > personListTest baseDir = do->     hs <- load baseDir [ ("people", allPeopleSplice) ]+>     hs <- load baseDir ("people" ## allPeopleSplice) >     let runtime = fromJust $ C.renderTemplate hs "people" >     builder <- evalStateT (fst runtime) >                  [ Person "John" "Doe" 42@@ -246,24 +250,25 @@ < failingSplice = do <     children <- childNodes <$> getParamNode <     promise <- C.newEmptyPromise-<     outputChildren <- C.promiseChildrenWithNodes splices promise+<     outputChildren <- C.withSplices C.runChildren splices (C.getPromise promise) <     return $ C.yieldRuntime $ do          <         -- :: RuntimeSplice m Builder <         mname <- lift $ getParam "username" <         let err = return $ fromByteString "Must supply a username" <             single name = do          -<                 euser <- liftIO $ lookupUser $ decodeUtf8 name+<                 euser <- lift $ lookupUser name <                 either (return . fromByteString . encodeUtf8 . T.pack) <                        doUser euser <               where <                 doUser value = do <                   C.putPromise promise (name, value)-<                   outputChildren+<                   C.codeGen outputChildren <         maybe err single mname <    <   -< splices :: [(Text, (Text, Text) -> [Node])]-< splices = [ ("user", (:[]) . TextNode . T.pack . fst)-<           , ("value", (:[]) . TextNode . T.pack . snd)-<           ]                                                                                                                                             +< splices :: Monad n+<         => Splices (RuntimeSplice n (Text, Text) -> C.Splice n)+< splices = mapS (C.pureSplice . C.nodeSplice) $ do+<   "user"  ## (:[]) . TextNode . fst+<   "value" ## (:[]) . TextNode . snd