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 49ab67d5ffcfdf96dff5ca5623ffcc5aaf10a8c8 (commit)
from 45b43591c0de602d82b723013cc90dcfd1516391 (commit)
Summary of changes:
heist.cabal | 3 +-
src/Text/Templating/Heist/Internal.hs | 1 +
src/Text/Templating/Heist/TemplateDirectory.hs | 85 ++++++++++++++++++++++++
3 files changed, 88 insertions(+), 1 deletions(-)
create mode 100644 src/Text/Templating/Heist/TemplateDirectory.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 49ab67d5ffcfdf96dff5ca5623ffcc5aaf10a8c8
Author: Mighty Byte <[email protected]>
Date: Fri Jun 18 20:32:48 2010 -0400
Moved TemplateDirectory code from template project in snap-core.
diff --git a/heist.cabal b/heist.cabal
index 36f6910..aff399e 100644
--- a/heist.cabal
+++ b/heist.cabal
@@ -79,7 +79,8 @@ Library
Text.Templating.Heist.Splices.Bind,
Text.Templating.Heist.Splices.Ignore,
Text.Templating.Heist.Splices.Markdown,
- Text.Templating.Heist.Splices.Static
+ Text.Templating.Heist.Splices.Static,
+ Text.Templating.Heist.TemplateDirectory
other-modules:
Text.Templating.Heist.Internal,
diff --git a/src/Text/Templating/Heist/Internal.hs
b/src/Text/Templating/Heist/Internal.hs
index 58efaf5..3486ed6 100644
--- a/src/Text/Templating/Heist/Internal.hs
+++ b/src/Text/Templating/Heist/Internal.hs
@@ -89,6 +89,7 @@ bindSplices ss ts = foldl' (flip id) ts acts
where
acts = map (uncurry bindSplice) ss
+
------------------------------------------------------------------------------
-- | Convenience function for looking up a splice.
lookupSplice :: Monad m =>
diff --git a/src/Text/Templating/Heist/TemplateDirectory.hs
b/src/Text/Templating/Heist/TemplateDirectory.hs
new file mode 100644
index 0000000..78b7b52
--- /dev/null
+++ b/src/Text/Templating/Heist/TemplateDirectory.hs
@@ -0,0 +1,85 @@
+{-|
+
+This module defines a TemplateDirectory data structure for convenient
+interaction with templates within web apps.
+
+-}
+
+module Text.Templating.Heist.TemplateDirectory
+ ( TemplateDirectory
+ , newTemplateDirectory
+ , newTemplateDirectory'
+
+ , getDirectoryTS
+ , reloadTemplateDirectory
+ ) where
+
+------------------------------------------------------------------------------
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.Trans
+import Data.ByteString.Char8 (ByteString)
+import Text.Templating.Heist
+import Text.Templating.Heist.Splices.Static
+
+
+------------------------------------------------------------------------------
+-- | Structure representing a template directory.
+data TemplateDirectory m
+ = TemplateDirectory
+ FilePath
+ (TemplateState m)
+ (MVar (TemplateState m))
+ StaticTagState
+
+
+------------------------------------------------------------------------------
+-- | Creates and returns a new 'TemplateDirectory' wrapped in an Either for
+-- error handling.
+newTemplateDirectory :: (MonadIO m, MonadIO n)
+ => FilePath
+ -> TemplateState m
+ -> n (Either String (TemplateDirectory m))
+newTemplateDirectory dir templateState = liftIO $ do
+ (origTs,sts) <- bindStaticTag templateState
+ ets <- loadTemplates dir origTs
+ leftPass ets $ \ts -> do
+ tsMVar <- newMVar $ ts
+ return $ TemplateDirectory dir origTs tsMVar sts
+
+
+------------------------------------------------------------------------------
+-- | Creates and returns a new 'TemplateDirectory', using the monad's fail
+-- function on error.
+newTemplateDirectory' :: (MonadIO m, MonadIO n)
+ => FilePath
+ -> TemplateState m
+ -> n (TemplateDirectory m)
+newTemplateDirectory' = ((either fail return =<<) .) . newTemplateDirectory
+
+
+------------------------------------------------------------------------------
+-- | Gets the 'TemplateState' from a TemplateDirectory.
+getDirectoryTS :: (Monad m, MonadIO n)
+ => TemplateDirectory m
+ -> n (TemplateState m)
+getDirectoryTS (TemplateDirectory _ _ tsMVar _) = liftIO $ readMVar $ tsMVar
+
+
+------------------------------------------------------------------------------
+-- | Clears cached content and reloads templates from disk.
+reloadTemplateDirectory :: (MonadIO m, MonadIO n)
+ => TemplateDirectory m
+ -> n (Either String ())
+reloadTemplateDirectory (TemplateDirectory p origTs tsMVar sts) = liftIO $ do
+ clearStaticTagCache sts
+ ets <- loadTemplates p origTs
+ leftPass ets $ \ts -> modifyMVar_ tsMVar (const $ return ts)
+
+
+------------------------------------------------------------------------------
+-- | Prepends an error onto a Left.
+leftPass :: Monad m => Either String b -> (b -> m c) -> m (Either String c)
+leftPass e m = either (return . Left . loadError) (liftM Right . m) e
+ where
+ loadError = (++) "Error loading templates: "
-----------------------------------------------------------------------
hooks/post-receive
--
heist
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
