module Heist
(
loadTemplates
, addTemplatePathPrefix
, initHeist
, initHeistWithCacheTag
, defaultLoadTimeSplices
, Template
, TPath
, HeistConfig(..)
, MIMEType
, DocumentFile(..)
, AttrSplice
, RuntimeSplice
, Chunk
, HeistState(..)
, templateNames
, compiledTemplateNames
, hasTemplate
, spliceNames
, 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
data HeistConfig m = HeistConfig
{ hcInterpretedSplices :: [(Text, I.Splice m)]
, hcLoadTimeSplices :: [(Text, I.Splice IO)]
, hcCompiledSplices :: [(Text, C.Splice m)]
, hcAttributeSplices :: [(Text, AttrSplice m)]
, hcTemplates :: HashMap TPath DocumentFile
}
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 =
[ (applyTag, applyImpl)
, (bindTag, bindImpl)
, (ignoreTag, ignoreImpl)
, (markdownTag, markdownSplice)
, ("content", deprecatedContentCheck)
]
loadTemplates :: FilePath -> EitherT [String] IO (HashMap TPath DocumentFile)
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
-> HashMap TPath DocumentFile
-> HashMap TPath DocumentFile
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
initHeist :: Monad n
=> HeistConfig n
-> EitherT [String] IO (HeistState n)
initHeist (HeistConfig i lt c a rawTemplates) = do
keyGen <- lift HE.newKeyGen
let empty = HeistState Map.empty Map.empty Map.empty Map.empty
Map.empty True [] 0 [] Nothing keyGen False
hs0 = empty { _spliceMap = Map.fromList lt
, _templateMap = rawTemplates
, _preprocessingMode = True }
tPairs <- lift $ evalHeistT
(mapM preprocess $ Map.toList rawTemplates) (X.TextNode "") hs0
let bad = lefts tPairs
tmap = Map.fromList $ rights tPairs
hs1 = empty { _spliceMap = Map.fromList i
, _templateMap = tmap
, _compiledSpliceMap = Map.fromList c
, _attrSpliceMap = Map.fromList a
}
if not (null bad)
then left bad
else lift $ C.compileTemplates hs1
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"
hc' = HeistConfig ((tag, cacheImpl cts) : i)
((tag, ss) : lt)
((tag, cacheImplCompiled cts) : c)
a rawTemplates
hs <- initHeist hc'
return (hs, cts)