{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoMonomorphismRestriction  #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeSynonymInstances       #-}

module Heist.Compiled.Internal where


------------------------------------------------------------------------------
import           Blaze.ByteString.Builder
import           Blaze.ByteString.Builder.Char.Utf8
import           Control.Arrow
import           Control.Exception
import           Control.Monad
import           Control.Monad.RWS.Strict
import           Control.Monad.State.Strict
import qualified Data.Attoparsec.Text               as AP
import           Data.ByteString                    (ByteString)
import           Data.DList                         (DList)
import qualified Data.DList                         as DL
import qualified Data.HashMap.Strict                as H
import qualified Data.HashSet                       as S
import qualified Data.HeterogeneousEnvironment      as HE
import           Data.Map.Syntax
import           Data.Maybe
import           Data.Text                          (Text)
import qualified Data.Text                          as T
import qualified Data.Text.Encoding                 as T
import qualified Data.Vector                        as V
import           Text.Printf
import qualified Text.XmlHtml                       as X
import qualified Text.XmlHtml.HTML.Meta             as X
------------------------------------------------------------------------------
#if !MIN_VERSION_base(4,8,0)
import           Data.Foldable                      (Foldable)
#endif
import qualified Data.Foldable                      as Foldable
------------------------------------------------------------------------------
import           Heist.Common
import           Heist.Internal.Types.HeistState
------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | A compiled Splice is a HeistT computation that returns a @DList
-- (Chunk m)@.
--
-- The more interesting part of the type signature is what comes before the
-- return value.  The first type parameter in @'HeistT' n IO@ is the runtime
-- monad.  This reveals that the Chunks know about the runtime monad.  The
-- second type parameter in @HeistT n IO@ is @IO@.  This tells us that the
-- compiled splices themselves are run in the IO monad, which will usually
-- mean at load time.  Compiled splices run at load time, and they return
-- computations that run at runtime.
type Splice n = HeistT n IO (DList (Chunk n))


------------------------------------------------------------------------------
-- | Runs the parameter node's children and returns the resulting compiled
-- chunks.  By itself this function is a simple passthrough splice that makes
-- the spliced node disappear.  In combination with locally bound splices,
-- this function makes it easier to pass the desired view into your splices.
runChildren :: Monad n => Splice n
runChildren :: forall (n :: * -> *). Monad n => Splice n
runChildren = [Node] -> Splice n
forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList ([Node] -> Splice n) -> (Node -> [Node]) -> Node -> Splice n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
X.childNodes (Node -> Splice n) -> HeistT n IO Node -> Splice n
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HeistT n IO Node
forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode
{-# INLINE runChildren #-}


renderFragment :: Markup -> [X.Node] -> Builder
renderFragment :: Markup -> [Node] -> Builder
renderFragment Markup
markup [Node]
ns =
    case Markup
markup of
      Markup
Html -> Encoding -> [Node] -> Builder
X.renderHtmlFragment Encoding
X.UTF8 [Node]
ns
      Markup
Xml  -> Encoding -> [Node] -> Builder
X.renderXmlFragment Encoding
X.UTF8 [Node]
ns


------------------------------------------------------------------------------
-- | Yields pure text known at load time.
pureTextChunk :: Text -> Chunk n
pureTextChunk :: forall (n :: * -> *). Text -> Chunk n
pureTextChunk Text
t = ByteString -> Chunk n
forall (m :: * -> *). ByteString -> Chunk m
Pure (ByteString -> Chunk n) -> ByteString -> Chunk n
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
t
{-# INLINE pureTextChunk #-}


------------------------------------------------------------------------------
-- | Yields a pure Builder known at load time.  You should use this and
-- 'yieldPureText' as much as possible to maximize the parts of your page that
-- can be compiled to static ByteStrings.
yieldPure :: Builder -> DList (Chunk n)
yieldPure :: forall (n :: * -> *). Builder -> DList (Chunk n)
yieldPure = Chunk n -> DList (Chunk n)
forall a. a -> DList a
DL.singleton (Chunk n -> DList (Chunk n))
-> (Builder -> Chunk n) -> Builder -> DList (Chunk n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Chunk n
forall (m :: * -> *). ByteString -> Chunk m
Pure (ByteString -> Chunk n)
-> (Builder -> ByteString) -> Builder -> Chunk n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toByteString
{-# INLINE yieldPure #-}


------------------------------------------------------------------------------
-- | Yields a runtime action that returns a builder.
yieldRuntime :: RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime :: forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime = Chunk n -> DList (Chunk n)
forall a. a -> DList a
DL.singleton (Chunk n -> DList (Chunk n))
-> (RuntimeSplice n Builder -> Chunk n)
-> RuntimeSplice n Builder
-> DList (Chunk n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeSplice n Builder -> Chunk n
forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml
{-# INLINE yieldRuntime #-}


------------------------------------------------------------------------------
-- | Yields a runtime action that returns no value and is only needed for its
-- side effect.
yieldRuntimeEffect :: Monad n => RuntimeSplice n () -> DList (Chunk n)
yieldRuntimeEffect :: forall (n :: * -> *).
Monad n =>
RuntimeSplice n () -> DList (Chunk n)
yieldRuntimeEffect = Chunk n -> DList (Chunk n)
forall a. a -> DList a
DL.singleton (Chunk n -> DList (Chunk n))
-> (RuntimeSplice n () -> Chunk n)
-> RuntimeSplice n ()
-> DList (Chunk n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeSplice n () -> Chunk n
forall (m :: * -> *). RuntimeSplice m () -> Chunk m
RuntimeAction
{-# INLINE yieldRuntimeEffect #-}


------------------------------------------------------------------------------
-- | A convenience wrapper around yieldPure for working with Text.  Roughly
-- equivalent to 'textSplice' from Heist.Interpreted.
yieldPureText :: Text -> DList (Chunk n)
yieldPureText :: forall (n :: * -> *). Text -> DList (Chunk n)
yieldPureText = Chunk n -> DList (Chunk n)
forall a. a -> DList a
DL.singleton (Chunk n -> DList (Chunk n))
-> (Text -> Chunk n) -> Text -> DList (Chunk n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Chunk n
forall (n :: * -> *). Text -> Chunk n
pureTextChunk
{-# INLINE yieldPureText #-}


------------------------------------------------------------------------------
-- | Convenience wrapper around yieldRuntime allowing you to work with Text.
yieldRuntimeText :: Monad n => RuntimeSplice n Text -> DList (Chunk n)
yieldRuntimeText :: forall (n :: * -> *).
Monad n =>
RuntimeSplice n Text -> DList (Chunk n)
yieldRuntimeText = RuntimeSplice n Builder -> DList (Chunk n)
forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime (RuntimeSplice n Builder -> DList (Chunk n))
-> (RuntimeSplice n Text -> RuntimeSplice n Builder)
-> RuntimeSplice n Text
-> DList (Chunk n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (Text -> Builder)
-> RuntimeSplice n Text -> RuntimeSplice n Builder
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Builder
fromText
{-# INLINE yieldRuntimeText #-}


------------------------------------------------------------------------------
-- | Returns a computation that performs load-time splice processing on the
-- supplied list of nodes.
runNodeList :: Monad n => [X.Node] -> Splice n
runNodeList :: forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList = (Node -> HeistT n IO (DList (Chunk n)))
-> [Node] -> HeistT n IO (DList (Chunk n))
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
mapSplices Node -> HeistT n IO (DList (Chunk n))
forall (n :: * -> *). Monad n => Node -> Splice n
runNode


------------------------------------------------------------------------------
-- | Runs a DocumentFile with the appropriate template context set.
runDocumentFile :: Monad n
                => TPath
                -> DocumentFile
                -> Splice n
runDocumentFile :: forall (n :: * -> *). Monad n => TPath -> DocumentFile -> Splice n
runDocumentFile TPath
tpath DocumentFile
df = do
    let markup :: Markup
markup = case DocumentFile -> Document
dfDoc DocumentFile
df of
                   X.XmlDocument Encoding
_ Maybe DocType
_ [Node]
_ -> Markup
Xml
                   X.HtmlDocument Encoding
_ Maybe DocType
_ [Node]
_ -> Markup
Html
    (HeistState n -> HeistState n) -> HeistT n IO ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
hs -> HeistState n
hs { _curMarkup = markup })
    let inDoctype :: Maybe DocType
inDoctype = Document -> Maybe DocType
X.docType (Document -> Maybe DocType) -> Document -> Maybe DocType
forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
df
    [DocType] -> HeistT n IO ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
[DocType] -> HeistT n m ()
addDoctype ([DocType] -> HeistT n IO ()) -> [DocType] -> HeistT n IO ()
forall a b. (a -> b) -> a -> b
$ Maybe DocType -> [DocType]
forall a. Maybe a -> [a]
maybeToList Maybe DocType
inDoctype
    (HeistState n -> HeistState n) -> HeistT n IO ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (Maybe [Char] -> HeistState n -> HeistState n
forall (n :: * -> *). Maybe [Char] -> HeistState n -> HeistState n
setCurTemplateFile Maybe [Char]
curPath (HeistState n -> HeistState n)
-> (HeistState n -> HeistState n) -> HeistState n -> HeistState n
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  TPath -> HeistState n -> HeistState n
forall (n :: * -> *). TPath -> HeistState n -> HeistState n
setCurContext TPath
tpath)
    res <- [Node] -> Splice n
forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList [Node]
nodes
    dt <- getsHS (listToMaybe . _doctypes)
    let enc = Document -> Encoding
X.docEncoding (Document -> Encoding) -> Document -> Encoding
forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
df
    return $! (yieldPure (X.renderDocType enc dt) `mappend` res)
  where
    curPath :: Maybe [Char]
curPath     = DocumentFile -> Maybe [Char]
dfFile DocumentFile
df
    nodes :: [Node]
nodes       = Document -> [Node]
X.docContent (Document -> [Node]) -> Document -> [Node]
forall a b. (a -> b) -> a -> b
$! DocumentFile -> Document
dfDoc DocumentFile
df


------------------------------------------------------------------------------
compileTemplate
    :: Monad n
    => TPath
    -> DocumentFile
    -> HeistT n IO [Chunk n]
compileTemplate :: forall (n :: * -> *).
Monad n =>
TPath -> DocumentFile -> HeistT n IO [Chunk n]
compileTemplate TPath
tpath DocumentFile
df = do
    !chunks <- TPath -> DocumentFile -> Splice n
forall (n :: * -> *). Monad n => TPath -> DocumentFile -> Splice n
runDocumentFile TPath
tpath DocumentFile
df
    return $! consolidate chunks


------------------------------------------------------------------------------
compileTemplates
    :: Monad n
    => (TPath -> Bool)
    -> HeistState n
    -> IO (Either [String] (HeistState n))
compileTemplates :: forall (n :: * -> *).
Monad n =>
(TPath -> Bool)
-> HeistState n -> IO (Either [[Char]] (HeistState n))
compileTemplates TPath -> Bool
f HeistState n
hs = do
    (tmap, hs') <- HeistT n IO (HashMap TPath ([Chunk n], ByteString))
-> Node
-> HeistState n
-> IO (HashMap TPath ([Chunk n], ByteString), HeistState n)
forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT ((TPath -> Bool)
-> HeistT n IO (HashMap TPath ([Chunk n], ByteString))
forall (n :: * -> *).
Monad n =>
(TPath -> Bool)
-> HeistT n IO (HashMap TPath ([Chunk n], ByteString))
compileTemplates' TPath -> Bool
f) (Text -> Node
X.TextNode Text
"") HeistState n
hs
    let pre = HeistState n -> Text
forall (m :: * -> *). HeistState m -> Text
_splicePrefix HeistState n
hs'
    let canError = HeistState n -> Bool
forall (m :: * -> *). HeistState m -> Bool
_errorNotBound HeistState n
hs'
    let errs = HeistState n -> [SpliceError]
forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors HeistState n
hs'
    let nsErr = if Bool -> Bool
not (Text -> Bool
T.null Text
pre) Bool -> Bool -> Bool
&& (HeistState n -> Int
forall (m :: * -> *). HeistState m -> Int
_numNamespacedTags HeistState n
hs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
                  then [[Char]] -> Either [[Char]] ()
forall a b. a -> Either a b
Left [[Char] -> [Char]
noNamespaceSplicesMsg ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
pre]
                  else () -> Either [[Char]] ()
forall a b. b -> Either a b
Right ()
    return $ if canError
               then case errs of
                     [] -> Either [[Char]] ()
nsErr Either [[Char]] ()
-> Either [[Char]] (HeistState n) -> Either [[Char]] (HeistState n)
forall a b.
Either [[Char]] a -> Either [[Char]] b -> Either [[Char]] b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                           (HeistState n -> Either [[Char]] (HeistState n)
forall a b. b -> Either a b
Right (HeistState n -> Either [[Char]] (HeistState n))
-> HeistState n -> Either [[Char]] (HeistState n)
forall a b. (a -> b) -> a -> b
$! HeistState n
hs { _compiledTemplateMap = tmap })
                     [SpliceError]
es -> [[Char]] -> Either [[Char]] (HeistState n)
forall a b. a -> Either a b
Left ([[Char]] -> Either [[Char]] (HeistState n))
-> [[Char]] -> Either [[Char]] (HeistState n)
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> [[Char]] -> [[Char]])
-> (() -> [[Char]] -> [[Char]])
-> Either [[Char]] ()
-> [[Char]]
-> [[Char]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
(++) (([[Char]] -> [[Char]]) -> () -> [[Char]] -> [[Char]]
forall a b. a -> b -> a
const [[Char]] -> [[Char]]
forall a. a -> a
id) Either [[Char]] ()
nsErr ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$
                           (SpliceError -> [Char]) -> [SpliceError] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
T.unpack (Text -> [Char]) -> (SpliceError -> Text) -> SpliceError -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpliceError -> Text
spliceErrorText) [SpliceError]
es
               else nsErr >> (Right $! hs { _compiledTemplateMap = tmap
                                          , _spliceErrors = errs
                                          })


------------------------------------------------------------------------------
noNamespaceSplicesMsg :: String -> String
noNamespaceSplicesMsg :: [Char] -> [Char]
noNamespaceSplicesMsg [Char]
pre = [[Char]] -> [Char]
unwords
    [ [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"You are using a namespace of '%s', but you don't have any" [Char]
ns
    , [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"tags starting with '%s'.  If you have not defined any" [Char]
pre
    , [Char]
"splices, then change your namespace to the empty string to get rid"
    , [Char]
"of this message."
    ]
  where
    ns :: [Char]
ns = [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
forall a. [a] -> [a]
reverse [Char]
pre


------------------------------------------------------------------------------
compileTemplates'
    :: Monad n
    => (TPath -> Bool)
    -> HeistT n IO (H.HashMap TPath ([Chunk n], MIMEType))
compileTemplates' :: forall (n :: * -> *).
Monad n =>
(TPath -> Bool)
-> HeistT n IO (HashMap TPath ([Chunk n], ByteString))
compileTemplates' TPath -> Bool
f = do
    hs <- HeistT n IO (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
    let tpathDocfiles :: [(TPath, DocumentFile)]
        tpathDocfiles = ((TPath, DocumentFile) -> Bool)
-> [(TPath, DocumentFile)] -> [(TPath, DocumentFile)]
forall a. (a -> Bool) -> [a] -> [a]
filter (TPath -> Bool
f (TPath -> Bool)
-> ((TPath, DocumentFile) -> TPath)
-> (TPath, DocumentFile)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TPath, DocumentFile) -> TPath
forall a b. (a, b) -> a
fst)
                            (HashMap TPath DocumentFile -> [(TPath, DocumentFile)]
forall k v. HashMap k v -> [(k, v)]
H.toList (HashMap TPath DocumentFile -> [(TPath, DocumentFile)])
-> HashMap TPath DocumentFile -> [(TPath, DocumentFile)]
forall a b. (a -> b) -> a -> b
$ HeistState n -> HashMap TPath DocumentFile
forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap HeistState n
hs)
    foldM runOne H.empty tpathDocfiles
  where
    runOne :: HashMap TPath ([Chunk m], ByteString)
-> (TPath, DocumentFile)
-> HeistT m IO (HashMap TPath ([Chunk m], ByteString))
runOne HashMap TPath ([Chunk m], ByteString)
tmap (TPath
tpath, DocumentFile
df) = do
        (HeistState m -> HeistState m) -> HeistT m IO ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState m
hs -> HeistState m
hs { _doctypes = []})
        !mHtml <- TPath -> DocumentFile -> HeistT m IO [Chunk m]
forall (n :: * -> *).
Monad n =>
TPath -> DocumentFile -> HeistT n IO [Chunk n]
compileTemplate TPath
tpath DocumentFile
df
        return $! H.insert tpath (mHtml, mimeType $! dfDoc df) tmap


------------------------------------------------------------------------------
-- | Consolidate consecutive Pure Chunks.
consolidate :: (Monad n) => DList (Chunk n) -> [Chunk n]
consolidate :: forall (n :: * -> *). Monad n => DList (Chunk n) -> [Chunk n]
consolidate = [Chunk n] -> [Chunk n]
forall {m :: * -> *}. Monad m => [Chunk m] -> [Chunk m]
consolidateL ([Chunk n] -> [Chunk n])
-> (DList (Chunk n) -> [Chunk n]) -> DList (Chunk n) -> [Chunk n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (Chunk n) -> [Chunk n]
forall a. DList a -> [a]
DL.toList
  where
    consolidateL :: [Chunk m] -> [Chunk m]
consolidateL []     = []
    consolidateL (Chunk m
y:[Chunk m]
ys) = [Chunk m] -> [Chunk m] -> [Chunk m]
forall {m :: * -> *}. [Chunk m] -> [Chunk m] -> [Chunk m]
boilDown [] ([Chunk m] -> [Chunk m]) -> [Chunk m] -> [Chunk m]
forall a b. (a -> b) -> a -> b
$! [Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
forall {m :: * -> *}.
Monad m =>
[Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
go [] Chunk m
y [Chunk m]
ys
      where
        ----------------------------------------------------------------------
        go :: [Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
go [Chunk m]
soFar Chunk m
x [] = Chunk m
x Chunk m -> [Chunk m] -> [Chunk m]
forall a. a -> [a] -> [a]
: [Chunk m]
soFar

        go [Chunk m]
soFar (Pure ByteString
a) ((Pure ByteString
b) : [Chunk m]
xs) =
            [Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
go [Chunk m]
soFar (ByteString -> Chunk m
forall (m :: * -> *). ByteString -> Chunk m
Pure (ByteString -> Chunk m) -> ByteString -> Chunk m
forall a b. (a -> b) -> a -> b
$! ByteString
a ByteString -> ByteString -> ByteString
forall a. Monoid a => a -> a -> a
`mappend` ByteString
b) [Chunk m]
xs

        go [Chunk m]
soFar (RuntimeHtml RuntimeSplice m Builder
a) ((RuntimeHtml RuntimeSplice m Builder
b) : [Chunk m]
xs) =
            [Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
go [Chunk m]
soFar (RuntimeSplice m Builder -> Chunk m
forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml (RuntimeSplice m Builder -> Chunk m)
-> RuntimeSplice m Builder -> Chunk m
forall a b. (a -> b) -> a -> b
$! RuntimeSplice m Builder
a RuntimeSplice m Builder
-> RuntimeSplice m Builder -> RuntimeSplice m Builder
forall a. Monoid a => a -> a -> a
`mappend` RuntimeSplice m Builder
b) [Chunk m]
xs

        go [Chunk m]
soFar (RuntimeHtml RuntimeSplice m Builder
a) ((RuntimeAction RuntimeSplice m ()
b) : [Chunk m]
xs) =
            [Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
go [Chunk m]
soFar (RuntimeSplice m Builder -> Chunk m
forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml (RuntimeSplice m Builder -> Chunk m)
-> RuntimeSplice m Builder -> Chunk m
forall a b. (a -> b) -> a -> b
$! RuntimeSplice m Builder
a RuntimeSplice m Builder
-> (Builder -> RuntimeSplice m Builder) -> RuntimeSplice m Builder
forall a b.
RuntimeSplice m a -> (a -> RuntimeSplice m b) -> RuntimeSplice m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Builder
x -> RuntimeSplice m ()
b RuntimeSplice m ()
-> RuntimeSplice m Builder -> RuntimeSplice m Builder
forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder -> RuntimeSplice m Builder
forall a. a -> RuntimeSplice m a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
x) [Chunk m]
xs

        go [Chunk m]
soFar (RuntimeAction RuntimeSplice m ()
a) ((RuntimeHtml RuntimeSplice m Builder
b) : [Chunk m]
xs) =
            [Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
go [Chunk m]
soFar (RuntimeSplice m Builder -> Chunk m
forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml (RuntimeSplice m Builder -> Chunk m)
-> RuntimeSplice m Builder -> Chunk m
forall a b. (a -> b) -> a -> b
$! RuntimeSplice m ()
a RuntimeSplice m ()
-> RuntimeSplice m Builder -> RuntimeSplice m Builder
forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RuntimeSplice m Builder
b) [Chunk m]
xs

        go [Chunk m]
soFar (RuntimeAction RuntimeSplice m ()
a) ((RuntimeAction RuntimeSplice m ()
b) : [Chunk m]
xs) =
            [Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
go [Chunk m]
soFar (RuntimeSplice m () -> Chunk m
forall (m :: * -> *). RuntimeSplice m () -> Chunk m
RuntimeAction (RuntimeSplice m () -> Chunk m) -> RuntimeSplice m () -> Chunk m
forall a b. (a -> b) -> a -> b
$! RuntimeSplice m ()
a RuntimeSplice m () -> RuntimeSplice m () -> RuntimeSplice m ()
forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> RuntimeSplice m ()
b) [Chunk m]
xs

        go [Chunk m]
soFar Chunk m
a (Chunk m
b : [Chunk m]
xs) = [Chunk m] -> Chunk m -> [Chunk m] -> [Chunk m]
go (Chunk m
a Chunk m -> [Chunk m] -> [Chunk m]
forall a. a -> [a] -> [a]
: [Chunk m]
soFar) Chunk m
b [Chunk m]
xs

        ----------------------------------------------------------------------
        boilDown :: [Chunk m] -> [Chunk m] -> [Chunk m]
boilDown [Chunk m]
soFar []              = [Chunk m]
soFar

        boilDown [Chunk m]
soFar ((Pure ByteString
h) : [Chunk m]
xs) = [Chunk m] -> [Chunk m] -> [Chunk m]
boilDown ((ByteString -> Chunk m
forall (m :: * -> *). ByteString -> Chunk m
Pure (ByteString -> Chunk m) -> ByteString -> Chunk m
forall a b. (a -> b) -> a -> b
$! ByteString
h) Chunk m -> [Chunk m] -> [Chunk m]
forall a. a -> [a] -> [a]
: [Chunk m]
soFar) [Chunk m]
xs

        boilDown [Chunk m]
soFar (Chunk m
x : [Chunk m]
xs) = [Chunk m] -> [Chunk m] -> [Chunk m]
boilDown (Chunk m
x Chunk m -> [Chunk m] -> [Chunk m]
forall a. a -> [a] -> [a]
: [Chunk m]
soFar) [Chunk m]
xs


------------------------------------------------------------------------------
-- | Given a list of output chunks, codeGen turns consecutive runs of
-- @Pure Html@ values into maximally-efficient pre-rendered strict
-- 'ByteString' chunks.
codeGen :: Monad n => DList (Chunk n) -> RuntimeSplice n Builder
codeGen :: forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
codeGen DList (Chunk n)
l = (RuntimeSplice n Builder
 -> RuntimeSplice n Builder -> RuntimeSplice n Builder)
-> RuntimeSplice n Builder
-> Vector (RuntimeSplice n Builder)
-> RuntimeSplice n Builder
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr RuntimeSplice n Builder
-> RuntimeSplice n Builder -> RuntimeSplice n Builder
forall a. Monoid a => a -> a -> a
mappend RuntimeSplice n Builder
forall a. Monoid a => a
mempty (Vector (RuntimeSplice n Builder) -> RuntimeSplice n Builder)
-> Vector (RuntimeSplice n Builder) -> RuntimeSplice n Builder
forall a b. (a -> b) -> a -> b
$!
            (Chunk n -> RuntimeSplice n Builder)
-> Vector (Chunk n) -> Vector (RuntimeSplice n Builder)
forall a b. (a -> b) -> Vector a -> Vector b
V.map Chunk n -> RuntimeSplice n Builder
forall {m :: * -> *}. Monad m => Chunk m -> RuntimeSplice m Builder
toAct (Vector (Chunk n) -> Vector (RuntimeSplice n Builder))
-> Vector (Chunk n) -> Vector (RuntimeSplice n Builder)
forall a b. (a -> b) -> a -> b
$! [Chunk n] -> Vector (Chunk n)
forall a. [a] -> Vector a
V.fromList ([Chunk n] -> Vector (Chunk n)) -> [Chunk n] -> Vector (Chunk n)
forall a b. (a -> b) -> a -> b
$! DList (Chunk n) -> [Chunk n]
forall (n :: * -> *). Monad n => DList (Chunk n) -> [Chunk n]
consolidate DList (Chunk n)
l
  where
    toAct :: Chunk m -> RuntimeSplice m Builder
toAct !(RuntimeHtml !RuntimeSplice m Builder
m)   = RuntimeSplice m Builder
m
    toAct !(Pure !ByteString
h)          = Builder -> RuntimeSplice m Builder
forall a. a -> RuntimeSplice m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> RuntimeSplice m Builder)
-> Builder -> RuntimeSplice m Builder
forall a b. (a -> b) -> a -> b
$! ByteString -> Builder
fromByteString ByteString
h
    toAct !(RuntimeAction !RuntimeSplice m ()
m) = RuntimeSplice m ()
m RuntimeSplice m ()
-> RuntimeSplice m Builder -> RuntimeSplice m Builder
forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Builder -> RuntimeSplice m Builder
forall a. a -> RuntimeSplice m a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
forall a. Monoid a => a
mempty
{-# INLINE codeGen #-}


------------------------------------------------------------------------------
-- | Looks up a splice in the compiled splice map.
lookupSplice :: Text -> HeistT n IO (Maybe (Splice n))
lookupSplice :: forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
nm = do
    pre <- (HeistState n -> Text) -> HeistT n IO Text
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> Text
forall (m :: * -> *). HeistState m -> Text
_splicePrefix
    res <- getsHS (H.lookup nm . _compiledSpliceMap)
    if isNothing res && T.isPrefixOf pre nm && not (T.null pre)
      then do
          tellSpliceError $ "No splice bound for " `mappend` nm
          return Nothing
      else return res


------------------------------------------------------------------------------
-- | Runs a single node.  If there is no splice referenced anywhere in the
-- subtree, then it is rendered as a pure chunk, otherwise it calls
-- compileNode to generate the appropriate runtime computation.
runNode :: Monad n => X.Node -> Splice n
runNode :: forall (n :: * -> *). Monad n => Node -> Splice n
runNode Node
node = (Node -> Node)
-> HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n))
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode (Node -> Node -> Node
forall a b. a -> b -> a
const Node
node) (HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n)))
-> HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n))
forall a b. (a -> b) -> a -> b
$ do
    hs <- HeistT n IO (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
    let pre = HeistState n -> Text
forall (m :: * -> *). HeistState m -> Text
_splicePrefix HeistState n
hs
    let hasPrefix = (Text -> Text -> Bool
T.isPrefixOf Text
pre (Text -> Bool) -> Maybe Text -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Node -> Maybe Text
X.tagName Node
node) Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    when (not (T.null pre) && hasPrefix) incNamespacedTags
    hs' <- getHS
    -- Plain rethrows for CompileException to avoid multiple annotations.
    (res, hs'') <- liftIO $ catches (compileIO hs')
                     [ Handler (\(CompileException
ex :: CompileException) -> CompileException -> IO (DList (Chunk n), HeistState n)
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO CompileException
ex)
                     , Handler (\(SomeException
ex :: SomeException) -> SomeException -> HeistState n -> IO (DList (Chunk n), HeistState n)
forall {e} {n :: * -> *} {b}.
Exception e =>
e -> HeistState n -> IO b
handleError SomeException
ex HeistState n
hs')]
    putHS hs''
    return res
  where
    localSplicePath :: HeistT m m a -> HeistT m m a
localSplicePath =
        (HeistState m -> HeistState m) -> HeistT m m a -> HeistT m m a
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
localHS (\HeistState m
hs -> HeistState m
hs {_splicePath = (_curContext hs,
                                           _curTemplateFile hs,
                                           X.elementTag node):
                                          (_splicePath hs)})
    compileIO :: HeistState n -> IO (DList (Chunk n), HeistState n)
compileIO HeistState n
hs = HeistT n IO (DList (Chunk n))
-> Node -> HeistState n -> IO (DList (Chunk n), HeistState n)
forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT HeistT n IO (DList (Chunk n))
forall (n :: * -> *). Monad n => Splice n
compile Node
node HeistState n
hs
    compile :: HeistT n IO (DList (Chunk n))
compile = do
        isStatic <- Node -> HeistT n IO Bool
forall (n :: * -> *). Node -> HeistT n IO Bool
subtreeIsStatic Node
node
        dl <- compile' isStatic
        liftIO $ evaluate $ DL.fromList $! consolidate dl
    compile' :: Bool -> HeistT n IO (DList (Chunk n))
compile' Bool
True = do
        markup <- (HeistState n -> Markup) -> HeistT n IO Markup
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> Markup
forall (m :: * -> *). HeistState m -> Markup
_curMarkup
        return $! yieldPure $! renderFragment markup [parseAttrs node]
    compile' Bool
False = HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n))
forall {m :: * -> *} {m :: * -> *} {a}.
Monad m =>
HeistT m m a -> HeistT m m a
localSplicePath (HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n)))
-> HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n))
forall a b. (a -> b) -> a -> b
$ Node -> HeistT n IO (DList (Chunk n))
forall (n :: * -> *). Monad n => Node -> Splice n
compileNode Node
node
    handleError :: e -> HeistState n -> IO b
handleError e
ex HeistState n
hs = do
        errs <- HeistT n IO [SpliceError]
-> Node -> HeistState n -> IO [SpliceError]
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
HeistT n m a -> Node -> HeistState n -> m a
evalHeistT (do HeistT n IO () -> HeistT n IO ()
forall {m :: * -> *} {m :: * -> *} {a}.
Monad m =>
HeistT m m a -> HeistT m m a
localSplicePath (HeistT n IO () -> HeistT n IO ())
-> HeistT n IO () -> HeistT n IO ()
forall a b. (a -> b) -> a -> b
$ Text -> HeistT n IO ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m ()
tellSpliceError (Text -> HeistT n IO ()) -> Text -> HeistT n IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$
                                 [Char]
"Exception in splice compile: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ e -> [Char]
forall a. Show a => a -> [Char]
show e
ex
                               (HeistState n -> [SpliceError]) -> HeistT n IO [SpliceError]
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> [SpliceError]
forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors) Node
node HeistState n
hs
        throwIO $ CompileException ex errs


parseAttrs :: X.Node -> X.Node
parseAttrs :: Node -> Node
parseAttrs (X.Element Text
nm [(Text, Text)]
attrs [Node]
ch) = [(Text, Text)]
newAttrs [(Text, Text)] -> Node -> Node
forall a b. a -> b -> b
`seq` Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
nm [(Text, Text)]
newAttrs [Node]
ch
  where
    newAttrs :: [(Text, Text)]
newAttrs = ((Text, Text) -> (Text, Text)) -> [(Text, Text)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> (Text, Text)
parseAttr [(Text, Text)]
attrs
parseAttrs !Node
n = Node
n

parseAttr :: (Text, Text) -> (Text, Text)
parseAttr :: (Text, Text) -> (Text, Text)
parseAttr (Text
k,Text
v) = (Text
k, [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$! (AttAST -> Text) -> [AttAST] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map AttAST -> Text
cvt [AttAST]
ast)
  where
    !ast :: [AttAST]
ast = case IResult Text [AttAST] -> Text -> IResult Text [AttAST]
forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (Parser [AttAST] -> Text -> IResult Text [AttAST]
forall a. Parser a -> Text -> Result a
AP.parse Parser [AttAST]
attParser Text
v) Text
"" of
            (AP.Done Text
_ [AttAST]
res) -> [AttAST]
res
            (AP.Fail Text
_ [[Char]]
_ [Char]
_) -> []
            (AP.Partial Text -> IResult Text [AttAST]
_ ) -> []
    cvt :: AttAST -> Text
cvt (Literal Text
x) = Text
x
    cvt (Ident Text
i) = [Text] -> Text
T.concat [Text
"${", Text
i, Text
"}"]

------------------------------------------------------------------------------
-- | Checks whether a node's subtree is static and can be rendered up front at
-- load time.
subtreeIsStatic :: X.Node -> HeistT n IO Bool
subtreeIsStatic :: forall (n :: * -> *). Node -> HeistT n IO Bool
subtreeIsStatic (X.Element Text
nm [(Text, Text)]
attrs [Node]
ch) = do
    isNodeDynamic <- (Maybe (Splice n) -> Bool)
-> HeistT n IO (Maybe (Splice n)) -> HeistT n IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe (Splice n) -> Bool
forall a. Maybe a -> Bool
isJust (HeistT n IO (Maybe (Splice n)) -> HeistT n IO Bool)
-> HeistT n IO (Maybe (Splice n)) -> HeistT n IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> HeistT n IO (Maybe (Splice n))
forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
nm
    attrSplices <- getsHS _attrSpliceMap
    let hasSubstitutions (Text
k,Text
v) = Text -> Bool
hasAttributeSubstitutions Text
v Bool -> Bool -> Bool
||
                                 Text -> HashMap Text (AttrSplice n) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member Text
k HashMap Text (AttrSplice n)
attrSplices
    if isNodeDynamic
      then return False
      else do
          let hasDynamicAttrs = ((Text, Text) -> Bool) -> [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text, Text) -> Bool
hasSubstitutions [(Text, Text)]
attrs
          if hasDynamicAttrs
            then return False
            else do
                staticSubtrees <- mapM subtreeIsStatic ch
                return $ and staticSubtrees

subtreeIsStatic Node
_ = Bool -> HeistT n IO Bool
forall a. a -> HeistT n IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True


------------------------------------------------------------------------------
-- | Checks whether a string has any attribute substitutions.
hasAttributeSubstitutions :: Text -> Bool
hasAttributeSubstitutions :: Text -> Bool
hasAttributeSubstitutions Text
txt = (AttAST -> Bool) -> [AttAST] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any AttAST -> Bool
isIdent [AttAST]
ast
  where
    ast :: [AttAST]
ast = case IResult Text [AttAST] -> Text -> IResult Text [AttAST]
forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (Parser [AttAST] -> Text -> IResult Text [AttAST]
forall a. Parser a -> Text -> Result a
AP.parse Parser [AttAST]
attParser Text
txt) Text
"" of
            (AP.Done Text
_ [AttAST]
res) -> [AttAST]
res
            (AP.Fail Text
_ [[Char]]
_ [Char]
_) -> []
            (AP.Partial Text -> IResult Text [AttAST]
_ ) -> []


------------------------------------------------------------------------------
-- | Given a 'X.Node' in the DOM tree, produces a \"runtime splice\" that will
-- generate html at runtime.
compileNode :: Monad n => X.Node -> Splice n
compileNode :: forall (n :: * -> *). Monad n => Node -> Splice n
compileNode (X.Element Text
nm [(Text, Text)]
attrs [Node]
ch) = do
    msplice <- Text -> HeistT n IO (Maybe (Splice n))
forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
nm
    fromMaybe compileStaticElement msplice
  where
    tag0 :: Text
tag0 = Text -> Text -> Text
T.append Text
"<" Text
nm
    end :: Text
end = [Text] -> Text
T.concat [ Text
"</" , Text
nm , Text
">"]
    -- If the tag is not a splice, but it contains dynamic children
    compileStaticElement :: HeistT n IO (DList (Chunk n))
compileStaticElement = do
        -- Parse the attributes: we have Left for static and Right for runtime
        compiledAttrs <- [(Text, Text)] -> HeistT n IO [DList (Chunk n)]
forall (n :: * -> *).
Monad n =>
[(Text, Text)] -> HeistT n IO [DList (Chunk n)]
runAttributes [(Text, Text)]
attrs

        childHtml <- runNodeList ch

        return $! if null (DL.toList childHtml) && nm `S.member` X.voidTags
          then DL.concat [ DL.singleton $! pureTextChunk $! tag0
                         , DL.concat compiledAttrs
                         , DL.singleton $! pureTextChunk " />"
                         ]
          else DL.concat [ DL.singleton $! pureTextChunk $! tag0
                         , DL.concat compiledAttrs
                         , DL.singleton $! pureTextChunk ">"
                         , childHtml
                         , DL.singleton $! pureTextChunk $! end
                         ]
compileNode Node
_ = [Char] -> Splice n
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"


------------------------------------------------------------------------------
-- |
parseAtt :: Monad n => (Text, Text) -> HeistT n IO (DList (Chunk n))
parseAtt :: forall (n :: * -> *).
Monad n =>
(Text, Text) -> HeistT n IO (DList (Chunk n))
parseAtt (Text
k,Text
v) = do
    mas <- (HeistState n -> Maybe (AttrSplice n))
-> HeistT n IO (Maybe (AttrSplice n))
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS (Text -> HashMap Text (AttrSplice n) -> Maybe (AttrSplice n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k (HashMap Text (AttrSplice n) -> Maybe (AttrSplice n))
-> (HeistState n -> HashMap Text (AttrSplice n))
-> HeistState n
-> Maybe (AttrSplice n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeistState n -> HashMap Text (AttrSplice n)
forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap)
    maybe doInline (return . doAttrSplice) mas

  where
    cvt :: AttAST -> HeistT n IO (DList (Chunk n))
cvt (Literal Text
x) = DList (Chunk n) -> HeistT n IO (DList (Chunk n))
forall a. a -> HeistT n IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DList (Chunk n) -> HeistT n IO (DList (Chunk n)))
-> DList (Chunk n) -> HeistT n IO (DList (Chunk n))
forall a b. (a -> b) -> a -> b
$ Text -> DList (Chunk n)
forall (n :: * -> *). Text -> DList (Chunk n)
yieldPureText Text
x
    cvt (Ident Text
x) =
        (Node -> Node)
-> HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n))
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode (Node -> Node -> Node
forall a b. a -> b -> a
const (Node -> Node -> Node) -> Node -> Node -> Node
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
x [] []) (HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n)))
-> HeistT n IO (DList (Chunk n)) -> HeistT n IO (DList (Chunk n))
forall a b. (a -> b) -> a -> b
$ Text -> HeistT n IO (DList (Chunk n))
forall (n :: * -> *). Text -> HeistT n IO (DList (Chunk n))
getAttributeSplice Text
x

    -- Handles inline parsing of $() splice syntax in attributes
    doInline :: HeistT n IO (DList (Chunk n))
doInline = do
        let ast :: [AttAST]
ast = case IResult Text [AttAST] -> Text -> IResult Text [AttAST]
forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (Parser [AttAST] -> Text -> IResult Text [AttAST]
forall a. Parser a -> Text -> Result a
AP.parse Parser [AttAST]
attParser Text
v) Text
"" of
                    (AP.Done Text
_ [AttAST]
res) -> [AttAST]
res
                    (AP.Fail Text
_ [[Char]]
_ [Char]
_) -> []
                    (AP.Partial Text -> IResult Text [AttAST]
_ ) -> []
        chunks <- (AttAST -> HeistT n IO (DList (Chunk n)))
-> [AttAST] -> HeistT n IO [DList (Chunk n)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AttAST -> HeistT n IO (DList (Chunk n))
forall {n :: * -> *}. AttAST -> HeistT n IO (DList (Chunk n))
cvt [AttAST]
ast
        let value = [DList (Chunk n)] -> DList (Chunk n)
forall a. [DList a] -> DList a
DL.concat [DList (Chunk n)]
chunks
        return $ attrToChunk k value

    -- Handles attribute splices
    doAttrSplice :: (Text -> RuntimeSplice m [(Text, Text)]) -> DList (Chunk m)
doAttrSplice Text -> RuntimeSplice m [(Text, Text)]
splice = Chunk m -> DList (Chunk m)
forall a. a -> DList a
DL.singleton (Chunk m -> DList (Chunk m)) -> Chunk m -> DList (Chunk m)
forall a b. (a -> b) -> a -> b
$ RuntimeSplice m Builder -> Chunk m
forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml (RuntimeSplice m Builder -> Chunk m)
-> RuntimeSplice m Builder -> Chunk m
forall a b. (a -> b) -> a -> b
$ do
        res <- Text -> RuntimeSplice m [(Text, Text)]
splice Text
v
        return $ mconcat $ map attrToBuilder res


------------------------------------------------------------------------------
-- |
parseAtt2 :: Monad n
          => (Text, Text)
          -> HeistT n IO (RuntimeSplice n [(Text, Text)])
parseAtt2 :: forall (n :: * -> *).
Monad n =>
(Text, Text) -> HeistT n IO (RuntimeSplice n [(Text, Text)])
parseAtt2 (Text
k,Text
v) = do
    mas <- (HeistState n -> Maybe (AttrSplice n))
-> HeistT n IO (Maybe (AttrSplice n))
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS (Text -> HashMap Text (AttrSplice n) -> Maybe (AttrSplice n)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k (HashMap Text (AttrSplice n) -> Maybe (AttrSplice n))
-> (HeistState n -> HashMap Text (AttrSplice n))
-> HeistState n
-> Maybe (AttrSplice n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeistState n -> HashMap Text (AttrSplice n)
forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap)
    maybe doInline (return . doAttrSplice) mas

  where
    cvt :: AttAST -> HeistT n IO (RuntimeSplice n Text)
cvt (Literal Text
x) = RuntimeSplice n Text -> HeistT n IO (RuntimeSplice n Text)
forall a. a -> HeistT n IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RuntimeSplice n Text -> HeistT n IO (RuntimeSplice n Text))
-> RuntimeSplice n Text -> HeistT n IO (RuntimeSplice n Text)
forall a b. (a -> b) -> a -> b
$ Text -> RuntimeSplice n Text
forall a. a -> RuntimeSplice n a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
    cvt (Ident Text
x) =
        (Node -> Node)
-> HeistT n IO (RuntimeSplice n Text)
-> HeistT n IO (RuntimeSplice n Text)
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode (Node -> Node -> Node
forall a b. a -> b -> a
const (Node -> Node -> Node) -> Node -> Node -> Node
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
x [] []) (HeistT n IO (RuntimeSplice n Text)
 -> HeistT n IO (RuntimeSplice n Text))
-> HeistT n IO (RuntimeSplice n Text)
-> HeistT n IO (RuntimeSplice n Text)
forall a b. (a -> b) -> a -> b
$ Text -> HeistT n IO (RuntimeSplice n Text)
forall (n :: * -> *).
Monad n =>
Text -> HeistT n IO (RuntimeSplice n Text)
getAttributeSplice2 Text
x

    -- Handles inline parsing of $() splice syntax in attributes
    doInline :: HeistT n IO (RuntimeSplice n [(Text, Text)])
doInline = do
        let ast :: [AttAST]
ast = case IResult Text [AttAST] -> Text -> IResult Text [AttAST]
forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (Parser [AttAST] -> Text -> IResult Text [AttAST]
forall a. Parser a -> Text -> Result a
AP.parse Parser [AttAST]
attParser Text
v) Text
"" of
                    (AP.Done Text
_ [AttAST]
res) -> [AttAST]
res
                    (AP.Fail Text
_ [[Char]]
_ [Char]
_) -> []
                    (AP.Partial Text -> IResult Text [AttAST]
_ ) -> []
        chunks <- (AttAST -> HeistT n IO (RuntimeSplice n Text))
-> [AttAST] -> HeistT n IO [RuntimeSplice n Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM AttAST -> HeistT n IO (RuntimeSplice n Text)
forall {n :: * -> *}.
Monad n =>
AttAST -> HeistT n IO (RuntimeSplice n Text)
cvt [AttAST]
ast
        return $ do
            list <- sequence chunks
            return [(k, T.concat list)]

    -- Handles attribute splices
    doAttrSplice :: (Text -> t) -> t
doAttrSplice Text -> t
splice = Text -> t
splice Text
v


------------------------------------------------------------------------------
-- | Performs splice processing on a list of attributes.  This is useful in
-- situations where you need to stop recursion, but still run splice
-- processing on the node's attributes.
runAttributes :: Monad n
              => [(Text, Text)] -- ^ List of attributes
              -> HeistT n IO [DList (Chunk n)]
runAttributes :: forall (n :: * -> *).
Monad n =>
[(Text, Text)] -> HeistT n IO [DList (Chunk n)]
runAttributes = ((Text, Text) -> HeistT n IO (DList (Chunk n)))
-> [(Text, Text)] -> HeistT n IO [DList (Chunk n)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, Text) -> HeistT n IO (DList (Chunk n))
forall (n :: * -> *).
Monad n =>
(Text, Text) -> HeistT n IO (DList (Chunk n))
parseAtt


------------------------------------------------------------------------------
-- | Performs splice processing on a list of attributes.  This is useful in
-- situations where you need to stop recursion, but still run splice
-- processing on the node's attributes.
runAttributesRaw :: Monad n
                 -- Note that this parameter should not be changed to Splices
                 => [(Text, Text)] -- ^ List of attributes
                 -> HeistT n IO (RuntimeSplice n [(Text, Text)])
runAttributesRaw :: forall (n :: * -> *).
Monad n =>
[(Text, Text)] -> HeistT n IO (RuntimeSplice n [(Text, Text)])
runAttributesRaw [(Text, Text)]
attrs = do
    arrs <- ((Text, Text) -> HeistT n IO (RuntimeSplice n [(Text, Text)]))
-> [(Text, Text)] -> HeistT n IO [RuntimeSplice n [(Text, Text)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, Text) -> HeistT n IO (RuntimeSplice n [(Text, Text)])
forall (n :: * -> *).
Monad n =>
(Text, Text) -> HeistT n IO (RuntimeSplice n [(Text, Text)])
parseAtt2 [(Text, Text)]
attrs
    return $ liftM concat $ sequence arrs


attrToChunk :: Text -> DList (Chunk n) -> DList (Chunk n)
attrToChunk :: forall (n :: * -> *). Text -> DList (Chunk n) -> DList (Chunk n)
attrToChunk !Text
k !DList (Chunk n)
v = do
    [DList (Chunk n)] -> DList (Chunk n)
forall a. [DList a] -> DList a
DL.concat
        [ Chunk n -> DList (Chunk n)
forall a. a -> DList a
DL.singleton (Chunk n -> DList (Chunk n)) -> Chunk n -> DList (Chunk n)
forall a b. (a -> b) -> a -> b
$! Text -> Chunk n
forall (n :: * -> *). Text -> Chunk n
pureTextChunk (Text -> Chunk n) -> Text -> Chunk n
forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.concat [Text
" ", Text
k, Text
"=\""]
        , DList (Chunk n)
v, Chunk n -> DList (Chunk n)
forall a. a -> DList a
DL.singleton (Chunk n -> DList (Chunk n)) -> Chunk n -> DList (Chunk n)
forall a b. (a -> b) -> a -> b
$! Text -> Chunk n
forall (n :: * -> *). Text -> Chunk n
pureTextChunk Text
"\"" ]


attrToBuilder :: (Text, Text) -> Builder
attrToBuilder :: (Text, Text) -> Builder
attrToBuilder (Text
k,Text
v)
  | Text -> Bool
T.null Text
v  = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ Text -> Builder
fromText Text
" "
    , Text -> Builder
fromText Text
k
    ]
  | Bool
otherwise = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
    [ Text -> Builder
fromText Text
" "
    , Text -> Builder
fromText Text
k
    , Text -> Builder
fromText Text
"=\""
    , Text -> Builder
fromText Text
v
    , Text -> Builder
fromText Text
"\""
    ]


------------------------------------------------------------------------------
getAttributeSplice :: Text -> HeistT n IO (DList (Chunk n))
getAttributeSplice :: forall (n :: * -> *). Text -> HeistT n IO (DList (Chunk n))
getAttributeSplice Text
name =
    Text -> HeistT n IO (Maybe (Splice n))
forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
name HeistT n IO (Maybe (Splice n))
-> (Maybe (Splice n) -> Splice n) -> Splice n
forall a b. HeistT n IO a -> (a -> HeistT n IO b) -> HeistT n IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Splice n -> Maybe (Splice n) -> Splice n
forall a. a -> Maybe a -> a
fromMaybe
      (DList (Chunk n) -> Splice n
forall a. a -> HeistT n IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DList (Chunk n) -> Splice n) -> DList (Chunk n) -> Splice n
forall a b. (a -> b) -> a -> b
$ Chunk n -> DList (Chunk n)
forall a. a -> DList a
DL.singleton (Chunk n -> DList (Chunk n)) -> Chunk n -> DList (Chunk n)
forall a b. (a -> b) -> a -> b
$ ByteString -> Chunk n
forall (m :: * -> *). ByteString -> Chunk m
Pure (ByteString -> Chunk n) -> ByteString -> Chunk n
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$
       [Text] -> Text
T.concat [Text
"${", Text
name, Text
"}"])
{-# INLINE getAttributeSplice #-}


getAttributeSplice2 :: Monad n => Text -> HeistT n IO (RuntimeSplice n Text)
getAttributeSplice2 :: forall (n :: * -> *).
Monad n =>
Text -> HeistT n IO (RuntimeSplice n Text)
getAttributeSplice2 Text
name = do
    mSplice <- Text -> HeistT n IO (Maybe (Splice n))
forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
name
    case mSplice of
      Maybe (Splice n)
Nothing -> RuntimeSplice n Text -> HeistT n IO (RuntimeSplice n Text)
forall a. a -> HeistT n IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RuntimeSplice n Text -> HeistT n IO (RuntimeSplice n Text))
-> RuntimeSplice n Text -> HeistT n IO (RuntimeSplice n Text)
forall a b. (a -> b) -> a -> b
$ Text -> RuntimeSplice n Text
forall a. a -> RuntimeSplice n a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> RuntimeSplice n Text) -> Text -> RuntimeSplice n Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"${", Text
name, Text
"}"]
      Just Splice n
splice -> do
        res <- Splice n
splice
        return $ liftM (T.decodeUtf8 . toByteString) $ codeGen res
{-# INLINE getAttributeSplice2 #-}


------------------------------------------------------------------------------
-- | Promises are used for referencing the results of future runtime
-- computations during load time splice processing.
newtype Promise a = Promise (HE.Key a)


------------------------------------------------------------------------------
-- | Gets the result of a promised runtime computation.
getPromise :: (Monad n) => Promise a -> RuntimeSplice n a
getPromise :: forall (n :: * -> *) a. Monad n => Promise a -> RuntimeSplice n a
getPromise (Promise Key a
k) = do
    mb <- (HeterogeneousEnvironment -> Maybe a) -> RuntimeSplice n (Maybe a)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Key a -> HeterogeneousEnvironment -> Maybe a
forall a. Key a -> HeterogeneousEnvironment -> Maybe a
HE.lookup Key a
k)
    return $ fromMaybe e mb

  where
    e :: a
e = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"getPromise: dereferenced empty key (id "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Key a -> Int
forall a. Key a -> Int
HE.getKeyId Key a
k) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
{-# INLINE getPromise #-}


------------------------------------------------------------------------------
-- | Adds a promise to the runtime splice context.
putPromise :: (Monad n) => Promise a -> a -> RuntimeSplice n ()
putPromise :: forall (n :: * -> *) a.
Monad n =>
Promise a -> a -> RuntimeSplice n ()
putPromise (Promise Key a
k) a
x = (HeterogeneousEnvironment -> HeterogeneousEnvironment)
-> RuntimeSplice n ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Key a -> a -> HeterogeneousEnvironment -> HeterogeneousEnvironment
forall a.
Key a -> a -> HeterogeneousEnvironment -> HeterogeneousEnvironment
HE.insert Key a
k a
x)
{-# INLINE putPromise #-}


------------------------------------------------------------------------------
-- | Modifies a promise.
adjustPromise :: Monad n => Promise a -> (a -> a) -> RuntimeSplice n ()
adjustPromise :: forall (n :: * -> *) a.
Monad n =>
Promise a -> (a -> a) -> RuntimeSplice n ()
adjustPromise (Promise Key a
k) a -> a
f = (HeterogeneousEnvironment -> HeterogeneousEnvironment)
-> RuntimeSplice n ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((a -> a)
-> Key a -> HeterogeneousEnvironment -> HeterogeneousEnvironment
forall a.
(a -> a)
-> Key a -> HeterogeneousEnvironment -> HeterogeneousEnvironment
HE.adjust a -> a
f Key a
k)
{-# INLINE adjustPromise #-}


------------------------------------------------------------------------------
-- | Creates an empty promise.
newEmptyPromise :: HeistT n IO (Promise a)
newEmptyPromise :: forall (n :: * -> *) a. HeistT n IO (Promise a)
newEmptyPromise = do
    keygen <- (HeistState n -> KeyGen) -> HeistT n IO KeyGen
forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> KeyGen
forall (m :: * -> *). HeistState m -> KeyGen
_keygen
    key    <- liftIO $ HE.makeKey keygen
    return $! Promise key
{-# INLINE newEmptyPromise #-}


-- ------------------------------------------------------------------------------
-- -- | Creates an empty promise with some error checking to help with debugging.
-- newEmptyPromiseWithError :: (Monad n)
--                          => String -> HeistT n IO (Promise a)
-- newEmptyPromiseWithError from = do
--     keygen <- getsHS _keygen
--     prom   <- liftM Promise $ liftIO $ HE.makeKey keygen
--     yieldRuntimeEffect $ putPromise prom
--                        $ error
--                        $ "deferenced empty promise created at" ++ from
--     return prom
-- {-# INLINE newEmptyPromiseWithError #-}


------------------------------------------------------------------------------
-- | Binds a compiled splice.  This function should not be exported.
bindSplice :: Text             -- ^ tag name
           -> Splice n         -- ^ splice action
           -> HeistState n     -- ^ source state
           -> HeistState n
bindSplice :: forall (n :: * -> *).
Text -> Splice n -> HeistState n -> HeistState n
bindSplice Text
n Splice n
v HeistState n
ts =
    HeistState n
ts { _compiledSpliceMap = H.insert n' v (_compiledSpliceMap ts) }
  where
    n' :: Text
n' = HeistState n -> Text
forall (m :: * -> *). HeistState m -> Text
_splicePrefix HeistState n
ts Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
n

------------------------------------------------------------------------------
-- | Binds a list of compiled splices.  This function should not be exported.
bindSplices :: Splices (Splice n)  -- ^ splices to bind
            -> HeistState n        -- ^ source state
            -> HeistState n
bindSplices :: forall (n :: * -> *).
Splices (Splice n) -> HeistState n -> HeistState n
bindSplices Splices (Splice n)
ss HeistState n
hs =
    HeistState n
hs { _compiledSpliceMap = applySpliceMap hs _compiledSpliceMap ss }


------------------------------------------------------------------------------
-- | Adds a list of compiled splices to the splice map.  This function is
-- useful because it allows compiled splices to bind other compiled splices
-- during load-time splice processing.
withLocalSplices :: Splices (Splice n)
                 -> Splices (AttrSplice n)
                 -> HeistT n IO a
                 -> HeistT n IO a
withLocalSplices :: forall (n :: * -> *) a.
Splices (Splice n)
-> Splices (AttrSplice n) -> HeistT n IO a -> HeistT n IO a
withLocalSplices Splices (Splice n)
ss Splices (AttrSplice n)
as = (HeistState n -> HeistState n) -> HeistT n IO a -> HeistT n IO a
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
localHS (Splices (Splice n) -> HeistState n -> HeistState n
forall (n :: * -> *).
Splices (Splice n) -> HeistState n -> HeistState n
bindSplices Splices (Splice n)
ss (HeistState n -> HeistState n)
-> (HeistState n -> HeistState n) -> HeistState n -> HeistState n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Splices (AttrSplice n) -> HeistState n -> HeistState n
forall (n :: * -> *).
Splices (AttrSplice n) -> HeistState n -> HeistState n
bindAttributeSplices Splices (AttrSplice n)
as)


------------------------------------------------------------------------------
-- | Looks up a compiled template and returns a runtime monad computation that
-- constructs a builder.
--
-- Note that template names should not include the .tpl extension:
--
-- @renderTemplate hs "index"@
renderTemplate :: Monad n
               => HeistState n
               -> ByteString
               -> Maybe (n Builder, MIMEType)
renderTemplate :: forall (n :: * -> *).
Monad n =>
HeistState n -> ByteString -> Maybe (n Builder, ByteString)
renderTemplate HeistState n
hs ByteString
nm =
    ((([Chunk n], ByteString), TPath) -> (n Builder, ByteString))
-> Maybe (([Chunk n], ByteString), TPath)
-> Maybe (n Builder, ByteString)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Chunk n] -> n Builder)
-> ([Chunk n], ByteString) -> (n Builder, ByteString)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (DList (Chunk n) -> n Builder
forall (n :: * -> *). Monad n => DList (Chunk n) -> n Builder
interpret (DList (Chunk n) -> n Builder)
-> ([Chunk n] -> DList (Chunk n)) -> [Chunk n] -> n Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk n] -> DList (Chunk n)
forall a. [a] -> DList a
DL.fromList) (([Chunk n], ByteString) -> (n Builder, ByteString))
-> ((([Chunk n], ByteString), TPath) -> ([Chunk n], ByteString))
-> (([Chunk n], ByteString), TPath)
-> (n Builder, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Chunk n], ByteString), TPath) -> ([Chunk n], ByteString)
forall a b. (a, b) -> a
fst) (Maybe (([Chunk n], ByteString), TPath)
 -> Maybe (n Builder, ByteString))
-> Maybe (([Chunk n], ByteString), TPath)
-> Maybe (n Builder, ByteString)
forall a b. (a -> b) -> a -> b
$!
      ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath ([Chunk n], ByteString))
-> Maybe (([Chunk n], ByteString), TPath)
forall (n :: * -> *) t.
ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
lookupTemplate ByteString
nm HeistState n
hs HeistState n -> HashMap TPath ([Chunk n], ByteString)
forall (m :: * -> *).
HeistState m -> HashMap TPath ([Chunk m], ByteString)
_compiledTemplateMap


------------------------------------------------------------------------------
-- | Looks up a compiled template and returns a compiled splice.
callTemplate :: Monad n
             => ByteString
             -> Splice n
callTemplate :: forall (n :: * -> *). Monad n => ByteString -> Splice n
callTemplate ByteString
nm = do
    hs <- HeistT n IO (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
    maybe (error err) call $ lookupTemplate nm hs _templateMap
  where
    err :: [Char]
err = [Char]
"callTemplate: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
nm)[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++([Char]
" does not exist")
    call :: (DocumentFile, b) -> HeistT m IO (DList (Chunk m))
call (DocumentFile
df,b
_) = (HeistState m -> HeistState m)
-> HeistT m IO (DList (Chunk m)) -> HeistT m IO (DList (Chunk m))
forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
localHS (\HeistState m
hs' -> HeistState m
hs' {_curTemplateFile = dfFile df}) (HeistT m IO (DList (Chunk m)) -> HeistT m IO (DList (Chunk m)))
-> HeistT m IO (DList (Chunk m)) -> HeistT m IO (DList (Chunk m))
forall a b. (a -> b) -> a -> b
$
                    [Node] -> HeistT m IO (DList (Chunk m))
forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList ([Node] -> HeistT m IO (DList (Chunk m)))
-> [Node] -> HeistT m IO (DList (Chunk m))
forall a b. (a -> b) -> a -> b
$ Document -> [Node]
X.docContent (Document -> [Node]) -> Document -> [Node]
forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
df


interpret :: Monad n => DList (Chunk n) -> n Builder
interpret :: forall (n :: * -> *). Monad n => DList (Chunk n) -> n Builder
interpret = (StateT HeterogeneousEnvironment n Builder
 -> HeterogeneousEnvironment -> n Builder)
-> HeterogeneousEnvironment
-> StateT HeterogeneousEnvironment n Builder
-> n Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT HeterogeneousEnvironment n Builder
-> HeterogeneousEnvironment -> n Builder
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HeterogeneousEnvironment
HE.empty (StateT HeterogeneousEnvironment n Builder -> n Builder)
-> (DList (Chunk n) -> StateT HeterogeneousEnvironment n Builder)
-> DList (Chunk n)
-> n Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeSplice n Builder
-> StateT HeterogeneousEnvironment n Builder
forall (m :: * -> *) a.
RuntimeSplice m a -> StateT HeterogeneousEnvironment m a
unRT (RuntimeSplice n Builder
 -> StateT HeterogeneousEnvironment n Builder)
-> (DList (Chunk n) -> RuntimeSplice n Builder)
-> DList (Chunk n)
-> StateT HeterogeneousEnvironment n Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList (Chunk n) -> RuntimeSplice n Builder
forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
codeGen


------------------------------------------------------------------------------
-- | Converts a pure text splice function to a pure Builder splice function.
textSplice :: (a -> Text) -> a -> Builder
textSplice :: forall a. (a -> Text) -> a -> Builder
textSplice a -> Text
f = Text -> Builder
fromText (Text -> Builder) -> (a -> Text) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
f


                               ---------------
                               -- New Stuff --
                               ---------------


------------------------------------------------------------------------------
-- | This is the same as htmlNodeSplice.  
nodeSplice :: (a -> [X.Node]) -> a -> Builder
nodeSplice :: forall a. (a -> [Node]) -> a -> Builder
nodeSplice a -> [Node]
f = Encoding -> [Node] -> Builder
X.renderHtmlFragment Encoding
X.UTF8 ([Node] -> Builder) -> (a -> [Node]) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Node]
f
{-# DEPRECATED nodeSplice
   "Use xmlNodeSplice or htmlNodeSplice, will be removed in Heist 1.1" #-}


------------------------------------------------------------------------------
-- | Converts a pure XML Node splice function to a pure Builder splice
-- function.
xmlNodeSplice :: (a -> [X.Node]) -> a -> Builder
xmlNodeSplice :: forall a. (a -> [Node]) -> a -> Builder
xmlNodeSplice a -> [Node]
f = Encoding -> [Node] -> Builder
X.renderXmlFragment Encoding
X.UTF8 ([Node] -> Builder) -> (a -> [Node]) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Node]
f


------------------------------------------------------------------------------
-- | Converts a pure HTML Node splice function to a pure Builder splice
-- function.
htmlNodeSplice :: (a -> [X.Node]) -> a -> Builder
htmlNodeSplice :: forall a. (a -> [Node]) -> a -> Builder
htmlNodeSplice a -> [Node]
f = Encoding -> [Node] -> Builder
X.renderHtmlFragment Encoding
X.UTF8 ([Node] -> Builder) -> (a -> [Node]) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Node]
f


------------------------------------------------------------------------------
-- | Converts a pure Builder splice function into a monadic splice function
-- of a RuntimeSplice.
pureSplice :: Monad n => (a -> Builder) -> RuntimeSplice n a -> Splice n
pureSplice :: forall (n :: * -> *) a.
Monad n =>
(a -> Builder) -> RuntimeSplice n a -> Splice n
pureSplice a -> Builder
f RuntimeSplice n a
n = DList (Chunk n) -> HeistT n IO (DList (Chunk n))
forall a. a -> HeistT n IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DList (Chunk n) -> HeistT n IO (DList (Chunk n)))
-> DList (Chunk n) -> HeistT n IO (DList (Chunk n))
forall a b. (a -> b) -> a -> b
$ RuntimeSplice n Builder -> DList (Chunk n)
forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime (Builder -> RuntimeSplice n Builder
forall a. a -> RuntimeSplice n a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> RuntimeSplice n Builder)
-> (a -> Builder) -> a -> RuntimeSplice n Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
f (a -> RuntimeSplice n Builder)
-> RuntimeSplice n a -> RuntimeSplice n Builder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RuntimeSplice n a
n)


------------------------------------------------------------------------------
-- | Runs a splice, but first binds splices given by splice functions that
-- need some runtime data.
withSplices :: Monad n
            => Splice n
            -- ^ Splice to be run
            -> Splices (RuntimeSplice n a -> Splice n)
            -- ^ Splices to be bound first
            -> RuntimeSplice n a
            -- ^ Runtime data needed by the above splices
            -> Splice n
withSplices :: forall (n :: * -> *) a.
Monad n =>
Splice n
-> Splices (RuntimeSplice n a -> Splice n)
-> RuntimeSplice n a
-> Splice n
withSplices Splice n
splice Splices (RuntimeSplice n a -> Splice n)
splices RuntimeSplice n a
runtimeAction =
    Splices (Splice n)
-> Splices (AttrSplice n) -> Splice n -> Splice n
forall (n :: * -> *) a.
Splices (Splice n)
-> Splices (AttrSplice n) -> HeistT n IO a -> HeistT n IO a
withLocalSplices Splices (Splice n)
splices' Splices (AttrSplice n)
forall a. Monoid a => a
mempty Splice n
splice
  where
    splices' :: Splices (Splice n)
splices' = ((RuntimeSplice n a -> Splice n) -> Splice n)
-> Splices (RuntimeSplice n a -> Splice n) -> Splices (Splice n)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV ((RuntimeSplice n a -> Splice n) -> RuntimeSplice n a -> Splice n
forall a b. (a -> b) -> a -> b
$ RuntimeSplice n a
runtimeAction) Splices (RuntimeSplice n a -> Splice n)
splices


------------------------------------------------------------------------------
{-# INLINE foldMapM #-}
foldMapM :: (Monad f, Monoid m, Foldable list)
         => (a -> f m)
         -> list a
         -> f m
foldMapM :: forall (f :: * -> *) m (list :: * -> *) a.
(Monad f, Monoid m, Foldable list) =>
(a -> f m) -> list a -> f m
foldMapM a -> f m
f =
  (m -> a -> f m) -> m -> list a -> f m
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Foldable.foldlM (\m
xs a
x -> m
xs m -> f m -> f m
forall a b. a -> b -> b
`seq` (m -> m) -> f m -> f m
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (m
xs m -> m -> m
forall a. Semigroup a => a -> a -> a
<>) (a -> f m
f a
x)) m
forall a. Monoid a => a
mempty

------------------------------------------------------------------------------
-- | Like withSplices, but evaluates the splice repeatedly for each element in
-- a list generated at runtime.
manyWithSplices :: (Foldable f, Monad n)
                => Splice n
                -> Splices (RuntimeSplice n a -> Splice n)
                -> RuntimeSplice n (f a)
                -> Splice n
manyWithSplices :: forall (f :: * -> *) (n :: * -> *) a.
(Foldable f, Monad n) =>
Splice n
-> Splices (RuntimeSplice n a -> Splice n)
-> RuntimeSplice n (f a)
-> Splice n
manyWithSplices Splice n
splice Splices (RuntimeSplice n a -> Splice n)
splices RuntimeSplice n (f a)
runtimeAction =
    Splice n
-> Splices (RuntimeSplice n a -> Splice n)
-> Splices (RuntimeSplice n a -> AttrSplice n)
-> RuntimeSplice n (f a)
-> Splice n
forall (f :: * -> *) (n :: * -> *) a.
(Foldable f, Monad n) =>
Splice n
-> Splices (RuntimeSplice n a -> Splice n)
-> Splices (RuntimeSplice n a -> AttrSplice n)
-> RuntimeSplice n (f a)
-> Splice n
manyWith Splice n
splice Splices (RuntimeSplice n a -> Splice n)
splices Splices (RuntimeSplice n a -> AttrSplice n)
forall a. Monoid a => a
mempty RuntimeSplice n (f a)
runtimeAction


------------------------------------------------------------------------------
-- | More powerful version of manyWithSplices that lets you also define
-- attribute splices.
manyWith :: (Foldable f, Monad n)
         => Splice n
         -> Splices (RuntimeSplice n a -> Splice n)
         -> Splices (RuntimeSplice n a -> AttrSplice n)
         -> RuntimeSplice n (f a)
         -> Splice n
manyWith :: forall (f :: * -> *) (n :: * -> *) a.
(Foldable f, Monad n) =>
Splice n
-> Splices (RuntimeSplice n a -> Splice n)
-> Splices (RuntimeSplice n a -> AttrSplice n)
-> RuntimeSplice n (f a)
-> Splice n
manyWith Splice n
splice Splices (RuntimeSplice n a -> Splice n)
splices Splices (RuntimeSplice n a -> AttrSplice n)
attrSplices RuntimeSplice n (f a)
runtimeAction = do
    p <- HeistT n IO (Promise a)
forall (n :: * -> *) a. HeistT n IO (Promise a)
newEmptyPromise
    let splices' = ((RuntimeSplice n a -> Splice n) -> Splice n)
-> Splices (RuntimeSplice n a -> Splice n)
-> MapSyntax Text (Splice n)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV ((RuntimeSplice n a -> Splice n) -> RuntimeSplice n a -> Splice n
forall a b. (a -> b) -> a -> b
$ Promise a -> RuntimeSplice n a
forall (n :: * -> *) a. Monad n => Promise a -> RuntimeSplice n a
getPromise Promise a
p) Splices (RuntimeSplice n a -> Splice n)
splices
    let attrSplices' = ((RuntimeSplice n a -> AttrSplice n) -> AttrSplice n)
-> Splices (RuntimeSplice n a -> AttrSplice n)
-> MapSyntax Text (AttrSplice n)
forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV ((RuntimeSplice n a -> AttrSplice n)
-> RuntimeSplice n a -> AttrSplice n
forall a b. (a -> b) -> a -> b
$ Promise a -> RuntimeSplice n a
forall (n :: * -> *) a. Monad n => Promise a -> RuntimeSplice n a
getPromise Promise a
p) Splices (RuntimeSplice n a -> AttrSplice n)
attrSplices
    chunks <- withLocalSplices splices' attrSplices' splice
    return $ yieldRuntime $ do
        items <- runtimeAction
        foldMapM (\a
item -> Promise a -> a -> RuntimeSplice n ()
forall (n :: * -> *) a.
Monad n =>
Promise a -> a -> RuntimeSplice n ()
putPromise Promise a
p a
item RuntimeSplice n ()
-> RuntimeSplice n Builder -> RuntimeSplice n Builder
forall a b.
RuntimeSplice n a -> RuntimeSplice n b -> RuntimeSplice n b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DList (Chunk n) -> RuntimeSplice n Builder
forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
codeGen DList (Chunk n)
chunks) items


------------------------------------------------------------------------------
-- | Similar to 'mapSplices' in interpreted mode.  Gets a runtime list of
-- items and applies a compiled runtime splice function to each element of the
-- list.
deferMany :: (Foldable f, Monad n)
          => (RuntimeSplice n a -> Splice n)
          -> RuntimeSplice n (f a)
          -> Splice n
deferMany :: forall (f :: * -> *) (n :: * -> *) a.
(Foldable f, Monad n) =>
(RuntimeSplice n a -> Splice n)
-> RuntimeSplice n (f a) -> Splice n
deferMany RuntimeSplice n a -> Splice n
f RuntimeSplice n (f a)
getItems = do
    promise <- HeistT n IO (Promise a)
forall (n :: * -> *) a. HeistT n IO (Promise a)
newEmptyPromise
    chunks <- f $ getPromise promise
    return $ yieldRuntime $ do
        items <- getItems
        foldMapM (\a
item -> Promise a -> a -> RuntimeSplice n ()
forall (n :: * -> *) a.
Monad n =>
Promise a -> a -> RuntimeSplice n ()
putPromise Promise a
promise a
item RuntimeSplice n ()
-> RuntimeSplice n Builder -> RuntimeSplice n Builder
forall a b.
RuntimeSplice n a -> RuntimeSplice n b -> RuntimeSplice n b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DList (Chunk n) -> RuntimeSplice n Builder
forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
codeGen DList (Chunk n)
chunks) items


------------------------------------------------------------------------------
-- | Saves the results of a runtime computation in a 'Promise' so they don't
-- get recalculated if used more than once.
--
-- Note that this is just a specialized version of function application ($)
-- done for the side effect in runtime splice.
defer :: Monad n
      => (RuntimeSplice n a -> Splice n)
      -> RuntimeSplice n a -> Splice n
defer :: forall (n :: * -> *) a.
Monad n =>
(RuntimeSplice n a -> Splice n) -> RuntimeSplice n a -> Splice n
defer RuntimeSplice n a -> Splice n
pf RuntimeSplice n a
n = do
    p2 <- HeistT n IO (Promise a)
forall (n :: * -> *) a. HeistT n IO (Promise a)
newEmptyPromise
    let action = RuntimeSplice n () -> DList (Chunk n)
forall (n :: * -> *).
Monad n =>
RuntimeSplice n () -> DList (Chunk n)
yieldRuntimeEffect (RuntimeSplice n () -> DList (Chunk n))
-> RuntimeSplice n () -> DList (Chunk n)
forall a b. (a -> b) -> a -> b
$ Promise a -> a -> RuntimeSplice n ()
forall (n :: * -> *) a.
Monad n =>
Promise a -> a -> RuntimeSplice n ()
putPromise Promise a
p2 (a -> RuntimeSplice n ())
-> RuntimeSplice n a -> RuntimeSplice n ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RuntimeSplice n a
n
    res <- pf $ getPromise p2
    return $ action `mappend` res


------------------------------------------------------------------------------
-- | A version of defer which applies a function on the runtime value.
deferMap :: Monad n
         => (a -> RuntimeSplice n b)
         -> (RuntimeSplice n b -> Splice n)
         -> RuntimeSplice n a -> Splice n
deferMap :: forall (n :: * -> *) a b.
Monad n =>
(a -> RuntimeSplice n b)
-> (RuntimeSplice n b -> Splice n) -> RuntimeSplice n a -> Splice n
deferMap a -> RuntimeSplice n b
f RuntimeSplice n b -> Splice n
pf RuntimeSplice n a
n = (RuntimeSplice n b -> Splice n) -> RuntimeSplice n b -> Splice n
forall (n :: * -> *) a.
Monad n =>
(RuntimeSplice n a -> Splice n) -> RuntimeSplice n a -> Splice n
defer RuntimeSplice n b -> Splice n
pf (RuntimeSplice n b -> Splice n) -> RuntimeSplice n b -> Splice n
forall a b. (a -> b) -> a -> b
$ a -> RuntimeSplice n b
f (a -> RuntimeSplice n b) -> RuntimeSplice n a -> RuntimeSplice n b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RuntimeSplice n a
n


------------------------------------------------------------------------------
-- | Like deferMap, but only runs the result if a Maybe function of the
-- runtime value returns Just.  If it returns Nothing, then no output is
-- generated.
mayDeferMap :: Monad n
            => (a -> RuntimeSplice n (Maybe b))
            -> (RuntimeSplice n b -> Splice n)
            -> RuntimeSplice n a -> Splice n
mayDeferMap :: forall (n :: * -> *) a b.
Monad n =>
(a -> RuntimeSplice n (Maybe b))
-> (RuntimeSplice n b -> Splice n) -> RuntimeSplice n a -> Splice n
mayDeferMap a -> RuntimeSplice n (Maybe b)
f RuntimeSplice n b -> Splice n
pf RuntimeSplice n a
n = (RuntimeSplice n b -> Splice n)
-> RuntimeSplice n (Maybe b) -> Splice n
forall (f :: * -> *) (n :: * -> *) a.
(Foldable f, Monad n) =>
(RuntimeSplice n a -> Splice n)
-> RuntimeSplice n (f a) -> Splice n
deferMany RuntimeSplice n b -> Splice n
pf (RuntimeSplice n (Maybe b) -> Splice n)
-> RuntimeSplice n (Maybe b) -> Splice n
forall a b. (a -> b) -> a -> b
$ a -> RuntimeSplice n (Maybe b)
f (a -> RuntimeSplice n (Maybe b))
-> RuntimeSplice n a -> RuntimeSplice n (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RuntimeSplice n a
n


------------------------------------------------------------------------------
-- | Converts an RuntimeSplice into a Splice, given a helper function that
-- generates a Builder.
bindLater :: (Monad n)
          => (a -> RuntimeSplice n Builder)
          -> RuntimeSplice n a
          -> Splice n
bindLater :: forall (n :: * -> *) a.
Monad n =>
(a -> RuntimeSplice n Builder) -> RuntimeSplice n a -> Splice n
bindLater a -> RuntimeSplice n Builder
f RuntimeSplice n a
p = DList (Chunk n) -> HeistT n IO (DList (Chunk n))
forall a. a -> HeistT n IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DList (Chunk n) -> HeistT n IO (DList (Chunk n)))
-> DList (Chunk n) -> HeistT n IO (DList (Chunk n))
forall a b. (a -> b) -> a -> b
$ RuntimeSplice n Builder -> DList (Chunk n)
forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime (RuntimeSplice n Builder -> DList (Chunk n))
-> RuntimeSplice n Builder -> DList (Chunk n)
forall a b. (a -> b) -> a -> b
$ a -> RuntimeSplice n Builder
f (a -> RuntimeSplice n Builder)
-> RuntimeSplice n a -> RuntimeSplice n Builder
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RuntimeSplice n a
p