module Text.Templating.Heist.Splices.Static
  ( StaticTagState
  , bindStaticTag
  , clearStaticTagCache
  ) 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           System.Random
import           Text.XmlHtml.Cursor
import           Text.XmlHtml hiding (Node)

import           Text.Templating.Heist.Internal
import           Text.Templating.Heist.Types

-- | State for storing static tag information
newtype StaticTagState = STS (MVar (Map Text Template))

-- | Clears the static tag state.
clearStaticTagCache :: StaticTagState -> IO ()
clearStaticTagCache (STS staticMVar) =
    modifyMVar_ staticMVar (const $ return Map.empty)

-- | The \"static\" splice ensures that its contents are evaluated once and
-- then cached.  The cached contents are returned every time the splice is
-- referenced.
staticImpl :: (MonadIO m)
           => StaticTagState
           -> TemplateMonad m Template
staticImpl (STS mv) = do
    tree <- getParamNode
    let i = fromJust $ getAttribute "id" tree

    mp <- liftIO $ readMVar mv

    (mp',ns) <- do
                   let mbn = Map.lookup i mp
                   case mbn of
                       Nothing -> do
                           nodes' <- runNodeList $ childNodes tree
                           return $! (Map.insert i nodes' mp, nodes')
                       (Just n) -> do
                           return $! (mp,n)

    liftIO $ modifyMVar_ mv (const $ return mp')

    return ns

-- | Modifies a TemplateState to include a \"static\" tag.  The static tag is
-- not bound automatically with the other default Heist tags.  This is because
-- this function also returns StaticTagState, so the user will be able to
-- clear it with the 'clearStaticTagCache' function.
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,

    generateId :: IO Int
    generateId = getStdRandom random

    assignIds setref = mapM f
          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 i

          g curs = do
              let node = current curs
              curs' <- if tagName node == Just "static"
                         then do
                             i <- getId
                             return $ modifyNode (setAttribute "id" i) curs
                         else return curs
              let mbc = nextDF curs'
              maybe (return $ topNode curs') g mbc