This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "heist".
The branch, master has been updated
via 898cd9f88634011115dded7f0352ff75f34ee16f (commit)
from 1aa64bfb34dc80e42f093f5ec241d1c5385375dd (commit)
Summary of changes:
src/Text/Templating/Heist.hs | 1 +
src/Text/Templating/Heist/Internal.hs | 95 ++++++++++++++++++++-------------
src/Text/Templating/Heist/Types.hs | 34 ++++++------
3 files changed, 75 insertions(+), 55 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 898cd9f88634011115dded7f0352ff75f34ee16f
Author: Gregory Collins <[email protected]>
Date: Thu Jun 17 23:40:52 2010 -0400
Add 'parseDoc' function
diff --git a/src/Text/Templating/Heist.hs b/src/Text/Templating/Heist.hs
index 3b6228b..07c73b6 100644
--- a/src/Text/Templating/Heist.hs
+++ b/src/Text/Templating/Heist.hs
@@ -97,6 +97,7 @@ module Text.Templating.Heist
-- * Misc functions
, getDoc
+ , parseDoc
, bindStaticTag
) where
diff --git a/src/Text/Templating/Heist/Internal.hs
b/src/Text/Templating/Heist/Internal.hs
index 7e5ec84..42acb93 100644
--- a/src/Text/Templating/Heist/Internal.hs
+++ b/src/Text/Templating/Heist/Internal.hs
@@ -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
------------------------------------------------------------------------------
@@ -447,29 +448,47 @@ renderTemplate ts name = do
-- 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
@@ -482,7 +501,7 @@ hasDoctype bs = "<!DOCTYPE" `B.isPrefixOf` bs
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 = (/='>')
diff --git a/src/Text/Templating/Heist/Types.hs
b/src/Text/Templating/Heist/Types.hs
index f513999..28f3f2f 100644
--- a/src/Text/Templating/Heist/Types.hs
+++ b/src/Text/Templating/Heist/Types.hs
@@ -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 @@ liberating us from the unused writer portion of RWST.
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
------------------------------------------------------------------------------
-----------------------------------------------------------------------
hooks/post-receive
--
heist
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
