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 f8b93a404136e7678e3d420897d0515c194ac277 (commit)
via 05cb43fdd4c5c614f97331aed194e594a01d62b5 (commit)
via fa50ec658cb338ffdacbdc287ff7093ee99134c1 (commit)
via f9453bd4ae6812bff033dca2bd5d840b54700918 (commit)
via d40e4e66b27acf7b20d3e6f620bf187767f8d319 (commit)
via 3295bedc34345485a5007cdadc1093e27bf0be13 (commit)
via a2c92a7540f3c3c026d52af945ba07aef4664797 (commit)
via f6891e492f76640685976202d143817586c88cba (commit)
via a81f153aba6ed5e74224e47884d990e42bb84011 (commit)
via 9bf32d7fbd14f9deae0b9166b26ca2f82d86dc0a (commit)
from 78f7b5039b12a73ef30f0aa15e3ac9b8be0052db (commit)
Summary of changes:
heist.cabal | 10 +-
src/Text/Templating/Heist.hs | 31 ++--
src/Text/Templating/Heist/Constants.hs | 268 ----------------------
src/Text/Templating/Heist/Internal.hs | 299 ++++++++++++-------------
src/Text/Templating/Heist/Splices/Apply.hs | 24 +-
src/Text/Templating/Heist/Splices/Bind.hs | 12 +-
src/Text/Templating/Heist/Splices/Ignore.hs | 4 +-
src/Text/Templating/Heist/Splices/Markdown.hs | 34 ++--
src/Text/Templating/Heist/Splices/Static.hs | 24 +-
src/Text/Templating/Heist/Types.hs | 38 +--
test/heist-testsuite.cabal | 5 +-
test/suite/Text/Templating/Heist/Tests.hs | 147 +++++++------
12 files changed, 315 insertions(+), 581 deletions(-)
delete mode 100644 src/Text/Templating/Heist/Constants.hs
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 f8b93a404136e7678e3d420897d0515c194ac277
Author: Chris Smith <[email protected]>
Date: Tue Jan 11 09:38:06 2011 -0700
Update documentation on MIME types
diff --git a/src/Text/Templating/Heist/Internal.hs
b/src/Text/Templating/Heist/Internal.hs
index c570109..c3a59f0 100644
--- a/src/Text/Templating/Heist/Internal.hs
+++ b/src/Text/Templating/Heist/Internal.hs
@@ -473,7 +473,11 @@ mimeType d = case d of
------------------------------------------------------------------------------
--- | Renders a template from the specified TemplateState to a 'Builder'.
+-- | Renders a template from the specified TemplateState to a 'Builder'. The
+-- MIME type returned is based on the detected character encoding, and whether
+-- the root template was an HTML or XML format template. It will always be
+-- @text/html@ or @text/xml@. If a more specific MIME type is needed for a
+-- particular XML application, it must be provided by the application.
renderTemplate :: Monad m
=> TemplateState m
-> ByteString
commit 05cb43fdd4c5c614f97331aed194e594a01d62b5
Author: Chris Smith <[email protected]>
Date: Tue Jan 11 09:25:48 2011 -0700
Export type I forgot
diff --git a/src/Text/Templating/Heist.hs b/src/Text/Templating/Heist.hs
index 6cd74fc..bfaf0f3 100644
--- a/src/Text/Templating/Heist.hs
+++ b/src/Text/Templating/Heist.hs
@@ -69,6 +69,7 @@ module Text.Templating.Heist
(
-- * Types
Template
+ , MIMEType
, Splice
, TemplateMonad
, TemplateState
commit fa50ec658cb338ffdacbdc287ff7093ee99134c1
Author: Chris Smith <[email protected]>
Date: Tue Jan 11 09:23:57 2011 -0700
Include MIME type in template results
diff --git a/src/Text/Templating/Heist/Internal.hs
b/src/Text/Templating/Heist/Internal.hs
index d434093..c570109 100644
--- a/src/Text/Templating/Heist/Internal.hs
+++ b/src/Text/Templating/Heist/Internal.hs
@@ -459,15 +459,30 @@ callTemplate name params = do
------------------------------------------------------------------------------
+-- Gives the MIME type for a 'X.Document'
+mimeType :: X.Document -> ByteString
+mimeType d = case d of
+ (X.HtmlDocument e _ _) -> "text/html;charset=" `BC.append` enc e
+ (X.XmlDocument e _ _) -> "text/xml;charset=" `BC.append` enc e
+ where
+ enc X.UTF8 = "utf-8"
+ -- Should not include byte order designation for UTF-16 since
+ -- rendering will include a byte order mark. (RFC 2781, Sec. 3.3)
+ enc X.UTF16BE = "utf-16"
+ enc X.UTF16LE = "utf-16"
+
+
+------------------------------------------------------------------------------
-- | Renders a template from the specified TemplateState to a 'Builder'.
renderTemplate :: Monad m
=> TemplateState m
-> ByteString
- -> m (Maybe Builder)
+ -> m (Maybe (Builder, MIMEType))
renderTemplate ts name = evalTemplateMonad tpl (X.TextNode "") ts
where tpl = do mt <- evalWithHooksInternal name
- case mt of Nothing -> return Nothing
- Just doc -> return $ Just $ X.render doc
+ case mt of
+ Nothing -> return Nothing
+ Just doc -> return $ Just $ (X.render doc, mimeType doc)
------------------------------------------------------------------------------
@@ -479,7 +494,7 @@ renderWithArgs :: Monad m
=> [(Text, Text)]
-> TemplateState m
-> ByteString
- -> m (Maybe Builder)
+ -> m (Maybe (Builder, MIMEType))
renderWithArgs args ts = renderTemplate (bindStrings args ts)
diff --git a/src/Text/Templating/Heist/Types.hs
b/src/Text/Templating/Heist/Types.hs
index db5cc35..b847bbb 100644
--- a/src/Text/Templating/Heist/Types.hs
+++ b/src/Text/Templating/Heist/Types.hs
@@ -45,6 +45,11 @@ type Template = [X.Node]
------------------------------------------------------------------------------
+-- | MIME Type. The type alias is here to make the API clearer.
+type MIMEType = ByteString
+
+
+------------------------------------------------------------------------------
-- | Reversed list of directories. This holds the path to the template
-- currently being processed.
type TPath = [ByteString]
diff --git a/test/suite/Text/Templating/Heist/Tests.hs
b/test/suite/Text/Templating/Heist/Tests.hs
index 5ab54d0..9618f59 100644
--- a/test/suite/Text/Templating/Heist/Tests.hs
+++ b/test/suite/Text/Templating/Heist/Tests.hs
@@ -167,12 +167,12 @@ doctypeTest :: H.Assertion
doctypeTest = do
ets <- loadT "templates"
let ts = either (error "Error loading templates") id ets
- index <- renderTemplate ts "index"
+ Just (indexDoc, indexMIME) <- renderTemplate ts "index"
H.assertBool "doctype test index" $ isJust $ X.docType $
- fromRight $ (X.parseHTML "index") $ toByteString $ fromJust index
- ioc <- renderTemplate ts "ioc"
+ fromRight $ (X.parseHTML "index") $ toByteString $ indexDoc
+ Just (iocDoc, iocMIME) <- renderTemplate ts "ioc"
H.assertBool "doctype test ioc" $ isJust $ X.docType $
- fromRight $ (X.parseHTML "index") $ toByteString $ fromJust ioc
+ fromRight $ (X.parseHTML "index") $ toByteString $ iocDoc
where fromRight (Right x) = x
fromRight (Left s) = error s
@@ -187,11 +187,11 @@ attrSubstTest = do
where
setTs val = bindSplice "foo" (return [X.TextNode val])
check ts str = do
- res <- renderTemplate ts "attrs"
+ Just (resDoc, resMIME) <- renderTemplate ts "attrs"
H.assertBool ("attr subst " ++ (show str)) $ not $ B.null $
- snd $ B.breakSubstring str $ toByteString $ fromJust res
+ snd $ B.breakSubstring str $ toByteString $ resDoc
H.assertBool ("attr subst foo") $ not $ B.null $
- snd $ B.breakSubstring "$(foo)" $ toByteString $ fromJust res
+ snd $ B.breakSubstring "$(foo)" $ toByteString $ resDoc
------------------------------------------------------------------------------
@@ -203,11 +203,11 @@ bindAttrTest = do
where
check ts str = do
- res <- renderTemplate ts "bind-attrs"
+ Just (resDoc, resMIME) <- renderTemplate ts "bind-attrs"
H.assertBool ("attr subst " ++ (show str)) $ not $ B.null $
- snd $ B.breakSubstring str $ toByteString $ fromJust res
+ snd $ B.breakSubstring str $ toByteString $ resDoc
H.assertBool ("attr subst bar") $ B.null $
- snd $ B.breakSubstring "$(bar)" $ toByteString $ fromJust res
+ snd $ B.breakSubstring "$(bar)" $ toByteString $ resDoc
------------------------------------------------------------------------------
@@ -226,9 +226,9 @@ markdownTest = do
where
check ts str = do
- result <- liftM (fmap $ B.filter (/= '\n')) $
- liftM (fmap toByteString) $ renderTemplate ts "markdown"
- H.assertEqual ("Should match " ++ (show str)) str (fromJust result)
+ Just (doc, mime) <- renderTemplate ts "markdown"
+ let result = B.filter (/= '\n') (toByteString doc)
+ H.assertEqual ("Should match " ++ (show str)) str result
------------------------------------------------------------------------------
@@ -359,8 +359,9 @@ processNode elems loc =
-- template. (Old convenience code.)
quickRender :: FilePath -> ByteString -> IO (Maybe ByteString)
quickRender baseDir name = do
- ts <- loadTS baseDir
- fmap (fmap toByteString) (renderTemplate ts name)
+ ts <- loadTS baseDir
+ res <- renderTemplate ts name
+ return (fmap (toByteString . fst) res)
------------------------------------------------------------------------------
commit f9453bd4ae6812bff033dca2bd5d840b54700918
Author: Chris Smith <[email protected]>
Date: Tue Jan 11 01:34:45 2011 -0700
Remove old ByteString functions, and give Builder versions the better names.
diff --git a/src/Text/Templating/Heist.hs b/src/Text/Templating/Heist.hs
index f9f181a..6cd74fc 100644
--- a/src/Text/Templating/Heist.hs
+++ b/src/Text/Templating/Heist.hs
@@ -107,9 +107,7 @@ module Text.Templating.Heist
, evalTemplate
, callTemplate
, renderTemplate
- , renderTemplateBuilder
, renderWithArgs
- , renderWithArgsBuilder
, bindStrings
, bindString
diff --git a/src/Text/Templating/Heist/Internal.hs
b/src/Text/Templating/Heist/Internal.hs
index dbc4762..d434093 100644
--- a/src/Text/Templating/Heist/Internal.hs
+++ b/src/Text/Templating/Heist/Internal.hs
@@ -460,24 +460,14 @@ callTemplate name params = do
------------------------------------------------------------------------------
-- | Renders a template from the specified TemplateState to a 'Builder'.
-renderTemplateBuilder :: Monad m
- => TemplateState m
- -> ByteString
- -> m (Maybe Builder)
-renderTemplateBuilder ts name = evalTemplateMonad tpl (X.TextNode "") ts
- where tpl = do mt <- evalWithHooksInternal name
- case mt of Nothing -> return Nothing
- Just doc -> return $ Just $ X.render doc
-
-
-------------------------------------------------------------------------------
--- | Renders a template from the specified TemplateState to a 'ByteString'.
renderTemplate :: Monad m
=> TemplateState m
-> ByteString
- -> m (Maybe ByteString)
-renderTemplate ts name =
- liftM (liftM toByteString) (renderTemplateBuilder ts name)
+ -> m (Maybe Builder)
+renderTemplate ts name = evalTemplateMonad tpl (X.TextNode "") ts
+ where tpl = do mt <- evalWithHooksInternal name
+ case mt of Nothing -> return Nothing
+ Just doc -> return $ Just $ X.render doc
------------------------------------------------------------------------------
@@ -489,24 +479,11 @@ renderWithArgs :: Monad m
=> [(Text, Text)]
-> TemplateState m
-> ByteString
- -> m (Maybe ByteString)
+ -> m (Maybe Builder)
renderWithArgs args ts = renderTemplate (bindStrings args ts)
------------------------------------------------------------------------------
--- | Renders a template with the specified arguments passed to it, and output
--- as a 'Builder'. This is a convenience function for the common pattern of
--- calling renderTemplateBuilder after using bindString, bindStrings, or
--- bindSplice to set up the arguments to the template.
-renderWithArgsBuilder :: Monad m
- => [(Text, Text)]
- -> TemplateState m
- -> ByteString
- -> m (Maybe Builder)
-renderWithArgsBuilder args ts = renderTemplateBuilder (bindStrings args ts)
-
-
-------------------------------------------------------------------------------
-- Template loading
------------------------------------------------------------------------------
diff --git a/test/suite/Text/Templating/Heist/Tests.hs
b/test/suite/Text/Templating/Heist/Tests.hs
index 8a1dace..5ab54d0 100644
--- a/test/suite/Text/Templating/Heist/Tests.hs
+++ b/test/suite/Text/Templating/Heist/Tests.hs
@@ -158,7 +158,7 @@ renderNoNameTest = do
ets <- loadT "templates"
either (error "Error loading templates")
(\ts -> do t <- renderTemplate ts ""
- H.assertBool "renderNoName" $ t == Nothing
+ H.assertBool "renderNoName" $ isNothing t
) ets
@@ -168,11 +168,11 @@ doctypeTest = do
ets <- loadT "templates"
let ts = either (error "Error loading templates") id ets
index <- renderTemplate ts "index"
- H.assertBool "doctype test index" $ isJust $
- X.docType $ fromRight $ (X.parseHTML "index") $ fromJust index
+ H.assertBool "doctype test index" $ isJust $ X.docType $
+ fromRight $ (X.parseHTML "index") $ toByteString $ fromJust index
ioc <- renderTemplate ts "ioc"
- H.assertBool "doctype test ioc" $ isJust $
- X.docType $ fromRight $ (X.parseHTML "index") $ fromJust ioc
+ H.assertBool "doctype test ioc" $ isJust $ X.docType $
+ fromRight $ (X.parseHTML "index") $ toByteString $ fromJust ioc
where fromRight (Right x) = x
fromRight (Left s) = error s
@@ -188,10 +188,10 @@ attrSubstTest = do
setTs val = bindSplice "foo" (return [X.TextNode val])
check ts str = do
res <- renderTemplate ts "attrs"
- H.assertBool ("attr subst " ++ (show str)) $
- not $ B.null $ snd $ B.breakSubstring str $ fromJust res
- H.assertBool ("attr subst foo") $
- not $ B.null $ snd $ B.breakSubstring "$(foo)" $ fromJust res
+ H.assertBool ("attr subst " ++ (show str)) $ not $ B.null $
+ snd $ B.breakSubstring str $ toByteString $ fromJust res
+ H.assertBool ("attr subst foo") $ not $ B.null $
+ snd $ B.breakSubstring "$(foo)" $ toByteString $ fromJust res
------------------------------------------------------------------------------
@@ -204,10 +204,10 @@ bindAttrTest = do
where
check ts str = do
res <- renderTemplate ts "bind-attrs"
- H.assertBool ("attr subst " ++ (show str)) $
- not $ B.null $ snd $ B.breakSubstring str $ fromJust res
- H.assertBool ("attr subst bar") $
- B.null $ snd $ B.breakSubstring "$(bar)" $ fromJust res
+ H.assertBool ("attr subst " ++ (show str)) $ not $ B.null $
+ snd $ B.breakSubstring str $ toByteString $ fromJust res
+ H.assertBool ("attr subst bar") $ B.null $
+ snd $ B.breakSubstring "$(bar)" $ toByteString $ fromJust res
------------------------------------------------------------------------------
@@ -227,7 +227,7 @@ markdownTest = do
where
check ts str = do
result <- liftM (fmap $ B.filter (/= '\n')) $
- renderTemplate ts "markdown"
+ liftM (fmap toByteString) $ renderTemplate ts "markdown"
H.assertEqual ("Should match " ++ (show str)) str (fromJust result)
@@ -360,7 +360,7 @@ processNode elems loc =
quickRender :: FilePath -> ByteString -> IO (Maybe ByteString)
quickRender baseDir name = do
ts <- loadTS baseDir
- renderTemplate ts name
+ fmap (fmap toByteString) (renderTemplate ts name)
------------------------------------------------------------------------------
commit d40e4e66b27acf7b20d3e6f620bf187767f8d319
Author: Chris Smith <[email protected]>
Date: Tue Jan 11 01:02:51 2011 -0700
Expose Builder versions of rendering functions.
Also fix rendering to choose the format/encoding of the root document.
diff --git a/src/Text/Templating/Heist.hs b/src/Text/Templating/Heist.hs
index 6cd74fc..f9f181a 100644
--- a/src/Text/Templating/Heist.hs
+++ b/src/Text/Templating/Heist.hs
@@ -107,7 +107,9 @@ module Text.Templating.Heist
, evalTemplate
, callTemplate
, renderTemplate
+ , renderTemplateBuilder
, renderWithArgs
+ , renderWithArgsBuilder
, bindStrings
, bindString
diff --git a/src/Text/Templating/Heist/Internal.hs
b/src/Text/Templating/Heist/Internal.hs
index 55739e6..dbc4762 100644
--- a/src/Text/Templating/Heist/Internal.hs
+++ b/src/Text/Templating/Heist/Internal.hs
@@ -210,7 +210,7 @@ addXMLTemplate :: Monad m =>
-> TemplateState m
-> TemplateState m
addXMLTemplate n t st = insertTemplate (splitTemplatePath n)
- (X.XmlDocument X.UTF8 Nothing t) st
+ (X.XmlDocument X.UTF8 Nothing t) st
------------------------------------------------------------------------------
@@ -389,20 +389,40 @@ evalTemplate name = lookupAndRun name
------------------------------------------------------------------------------
+-- | Sets the document type of a 'X.Document' based on the 'TemplateMonad'
+-- value.
+fixDocType :: Monad m => X.Document -> TemplateMonad m X.Document
+fixDocType d = do
+ dts <- getsTS _doctypes
+ return $ d { X.docType = listToMaybe dts }
+
+
+------------------------------------------------------------------------------
+-- | Same as evalWithHooks, but returns the entire 'X.Document' rather than
+-- just the nodes. This is the right thing to do if we are starting at the
+-- top level.
+evalWithHooksInternal :: Monad m
+ => ByteString
+ -> TemplateMonad m (Maybe X.Document)
+evalWithHooksInternal name = lookupAndRun name $ \(t,ctx) -> do
+ addDoctype $ maybeToList $ X.docType t
+ ts <- getTS
+ nodes <- lift $ _preRunHook ts $ X.docContent t
+ putTS (ts {_curContext = ctx})
+ res <- runNodeList nodes
+ restoreTS ts
+ newNodes <- lift (_postRunHook ts res)
+ newDoc <- fixDocType $ t { X.docContent = newNodes }
+ return (Just newDoc)
+
+
+------------------------------------------------------------------------------
-- | Looks up a template name evaluates it by calling runNodeList. This also
-- executes pre- and post-run hooks and adds the doctype.
evalWithHooks :: Monad m
=> ByteString
-> TemplateMonad m (Maybe Template)
-evalWithHooks name = lookupAndRun name
- (\(t,ctx) -> do
- addDoctype $ maybeToList $ X.docType t
- ts <- getTS
- nodes <- lift $ _preRunHook ts $ X.docContent t
- putTS (ts {_curContext = ctx})
- res <- runNodeList nodes
- restoreTS ts
- return . Just =<< lift (_postRunHook ts res))
+evalWithHooks name = liftM (liftM X.docContent) (evalWithHooksInternal name)
------------------------------------------------------------------------------
@@ -439,33 +459,25 @@ callTemplate name params = do
------------------------------------------------------------------------------
--- | Converts a Template to a X.Document. This can only be done inside
--- TemplateMonad where the doctype is available.
-toDocument :: Monad m => Template -> TemplateMonad m X.Document
-toDocument t = do
- dts <- getsTS _doctypes
- return $ X.HtmlDocument X.UTF8 (listToMaybe dts) t
+-- | Renders a template from the specified TemplateState to a 'Builder'.
+renderTemplateBuilder :: Monad m
+ => TemplateState m
+ -> ByteString
+ -> m (Maybe Builder)
+renderTemplateBuilder ts name = evalTemplateMonad tpl (X.TextNode "") ts
+ where tpl = do mt <- evalWithHooksInternal name
+ case mt of Nothing -> return Nothing
+ Just doc -> return $ Just $ X.render doc
------------------------------------------------------------------------------
--- | Renders a document by prepending the appropriate doctype.
-renderDocument :: Monad m => X.Document -> TemplateMonad m ByteString
-renderDocument d = return (toByteString (X.render d))
-
-
-------------------------------------------------------------------------------
--- | Renders a template from the specified TemplateState.
+-- | Renders a template from the specified TemplateState to a 'ByteString'.
renderTemplate :: Monad m
=> TemplateState m
-> ByteString
-> m (Maybe ByteString)
-renderTemplate ts name = do
- evalTemplateMonad
- (do mt <- evalWithHooks name
- maybe (return Nothing)
- (\t -> liftM Just $ renderDocument =<< toDocument t)
- mt
- ) (X.TextNode "") ts
+renderTemplate ts name =
+ liftM (liftM toByteString) (renderTemplateBuilder ts name)
------------------------------------------------------------------------------
@@ -482,6 +494,19 @@ renderWithArgs args ts = renderTemplate (bindStrings args
ts)
------------------------------------------------------------------------------
+-- | Renders a template with the specified arguments passed to it, and output
+-- as a 'Builder'. This is a convenience function for the common pattern of
+-- calling renderTemplateBuilder after using bindString, bindStrings, or
+-- bindSplice to set up the arguments to the template.
+renderWithArgsBuilder :: Monad m
+ => [(Text, Text)]
+ -> TemplateState m
+ -> ByteString
+ -> m (Maybe Builder)
+renderWithArgsBuilder args ts = renderTemplateBuilder (bindStrings args ts)
+
+
+------------------------------------------------------------------------------
-- Template loading
------------------------------------------------------------------------------
commit 3295bedc34345485a5007cdadc1093e27bf0be13
Author: Chris Smith <[email protected]>
Date: Sun Jan 9 10:37:19 2011 -0700
* Fix some documentation that still called Heist an XML-based system.
* Export XML versions of some functions (getXMLDoc and addXMLTemplate)
* Identify .xtpl files as XML format templates and load them.
diff --git a/src/Text/Templating/Heist.hs b/src/Text/Templating/Heist.hs
index d2866d1..6cd74fc 100644
--- a/src/Text/Templating/Heist.hs
+++ b/src/Text/Templating/Heist.hs
@@ -4,10 +4,10 @@
This module contains the core definitions for the Heist template system.
- The Heist template system is based on XML\/xhtml. It allows you to build
- custom XML-based markup languages. With Heist you can define your own
- domain-specific XML tags implemented with Haskell and use them in your
- templates.
+ The Heist template system is based on HTML and XML. It allows you to build
+ custom HTML and XML based markup languages. With Heist you can define your
+ own domain-specific HTML and XML tags implemented with Haskell and use them
+ in your templates.
The most important concept in Heist is the 'Splice'. Splices can be thought
of as functions that transform a node into a list of nodes. Heist then
@@ -19,23 +19,25 @@
Suppose you have a place on your page where you want to display a link with
the text \"Logout username\" if the user is currently logged in or a link to
the login page if no user is logged in. Assume you have a function
- @getUser :: MyAppMonad (Maybe ByteString)@ that gets the current user.
+ @getUser :: MyAppMonad (Maybe Text)@ that gets the current user.
You can implement this functionality with a 'Splice' as follows:
> import Data.ByteString.Char8 (ByteString)
> import qualified Data.ByteString.Char8 as B
- > import qualified Text.XML.Expat.Tree as X
+ > import Data.Text (Text)
+ > import qualified Data.Text as T
+ > import qualified Text.XmlHtml as X
>
> import Text.Templating.Heist
>
- > link :: ByteString -> ByteString -> Node
- > link target text = X.Element "a" [("href", target)] [X.Text text]
+ > link :: Text -> Text -> Node
+ > link target text = X.Element "a" [("href", target)] [X.TextNode text]
>
> loginLink :: Node
> loginLink = link "/login" "Login"
>
- > logoutLink :: ByteString -> Node
- > logoutLink user = link "/logout" (B.append "Logout " user)
+ > logoutLink :: Text -> Node
+ > logoutLink user = link "/logout" (T.append "Logout " user)
>
> loginLogoutSplice :: Splice MyAppMonad
> loginLogoutSplice = do
@@ -43,7 +45,7 @@
> return $ [maybe loginLink logoutLink user]
>
- Next, you need to bind that splice to an XML tag. Heist stores information
+ Next, you need to bind that splice to a tag. Heist stores information
about splices and templates in the 'TemplateState' data structure. The
following code demonstrates how this splice would be used.
@@ -73,6 +75,7 @@ module Text.Templating.Heist
-- * Functions and declarations on TemplateState values
, addTemplate
+ , addXMLTemplate
, emptyTemplateState
, bindSplice
, bindSplices
@@ -110,6 +113,7 @@ module Text.Templating.Heist
-- * Misc functions
, getDoc
+ , getXMLDoc
, bindStaticTag
) where
diff --git a/src/Text/Templating/Heist/Internal.hs
b/src/Text/Templating/Heist/Internal.hs
index 66f7a4e..55739e6 100644
--- a/src/Text/Templating/Heist/Internal.hs
+++ b/src/Text/Templating/Heist/Internal.hs
@@ -192,7 +192,7 @@ insertTemplate p t st =
------------------------------------------------------------------------------
--- | Adds a template to the template state.
+-- | Adds an HTML format template to the template state.
addTemplate :: Monad m =>
ByteString
-> Template
@@ -485,17 +485,36 @@ renderWithArgs args ts = renderTemplate (bindStrings args
ts)
-- Template loading
------------------------------------------------------------------------------
--- | Reads an HTML template from disk.
-getDoc :: String -> IO (Either String X.Document)
-getDoc f = do
+
+------------------------------------------------------------------------------
+-- | Type synonym for parsers.
+type ParserFun = String -> ByteString -> Either String X.Document
+
+
+------------------------------------------------------------------------------
+-- | Reads an HTML or XML template from disk.
+getDocWith :: ParserFun -> String -> IO (Either String X.Document)
+getDocWith parser f = do
bs <- catch (liftM Right $ B.readFile f)
(\(e::SomeException) -> return $ Left $ show e)
- let d = either Left (X.parseHTML f) bs
+ let d = either Left (parser f) bs
return $ mapLeft (\s -> f ++ " " ++ s) d
------------------------------------------------------------------------------
+-- | Reads an HTML template from disk.
+getDoc :: String -> IO (Either String X.Document)
+getDoc = getDocWith X.parseHTML
+
+
+------------------------------------------------------------------------------
+-- | Reads an XML template from disk.
+getXMLDoc :: String -> IO (Either String X.Document)
+getXMLDoc = getDocWith X.parseHTML
+
+
+------------------------------------------------------------------------------
mapLeft :: (a -> b) -> Either a c -> Either b c
mapLeft g = either (Left . g) Right
mapRight :: (b -> c) -> Either a b -> Either a c
@@ -504,25 +523,31 @@ mapRight g = either Left (Right . g)
------------------------------------------------------------------------------
-- | Loads a template with the specified path and filename. The
--- template is only loaded if it has a ".tpl" extension.
+-- template is only loaded if it has a ".tpl" or ".xtpl" extension.
loadTemplate :: String -- ^ path of the template root
-> String -- ^ full file path (includes the template root)
-> IO [Either String (TPath, X.Document)] --TemplateMap
loadTemplate templateRoot fname
- | ".tpl" `isSuffixOf` fname = do
+ | isHTMLTemplate = do
c <- getDoc fname
return [fmap (\t -> (splitLocalPath $ BC.pack tName, t)) c]
+ | isXMLTemplate = do
+ c <- getXMLDoc fname
+ return [fmap (\t -> (splitLocalPath $ BC.pack tName, t)) c]
| otherwise = return []
where -- tName is path relative to the template root directory
+ isHTMLTemplate = ".tpl" `isSuffixOf` fname
+ isXMLTemplate = ".xtpl" `isSuffixOf` fname
correction = if last templateRoot == '/' then 0 else 1
+ extLen = if isHTMLTemplate then 4 else 5
tName = drop ((length templateRoot)+correction) $
-- We're only dropping the template root, not the whole path
- take ((length fname) - 4) fname
+ take ((length fname) - extLen) fname
------------------------------------------------------------------------------
-- | Traverses the specified directory structure and builds a
--- TemplateState by loading all the files with a ".tpl" extension.
+-- TemplateState by loading all the files with a ".tpl" or ".xtpl" extension.
loadTemplates :: Monad m => FilePath -> TemplateState m -> IO (Either String
(TemplateState m))
loadTemplates dir ts = do
d <- readDirectoryWith (loadTemplate dir) dir
-----------------------------------------------------------------------
hooks/post-receive
--
heist
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
