heist 0.2.0 → 0.2.1

raw patch · 6 files changed

+135/−84 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CONTRIBUTORS +2/−0
• heist.cabal +1/−1
• src/Text/Templating/Heist.hs +4/−2
• src/Text/Templating/Heist/Internal.hs +79/−45
• src/Text/Templating/Heist/Splices/Static.hs +5/−2
• src/Text/Templating/Heist/Types.hs +44/−34

@@ -1,4 +1,6 @@ Doug Beardsley <mightybyte@gmail.com> Gregory Collins <greg@gregorycollins.net>+Carl Howells <chowells79@gmail.com> Edward Kmett+Shane O'Brien <shane@duairc.com> James Sanders <jimmyjazz14@gmail.com>

@@ -1,5 +1,5 @@ name:           heist-version:        0.2.0+version:        0.2.1 synopsis:       An xhtml templating system license:        BSD3 license-file:   LICENSE

@@ -97,6 +97,7 @@      -- * Misc functions   , getDoc+  , parseDoc   , bindStaticTag    ) where@@ -120,8 +121,9 @@   --------------------------------------------------------------------------------- | An empty template state, with Heist's default splices (@\<bind\>@ and--- @\<apply\>@) mapped.+-- | An empty template state, with Heist's default splices (@\<apply\>@,+-- @\<bind\>@, @\<ignore\>@, and @\<markdown\>@) mapped.  The static tag is+-- not mapped here because it must be mapped manually in your application. emptyTemplateState :: MonadIO m => TemplateState m emptyTemplateState = TemplateState defaultSpliceMap Map.empty True [] 0                                    return return return []

@@ -1,32 +1,33 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}  module Text.Templating.Heist.Internal where  -------------------------------------------------------------------------------import           Control.Applicative-import           Control.Exception (SomeException)-import           Control.Monad.CatchIO-import           Control.Monad.RWS.Strict-import qualified Data.Attoparsec.Char8 as AP-import           Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy as L-import           Data.Either-import qualified Data.Foldable as F-import           Data.List-import qualified Data.Map as Map-import           Data.Maybe-import           Prelude hiding (catch)-import           System.Directory.Tree hiding (name)-import           System.FilePath-import           Text.XML.Expat.Format-import qualified Text.XML.Expat.Tree as X+import             Control.Applicative+import             Control.Exception (SomeException)+import             Control.Monad.CatchIO+import "monads-fd" Control.Monad.RWS.Strict+import qualified   Data.Attoparsec.Char8 as AP+import             Data.ByteString.Char8 (ByteString)+import qualified   Data.ByteString.Char8 as B+import qualified   Data.ByteString.Lazy as L+import             Data.Either+import qualified   Data.Foldable as F+import             Data.List+import qualified   Data.Map as Map+import             Data.Maybe+import             Prelude hiding (catch)+import             System.Directory.Tree hiding (name)+import             System.FilePath+import             Text.XML.Expat.Format+import qualified   Text.XML.Expat.Tree as X  -------------------------------------------------------------------------------import           Text.Templating.Heist.Constants-import           Text.Templating.Heist.Types+import             Text.Templating.Heist.Constants+import             Text.Templating.Heist.Types   ------------------------------------------------------------------------------@@ -283,17 +284,32 @@   --------------------------------------------------------------------------------- | Get's the attribute value.  This is just a normal splice lookup with the--- added restriction that the splice's result list has to contain a single--- text element.  Otherwise the attribute evaluates to the empty string.+-- | Get's the attribute value.  If the splice's result list contains non-text+-- nodes, this will translate them into text nodes with textContent and+-- concatenate them together.+--+-- Originally, this only took the first node from the splices's result list,+-- and only if it was a text node. This caused problems when the splice's+-- result contained HTML entities, as they would split a text node. This was+-- then fixed to take the first consecutive bunch of text nodes, and return+-- their concatenation. This was seen as more useful than throwing an error,+-- and more intuitive than trying to render all the nodes as text.+-- +-- However, it was decided in the end to render all the nodes as text, and+-- then concatenate them. If a splice returned+-- \"some \<b\>text\<\/b\> foobar\", the user would almost certainly want+-- \"some text foobar\" to be rendered, and Heist would probably seem+-- annoyingly limited for not being able to do this. If the user really did+-- want it to render \"some \", it would probably be easier for them to+-- accept that they were silly to pass more than that to be substituted than+-- it would be for the former user to accept that+-- \"some \<b\>text\<\/b\> foobar\" is being rendered as \"some \" because+-- it's \"more intuitive\". getAttributeSplice :: Monad m => ByteString -> TemplateMonad m ByteString getAttributeSplice name = do     s <- liftM (lookupSplice name) getTS     nodes <- maybe (return []) id s-    return $ check nodes-  where-    check ((X.Text t):_) = t-    check _ = ""+    return $ B.concat $ map X.textContent nodes  ------------------------------------------------------------------------------ -- | Performs splice processing on a list of nodes.@@ -432,29 +448,47 @@ -- Template loading ------------------------------------------------------------------------------ --- | Reads an XML document from disk.-getDoc :: String -> IO (Either String InternalTemplate)-getDoc f = do-    bs <- catch (liftM Right $ B.readFile f)-                (\(e::SomeException) -> return $ Left $ show e)-    return $ do-        (doctype, rest) <- liftM extractDoctype bs-        let wrap b = "<snap:root>\n" `B.append` b `B.append` "\n</snap:root>"-            toTemplate t = InternalTemplate {-                _itDoctype = doctype,-                _itNodes = t-            }-        mapRight (toTemplate . X.getChildren) .-            mapLeft genErrorMsg .-            X.parse' heistExpatOptions . wrap $ rest+-- | Turns an in-memory XML/XHTML bytestring into a (doctype,'[Node]') pair.+parseDoc :: ByteString -> IO (Either String (Maybe ByteString,[Node]))+parseDoc bs = do+    let (doctype,rest) = extractDoctype bs+    let wrap b = B.concat ["<snap:root>\n", b, "\n</snap:root>"]++    return $+      mapRight (\n -> (doctype,X.getChildren n)) $+      mapLeft genErrorMsg $+      X.parse' heistExpatOptions (wrap rest)+   where-    genErrorMsg (X.XMLParseError str loc) = f ++ " " ++ locMsg loc ++ ": " ++ translate str+    genErrorMsg (X.XMLParseError str loc) = locMsg loc ++ ": " ++ translate str+     locMsg (X.XMLParseLocation line col _ _) =         "(line " ++ show (line-1) ++ ", col " ++ show col ++ ")"+     translate "junk after document element" = "document must have a single root element"     translate s = s  +-- | Reads an XML document from disk.+getDoc :: String -> IO (Either String InternalTemplate)+getDoc f = do+    bs <- catch (liftM Right $ B.readFile f)+                (\(e::SomeException) -> return $ Left $ show e)++    d' <- either (return . Left)+                 parseDoc+                 bs++    let d = mapLeft (\s -> f ++ " " ++ s) d'++    return $ either Left+               (\(doctype, nodes) -> Right $ InternalTemplate {+                    _itDoctype = doctype,+                    _itNodes = nodes+                })+               d++ ------------------------------------------------------------------------------ -- | Checks whether the bytestring has a doctype. hasDoctype :: ByteString -> Bool@@ -467,7 +501,7 @@ extractDoctype :: ByteString -> (Maybe ByteString, ByteString) extractDoctype bs =      if hasDoctype bs-        then (Just $ B.snoc (B.takeWhile p bs) '>', B.tail $ B.dropWhile p bs)+        then (Just $ B.snoc (B.takeWhile p bs) '>',B.tail $ B.dropWhile p bs)         else (Nothing, bs)   where     p = (/='>')

@@ -40,7 +40,7 @@   --------------------------------------------------------------------------------- | The "static" splice ensures that its contents are evaluated once and then+-- | The \"static\" splice ensures that its contents are evaluated once and then -- cached.  The cached contents are returned every time the splice is -- referenced. staticImpl :: (MonadIO m)@@ -68,7 +68,10 @@   --------------------------------------------------------------------------------- | Modifies a TemplateState to include a "static" tag.+-- | Modifies a TemplateState to include a \"static\" tag.  The static tag is+-- not bound automatically with the other default Heist tags.  This is because+-- this function also returns StaticTagState, so the user will be able to+-- clear it with the 'clearStaticTagCache' function. bindStaticTag :: MonadIO m               => TemplateState m               -> IO (TemplateState m, StaticTagState)

@@ -1,9 +1,10 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}  {-| @@ -21,20 +22,19 @@ module Text.Templating.Heist.Types where  -------------------------------------------------------------------------------import           Control.Applicative-import           Control.Monad.Cont-import           Control.Monad.Error-import           Control.Monad.Reader-import           Control.Monad.State-import           Control.Monad.Trans-import           Data.ByteString.Char8 (ByteString)-import qualified Data.ByteString.Char8 as B-import qualified Data.Map as Map-import           Data.Map (Map)-import           Data.Monoid-import           Data.Typeable-import           Prelude hiding (catch)-import qualified Text.XML.Expat.Tree as X+import             Control.Applicative+import "monads-fd" Control.Monad.Cont+import "monads-fd" Control.Monad.Error+import "monads-fd" Control.Monad.Reader+import "monads-fd" Control.Monad.State+import "monads-fd" Control.Monad.Trans+import             Data.ByteString.Char8 (ByteString)+import qualified   Data.Map as Map+import             Data.Map (Map)+import             Data.Monoid+import             Data.Typeable+import             Prelude hiding (catch)+import qualified   Text.XML.Expat.Tree as X   ------------------------------------------------------------------------------@@ -135,9 +135,20 @@   --------------------------------------------------------------------------------- | TemplateMonad is a combination of the reader and state monads.  The--- reader environment is the contents of the node being spliced.  The state is--- the TemplateState data structure.+-- | The Typeable instance is here so Heist can be dynamically executed with+-- Hint.+templateStateTyCon :: TyCon+templateStateTyCon = mkTyCon "Text.Templating.Heist.TemplateState"+{-# NOINLINE templateStateTyCon #-}++instance (Typeable1 m) => Typeable (TemplateState m) where+    typeOf _ = mkTyConApp templateStateTyCon [typeOf1 (undefined :: m ())]+++------------------------------------------------------------------------------+-- | TemplateMonad is the monad used for 'Splice' processing.  TemplateMonad+-- provides \"passthrough\" instances for many of the monads you might use in+-- the inner monad. newtype TemplateMonad m a = TemplateMonad {     runTemplateMonad :: Node                      -> TemplateState m@@ -146,7 +157,7 @@   --------------------------------------------------------------------------------- | Helper function for the functor instance+-- | Evaluates a template monad as a computation in the underlying monad. evalTemplateMonad :: Monad m                   => TemplateMonad m a                   -> Node@@ -155,7 +166,7 @@ evalTemplateMonad m r s = do     (a, _) <- runTemplateMonad m r s     return a-  + ------------------------------------------------------------------------------ -- | Helper function for the functor instance first :: (a -> b) -> (a, c) -> (b, c)@@ -279,15 +290,14 @@ ------------------------------------------------------------------------------ -- | The Typeable instance is here so Heist can be dynamically executed with -- Hint.-instance (Typeable1 m, Typeable a) => Typeable (TemplateMonad m a) where-    typeOf _ = mkTyConApp tCon [mRep, aRep]-      where-        tCon = mkTyCon "TemplateMonad"-        maRep = typeOf (undefined :: m a)-        (mCon, [aRep]) = splitTyConApp maRep-        mRep = mkTyConApp mCon []+templateMonadTyCon :: TyCon+templateMonadTyCon = mkTyCon "Text.Templating.Heist.TemplateMonad"+{-# NOINLINE templateMonadTyCon #-} +instance (Typeable1 m) => Typeable1 (TemplateMonad m) where+    typeOf1 _ = mkTyConApp templateMonadTyCon [typeOf1 (undefined :: m ())] + ------------------------------------------------------------------------------ -- Functions for our monad. ------------------------------------------------------------------------------@@ -310,7 +320,7 @@   --------------------------------------------------------------------------------- | +-- | TemplateMonad's local localParamNode :: Monad m                => (Node -> Node)                -> TemplateMonad m a@@ -319,25 +329,25 @@   --------------------------------------------------------------------------------- | +-- | TemplateMonad's gets getsTS :: Monad m => (TemplateState m -> r) -> TemplateMonad m r getsTS f = TemplateMonad $ \_ s -> return (f s, s)   --------------------------------------------------------------------------------- | +-- | TemplateMonad's get getTS :: Monad m => TemplateMonad m (TemplateState m) getTS = TemplateMonad $ \_ s -> return (s, s)   --------------------------------------------------------------------------------- | +-- | TemplateMonad's put putTS :: Monad m => TemplateState m -> TemplateMonad m () putTS s = TemplateMonad $ \_ _ -> return ((), s)   --------------------------------------------------------------------------------- | +-- | TemplateMonad's modify modifyTS :: Monad m                     => (TemplateState m -> TemplateState m)                     -> TemplateMonad m ()