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 599a6e874e881a4748d43b4f89309d0e60934a80 (commit)
from adeb763231793c424ba2d6e5493ed2e74e879e20 (commit)
Summary of changes:
heist.cabal | 2 +
src/Text/Templating/Heist/Splices.hs | 1 +
src/Text/Templating/Heist/Splices/Cache.hs | 146 ++++++++++++++++++++++++++++
3 files changed, 149 insertions(+), 0 deletions(-)
create mode 100644 src/Text/Templating/Heist/Splices/Cache.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 599a6e874e881a4748d43b4f89309d0e60934a80
Author: Mighty Byte <[email protected]>
Date: Fri Mar 18 00:55:30 2011 -0400
Added a splice for a <cache> tag.
diff --git a/heist.cabal b/heist.cabal
index 7bffeee..beefb61 100644
--- a/heist.cabal
+++ b/heist.cabal
@@ -68,6 +68,7 @@ Library
Text.Templating.Heist.Splices,
Text.Templating.Heist.Splices.Apply,
Text.Templating.Heist.Splices.Bind,
+ Text.Templating.Heist.Splices.Cache,
Text.Templating.Heist.Splices.Html,
Text.Templating.Heist.Splices.Ignore,
Text.Templating.Heist.Splices.Markdown,
@@ -93,6 +94,7 @@ Library
process,
random,
text >= 0.10 && < 0.12,
+ time >= 1.1 && < 1.3,
transformers,
xmlhtml == 0.1.*
diff --git a/src/Text/Templating/Heist/Splices.hs
b/src/Text/Templating/Heist/Splices.hs
index 96a0bf5..5b2042f 100644
--- a/src/Text/Templating/Heist/Splices.hs
+++ b/src/Text/Templating/Heist/Splices.hs
@@ -9,6 +9,7 @@ module Text.Templating.Heist.Splices
import Text.Templating.Heist.Splices.Apply
import Text.Templating.Heist.Splices.Bind
+import Text.Templating.Heist.Splices.Cache
import Text.Templating.Heist.Splices.Html
import Text.Templating.Heist.Splices.Ignore
import Text.Templating.Heist.Splices.Markdown
diff --git a/src/Text/Templating/Heist/Splices/Cache.hs
b/src/Text/Templating/Heist/Splices/Cache.hs
new file mode 100644
index 0000000..2ba59a8
--- /dev/null
+++ b/src/Text/Templating/Heist/Splices/Cache.hs
@@ -0,0 +1,146 @@
+module Text.Templating.Heist.Splices.Cache
+ ( CacheTagState
+ , mkCacheTag
+ , clearCacheTagState
+ ) where
+
+------------------------------------------------------------------------------
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.Trans
+import Data.IORef
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe
+import qualified Data.Set as Set
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Read
+import Data.Time.Clock
+import System.Random
+import Text.XmlHtml.Cursor
+import Text.XmlHtml hiding (Node)
+
+
+------------------------------------------------------------------------------
+import Text.Templating.Heist.Internal
+import Text.Templating.Heist.Types
+
+
+cacheTagName :: Text
+cacheTagName = "cache"
+
+------------------------------------------------------------------------------
+-- | State for storing cache tag information
+newtype CacheTagState = CTS (MVar (Map Text (UTCTime, Template)))
+
+
+------------------------------------------------------------------------------
+-- | Clears the cache tag state.
+clearCacheTagState :: CacheTagState -> IO ()
+clearCacheTagState (CTS cacheMVar) =
+ modifyMVar_ cacheMVar (const $ return Map.empty)
+
+
+------------------------------------------------------------------------------
+-- | Converts a TTL string into an integer number of seconds.
+parseTTL :: Text -> Int
+parseTTL s = value * multiplier
+ where
+ value = either (const 0) fst $ decimal s
+ multiplier = case T.last s of
+ 's' -> 1
+ 'm' -> 60
+ 'h' -> 3600
+ 'd' -> 86400
+ 'w' -> 604800
+ _ -> 0
+
+------------------------------------------------------------------------------
+-- | The \"cache\" splice ensures that its contents are cached and only
+-- evaluated periodically. The cached contents are returned every time the
+-- splice is referenced.
+--
+-- Use the ttl attribute to set the amount of time between reloads. The ttl
+-- value should be a positive integer followed by a single character
+-- specifying the units. Valid units are seconds, minutes, hours, days, and
+-- weeks. If the ttl string is invalid or the ttl attribute is not specified,
+-- the cache is never refreshed unless explicitly cleared with
+-- clearCacheTagState.
+cacheImpl :: (MonadIO m)
+ => CacheTagState
+ -> TemplateMonad m Template
+cacheImpl (CTS mv) = do
+ tree <- getParamNode
+ let i = fromJust $ getAttribute "id" tree
+ ttl = maybe 0 parseTTL $ getAttribute "ttl" tree
+ mp <- liftIO $ readMVar mv
+
+ (mp',ns) <- do
+ curTime <- liftIO getCurrentTime
+ let mbn = Map.lookup i mp
+ reload = do
+ nodes' <- runNodeList $ childNodes tree
+ return $! (Map.insert i (curTime,nodes') mp, nodes')
+ case mbn of
+ Nothing -> reload
+ (Just (lastUpdate,n)) -> do
+ if ttl > 0 &&
+ diffUTCTime curTime lastUpdate > fromIntegral ttl
+ then reload
+ else do
+ stopRecursion
+ return $! (mp,n)
+
+ liftIO $ modifyMVar_ mv (const $ return mp')
+
+ return ns
+
+
+mkCacheTagState :: IO CacheTagState
+mkCacheTagState = liftM CTS $ newMVar Map.empty
+
+------------------------------------------------------------------------------
+-- | Modifies a TemplateState to include a \"cache\" tag. The cache tag is
+-- not bound automatically with the other default Heist tags. This is because
+-- this function also returns CacheTagState, so the user will be able to
+-- clear it with the 'clearCacheTagState' function.
+mkCacheTag :: MonadIO m
+ => IO (TemplateState m -> TemplateState m, CacheTagState)
+mkCacheTag = do
+ sr <- newIORef $ Set.empty
+ mv <- liftM CTS $ newMVar Map.empty
+
+ return $ (addOnLoadHook (assignIds sr) .
+ bindSplice cacheTagName (cacheImpl mv), mv)
+
+ where
+ generateId :: IO Int
+ generateId = getStdRandom random
+
+ assignIds setref = mapM f
+ where
+ f node = g $ fromNode node
+
+ getId = do
+ i <- liftM (T.pack . show) generateId
+ st <- readIORef setref
+ if Set.member i st
+ then getId
+ else do
+ writeIORef setref $ Set.insert i st
+ return $ T.append "cache-id-" i
+
+ g curs = do
+ let node = current curs
+ curs' <- if tagName node == Just cacheTagName
+ then do
+ i <- getId
+ return $ modifyNode (setAttribute "id" i) curs
+ else return curs
+ let mbc = nextDF curs'
+ maybe (return $ topNode curs') g mbc
+
+
+
+
-----------------------------------------------------------------------
hooks/post-receive
--
heist
_______________________________________________
Snap mailing list
[email protected]
http://mailman-mail5.webfaction.com/listinfo/snap
