module Text.Templating.Heist.TemplateDirectory
( TemplateDirectory
, newTemplateDirectory
, newTemplateDirectory'
, getDirectoryTS
, reloadTemplateDirectory
) where
import Control.Concurrent
import Control.Monad
import Control.Monad.Trans
import Text.Templating.Heist
import Text.Templating.Heist.Splices.Static
data TemplateDirectory m
= TemplateDirectory
FilePath
(TemplateState m)
(MVar (TemplateState m))
StaticTagState
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
newTemplateDirectory' :: (MonadIO m, MonadIO n)
=> FilePath
-> TemplateState m
-> n (TemplateDirectory m)
newTemplateDirectory' = ((either fail return =<<) .) . newTemplateDirectory
getDirectoryTS :: (Monad m, MonadIO n)
=> TemplateDirectory m
-> n (TemplateState m)
getDirectoryTS (TemplateDirectory _ _ tsMVar _) = liftIO $ readMVar $ tsMVar
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)
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: "