    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE BangPatterns      #-}
    {-# LANGUAGE OverloadedStrings #-}

    -- | 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 a single letter abbreviation for one
    -- of 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.  The compiled splice version of
    -- the cache tag does not require a cache tag state, so clearCacheTagState
    -- will not work for compiled cache tags.

    module Heist.Splices.Cache
      ( CacheTagState
      , cacheImpl
      , cacheImplCompiled
      , mkCacheTag
      , clearCacheTagState
      ) where

    ------------------------------------------------------------------------------
    import           Blaze.ByteString.Builder
    import           Control.Concurrent
    import           Control.Monad
    import           Control.Monad.Trans
    import           Data.IORef
    import qualified Data.HashMap.Strict as H
    import           Data.HashMap.Strict (HashMap)
    import qualified Data.HashSet 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

    #if !MIN_VERSION_base(4,8,0)
    import           Data.Word (Word)
    #endif

    ------------------------------------------------------------------------------
    import qualified Heist.Compiled.Internal as C
    import           Heist.Interpreted.Internal
    import           Heist.Internal.Types.HeistState

    ------------------------------------------------------------------------------
    cacheTagName :: Text
    cacheTagName :: Text
    cacheTagName = "cache"

    ------------------------------------------------------------------------------
    -- | State for storing cache tag information
    newtype CacheTagState =
        CTS (MVar ([IORef (Maybe (UTCTime, Builder))], HashMap Text (UTCTime, Template)))

    addCompiledRef :: IORef (Maybe (UTCTime, Builder)) -> CacheTagState -> IO ()
    addCompiledRef :: IORef (Maybe (UTCTime, Builder)) -> CacheTagState -> IO ()
    addCompiledRef ref :: IORef (Maybe (UTCTime, Builder))
    ref (CTS mv :: MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    mv) = do
        MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    -> (([IORef (Maybe (UTCTime, Builder))],
         HashMap Text (UTCTime, Template))
        -> IO
             ([IORef (Maybe (UTCTime, Builder))],
              HashMap Text (UTCTime, Template)))
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    mv (\(a :: [IORef (Maybe (UTCTime, Builder))]
    a,b :: HashMap Text (UTCTime, Template)
    b) -> ([IORef (Maybe (UTCTime, Builder))],
     HashMap Text (UTCTime, Template))
    -> IO
         ([IORef (Maybe (UTCTime, Builder))],
          HashMap Text (UTCTime, Template))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IORef (Maybe (UTCTime, Builder))
    refIORef (Maybe (UTCTime, Builder))
    -> [IORef (Maybe (UTCTime, Builder))]
    -> [IORef (Maybe (UTCTime, Builder))]
    forall a. a -> [a] -> [a]
    :[IORef (Maybe (UTCTime, Builder))]
    a, HashMap Text (UTCTime, Template)
    b))

    ------------------------------------------------------------------------------
    -- | Clears the cache tag state.
    clearCacheTagState :: CacheTagState -> IO ()
    clearCacheTagState :: CacheTagState -> IO ()
    clearCacheTagState (CTS cacheMVar :: MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    cacheMVar) = do
        [IORef (Maybe (UTCTime, Builder))]
    refs <- MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    -> (([IORef (Maybe (UTCTime, Builder))],
         HashMap Text (UTCTime, Template))
        -> IO
             (([IORef (Maybe (UTCTime, Builder))],
               HashMap Text (UTCTime, Template)),
              [IORef (Maybe (UTCTime, Builder))]))
    -> IO [IORef (Maybe (UTCTime, Builder))]
    forall a b. MVar a -> (a -> IO (a, b)) -> IO b
    modifyMVar MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    cacheMVar (\(a :: [IORef (Maybe (UTCTime, Builder))]
    a,_) -> (([IORef (Maybe (UTCTime, Builder))],
      HashMap Text (UTCTime, Template)),
     [IORef (Maybe (UTCTime, Builder))])
    -> IO
         (([IORef (Maybe (UTCTime, Builder))],
           HashMap Text (UTCTime, Template)),
          [IORef (Maybe (UTCTime, Builder))])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([IORef (Maybe (UTCTime, Builder))]
    a, HashMap Text (UTCTime, Template)
    forall k v. HashMap k v
    H.empty), [IORef (Maybe (UTCTime, Builder))]
    a))
        (IORef (Maybe (UTCTime, Builder)) -> IO ())
    -> [IORef (Maybe (UTCTime, Builder))] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (\ref :: IORef (Maybe (UTCTime, Builder))
    ref -> IORef (Maybe (UTCTime, Builder))
    -> Maybe (UTCTime, Builder) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe (UTCTime, Builder))
    ref Maybe (UTCTime, Builder)
    forall a. Maybe a
    Nothing) [IORef (Maybe (UTCTime, Builder))]
    refs

    ------------------------------------------------------------------------------
    -- | Converts a TTL string into an integer number of seconds.
    parseTTL :: Text -> Int
    parseTTL :: Text -> Int
    parseTTL s :: Text
    s = Int
    value Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    multiplier
      where
        (value :: Int
    value,rest :: Text
    rest) = (String -> (Int, Text))
    -> ((Int, Text) -> (Int, Text))
    -> Either String (Int, Text)
    -> (Int, Text)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ((Int, Text) -> String -> (Int, Text)
    forall a b. a -> b -> a
    const (0::Int,"s")) (Int, Text) -> (Int, Text)
    forall a. a -> a
    id (Either String (Int, Text) -> (Int, Text))
    -> Either String (Int, Text) -> (Int, Text)
    forall a b. (a -> b) -> a -> b
    $ Reader Int
    forall a. Integral a => Reader a
    decimal Text
    s
        multiplier :: Int
    multiplier = case Int -> Text -> Text
    T.take 1 Text
    rest of
            "s" -> 1 :: Int
            "m" -> 60
            "h" -> 3600
            "d" -> 86400
            "w" -> 604800
            _   -> 1

    getTTL :: Node -> NominalDiffTime
    getTTL :: Node -> NominalDiffTime
    getTTL tree :: Node
    tree = Int -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> NominalDiffTime) -> Int -> NominalDiffTime
    forall a b. (a -> b) -> a -> b
    $ Int -> (Text -> Int) -> Maybe Text -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe 0 Text -> Int
    parseTTL (Maybe Text -> Int) -> Maybe Text -> Int
    forall a b. (a -> b) -> a -> b
    $ Text -> Node -> Maybe Text
    getAttribute "ttl" Node
    tree
    {-# INLINE getTTL #-}

    ------------------------------------------------------------------------------
    -- | This is the splice that actually does the work.  You should bind it to
    -- the same tag name as you bound the splice returned by mkCacheTag otherwise
    -- it won't work and you'll get runtime errors.
    cacheImpl :: (MonadIO n) => CacheTagState -> Splice n
    cacheImpl :: CacheTagState -> Splice n
    cacheImpl (CTS mv :: MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    mv) = do
        Node
    tree <- HeistT n n Node
    forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
    getParamNode
        let err :: a
    err = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    unwords ["cacheImpl is bound to a tag"
                                  ,"that didn't get an id attribute."
                                  ," This should never happen."]
        let i :: Text
    i = Text -> (Text -> Text) -> Maybe Text -> Text
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Text
    forall a. a
    err Text -> Text
    forall a. a -> a
    id (Maybe Text -> Text) -> Maybe Text -> Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Node -> Maybe Text
    getAttribute "id" Node
    tree
            !ttl :: NominalDiffTime
    ttl = Node -> NominalDiffTime
    getTTL Node
    tree
        ([IORef (Maybe (UTCTime, Builder))],
     HashMap Text (UTCTime, Template))
    mp <- IO
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    -> HeistT
         n
         n
         ([IORef (Maybe (UTCTime, Builder))],
          HashMap Text (UTCTime, Template))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO
       ([IORef (Maybe (UTCTime, Builder))],
        HashMap Text (UTCTime, Template))
     -> HeistT
          n
          n
          ([IORef (Maybe (UTCTime, Builder))],
           HashMap Text (UTCTime, Template)))
    -> IO
         ([IORef (Maybe (UTCTime, Builder))],
          HashMap Text (UTCTime, Template))
    -> HeistT
         n
         n
         ([IORef (Maybe (UTCTime, Builder))],
          HashMap Text (UTCTime, Template))
    forall a b. (a -> b) -> a -> b
    $ MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    -> IO
         ([IORef (Maybe (UTCTime, Builder))],
          HashMap Text (UTCTime, Template))
    forall a. MVar a -> IO a
    readMVar MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    mv

        Template
    ns <- do
            UTCTime
    cur <- IO UTCTime -> HeistT n n UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
            let mbn :: Maybe (UTCTime, Template)
    mbn = Text
    -> HashMap Text (UTCTime, Template) -> Maybe (UTCTime, Template)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    H.lookup Text
    i (HashMap Text (UTCTime, Template) -> Maybe (UTCTime, Template))
    -> HashMap Text (UTCTime, Template) -> Maybe (UTCTime, Template)
    forall a b. (a -> b) -> a -> b
    $ ([IORef (Maybe (UTCTime, Builder))],
     HashMap Text (UTCTime, Template))
    -> HashMap Text (UTCTime, Template)
    forall a b. (a, b) -> b
    snd ([IORef (Maybe (UTCTime, Builder))],
     HashMap Text (UTCTime, Template))
    mp
                reload :: HeistT n n Template
    reload = do
                    Template
    nodes' <- Template -> HeistT n n Template
    forall (n :: * -> *). Monad n => Template -> Splice n
    runNodeList (Template -> HeistT n n Template)
    -> Template -> HeistT n n Template
    forall a b. (a -> b) -> a -> b
    $ Node -> Template
    childNodes Node
    tree
                    let newMap :: HashMap Text (UTCTime, Template)
    newMap = Text
    -> (UTCTime, Template)
    -> HashMap Text (UTCTime, Template)
    -> HashMap Text (UTCTime, Template)
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    H.insert Text
    i (UTCTime
    cur, Template
    nodes') (HashMap Text (UTCTime, Template)
     -> HashMap Text (UTCTime, Template))
    -> HashMap Text (UTCTime, Template)
    -> HashMap Text (UTCTime, Template)
    forall a b. (a -> b) -> a -> b
    $ ([IORef (Maybe (UTCTime, Builder))],
     HashMap Text (UTCTime, Template))
    -> HashMap Text (UTCTime, Template)
    forall a b. (a, b) -> b
    snd ([IORef (Maybe (UTCTime, Builder))],
     HashMap Text (UTCTime, Template))
    mp
                    IO () -> HeistT n n ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> HeistT n n ()) -> IO () -> HeistT n n ()
    forall a b. (a -> b) -> a -> b
    $ MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    -> (([IORef (Maybe (UTCTime, Builder))],
         HashMap Text (UTCTime, Template))
        -> IO
             ([IORef (Maybe (UTCTime, Builder))],
              HashMap Text (UTCTime, Template)))
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    modifyMVar_ MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    mv (\(a :: [IORef (Maybe (UTCTime, Builder))]
    a,_) -> ([IORef (Maybe (UTCTime, Builder))],
     HashMap Text (UTCTime, Template))
    -> IO
         ([IORef (Maybe (UTCTime, Builder))],
          HashMap Text (UTCTime, Template))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([IORef (Maybe (UTCTime, Builder))]
    a, HashMap Text (UTCTime, Template)
    newMap))
                    Template -> HeistT n n Template
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Template -> HeistT n n Template)
    -> Template -> HeistT n n Template
    forall a b. (a -> b) -> a -> b
    $! Template
    nodes'
            case Maybe (UTCTime, Template)
    mbn of
                Nothing -> Splice n
    forall (n :: * -> *). MonadIO n => HeistT n n Template
    reload
                (Just (lastUpdate :: UTCTime
    lastUpdate,n :: Template
    n)) -> do
                    if NominalDiffTime
    ttl NominalDiffTime -> NominalDiffTime -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 Bool -> Bool -> Bool
    && Node -> Maybe Text
    tagName Node
    tree Maybe Text -> Maybe Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    cacheTagName Bool -> Bool -> Bool
    &&
                       UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    cur UTCTime
    lastUpdate NominalDiffTime -> NominalDiffTime -> Bool
    forall a. Ord a => a -> a -> Bool
    > NominalDiffTime
    ttl
                      then Splice n
    forall (n :: * -> *). MonadIO n => HeistT n n Template
    reload
                      else do
                          HeistT n n ()
    forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m ()
    stopRecursion
                          Template -> Splice n
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Template -> Splice n) -> Template -> Splice n
    forall a b. (a -> b) -> a -> b
    $! Template
    n

        Template -> Splice n
    forall (m :: * -> *) a. Monad m => a -> m a
    return Template
    ns

    ------------------------------------------------------------------------------
    -- | This is the compiled splice version of cacheImpl.
    cacheImplCompiled :: (MonadIO n) => CacheTagState -> C.Splice n
    cacheImplCompiled :: CacheTagState -> Splice n
    cacheImplCompiled cts :: CacheTagState
    cts = do
        Node
    tree <- HeistT n IO Node
    forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
    getParamNode
        let !ttl :: NominalDiffTime
    ttl = Node -> NominalDiffTime
    getTTL Node
    tree

        DList (Chunk n)
    compiled <- Template -> Splice n
    forall (n :: * -> *). Monad n => Template -> Splice n
    C.runNodeList (Template -> Splice n) -> Template -> Splice n
    forall a b. (a -> b) -> a -> b
    $ Node -> Template
    childNodes Node
    tree
        IORef (Maybe (UTCTime, Builder))
    ref <- IO (IORef (Maybe (UTCTime, Builder)))
    -> HeistT n IO (IORef (Maybe (UTCTime, Builder)))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef (Maybe (UTCTime, Builder)))
     -> HeistT n IO (IORef (Maybe (UTCTime, Builder))))
    -> IO (IORef (Maybe (UTCTime, Builder)))
    -> HeistT n IO (IORef (Maybe (UTCTime, Builder)))
    forall a b. (a -> b) -> a -> b
    $ Maybe (UTCTime, Builder) -> IO (IORef (Maybe (UTCTime, Builder)))
    forall a. a -> IO (IORef a)
    newIORef Maybe (UTCTime, Builder)
    forall a. Maybe a
    Nothing
        IO () -> HeistT n IO ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> HeistT n IO ()) -> IO () -> HeistT n IO ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe (UTCTime, Builder)) -> CacheTagState -> IO ()
    addCompiledRef IORef (Maybe (UTCTime, Builder))
    ref CacheTagState
    cts
        let reload :: UTCTime -> RuntimeSplice n Builder
    reload curTime :: UTCTime
    curTime = do
                Builder
    builder <- DList (Chunk n) -> RuntimeSplice n Builder
    forall (n :: * -> *).
    Monad n =>
    DList (Chunk n) -> RuntimeSplice n Builder
    C.codeGen DList (Chunk n)
    compiled
                let out :: Builder
    out = ByteString -> Builder
    fromByteString (ByteString -> Builder) -> ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $! Builder -> ByteString
    toByteString (Builder -> ByteString) -> Builder -> ByteString
    forall a b. (a -> b) -> a -> b
    $! Builder
    builder
                IO () -> RuntimeSplice n ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> RuntimeSplice n ()) -> IO () -> RuntimeSplice n ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe (UTCTime, Builder))
    -> Maybe (UTCTime, Builder) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe (UTCTime, Builder))
    ref ((UTCTime, Builder) -> Maybe (UTCTime, Builder)
    forall a. a -> Maybe a
    Just (UTCTime
    curTime, Builder
    out))
                Builder -> RuntimeSplice n Builder
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Builder -> RuntimeSplice n Builder)
    -> Builder -> RuntimeSplice n Builder
    forall a b. (a -> b) -> a -> b
    $! Builder
    out
        DList (Chunk n) -> Splice n
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DList (Chunk n) -> Splice n) -> DList (Chunk n) -> Splice n
    forall a b. (a -> b) -> a -> b
    $ RuntimeSplice n Builder -> DList (Chunk n)
    forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
    C.yieldRuntime (RuntimeSplice n Builder -> DList (Chunk n))
    -> RuntimeSplice n Builder -> DList (Chunk n)
    forall a b. (a -> b) -> a -> b
    $ do
            Maybe (UTCTime, Builder)
    mbn <- IO (Maybe (UTCTime, Builder))
    -> RuntimeSplice n (Maybe (UTCTime, Builder))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe (UTCTime, Builder))
     -> RuntimeSplice n (Maybe (UTCTime, Builder)))
    -> IO (Maybe (UTCTime, Builder))
    -> RuntimeSplice n (Maybe (UTCTime, Builder))
    forall a b. (a -> b) -> a -> b
    $ IORef (Maybe (UTCTime, Builder)) -> IO (Maybe (UTCTime, Builder))
    forall a. IORef a -> IO a
    readIORef IORef (Maybe (UTCTime, Builder))
    ref
            UTCTime
    cur <- IO UTCTime -> RuntimeSplice n UTCTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO UTCTime
    getCurrentTime
            case Maybe (UTCTime, Builder)
    mbn of
                Nothing -> UTCTime -> RuntimeSplice n Builder
    reload UTCTime
    cur
                (Just (lastUpdate :: UTCTime
    lastUpdate,bs :: Builder
    bs)) -> do
                    if (NominalDiffTime
    ttl NominalDiffTime -> NominalDiffTime -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 Bool -> Bool -> Bool
    && UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    cur UTCTime
    lastUpdate NominalDiffTime -> NominalDiffTime -> Bool
    forall a. Ord a => a -> a -> Bool
    > NominalDiffTime
    ttl)
                      then UTCTime -> RuntimeSplice n Builder
    reload UTCTime
    cur
                      else Builder -> RuntimeSplice n Builder
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Builder -> RuntimeSplice n Builder)
    -> Builder -> RuntimeSplice n Builder
    forall a b. (a -> b) -> a -> b
    $! Builder
    bs

    ------------------------------------------------------------------------------
    -- | Returns items necessary to set up a \"cache\" tag.  The cache tag cannot
    -- be 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.
    --
    -- This function returns a splice and a CacheTagState.  The splice is of type
    -- @Splice IO@ because it has to be bound as a load time preprocessing splice.
    -- Haskell's type system won't allow you to screw up and pass this splice as
    -- the wrong argument to initHeist.
    mkCacheTag :: IO (Splice IO, CacheTagState)
    mkCacheTag :: IO (Splice IO, CacheTagState)
    mkCacheTag = do
        IORef (HashSet Text)
    sr <- HashSet Text -> IO (IORef (HashSet Text))
    forall a. a -> IO (IORef a)
    newIORef (HashSet Text -> IO (IORef (HashSet Text)))
    -> HashSet Text -> IO (IORef (HashSet Text))
    forall a b. (a -> b) -> a -> b
    $ HashSet Text
    forall a. HashSet a
    Set.empty
        CacheTagState
    mv <- (MVar
       ([IORef (Maybe (UTCTime, Builder))],
        HashMap Text (UTCTime, Template))
     -> CacheTagState)
    -> IO
         (MVar
            ([IORef (Maybe (UTCTime, Builder))],
             HashMap Text (UTCTime, Template)))
    -> IO CacheTagState
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM MVar
      ([IORef (Maybe (UTCTime, Builder))],
       HashMap Text (UTCTime, Template))
    -> CacheTagState
    CTS (IO
       (MVar
          ([IORef (Maybe (UTCTime, Builder))],
           HashMap Text (UTCTime, Template)))
     -> IO CacheTagState)
    -> IO
         (MVar
            ([IORef (Maybe (UTCTime, Builder))],
             HashMap Text (UTCTime, Template)))
    -> IO CacheTagState
    forall a b. (a -> b) -> a -> b
    $ ([IORef (Maybe (UTCTime, Builder))],
     HashMap Text (UTCTime, Template))
    -> IO
         (MVar
            ([IORef (Maybe (UTCTime, Builder))],
             HashMap Text (UTCTime, Template)))
    forall a. a -> IO (MVar a)
    newMVar ([], HashMap Text (UTCTime, Template)
    forall k v. HashMap k v
    H.empty)

        (Splice IO, CacheTagState) -> IO (Splice IO, CacheTagState)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Splice IO, CacheTagState) -> IO (Splice IO, CacheTagState))
    -> (Splice IO, CacheTagState) -> IO (Splice IO, CacheTagState)
    forall a b. (a -> b) -> a -> b
    $ (IORef (HashSet Text) -> Splice IO
    setupSplice IORef (HashSet Text)
    sr, CacheTagState
    mv)

    ------------------------------------------------------------------------------
    -- | Explicit type signature to avoid the Show polymorphism problem.
    generateId :: IO Word
    generateId :: IO Word
    generateId = (StdGen -> (Word, StdGen)) -> IO Word
    forall a. (StdGen -> (a, StdGen)) -> IO a
    getStdRandom StdGen -> (Word, StdGen)
    forall a g. (Random a, RandomGen g) => g -> (a, g)
    random

    ------------------------------------------------------------------------------
    -- | Gets a unique ID for use in the cache tags.
    getId :: IORef (Set.HashSet Text) -> IO Text
    getId :: IORef (HashSet Text) -> IO Text
    getId setref :: IORef (HashSet Text)
    setref = do
        Text
    i <- (Word -> Text) -> IO Word -> IO Text
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (String -> Text
    T.pack (String -> Text) -> (Word -> String) -> Word -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word -> String
    forall a. Show a => a -> String
    show) IO Word
    generateId
        HashSet Text
    _set <- IORef (HashSet Text) -> IO (HashSet Text)
    forall a. IORef a -> IO a
    readIORef IORef (HashSet Text)
    setref
        if Text -> HashSet Text -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    Set.member Text
    i HashSet Text
    _set
          then IORef (HashSet Text) -> IO Text
    getId IORef (HashSet Text)
    setref
          else do
              IORef (HashSet Text) -> HashSet Text -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (HashSet Text)
    setref (HashSet Text -> IO ()) -> HashSet Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> HashSet Text -> HashSet Text
    forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
    Set.insert Text
    i HashSet Text
    _set
              Text -> IO Text
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> IO Text) -> Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $ Text -> Text -> Text
    T.append "cache-id-" Text
    i

    ------------------------------------------------------------------------------
    -- | A splice that sets the id attribute so that nodes can be cache-aware.
    setupSplice :: IORef (Set.HashSet Text) -> Splice IO
    setupSplice :: IORef (HashSet Text) -> Splice IO
    setupSplice setref :: IORef (HashSet Text)
    setref = do
        Text
    i <- IO Text -> HeistT IO IO Text
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Text -> HeistT IO IO Text) -> IO Text -> HeistT IO IO Text
    forall a b. (a -> b) -> a -> b
    $ IORef (HashSet Text) -> IO Text
    getId IORef (HashSet Text)
    setref
        Node
    node <- HeistT IO IO Node
    forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
    getParamNode

        Template
    newChildren <- Template -> Splice IO
    forall (n :: * -> *). Monad n => Template -> Splice n
    runNodeList (Template -> Splice IO) -> Template -> Splice IO
    forall a b. (a -> b) -> a -> b
    $ Node -> Template
    childNodes Node
    node
        HeistT IO IO ()
    forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m ()
    stopRecursion
        Template -> Splice IO
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Template -> Splice IO) -> Template -> Splice IO
    forall a b. (a -> b) -> a -> b
    $ [Text -> Text -> Node -> Node
    setAttribute "id" Text
    i (Node -> Node) -> Node -> Node
    forall a b. (a -> b) -> a -> b
    $ Node
    node { elementChildren :: Template
    elementChildren = Template
    newChildren }]