module Text.Templating.Heist.Splices.Static
( StaticTagState
, bindStaticTag
, clearStaticTagCache
) where
import Control.Concurrent
import Control.Monad
import Control.Monad.Trans
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.IORef
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe
import qualified Data.Set as Set
import System.Random
import Text.XML.Expat.Cursor
import Text.XML.Expat.Tree hiding (Node)
import Text.Templating.Heist.Internal
import Text.Templating.Heist.Types
newtype StaticTagState = STS (MVar (Map ByteString Template))
clearStaticTagCache :: StaticTagState -> IO ()
clearStaticTagCache (STS staticMVar) =
modifyMVar_ staticMVar (const $ return Map.empty)
staticImpl :: (MonadIO m)
=> StaticTagState
-> TemplateMonad m Template
staticImpl (STS mv) = do
tree <- getParamNode
let i = fromJust $ getAttribute tree "id"
mp <- liftIO $ readMVar mv
(mp',ns) <- do
let mbn = Map.lookup i mp
case mbn of
Nothing -> do
nodes' <- runNodeList $ getChildren tree
return $! (Map.insert i nodes' mp, nodes')
(Just n) -> do
stopRecursion
return $! (mp,n)
liftIO $ modifyMVar_ mv (const $ return mp')
return ns
bindStaticTag :: MonadIO m
=> TemplateState m
-> IO (TemplateState m, StaticTagState)
bindStaticTag ts = do
sr <- newIORef $ Set.empty
mv <- liftM STS $ newMVar Map.empty
return $ (addOnLoadHook (assignIds sr) $
bindSplice "static" (staticImpl mv) ts,
mv)
where
generateId :: IO Int
generateId = getStdRandom random
assignIds setref = mapM f
where
f node = g $ fromTree node
getId = do
i <- liftM (B.pack . show) generateId
st <- readIORef setref
if Set.member i st
then getId
else do
writeIORef setref $ Set.insert i st
return i
g curs = do
let node = current curs
curs' <- if getName node == "static"
then do
i <- getId
return $ modifyContent (setAttribute "id" i) curs
else return curs
let mbc = nextDF curs'
maybe (return $ toTree curs') g mbc