heist 0.11.0.1 → 0.11.1

raw patch · 4 files changed

+180/−61 lines, 4 filesdep ~blaze-htmldep ~xmlhtmlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: blaze-html, xmlhtml

API changes (from Hackage documentation)

Files

• heist.cabal +3/−3
• src/Heist/Compiled.hs +7/−0
• src/Heist/Compiled/Internal.hs +166/−54
• test/heist-testsuite.cabal +4/−4

@@ -1,5 +1,5 @@ name:           heist-version:        0.11.0.1+version:        0.11.1 synopsis:       An Haskell template system supporting both HTML5 and XML. description:     Heist is a powerful template system that supports both HTML5 and XML.@@ -141,7 +141,7 @@     attoparsec                 >= 0.10    && < 0.11,     base                       >= 4       && < 5,     blaze-builder              >= 0.2     && < 0.4,-    blaze-html                 >= 0.4     && < 0.6,+    blaze-html                 >= 0.4     && < 0.7,     bytestring                 >= 0.9     && < 0.11,     containers                 >= 0.2     && < 0.6,     directory                  >= 1.1     && < 1.3,@@ -157,7 +157,7 @@     time                       >= 1.1     && < 1.5,     unordered-containers       >= 0.1.4   && < 0.3,     vector                     >= 0.9     && < 0.11,-    xmlhtml                    >= 0.1.6   && < 0.3+    xmlhtml                    >= 0.2.1   && < 0.3    if impl(ghc >= 6.12.0)     ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

@@ -23,6 +23,8 @@   -- * Functions for manipulating lists of compiled splices   , mapSnd   , applySnd+  , prefixSplices+  , namespaceSplices   , textSplices   , nodeSplices   , pureSplices@@ -30,6 +32,10 @@   , nodeSplice   , pureSplice   , mapInputPromise+  , repromise+  , repromiseMay+  , repromise'+  , repromiseMay'   , defer   , deferMany   , withSplices@@ -66,6 +72,7 @@   , runNodeList   , runNode   , runAttributes+  , runAttributesRaw   , callTemplate    ) where

@@ -21,6 +21,7 @@ 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.Maybe import           Data.Text                       (Text)@@ -29,6 +30,7 @@ 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.Types@@ -86,7 +88,7 @@  ------------------------------------------------------------------------------ -- | Returns a runtime computation that simply renders the node's children.-promiseChildren :: Monad m => HeistT m IO (RuntimeSplice m Builder)+promiseChildren :: Monad n => HeistT n IO (RuntimeSplice n Builder) promiseChildren = liftM codeGen runChildren {-# INLINE promiseChildren #-} @@ -150,14 +152,14 @@ -- | Yields a pure Builder known at load time.  You should use this and -- 'yieldPureText' as much as possible to maximize the parts of your page that -- can be compiled to static ByteStrings.-yieldPure :: Builder -> DList (Chunk m)+yieldPure :: Builder -> DList (Chunk n) yieldPure = DL.singleton . Pure . toByteString {-# INLINE yieldPure #-}   ------------------------------------------------------------------------------ -- | Yields a runtime action that returns a builder.-yieldRuntime :: RuntimeSplice m Builder -> DList (Chunk m)+yieldRuntime :: RuntimeSplice n Builder -> DList (Chunk n) yieldRuntime = DL.singleton . RuntimeHtml {-# INLINE yieldRuntime #-} @@ -165,7 +167,7 @@ ------------------------------------------------------------------------------ -- | Yields a runtime action that returns no value and is only needed for its -- side effect.-yieldRuntimeEffect :: Monad m => RuntimeSplice m () -> DList (Chunk m)+yieldRuntimeEffect :: Monad n => RuntimeSplice n () -> DList (Chunk n) yieldRuntimeEffect = DL.singleton . RuntimeAction {-# INLINE yieldRuntimeEffect #-} @@ -173,14 +175,14 @@ ------------------------------------------------------------------------------ -- | A convenience wrapper around yieldPure for working with Text.  Roughly -- equivalent to 'textSplice' from Heist.Interpreted.-yieldPureText :: Text -> DList (Chunk m)+yieldPureText :: Text -> DList (Chunk n) yieldPureText = DL.singleton . pureTextChunk {-# INLINE yieldPureText #-}   ------------------------------------------------------------------------------ -- | Convenience wrapper around yieldRuntime allowing you to work with Text.-yieldRuntimeText :: Monad m => RuntimeSplice m Text -> DList (Chunk m)+yieldRuntimeText :: Monad n => RuntimeSplice n Text -> DList (Chunk n) yieldRuntimeText = yieldRuntime .  liftM fromText {-# INLINE yieldRuntimeText #-} @@ -188,7 +190,7 @@ ------------------------------------------------------------------------------ -- | This lets you turn a plain runtime monad function returning a Builder -- into a compiled splice.-yieldLater :: Monad m => m Builder -> DList (Chunk m)+yieldLater :: Monad n => n Builder -> DList (Chunk n) yieldLater = yieldRuntime . RuntimeSplice . lift {-# INLINE yieldLater #-} @@ -250,9 +252,9 @@   -------------------------------------------------------------------------------compileTemplates' :: Monad m-                  => HeistState m-                  -> IO (H.HashMap TPath ([Chunk m], MIMEType))+compileTemplates' :: Monad n+                  => HeistState n+                  -> IO (H.HashMap TPath ([Chunk n], MIMEType)) compileTemplates' hs = do     ctm <- foldM runOne H.empty tpathDocfiles     return $! ctm@@ -268,7 +270,7 @@  ------------------------------------------------------------------------------ -- | Consolidate consecutive Pure Chunks.-consolidate :: (Monad m) => DList (Chunk m) -> [Chunk m]+consolidate :: (Monad n) => DList (Chunk n) -> [Chunk n] consolidate = consolidateL . DL.toList   where     consolidateL []     = []@@ -306,7 +308,7 @@ -- | Given a list of output chunks, consolidate turns consecutive runs of -- @Pure Html@ values into maximally-efficient pre-rendered strict -- 'ByteString' chunks.-codeGen :: Monad m => DList (Chunk m) -> RuntimeSplice m Builder+codeGen :: Monad n => DList (Chunk n) -> RuntimeSplice n Builder codeGen l = V.foldr mappend mempty $!             V.map toAct $! V.fromList $! consolidate l   where@@ -385,34 +387,6 @@   --------------------------------------------------------------------------------- |-parseAtt :: Monad n => (Text, Text) -> HeistT n IO (DList (Chunk n))-parseAtt (k,v) = do-    mas <- getsHS (H.lookup k . _attrSpliceMap)-    maybe doInline (return . doAttrSplice) mas--  where-    cvt (Literal x) = return $ yieldPureText x-    cvt (Ident x) =-        localParamNode (const $ X.Element x [] []) $ getAttributeSplice x--    -- Handles inline parsing of $() splice syntax in attributes-    doInline = do-        let ast = case AP.feed (AP.parse attParser v) "" of-                    (AP.Done _ res) -> res-                    (AP.Fail _ _ _) -> []-                    (AP.Partial _ ) -> []-        chunks <- mapM cvt ast-        let value = DL.concat chunks-        return $ attrToChunk k value--    -- Handles attribute splices-    doAttrSplice splice = DL.singleton $ RuntimeHtml $ do-        res <- splice v-        return $ mconcat $ map attrToBuilder res--    ------------------------------------------------------------------------------- -- | 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@@ -429,7 +403,7 @@          childHtml <- runNodeList ch -        return $! if null (DL.toList childHtml)+        return $! if null (DL.toList childHtml) && nm `S.member` X.voidTags           then DL.concat [ DL.singleton $! pureTextChunk $! tag0                          , DL.concat compiledAttrs                          , DL.singleton $! pureTextChunk " />"@@ -444,6 +418,34 @@   ------------------------------------------------------------------------------+-- |+parseAtt :: Monad n => (Text, Text) -> HeistT n IO (DList (Chunk n))+parseAtt (k,v) = do+    mas <- getsHS (H.lookup k . _attrSpliceMap)+    maybe doInline (return . doAttrSplice) mas++  where+    cvt (Literal x) = return $ yieldPureText x+    cvt (Ident x) =+        localParamNode (const $ X.Element x [] []) $ getAttributeSplice x++    -- Handles inline parsing of $() splice syntax in attributes+    doInline = do+        let ast = case AP.feed (AP.parse attParser v) "" of+                    (AP.Done _ res) -> res+                    (AP.Fail _ _ _) -> []+                    (AP.Partial _ ) -> []+        chunks <- mapM cvt ast+        let value = DL.concat chunks+        return $ attrToChunk k value++    -- Handles attribute splices+    doAttrSplice splice = DL.singleton $ RuntimeHtml $ do+        res <- splice v+        return $ mconcat $ map attrToBuilder res+++------------------------------------------------------------------------------ -- | 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.@@ -451,6 +453,22 @@ runAttributes = mapM parseAtt  +------------------------------------------------------------------------------+-- | 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.+runAttributesRaw :: (Monad m, Monad n)+                 => [(Text, Text)]+                 -> HeistT n m (RuntimeSplice n [(Text, Text)])+runAttributesRaw attrs = do+    arrs <- mapM runSingle attrs+    return $ liftM concat $ sequence arrs+  where+    runSingle p@(k,v) = do+        mas <- getsHS (H.lookup k . _attrSpliceMap)+        return $ maybe (return [p]) ($v) mas++ attrToChunk :: Text -> DList (Chunk n) -> DList (Chunk n) attrToChunk !k !v = do     DL.concat@@ -490,7 +508,7 @@  ------------------------------------------------------------------------------ -- | Gets the result of a promised runtime computation.-getPromise :: (Monad m) => Promise a -> RuntimeSplice m a+getPromise :: (Monad n) => Promise a -> RuntimeSplice n a getPromise (Promise k) = do     mb <- gets (HE.lookup k)     return $ fromMaybe e mb@@ -503,14 +521,14 @@  ------------------------------------------------------------------------------ -- | Adds a promise to the runtime splice context.-putPromise :: (Monad m) => Promise a -> a -> RuntimeSplice m ()+putPromise :: (Monad n) => Promise a -> a -> RuntimeSplice n () putPromise (Promise k) x = modify (HE.insert k x) {-# INLINE putPromise #-}   ------------------------------------------------------------------------------ -- | Modifies a promise.-adjustPromise :: Monad m => Promise a -> (a -> a) -> RuntimeSplice m ()+adjustPromise :: Monad n => Promise a -> (a -> a) -> RuntimeSplice n () adjustPromise (Promise k) f = modify (HE.adjust f k) {-# INLINE adjustPromise #-} @@ -647,7 +665,7 @@     err = "callTemplate: "++(T.unpack $ T.decodeUtf8 nm)++(" does not exist")  -interpret :: Monad m => DList (Chunk m) -> m Builder+interpret :: Monad n => DList (Chunk n) -> n Builder interpret = flip evalStateT HE.empty . unRT . codeGen  @@ -656,44 +674,138 @@ ------------------------------------------------------------------------------  +------------------------------------------------------------------------------+-- | 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. nodeSplices :: [(Text, a -> [X.Node])] -> [(Text, a -> Builder)] nodeSplices = mapSnd nodeSplice ++------------------------------------------------------------------------------+-- | Converts a pure Node splice function to a pure Builder splice function. nodeSplice :: (a -> [X.Node]) -> a -> Builder nodeSplice f = X.renderHtmlFragment X.UTF8 . f -pureSplices :: Monad m => [(d, a -> Builder)] -> [(d, Promise a -> Splice m)]++------------------------------------------------------------------------------+-- | 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 -pureSplice :: Monad m => (a -> Builder) -> Promise a -> Splice m++------------------------------------------------------------------------------+-- | 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 -mapInputPromise :: Monad m++mapInputPromise :: Monad n                 => (a -> b)-                -> (Promise b -> Splice m)-                -> Promise a -> Splice m-mapInputPromise f g p1 = do+                -> (Promise b -> Splice n)+                -> Promise a -> Splice n+mapInputPromise f = repromise' (return . f)+{-# DEPRECATED mapInputPromise "Use repromise' instead."#-}+++------------------------------------------------------------------------------+-- | Change the promise type of a splice function.+repromise' :: Monad n+           => (a -> n b)+           -> (Promise b -> Splice n)+           -> Promise a -> Splice n+repromise' f pf p = do     p2 <- newEmptyPromise     let action = yieldRuntimeEffect $ do-        a <- getPromise p1-        putPromise p2 (f a)-    res <- g p2+            a <- getPromise p+            putPromise p2 =<< lift (f a)+    res <- pf p2     return $ action `mappend` res+++------------------------------------------------------------------------------+-- | Repromise a list of splices.+repromise :: Monad n+          => (a -> 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 -> 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 <- lift (f a)+        case mb of+          Nothing -> return mempty+          Just b -> do+            putPromise p2 b+            codeGen action+++------------------------------------------------------------------------------+-- | repromiseMay' for a list of splices.+repromiseMay :: Monad n+             => (a -> n (Maybe b))+             -> [(d, Promise b -> Splice n)]+             -> [(d, Promise a -> Splice n)]+repromiseMay f = mapSnd (repromiseMay' f)   ------------------------------------------------------------------------------

@@ -18,7 +18,7 @@     attoparsec                 >= 0.10    && < 0.11,     base                       >= 4       && < 5,     blaze-builder              >= 0.2     && < 0.4,-    blaze-html                 >= 0.4     && < 0.6,+    blaze-html                 >= 0.4     && < 0.7,     bytestring                 >= 0.9     && < 0.11,     containers                 >= 0.2     && < 0.6,     directory                  >= 1.1     && < 1.3,@@ -35,7 +35,7 @@     transformers               >= 0.2     && < 0.4,     unordered-containers       >= 0.1.4   && < 0.3,     vector                     >= 0.9     && < 0.11,-    xmlhtml                    >= 0.1.6   && < 0.3+    xmlhtml                    >= 0.2.1   && < 0.3     ghc-options: -O2 -Wall -fhpc -fwarn-tabs -funbox-strict-fields -threaded@@ -58,7 +58,7 @@     attoparsec                 >= 0.10    && < 0.11,     base                       >= 4       && < 5,     blaze-builder              >= 0.2     && < 0.4,-    blaze-html                 >= 0.4     && < 0.6,+    blaze-html                 >= 0.4     && < 0.7,     bytestring                 >= 0.9     && < 0.11,     containers                 >= 0.2     && < 0.6,     directory                  >= 1.1     && < 1.3,@@ -75,7 +75,7 @@     transformers               >= 0.2     && < 0.4,     unordered-containers       >= 0.1.4   && < 0.3,     vector                     >= 0.9     && < 0.11,-    xmlhtml                    >= 0.1.6   && < 0.3+    xmlhtml                    >= 0.2.1   && < 0.3    ghc-options: -O2 -Wall -fwarn-tabs -funbox-strict-fields -threaded                -fno-warn-unused-do-bind -rtsopts