module Heist
(
loadTemplates
, addTemplatePathPrefix
, initHeist
, initHeistWithCacheTag
, defaultInterpretedSplices
, defaultLoadTimeSplices
, Template
, TPath
, HeistConfig(..)
, MIMEType
, DocumentFile(..)
, AttrSplice
, RuntimeSplice
, Chunk
, HeistState(..)
, templateNames
, compiledTemplateNames
, hasTemplate
, spliceNames
, compiledSpliceNames
, HeistT
, evalHeistT
, getParamNode
, getContext
, getTemplateFilePath
, localParamNode
, getsHS
, getHS
, putHS
, modifyHS
, restoreHS
, localHS
, getDoc
, getXMLDoc
, orError
) where
import Control.Error
import Control.Exception (SomeException)
import Control.Monad.CatchIO
import Control.Monad.Trans
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.Foldable as F
import qualified Data.HeterogeneousEnvironment as HE
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import Data.Monoid
import Data.Text (Text)
import System.Directory.Tree
import qualified Text.XmlHtml as X
import Heist.Common
import qualified Heist.Compiled.Internal as C
import qualified Heist.Interpreted.Internal as I
import Heist.Splices
import Heist.Types
type TemplateRepo = HashMap TPath DocumentFile
data HeistConfig m = HeistConfig
{ hcInterpretedSplices :: [(Text, I.Splice m)]
, hcLoadTimeSplices :: [(Text, I.Splice IO)]
, hcCompiledSplices :: [(Text, C.Splice m)]
, hcAttributeSplices :: [(Text, AttrSplice m)]
, hcTemplates :: TemplateRepo
}
instance Monoid (HeistConfig m) where
mempty = HeistConfig [] [] [] [] Map.empty
mappend (HeistConfig a b c d e) (HeistConfig a' b' c' d' e') =
HeistConfig (a `mappend` a')
(b `mappend` b')
(c `mappend` c')
(d `mappend` d')
(e `mappend` e')
defaultLoadTimeSplices :: MonadIO m => [(Text, (I.Splice m))]
defaultLoadTimeSplices =
("content", deprecatedContentCheck)
: defaultInterpretedSplices
defaultInterpretedSplices :: MonadIO m => [(Text, (I.Splice m))]
defaultInterpretedSplices =
[ (applyTag, applyImpl)
, (bindTag, bindImpl)
, (ignoreTag, ignoreImpl)
, (markdownTag, markdownSplice)
]
loadTemplates :: FilePath -> EitherT [String] IO TemplateRepo
loadTemplates dir = do
d <- lift $ readDirectoryWith (loadTemplate dir) dir
let tlist = F.fold (free d)
errs = lefts tlist
case errs of
[] -> right $ Map.fromList $ rights tlist
_ -> left errs
addTemplatePathPrefix :: ByteString -> TemplateRepo -> TemplateRepo
addTemplatePathPrefix dir ts
| B.null dir = ts
| otherwise = Map.fromList $
map (\(x,y) -> (f x, y)) $
Map.toList ts
where
f ps = ps++splitTemplatePath dir
emptyHS :: HE.KeyGen -> HeistState m
emptyHS kg = HeistState Map.empty Map.empty Map.empty Map.empty
Map.empty True [] 0 [] Nothing kg False
initHeist :: Monad n
=> HeistConfig n
-> EitherT [String] IO (HeistState n)
initHeist hc = do
keyGen <- lift HE.newKeyGen
initHeist' keyGen hc
initHeist' :: Monad n
=> HE.KeyGen
-> HeistConfig n
-> EitherT [String] IO (HeistState n)
initHeist' keyGen (HeistConfig i lt c a rawTemplates) = do
let empty = emptyHS keyGen
tmap <- preproc keyGen lt rawTemplates
let hs1 = empty { _spliceMap = Map.fromList i
, _templateMap = tmap
, _compiledSpliceMap = Map.fromList c
, _attrSpliceMap = Map.fromList a
}
lift $ C.compileTemplates hs1
preproc :: HE.KeyGen
-> [(Text, I.Splice IO)]
-> TemplateRepo
-> EitherT [String] IO TemplateRepo
preproc keyGen splices templates = do
let hs = (emptyHS keyGen) { _spliceMap = Map.fromList splices
, _templateMap = templates
, _preprocessingMode = True }
let eval a = evalHeistT a (X.TextNode "") hs
tPairs <- lift $ mapM (eval . preprocess) $ Map.toList templates
let bad = lefts tPairs
if not (null bad)
then left bad
else right $ Map.fromList $ rights tPairs
preprocess :: (TPath, DocumentFile)
-> HeistT IO IO (Either String (TPath, DocumentFile))
preprocess (tpath, docFile) = do
let tname = tpathName tpath
!emdoc <- try $ I.evalWithDoctypes tname
:: HeistT IO IO (Either SomeException (Maybe X.Document))
let f !doc = (tpath, docFile { dfDoc = doc })
return $! either (Left . show) (Right . maybe die f) emdoc
where
die = error "Preprocess didn't succeed! This should never happen."
initHeistWithCacheTag :: MonadIO n
=> HeistConfig n
-> EitherT [String] IO (HeistState n, CacheTagState)
initHeistWithCacheTag (HeistConfig i lt c a rawTemplates) = do
(ss, cts) <- liftIO mkCacheTag
let tag = "cache"
keyGen <- lift HE.newKeyGen
rawWithCache <- preproc keyGen [(tag, ss)] rawTemplates
let hc' = HeistConfig ((tag, cacheImpl cts) : i) lt
((tag, cacheImplCompiled cts) : c)
a rawWithCache
hs <- initHeist' keyGen hc'
return (hs, cts)