{-# 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 = forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> [Node]
X.childNodes forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 = forall (m :: * -> *). ByteString -> Chunk m
Pure 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 = forall a. a -> DList a
DL.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ByteString -> Chunk m
Pure 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 = forall a. a -> DList a
DL.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> DList a
DL.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> DList a
DL.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime forall b c a. (b -> c) -> (a -> b) -> a -> c
.  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 = forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> [a] -> m b
mapSplices 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
    forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
hs -> HeistState n
hs { _curMarkup :: Markup
_curMarkup = Markup
markup })
    let inDoctype :: Maybe DocType
inDoctype = Document -> Maybe DocType
X.docType forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
df
    forall (m :: * -> *) (n :: * -> *).
Monad m =>
[DocType] -> HeistT n m ()
addDoctype forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe DocType
inDoctype
    forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (forall (n :: * -> *). Maybe [Char] -> HeistState n -> HeistState n
setCurTemplateFile Maybe [Char]
curPath forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (n :: * -> *). TPath -> HeistState n -> HeistState n
setCurContext TPath
tpath)
    DList (Chunk n)
res <- forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList [Node]
nodes
    Maybe DocType
dt <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS (forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). HeistState m -> [DocType]
_doctypes)
    let enc :: Encoding
enc = Document -> Encoding
X.docEncoding forall a b. (a -> b) -> a -> b
$ DocumentFile -> Document
dfDoc DocumentFile
df
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (forall (n :: * -> *). Builder -> DList (Chunk n)
yieldPure (Encoding -> Maybe DocType -> Builder
X.renderDocType Encoding
enc Maybe DocType
dt) forall a. Monoid a => a -> a -> a
`mappend` DList (Chunk n)
res)
  where
    curPath :: Maybe [Char]
curPath     = DocumentFile -> Maybe [Char]
dfFile DocumentFile
df
    nodes :: [Node]
nodes       = Document -> [Node]
X.docContent 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
    !DList (Chunk n)
chunks <- forall (n :: * -> *). Monad n => TPath -> DocumentFile -> Splice n
runDocumentFile TPath
tpath DocumentFile
df
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Monad n => DList (Chunk n) -> [Chunk n]
consolidate DList (Chunk n)
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
    (HashMap TPath ([Chunk n], ByteString)
tmap, HeistState n
hs') <- forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT (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 :: Text
pre = forall (m :: * -> *). HeistState m -> Text
_splicePrefix HeistState n
hs'
    let canError :: Bool
canError = forall (m :: * -> *). HeistState m -> Bool
_errorNotBound HeistState n
hs'
    let errs :: [SpliceError]
errs = forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors HeistState n
hs'
    let nsErr :: Either [[Char]] ()
nsErr = if Bool -> Bool
not (Text -> Bool
T.null Text
pre) Bool -> Bool -> Bool
&& (forall (m :: * -> *). HeistState m -> Int
_numNamespacedTags HeistState n
hs' forall a. Eq a => a -> a -> Bool
== Int
0)
                  then forall a b. a -> Either a b
Left [[Char] -> [Char]
noNamespaceSplicesMsg forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
pre]
                  else forall a b. b -> Either a b
Right ()
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
canError
               then case [SpliceError]
errs of
                     [] -> Either [[Char]] ()
nsErr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                           (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! HeistState n
hs { _compiledTemplateMap :: HashMap TPath ([Chunk n], ByteString)
_compiledTemplateMap = HashMap TPath ([Chunk n], ByteString)
tmap })
                     [SpliceError]
es -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. [a] -> [a] -> [a]
(++) (forall a b. a -> b -> a
const forall a. a -> a
id) Either [[Char]] ()
nsErr forall a b. (a -> b) -> a -> b
$
                           forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpliceError -> Text
spliceErrorText) [SpliceError]
es
               else Either [[Char]] ()
nsErr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! HeistState n
hs { _compiledTemplateMap :: HashMap TPath ([Chunk n], ByteString)
_compiledTemplateMap = HashMap TPath ([Chunk n], ByteString)
tmap
                                          , _spliceErrors :: [SpliceError]
_spliceErrors = [SpliceError]
errs
                                          })


------------------------------------------------------------------------------
noNamespaceSplicesMsg :: String -> String
noNamespaceSplicesMsg :: [Char] -> [Char]
noNamespaceSplicesMsg [Char]
pre = [[Char]] -> [Char]
unwords
    [ forall r. PrintfType r => [Char] -> r
printf [Char]
"You are using a namespace of '%s', but you don't have any" [Char]
ns
    , 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 = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ 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
    HeistState n
hs <- forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
    let tpathDocfiles :: [(TPath, DocumentFile)]
        tpathDocfiles :: [(TPath, DocumentFile)]
tpathDocfiles = forall a. (a -> Bool) -> [a] -> [a]
filter (TPath -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
                            (forall k v. HashMap k v -> [(k, v)]
H.toList forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap HeistState n
hs)
    forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {m :: * -> *}.
Monad m =>
HashMap TPath ([Chunk m], ByteString)
-> (TPath, DocumentFile)
-> HeistT m IO (HashMap TPath ([Chunk m], ByteString))
runOne forall k v. HashMap k v
H.empty [(TPath, DocumentFile)]
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
        forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState m
hs -> HeistState m
hs { _doctypes :: [DocType]
_doctypes = []})
        ![Chunk m]
mHtml <- forall (n :: * -> *).
Monad n =>
TPath -> DocumentFile -> HeistT n IO [Chunk n]
compileTemplate TPath
tpath DocumentFile
df
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert TPath
tpath ([Chunk m]
mHtml, Document -> ByteString
mimeType forall a b. (a -> b) -> a -> b
$! DocumentFile -> Document
dfDoc DocumentFile
df) HashMap TPath ([Chunk m], ByteString)
tmap


------------------------------------------------------------------------------
-- | Consolidate consecutive Pure Chunks.
consolidate :: (Monad n) => DList (Chunk n) -> [Chunk n]
consolidate :: forall (n :: * -> *). Monad n => DList (Chunk n) -> [Chunk n]
consolidate = forall {m :: * -> *}. Monad m => [Chunk m] -> [Chunk m]
consolidateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DList a -> [a]
DL.toList
  where
    consolidateL :: [Chunk m] -> [Chunk m]
consolidateL []     = []
    consolidateL (Chunk m
y:[Chunk m]
ys) = forall {m :: * -> *}. [Chunk m] -> [Chunk m] -> [Chunk m]
boilDown [] forall a b. (a -> b) -> a -> b
$! 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 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 (forall (m :: * -> *). ByteString -> Chunk m
Pure forall a b. (a -> b) -> a -> b
$! ByteString
a 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 (forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml forall a b. (a -> b) -> a -> b
$! RuntimeSplice m Builder
a 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 (forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml forall a b. (a -> b) -> a -> b
$! RuntimeSplice m Builder
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Builder
x -> RuntimeSplice m ()
b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 (forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml forall a b. (a -> b) -> a -> b
$! RuntimeSplice m ()
a 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 (forall (m :: * -> *). RuntimeSplice m () -> Chunk m
RuntimeAction forall a b. (a -> b) -> a -> b
$! RuntimeSplice m ()
a 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 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 ((forall (m :: * -> *). ByteString -> Chunk m
Pure forall a b. (a -> b) -> a -> b
$! ByteString
h) 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 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 = forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$!
            forall a b. (a -> b) -> Vector a -> Vector b
V.map forall {m :: * -> *}. Monad m => Chunk m -> RuntimeSplice m Builder
toAct forall a b. (a -> b) -> a -> b
$! forall a. [a] -> Vector a
V.fromList forall a b. (a -> b) -> a -> b
$! 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)          = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ByteString -> Builder
fromByteString ByteString
h
    toAct !(RuntimeAction !RuntimeSplice m ()
m) = RuntimeSplice m ()
m forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return 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
    Text
pre <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS forall (m :: * -> *). HeistState m -> Text
_splicePrefix
    Maybe (Splice n)
res <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
nm forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap)
    if forall a. Maybe a -> Bool
isNothing Maybe (Splice n)
res Bool -> Bool -> Bool
&& Text -> Text -> Bool
T.isPrefixOf Text
pre Text
nm Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
pre)
      then do
          forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m ()
tellSpliceError forall a b. (a -> b) -> a -> b
$ Text
"No splice bound for " forall a. Monoid a => a -> a -> a
`mappend` Text
nm
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      else forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Splice n)
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 = forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode (forall a b. a -> b -> a
const Node
node) forall a b. (a -> b) -> a -> b
$ do
    HeistState n
hs <- forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
    let pre :: Text
pre = forall (m :: * -> *). HeistState m -> Text
_splicePrefix HeistState n
hs
    let hasPrefix :: Bool
hasPrefix = (Text -> Text -> Bool
T.isPrefixOf Text
pre forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Node -> Maybe Text
X.tagName Node
node) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Text -> Bool
T.null Text
pre) Bool -> Bool -> Bool
&& Bool
hasPrefix) forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m ()
incNamespacedTags
    HeistState n
hs' <- forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
    -- Plain rethrows for CompileException to avoid multiple annotations.
    (DList (Chunk n)
res, HeistState n
hs'') <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> [Handler a] -> IO a
catches (forall {n :: * -> *}.
Monad n =>
HeistState n -> IO (DList (Chunk n), HeistState n)
compileIO HeistState n
hs')
                     [ forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\(CompileException
ex :: CompileException) -> forall e a. Exception e => e -> IO a
throwIO CompileException
ex)
                     , forall a e. Exception e => (e -> IO a) -> Handler a
Handler (\(SomeException
ex :: SomeException) -> forall {e} {n :: * -> *} {b}.
Exception e =>
e -> HeistState n -> IO b
handleError SomeException
ex HeistState n
hs')]
    forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
putHS HeistState n
hs''
    forall (m :: * -> *) a. Monad m => a -> m a
return DList (Chunk n)
res
  where
    localSplicePath :: HeistT m m a -> HeistT m m a
localSplicePath =
        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 :: [(TPath, Maybe [Char], Text)]
_splicePath = (forall (m :: * -> *). HeistState m -> TPath
_curContext HeistState m
hs,
                                           forall (m :: * -> *). HeistState m -> Maybe [Char]
_curTemplateFile HeistState m
hs,
                                           Node -> Text
X.elementTag Node
node)forall a. a -> [a] -> [a]
:
                                          (forall (m :: * -> *). HeistState m -> [(TPath, Maybe [Char], Text)]
_splicePath HeistState m
hs)})
    compileIO :: HeistState n -> IO (DList (Chunk n), HeistState n)
compileIO HeistState n
hs = forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT forall (n :: * -> *). Monad n => Splice n
compile Node
node HeistState n
hs
    compile :: HeistT n IO (DList (Chunk n))
compile = do
        Bool
isStatic <- forall (n :: * -> *). Node -> HeistT n IO Bool
subtreeIsStatic Node
node
        DList (Chunk n)
dl <- forall {n :: * -> *}.
Monad n =>
Bool -> HeistT n IO (DList (Chunk n))
compile' Bool
isStatic
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. [a] -> DList a
DL.fromList forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Monad n => DList (Chunk n) -> [Chunk n]
consolidate DList (Chunk n)
dl
    compile' :: Bool -> HeistT n IO (DList (Chunk n))
compile' Bool
True = do
        Markup
markup <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS forall (m :: * -> *). HeistState m -> Markup
_curMarkup
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Builder -> DList (Chunk n)
yieldPure forall a b. (a -> b) -> a -> b
$! Markup -> [Node] -> Builder
renderFragment Markup
markup [Node -> Node
parseAttrs Node
node]
    compile' Bool
False = forall {m :: * -> *} {m :: * -> *} {a}.
Monad m =>
HeistT m m a -> HeistT m m a
localSplicePath forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *). Monad n => Node -> Splice n
compileNode Node
node
    handleError :: e -> HeistState n -> IO b
handleError e
ex HeistState n
hs = do
        [SpliceError]
errs <- forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
HeistT n m a -> Node -> HeistState n -> m a
evalHeistT (do forall {m :: * -> *} {m :: * -> *} {a}.
Monad m =>
HeistT m m a -> HeistT m m a
localSplicePath forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (n :: * -> *).
Monad m =>
Text -> HeistT n m ()
tellSpliceError forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$
                                 [Char]
"Exception in splice compile: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show e
ex
                               forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors) Node
node HeistState n
hs
        forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> [SpliceError] -> CompileException
CompileException e
ex [SpliceError]
errs


parseAttrs :: X.Node -> X.Node
parseAttrs :: Node -> Node
parseAttrs (X.Element Text
nm [(Text, Text)]
attrs [Node]
ch) = [(Text, Text)]
newAttrs seq :: 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 = 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 forall a b. (a -> b) -> a -> b
$! forall a b. (a -> b) -> [a] -> [b]
map AttAST -> Text
cvt [AttAST]
ast)
  where
    !ast :: [AttAST]
ast = case forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (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
    Bool
isNodeDynamic <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
nm
    HashMap Text (AttrSplice n)
attrSplices <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap
    let hasSubstitutions :: (Text, Text) -> Bool
hasSubstitutions (Text
k,Text
v) = Text -> Bool
hasAttributeSubstitutions Text
v Bool -> Bool -> Bool
||
                                 forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
H.member Text
k HashMap Text (AttrSplice n)
attrSplices
    if Bool
isNodeDynamic
      then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      else do
          let hasDynamicAttrs :: Bool
hasDynamicAttrs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text, Text) -> Bool
hasSubstitutions [(Text, Text)]
attrs
          if Bool
hasDynamicAttrs
            then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else do
                [Bool]
staticSubtrees <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (n :: * -> *). Node -> HeistT n IO Bool
subtreeIsStatic [Node]
ch
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool]
staticSubtrees

subtreeIsStatic Node
_ = 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any AttAST -> Bool
isIdent [AttAST]
ast
  where
    ast :: [AttAST]
ast = case forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (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
    Maybe (Splice n)
msplice <- forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
nm
    forall a. a -> Maybe a -> a
fromMaybe forall (n :: * -> *). Monad n => Splice n
compileStaticElement Maybe (Splice n)
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
        [DList (Chunk n)]
compiledAttrs <- forall (n :: * -> *).
Monad n =>
[(Text, Text)] -> HeistT n IO [DList (Chunk n)]
runAttributes [(Text, Text)]
attrs

        DList (Chunk n)
childHtml <- forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList [Node]
ch

        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! if forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. DList a -> [a]
DL.toList DList (Chunk n)
childHtml) Bool -> Bool -> Bool
&& Text
nm forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`S.member` HashSet Text
X.voidTags
          then forall a. [DList a] -> DList a
DL.concat [ forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Text -> Chunk n
pureTextChunk forall a b. (a -> b) -> a -> b
$! Text
tag0
                         , forall a. [DList a] -> DList a
DL.concat [DList (Chunk n)]
compiledAttrs
                         , forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Text -> Chunk n
pureTextChunk Text
" />"
                         ]
          else forall a. [DList a] -> DList a
DL.concat [ forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Text -> Chunk n
pureTextChunk forall a b. (a -> b) -> a -> b
$! Text
tag0
                         , forall a. [DList a] -> DList a
DL.concat [DList (Chunk n)]
compiledAttrs
                         , forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Text -> Chunk n
pureTextChunk Text
">"
                         , DList (Chunk n)
childHtml
                         , forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Text -> Chunk n
pureTextChunk forall a b. (a -> b) -> a -> b
$! Text
end
                         ]
compileNode Node
_ = 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
    Maybe (AttrSplice n)
mas <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap)
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {n :: * -> *}. HeistT n IO (DList (Chunk n))
doInline (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *}.
Monad m =>
(Text -> RuntimeSplice m [(Text, Text)]) -> DList (Chunk m)
doAttrSplice) Maybe (AttrSplice n)
mas

  where
    cvt :: AttAST -> HeistT n IO (DList (Chunk n))
cvt (Literal Text
x) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *). Text -> DList (Chunk n)
yieldPureText Text
x
    cvt (Ident Text
x) =
        forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
x [] []) forall a b. (a -> b) -> a -> b
$ 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 forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (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]
_ ) -> []
        [DList (Chunk n)]
chunks <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {n :: * -> *}. AttAST -> HeistT n IO (DList (Chunk n))
cvt [AttAST]
ast
        let value :: DList (Chunk n)
value = forall a. [DList a] -> DList a
DL.concat [DList (Chunk n)]
chunks
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *). Text -> DList (Chunk n) -> DList (Chunk n)
attrToChunk Text
k DList (Chunk n)
value

    -- Handles attribute splices
    doAttrSplice :: (Text -> RuntimeSplice m [(Text, Text)]) -> DList (Chunk m)
doAttrSplice Text -> RuntimeSplice m [(Text, Text)]
splice = forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). RuntimeSplice m Builder -> Chunk m
RuntimeHtml forall a b. (a -> b) -> a -> b
$ do
        [(Text, Text)]
res <- Text -> RuntimeSplice m [(Text, Text)]
splice Text
v
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Builder
attrToBuilder [(Text, Text)]
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
    Maybe (AttrSplice n)
mas <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap)
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {n :: * -> *}.
Monad n =>
HeistT n IO (RuntimeSplice n [(Text, Text)])
doInline (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t}. (Text -> t) -> t
doAttrSplice) Maybe (AttrSplice n)
mas

  where
    cvt :: AttAST -> HeistT n IO (RuntimeSplice n Text)
cvt (Literal Text
x) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
    cvt (Ident Text
x) =
        forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> [Node] -> Node
X.Element Text
x [] []) forall a b. (a -> b) -> a -> b
$ 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 forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (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]
_ ) -> []
        [RuntimeSplice n Text]
chunks <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {n :: * -> *}.
Monad n =>
AttAST -> HeistT n IO (RuntimeSplice n Text)
cvt [AttAST]
ast
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
            [Text]
list <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [RuntimeSplice n Text]
chunks
            forall (m :: * -> *) a. Monad m => a -> m a
return [(Text
k, [Text] -> Text
T.concat [Text]
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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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
    [RuntimeSplice n [(Text, Text)]]
arrs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (n :: * -> *).
Monad n =>
(Text, Text) -> HeistT n IO (RuntimeSplice n [(Text, Text)])
parseAtt2 [(Text, Text)]
attrs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [RuntimeSplice n [(Text, Text)]]
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
    forall a. [DList a] -> DList a
DL.concat
        [ forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$! forall (n :: * -> *). Text -> Chunk n
pureTextChunk forall a b. (a -> b) -> a -> b
$! [Text] -> Text
T.concat [Text
" ", Text
k, Text
"=\""]
        , DList (Chunk n)
v, forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$! 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  = forall a. Monoid a => [a] -> a
mconcat
    [ Text -> Builder
fromText Text
" "
    , Text -> Builder
fromText Text
k
    ]
  | Bool
otherwise = 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 =
    forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
name forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> Maybe a -> a
fromMaybe
      (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> DList a
DL.singleton forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). ByteString -> Chunk m
Pure forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 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
    Maybe (Splice n)
mSplice <- forall (n :: * -> *). Text -> HeistT n IO (Maybe (Splice n))
lookupSplice Text
name
    case Maybe (Splice n)
mSplice of
      Maybe (Splice n)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [Text
"${", Text
name, Text
"}"]
      Just Splice n
splice -> do
        DList (Chunk n)
res <- Splice n
splice
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toByteString) forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
codeGen DList (Chunk n)
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
    Maybe a
mb <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. Key a -> HeterogeneousEnvironment -> Maybe a
HE.lookup Key a
k)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
e Maybe a
mb

  where
    e :: a
e = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"getPromise: dereferenced empty key (id "
                forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Key a -> Int
HE.getKeyId Key a
k) 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (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
keygen <- forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS forall (m :: * -> *). HeistState m -> KeyGen
_keygen
    Key a
key    <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. KeyGen -> IO (Key a)
HE.makeKey KeyGen
keygen
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Key a -> Promise a
Promise Key a
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 :: HashMap Text (Splice n)
_compiledSpliceMap = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
n' Splice n
v (forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap HeistState n
ts) }
  where
    n' :: Text
n' = forall (m :: * -> *). HeistState m -> Text
_splicePrefix HeistState n
ts 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 :: HashMap Text (Splice n)
_compiledSpliceMap = forall (n :: * -> *) v a.
HeistState n
-> (HeistState n -> HashMap Text v)
-> MapSyntaxM Text v a
-> HashMap Text v
applySpliceMap HeistState n
hs forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap Splices (Splice n)
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 = forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
localHS (forall (n :: * -> *).
Splices (Splice n) -> HeistState n -> HeistState n
bindSplices Splices (Splice n)
ss forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall (n :: * -> *). Monad n => DList (Chunk n) -> n Builder
interpret forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> DList a
DL.fromList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$!
      forall (n :: * -> *) t.
ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
lookupTemplate ByteString
nm HeistState n
hs 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
    HeistState n
hs <- forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => [Char] -> a
error [Char]
err) forall {m :: * -> *} {b}.
Monad m =>
(DocumentFile, b) -> HeistT m IO (DList (Chunk m))
call forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *) t.
ByteString
-> HeistState n
-> (HeistState n -> HashMap TPath t)
-> Maybe (t, TPath)
lookupTemplate ByteString
nm HeistState n
hs forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap
  where
    err :: [Char]
err = [Char]
"callTemplate: "forall a. [a] -> [a] -> [a]
++(Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
nm)forall a. [a] -> [a] -> [a]
++([Char]
" does not exist")
    call :: (DocumentFile, b) -> HeistT m IO (DList (Chunk m))
call (DocumentFile
df,b
_) = 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 :: Maybe [Char]
_curTemplateFile = DocumentFile -> Maybe [Char]
dfFile DocumentFile
df}) forall a b. (a -> b) -> a -> b
$
                    forall (n :: * -> *). Monad n => [Node] -> Splice n
runNodeList forall a b. (a -> b) -> a -> b
$ Document -> [Node]
X.docContent 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HeterogeneousEnvironment
HE.empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
RuntimeSplice m a -> StateT HeterogeneousEnvironment m a
unRT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 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 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 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
f 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 =
    forall (n :: * -> *) a.
Splices (Splice n)
-> Splices (AttrSplice n) -> HeistT n IO a -> HeistT n IO a
withLocalSplices MapSyntax Text (Splice n)
splices' forall a. Monoid a => a
mempty Splice n
splice
  where
    splices' :: MapSyntax Text (Splice n)
splices' = forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV (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 =
  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 seq :: forall a b. a -> b -> b
`seq` forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (m
xs forall a. Semigroup a => a -> a -> a
<>) (a -> f m
f a
x)) 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 =
    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 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
    Promise a
p <- forall (n :: * -> *) a. HeistT n IO (Promise a)
newEmptyPromise
    let splices' :: MapSyntax Text (Splice n)
splices' = forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV (forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *) a. Monad n => Promise a -> RuntimeSplice n a
getPromise Promise a
p) Splices (RuntimeSplice n a -> Splice n)
splices
    let attrSplices' :: MapSyntax Text (AttrSplice n)
attrSplices' = forall v1 v2 k a. (v1 -> v2) -> MapSyntaxM k v1 a -> MapSyntax k v2
mapV (forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *) a. Monad n => Promise a -> RuntimeSplice n a
getPromise Promise a
p) Splices (RuntimeSplice n a -> AttrSplice n)
attrSplices
    DList (Chunk n)
chunks <- forall (n :: * -> *) a.
Splices (Splice n)
-> Splices (AttrSplice n) -> HeistT n IO a -> HeistT n IO a
withLocalSplices MapSyntax Text (Splice n)
splices' MapSyntax Text (AttrSplice n)
attrSplices' Splice n
splice
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime forall a b. (a -> b) -> a -> b
$ do
        f a
items <- RuntimeSplice n (f a)
runtimeAction
        forall (f :: * -> *) m (list :: * -> *) a.
(Monad f, Monoid m, Foldable list) =>
(a -> f m) -> list a -> f m
foldMapM (\a
item -> forall (n :: * -> *) a.
Monad n =>
Promise a -> a -> RuntimeSplice n ()
putPromise Promise a
p a
item forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
codeGen DList (Chunk n)
chunks) f a
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 a
promise <- forall (n :: * -> *) a. HeistT n IO (Promise a)
newEmptyPromise
    DList (Chunk n)
chunks <- RuntimeSplice n a -> Splice n
f forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *) a. Monad n => Promise a -> RuntimeSplice n a
getPromise Promise a
promise
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime forall a b. (a -> b) -> a -> b
$ do
        f a
items <- RuntimeSplice n (f a)
getItems
        forall (f :: * -> *) m (list :: * -> *) a.
(Monad f, Monoid m, Foldable list) =>
(a -> f m) -> list a -> f m
foldMapM (\a
item -> forall (n :: * -> *) a.
Monad n =>
Promise a -> a -> RuntimeSplice n ()
putPromise Promise a
promise a
item forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (n :: * -> *).
Monad n =>
DList (Chunk n) -> RuntimeSplice n Builder
codeGen DList (Chunk n)
chunks) f a
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
    Promise a
p2 <- forall (n :: * -> *) a. HeistT n IO (Promise a)
newEmptyPromise
    let action :: DList (Chunk n)
action = forall (n :: * -> *).
Monad n =>
RuntimeSplice n () -> DList (Chunk n)
yieldRuntimeEffect forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *) a.
Monad n =>
Promise a -> a -> RuntimeSplice n ()
putPromise Promise a
p2 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RuntimeSplice n a
n
    DList (Chunk n)
res <- RuntimeSplice n a -> Splice n
pf forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *) a. Monad n => Promise a -> RuntimeSplice n a
getPromise Promise a
p2
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ DList (Chunk n)
action forall a. Monoid a => a -> a -> a
`mappend` DList (Chunk n)
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 = forall (n :: * -> *) a.
Monad n =>
(RuntimeSplice n a -> Splice n) -> RuntimeSplice n a -> Splice n
defer RuntimeSplice n b -> Splice n
pf forall a b. (a -> b) -> a -> b
$ a -> RuntimeSplice n b
f 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 = 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 forall a b. (a -> b) -> a -> b
$ a -> RuntimeSplice n (Maybe b)
f 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: * -> *). RuntimeSplice n Builder -> DList (Chunk n)
yieldRuntime forall a b. (a -> b) -> a -> b
$ a -> RuntimeSplice n Builder
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RuntimeSplice n a
p