{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Heist
(
loadTemplates
, reloadTemplates
, addTemplatePathPrefix
, initHeist
, initHeistWithCacheTag
, defaultInterpretedSplices
, defaultLoadTimeSplices
, emptyHeistConfig
, SpliceConfig
, HeistConfig
, TemplateRepo
, TemplateLocation
, Template
, TPath
, MIMEType
, DocumentFile(..)
, AttrSplice
, RuntimeSplice
, Chunk
, HeistState
, SpliceError(..)
, CompileException(..)
, HeistT
, scInterpretedSplices
, scLoadTimeSplices
, scCompiledSplices
, scAttributeSplices
, scTemplateLocations
, scCompiledTemplateFilter
, hcSpliceConfig
, hcNamespace
, hcErrorNotBound
, hcInterpretedSplices
, hcLoadTimeSplices
, hcCompiledSplices
, hcAttributeSplices
, hcTemplateLocations
, hcCompiledTemplateFilter
, templateNames
, compiledTemplateNames
, hasTemplate
, spliceNames
, compiledSpliceNames
, evalHeistT
, getParamNode
, getContext
, getTemplateFilePath
, localParamNode
, getsHS
, getHS
, putHS
, modifyHS
, restoreHS
, localHS
, getDoc
, getXMLDoc
, tellSpliceError
, spliceErrorText
, orError
, Splices
, lookupTemplate
, splitTemplatePath
) where
import Control.Exception.Lifted
import Control.Monad.State
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString as B
import Data.Either
import qualified Data.Foldable as F
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as Map
import qualified Data.HeterogeneousEnvironment as HE
import Data.Map.Syntax
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
import Data.Text (Text)
import qualified Data.Text as T
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.Internal.Types
defaultLoadTimeSplices :: MonadIO m => Splices (I.Splice m)
defaultLoadTimeSplices :: forall (m :: * -> *). MonadIO m => Splices (Splice m)
defaultLoadTimeSplices = do
forall (m :: * -> *). MonadIO m => Splices (Splice m)
defaultInterpretedSplices
Text
"content" forall k v. k -> v -> MapSyntax k v
#! forall (m :: * -> *). Monad m => Splice m
deprecatedContentCheck
defaultInterpretedSplices :: MonadIO m => Splices (I.Splice m)
defaultInterpretedSplices :: forall (m :: * -> *). MonadIO m => Splices (Splice m)
defaultInterpretedSplices = do
Text
applyTag forall k v. k -> v -> MapSyntax k v
## forall (m :: * -> *). Monad m => Splice m
applyImpl
Text
bindTag forall k v. k -> v -> MapSyntax k v
## forall (m :: * -> *). Monad m => Splice m
bindImpl
Text
ignoreTag forall k v. k -> v -> MapSyntax k v
## forall (m :: * -> *). Monad m => Splice m
ignoreImpl
Text
markdownTag forall k v. k -> v -> MapSyntax k v
## forall (m :: * -> *). MonadIO m => Splice m
markdownSplice
emptyHeistConfig :: HeistConfig m
emptyHeistConfig :: forall (m :: * -> *). HeistConfig m
emptyHeistConfig = forall (m :: * -> *).
SpliceConfig m -> Text -> Bool -> HeistConfig m
HeistConfig forall a. Monoid a => a
mempty Text
"h" Bool
True
allErrors :: [Either String (TPath, v)]
-> Either [String] (HashMap TPath v)
allErrors :: forall v.
[Either String (TPath, v)] -> Either [String] (HashMap TPath v)
allErrors [Either String (TPath, v)]
tlist =
case [String]
errs of
[] -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
rights [Either String (TPath, v)]
tlist
[String]
_ -> forall a b. a -> Either a b
Left [String]
errs
where
errs :: [String]
errs = forall a b. [Either a b] -> [a]
lefts [Either String (TPath, v)]
tlist
loadTemplates :: FilePath -> IO (Either [String] TemplateRepo)
loadTemplates :: String -> IO (Either [String] TemplateRepo)
loadTemplates String
dir = do
AnchoredDirTree [Either String (TPath, DocumentFile)]
d <- forall a. (String -> IO a) -> String -> IO (AnchoredDirTree a)
readDirectoryWith (String -> String -> IO [Either String (TPath, DocumentFile)]
loadTemplate String
dir) String
dir
#if MIN_VERSION_directory_tree(0,11,0)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v.
[Either String (TPath, v)] -> Either [String] (HashMap TPath v)
allErrors forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
F.fold (forall a. AnchoredDirTree a -> DirTree a
dirTree AnchoredDirTree [Either String (TPath, DocumentFile)]
d)
#else
return $ allErrors $ F.fold (free d)
#endif
reloadTemplates :: TemplateRepo -> IO (Either [String] TemplateRepo)
reloadTemplates :: TemplateRepo -> IO (Either [String] TemplateRepo)
reloadTemplates TemplateRepo
repo = do
[Either String (TPath, DocumentFile)]
tlist <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {t}.
(t, DocumentFile) -> IO (Either String (t, DocumentFile))
loadOrKeep forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
Map.toList TemplateRepo
repo
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v.
[Either String (TPath, v)] -> Either [String] (HashMap TPath v)
allErrors [Either String (TPath, DocumentFile)]
tlist
where
loadOrKeep :: (t, DocumentFile) -> IO (Either String (t, DocumentFile))
loadOrKeep (t
p,DocumentFile
df) =
case DocumentFile -> Maybe String
dfFile DocumentFile
df of
Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (t
p, DocumentFile
df)
Just String
fp -> do
[Either String DocumentFile]
df' <- String -> IO [Either String DocumentFile]
loadTemplate' String
fp
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (t
p,) forall a b. (a -> b) -> a -> b
$ case [Either String DocumentFile]
df' of
[Either String DocumentFile
t] -> Either String DocumentFile
t
[Either String DocumentFile]
_ -> forall a b. a -> Either a b
Left String
"Template repo has non-templates"
addTemplatePathPrefix :: ByteString -> TemplateRepo -> TemplateRepo
addTemplatePathPrefix :: ByteString -> TemplateRepo -> TemplateRepo
addTemplatePathPrefix ByteString
dir TemplateRepo
ts
| ByteString -> Bool
B.null ByteString
dir = TemplateRepo
ts
| Bool
otherwise = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\(TPath
x,DocumentFile
y) -> (TPath -> TPath
f TPath
x, DocumentFile
y)) forall a b. (a -> b) -> a -> b
$
forall k v. HashMap k v -> [(k, v)]
Map.toList TemplateRepo
ts
where
f :: TPath -> TPath
f TPath
ps = TPath
psforall a. [a] -> [a] -> [a]
++ByteString -> TPath
splitTemplatePath ByteString
dir
emptyHS :: HE.KeyGen -> HeistState m
emptyHS :: forall (m :: * -> *). KeyGen -> HeistState m
emptyHS KeyGen
kg = forall (m :: * -> *).
HashMap Text (HeistT m m Template)
-> TemplateRepo
-> HashMap Text (HeistT m IO (DList (Chunk m)))
-> HashMap TPath ([Chunk m], ByteString)
-> HashMap Text (AttrSplice m)
-> Bool
-> TPath
-> [(TPath, Maybe String, Text)]
-> Int
-> [DocType]
-> Maybe String
-> KeyGen
-> Bool
-> Markup
-> Text
-> [SpliceError]
-> Bool
-> Int
-> HeistState m
HeistState forall k v. HashMap k v
Map.empty forall k v. HashMap k v
Map.empty forall k v. HashMap k v
Map.empty forall k v. HashMap k v
Map.empty forall k v. HashMap k v
Map.empty
Bool
True [] [] Int
0 [] forall a. Maybe a
Nothing KeyGen
kg Bool
False Markup
Html Text
"" [] Bool
False Int
0
initHeist :: Monad n
=> HeistConfig n
-> IO (Either [String] (HeistState n))
initHeist :: forall (n :: * -> *).
Monad n =>
HeistConfig n -> IO (Either [String] (HeistState n))
initHeist HeistConfig n
hc = do
KeyGen
keyGen <- IO KeyGen
HE.newKeyGen
[Either [String] TemplateRepo]
repos <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
SpliceConfig m -> [IO (Either [String] TemplateRepo)]
_scTemplateLocations forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). HeistConfig m -> SpliceConfig m
_hcSpliceConfig HeistConfig n
hc
case forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either [String] TemplateRepo]
repos of
Left [String]
es -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [String]
es
Right [TemplateRepo]
rs -> forall (n :: * -> *).
Monad n =>
KeyGen
-> HeistConfig n
-> TemplateRepo
-> IO (Either [String] (HeistState n))
initHeist' KeyGen
keyGen HeistConfig n
hc (forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
Map.unions [TemplateRepo]
rs)
mkSplicePrefix :: Text -> Text
mkSplicePrefix :: Text -> Text
mkSplicePrefix Text
ns
| Text -> Bool
T.null Text
ns = Text
""
| Bool
otherwise = Text
ns forall a. Monoid a => a -> a -> a
`mappend` Text
":"
initHeist' :: Monad n
=> HE.KeyGen
-> HeistConfig n
-> TemplateRepo
-> IO (Either [String] (HeistState n))
initHeist' :: forall (n :: * -> *).
Monad n =>
KeyGen
-> HeistConfig n
-> TemplateRepo
-> IO (Either [String] (HeistState n))
initHeist' KeyGen
keyGen (HeistConfig SpliceConfig n
sc Text
ns Bool
enn) TemplateRepo
repo = do
let empty :: HeistState m
empty = forall (m :: * -> *). KeyGen -> HeistState m
emptyHS KeyGen
keyGen
let (SpliceConfig Splices (Splice n)
i Splices (Splice IO)
lt Splices (Splice n)
c Splices (AttrSplice n)
a [IO (Either [String] TemplateRepo)]
_ TPath -> Bool
f) = SpliceConfig n
sc
Either [String] TemplateRepo
etmap <- KeyGen
-> Splices (Splice IO)
-> TemplateRepo
-> Text
-> IO (Either [String] TemplateRepo)
preproc KeyGen
keyGen Splices (Splice IO)
lt TemplateRepo
repo Text
ns
let prefix :: Text
prefix = Text -> Text
mkSplicePrefix Text
ns
let eis :: Either [String] (HashMap Text (Splice n))
eis = forall s. Splices s -> Either [String] (HashMap Text s)
runHashMap forall a b. (a -> b) -> a -> b
$ forall k1 k2 v a. (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v
mapK (Text
prefixforall a. Semigroup a => a -> a -> a
<>) Splices (Splice n)
i
ecs :: Either [String] (HashMap Text (Splice n))
ecs = forall s. Splices s -> Either [String] (HashMap Text s)
runHashMap forall a b. (a -> b) -> a -> b
$ forall k1 k2 v a. (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v
mapK (Text
prefixforall a. Semigroup a => a -> a -> a
<>) Splices (Splice n)
c
eas :: Either [String] (HashMap Text (AttrSplice n))
eas = forall s. Splices s -> Either [String] (HashMap Text s)
runHashMap forall a b. (a -> b) -> a -> b
$ forall k1 k2 v a. (k1 -> k2) -> MapSyntaxM k1 v a -> MapSyntax k2 v
mapK (Text
prefixforall a. Semigroup a => a -> a -> a
<>) Splices (AttrSplice n)
a
let hs1 :: Either [String] (HeistState n)
hs1 = do
TemplateRepo
tmap <- Either [String] TemplateRepo
etmap
HashMap Text (Splice n)
is <- Either [String] (HashMap Text (Splice n))
eis
HashMap Text (Splice n)
cs <- Either [String] (HashMap Text (Splice n))
ecs
HashMap Text (AttrSplice n)
as <- Either [String] (HashMap Text (AttrSplice n))
eas
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}. HeistState m
empty { _spliceMap :: HashMap Text (Splice n)
_spliceMap = HashMap Text (Splice n)
is
, _templateMap :: TemplateRepo
_templateMap = TemplateRepo
tmap
, _compiledSpliceMap :: HashMap Text (Splice n)
_compiledSpliceMap = HashMap Text (Splice n)
cs
, _attrSpliceMap :: HashMap Text (AttrSplice n)
_attrSpliceMap = HashMap Text (AttrSplice n)
as
, _splicePrefix :: Text
_splicePrefix = Text
prefix
, _errorNotBound :: Bool
_errorNotBound = Bool
enn
}
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (n :: * -> *).
Monad n =>
(TPath -> Bool)
-> HeistState n -> IO (Either [String] (HeistState n))
C.compileTemplates TPath -> Bool
f) Either [String] (HeistState n)
hs1
preproc :: HE.KeyGen
-> Splices (I.Splice IO)
-> TemplateRepo
-> Text
-> IO (Either [String] TemplateRepo)
preproc :: KeyGen
-> Splices (Splice IO)
-> TemplateRepo
-> Text
-> IO (Either [String] TemplateRepo)
preproc KeyGen
keyGen Splices (Splice IO)
splices TemplateRepo
templates Text
ns = do
let esm :: Either [String] (HashMap Text (Splice IO))
esm = forall s. Splices s -> Either [String] (HashMap Text s)
runHashMap Splices (Splice IO)
splices
case Either [String] (HashMap Text (Splice IO))
esm of
Left [String]
errs -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [String]
errs
Right HashMap Text (Splice IO)
sm -> do
let hs :: HeistState IO
hs = (forall (m :: * -> *). KeyGen -> HeistState m
emptyHS KeyGen
keyGen) { _spliceMap :: HashMap Text (Splice IO)
_spliceMap = HashMap Text (Splice IO)
sm
, _templateMap :: TemplateRepo
_templateMap = TemplateRepo
templates
, _preprocessingMode :: Bool
_preprocessingMode = Bool
True
, _splicePrefix :: Text
_splicePrefix = Text -> Text
mkSplicePrefix Text
ns }
let eval :: HeistT IO m a -> m a
eval HeistT IO m a
a = forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
HeistT n m a -> Node -> HeistState n -> m a
evalHeistT HeistT IO m a
a (Text -> Node
X.TextNode Text
"") HeistState IO
hs
[Either String (TPath, DocumentFile)]
tPairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *} {a}. Monad m => HeistT IO m a -> m a
eval forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TPath, DocumentFile)
-> HeistT IO IO (Either String (TPath, DocumentFile))
preprocess) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
Map.toList TemplateRepo
templates
let bad :: [String]
bad = forall a b. [Either a b] -> [a]
lefts [Either String (TPath, DocumentFile)]
tPairs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bad)
then forall a b. a -> Either a b
Left [String]
bad
else forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
rights [Either String (TPath, DocumentFile)]
tPairs
preprocess :: (TPath, DocumentFile)
-> HeistT IO IO (Either String (TPath, DocumentFile))
preprocess :: (TPath, DocumentFile)
-> HeistT IO IO (Either String (TPath, DocumentFile))
preprocess (TPath
tpath, DocumentFile
docFile) = do
let tname :: ByteString
tname = TPath -> ByteString
tpathName TPath
tpath
die :: a
die = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Preprocess failed because the template `"
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BC.unpack ByteString
tname
forall a. [a] -> [a] -> [a]
++ String
"` was not found in the template repository."
!Either SomeException (Maybe Document)
emdoc <- forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *).
Monad n =>
ByteString -> HeistT n n (Maybe Document)
I.evalWithDoctypes ByteString
tname
:: HeistT IO IO (Either SomeException (Maybe X.Document))
let f :: Document -> (TPath, DocumentFile)
f !Document
doc = (TPath
tpath, DocumentFile
docFile { dfDoc :: Document
dfDoc = Document
doc })
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. a
die Document -> (TPath, DocumentFile)
f) Either SomeException (Maybe Document)
emdoc
initHeistWithCacheTag :: MonadIO n
=> HeistConfig n
-> IO (Either [String] (HeistState n, CacheTagState))
initHeistWithCacheTag :: forall (n :: * -> *).
MonadIO n =>
HeistConfig n -> IO (Either [String] (HeistState n, CacheTagState))
initHeistWithCacheTag (HeistConfig SpliceConfig n
sc Text
ns Bool
enn) = do
(Splice IO
ss, CacheTagState
cts) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Splice IO, CacheTagState)
mkCacheTag
let tag :: a
tag = a
"cache"
KeyGen
keyGen <- IO KeyGen
HE.newKeyGen
[Either [String] TemplateRepo]
erepos <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
SpliceConfig m -> [IO (Either [String] TemplateRepo)]
_scTemplateLocations SpliceConfig n
sc
case forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Either [String] TemplateRepo]
erepos of
Left [String]
es -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [String]
es
Right [TemplateRepo]
repos -> do
Either [String] TemplateRepo
eRawWithCache <- KeyGen
-> Splices (Splice IO)
-> TemplateRepo
-> Text
-> IO (Either [String] TemplateRepo)
preproc KeyGen
keyGen (forall {a}. IsString a => a
tag forall k v. k -> v -> MapSyntax k v
## Splice IO
ss) (forall k v. (Eq k, Hashable k) => [HashMap k v] -> HashMap k v
Map.unions [TemplateRepo]
repos) Text
ns
case Either [String] TemplateRepo
eRawWithCache of
Left [String]
es -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [String]
es
Right TemplateRepo
rawWithCache -> do
let sc' :: SpliceConfig m
sc' = forall (m :: * -> *).
Splices (Splice m)
-> Splices (Splice IO)
-> Splices (Splice m)
-> Splices (AttrSplice m)
-> [IO (Either [String] TemplateRepo)]
-> (TPath -> Bool)
-> SpliceConfig m
SpliceConfig (forall {a}. IsString a => a
tag forall k v. k -> v -> MapSyntax k v
#! forall (n :: * -> *). MonadIO n => CacheTagState -> Splice n
cacheImpl CacheTagState
cts) forall a. Monoid a => a
mempty
(forall {a}. IsString a => a
tag forall k v. k -> v -> MapSyntax k v
#! forall (n :: * -> *). MonadIO n => CacheTagState -> Splice n
cacheImplCompiled CacheTagState
cts)
forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (forall a b. a -> b -> a
const Bool
True)
let hc :: HeistConfig n
hc = forall (m :: * -> *).
SpliceConfig m -> Text -> Bool -> HeistConfig m
HeistConfig (forall a. Monoid a => a -> a -> a
mappend SpliceConfig n
sc forall {m :: * -> *}. MonadIO m => SpliceConfig m
sc') Text
ns Bool
enn
Either [String] (HeistState n)
hs <- forall (n :: * -> *).
Monad n =>
KeyGen
-> HeistConfig n
-> TemplateRepo
-> IO (Either [String] (HeistState n))
initHeist' KeyGen
keyGen HeistConfig n
hc TemplateRepo
rawWithCache
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,CacheTagState
cts) Either [String] (HeistState n)
hs