{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}

{-|

This module contains the core Heist data types.

Edward Kmett wrote most of the HeistT monad code and associated instances,
liberating us from the unused writer portion of RWST.

-}

module Heist.Internal.Types.HeistState where

------------------------------------------------------------------------------
import           Blaze.ByteString.Builder      (Builder)
import           Control.Applicative           (Alternative (..))
import           Control.Arrow                 (first)
import           Control.Exception             (Exception)
import           Control.Monad                 (MonadPlus (..), ap)
import           Control.Monad.Base
import           Control.Monad.Cont            (MonadCont (..))
#if MIN_VERSION_mtl(2,2,1)
import           Control.Monad.Except          (MonadError (..))
#else
import           Control.Monad.Error           (MonadError (..))
#endif
#if MIN_VERSION_base(4,9,0)
import qualified Control.Monad.Fail as Fail
#endif
import           Control.Monad.Fix             (MonadFix (..))
import           Control.Monad.Reader          (MonadReader (..))
import           Control.Monad.State.Strict    (MonadState (..), StateT)
import           Control.Monad.Trans           (MonadIO (..), MonadTrans (..))
import           Control.Monad.Trans.Control
import           Data.ByteString.Char8         (ByteString)
import           Data.DList                    (DList)
import           Data.HashMap.Strict           (HashMap)
import qualified Data.HashMap.Strict           as H
import           Data.HeterogeneousEnvironment (HeterogeneousEnvironment)
import qualified Data.HeterogeneousEnvironment as HE
import           Data.Map.Syntax
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup
#endif
import           Data.Text                     (Text)
import qualified Data.Text                     as T
import           Data.Text.Encoding            (decodeUtf8)
#if MIN_VERSION_base (4,7,0)
import           Data.Typeable                 (Typeable)
#else
import           Data.Typeable                 (TyCon, Typeable(..),
                                                Typeable1(..), mkTyCon,
                                                mkTyConApp)
#endif

#if !MIN_VERSION_base(4,8,0)
import           Control.Applicative           (Applicative (..), (<$>))
import           Data.Monoid                   (Monoid(..))
#endif

import qualified Text.XmlHtml                  as X
------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | Convenient type alies for splices.
type Splices s = MapSyntax Text s


------------------------------------------------------------------------------
-- | A 'Template' is a forest of XML nodes.  Here we deviate from the \"single
-- root node\" constraint of well-formed XML because we want to allow
-- templates to contain document fragments that may not have a single root.
type Template = [X.Node]


------------------------------------------------------------------------------
-- | MIME Type.  The type alias is here to make the API clearer.
type MIMEType = ByteString


------------------------------------------------------------------------------
-- | Reversed list of directories.  This holds the path to the template
-- currently being processed.
type TPath = [ByteString]


------------------------------------------------------------------------------
-- | Holds data about templates read from disk.
data DocumentFile = DocumentFile
    { DocumentFile -> Document
dfDoc  :: X.Document
    , DocumentFile -> Maybe [Char]
dfFile :: Maybe FilePath
    } deriving ( DocumentFile -> DocumentFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentFile -> DocumentFile -> Bool
$c/= :: DocumentFile -> DocumentFile -> Bool
== :: DocumentFile -> DocumentFile -> Bool
$c== :: DocumentFile -> DocumentFile -> Bool
Eq, Int -> DocumentFile -> ShowS
[DocumentFile] -> ShowS
DocumentFile -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DocumentFile] -> ShowS
$cshowList :: [DocumentFile] -> ShowS
show :: DocumentFile -> [Char]
$cshow :: DocumentFile -> [Char]
showsPrec :: Int -> DocumentFile -> ShowS
$cshowsPrec :: Int -> DocumentFile -> ShowS
Show
#if MIN_VERSION_base(4,7,0)
               , Typeable
#endif
               )


------------------------------------------------------------------------------
-- | Designates whether a document should be treated as XML or HTML.
data Markup = Xml | Html


------------------------------------------------------------------------------
-- | Monad used for runtime splice execution.
newtype RuntimeSplice m a = RuntimeSplice {
      forall (m :: * -> *) a.
RuntimeSplice m a -> StateT HeterogeneousEnvironment m a
unRT :: StateT HeterogeneousEnvironment m a
    } deriving ( forall a. a -> RuntimeSplice m a
forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m a
forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
forall a b.
RuntimeSplice m (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
forall a b c.
(a -> b -> c)
-> RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m c
forall {m :: * -> *}. Monad m => Functor (RuntimeSplice m)
forall (m :: * -> *) a. Monad m => a -> RuntimeSplice m a
forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m a
forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m a
*> :: forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
liftA2 :: forall a b c.
(a -> b -> c)
-> RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m c
<*> :: forall a b.
RuntimeSplice m (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
pure :: forall a. a -> RuntimeSplice m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> RuntimeSplice m a
Applicative
               , forall a b. a -> RuntimeSplice m b -> RuntimeSplice m a
forall a b. (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
forall (m :: * -> *) a b.
Functor m =>
a -> RuntimeSplice m b -> RuntimeSplice m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RuntimeSplice m b -> RuntimeSplice m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> RuntimeSplice m b -> RuntimeSplice m a
fmap :: forall a b. (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
Functor
               , forall a. a -> RuntimeSplice m a
forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
forall a b.
RuntimeSplice m a -> (a -> RuntimeSplice m b) -> RuntimeSplice m b
forall (m :: * -> *). Monad m => Applicative (RuntimeSplice m)
forall (m :: * -> *) a. Monad m => a -> RuntimeSplice m a
forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m a -> (a -> RuntimeSplice m b) -> RuntimeSplice m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> RuntimeSplice m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> RuntimeSplice m a
>> :: forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
>>= :: forall a b.
RuntimeSplice m a -> (a -> RuntimeSplice m b) -> RuntimeSplice m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
RuntimeSplice m a -> (a -> RuntimeSplice m b) -> RuntimeSplice m b
Monad
               , forall a. IO a -> RuntimeSplice m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (RuntimeSplice m)
forall (m :: * -> *) a. MonadIO m => IO a -> RuntimeSplice m a
liftIO :: forall a. IO a -> RuntimeSplice m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> RuntimeSplice m a
MonadIO
               , MonadState HeterogeneousEnvironment
               , forall (m :: * -> *) a. Monad m => m a -> RuntimeSplice m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> RuntimeSplice m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> RuntimeSplice m a
MonadTrans
#if MIN_VERSION_base(4,7,0)
               , Typeable
#endif
               )


------------------------------------------------------------------------------
instance (Monad m, Semigroup a) => Semigroup (RuntimeSplice m a) where
    RuntimeSplice m a
a <> :: RuntimeSplice m a -> RuntimeSplice m a -> RuntimeSplice m a
<> RuntimeSplice m a
b = do
        !a
x <- RuntimeSplice m a
a
        !a
y <- RuntimeSplice m a
b
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a
x forall a. Semigroup a => a -> a -> a
<> a
y


#if !MIN_VERSION_base(4,11,0)
instance (Monad m, Semigroup a, Monoid a) => Monoid (RuntimeSplice m a) where
#else
instance (Monad m, Monoid a) => Monoid (RuntimeSplice m a) where
#endif
    mempty :: RuntimeSplice m a
mempty = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
#if !MIN_VERSION_base(4,11,0)
    mappend = (<>)
#endif


------------------------------------------------------------------------------
-- | Opaque type representing pieces of output from compiled splices.
data Chunk m = Pure !ByteString
               -- ^ output known at load time
             | RuntimeHtml !(RuntimeSplice m Builder)
               -- ^ output computed at run time
             | RuntimeAction !(RuntimeSplice m ())
               -- ^ runtime action used only for its side-effect
#if MIN_VERSION_base(4,7,0)
             deriving Typeable
#endif

instance Show (Chunk m) where
    show :: Chunk m -> [Char]
show (Pure ByteString
_) = [Char]
"Pure"
    show (RuntimeHtml RuntimeSplice m Builder
_) = [Char]
"RuntimeHtml"
    show (RuntimeAction RuntimeSplice m ()
_) = [Char]
"RuntimeAction"


showChunk :: Chunk m -> String
showChunk :: forall (m :: * -> *). Chunk m -> [Char]
showChunk (Pure ByteString
b) = Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
b
showChunk (RuntimeHtml RuntimeSplice m Builder
_) = [Char]
"RuntimeHtml"
showChunk (RuntimeAction RuntimeSplice m ()
_) = [Char]
"RuntimeAction"


isPureChunk :: Chunk m -> Bool
isPureChunk :: forall (m :: * -> *). Chunk m -> Bool
isPureChunk (Pure ByteString
_) = Bool
True
isPureChunk Chunk m
_ = Bool
False


------------------------------------------------------------------------------
-- | Type alias for attribute splices.  The function parameter is the value of
-- the bound attribute splice.  The return value is a list of attribute
-- key/value pairs that get substituted in the place of the bound attribute.
type AttrSplice m = Text -> RuntimeSplice m [(Text, Text)]


------------------------------------------------------------------------------
-- | Detailed information about a splice error.
data SpliceError = SpliceError
    { SpliceError -> [(TPath, Maybe [Char], Text)]
spliceHistory      :: [(TPath, Maybe FilePath, Text)]
    , SpliceError -> Maybe [Char]
spliceTemplateFile :: Maybe FilePath
    , SpliceError -> [Text]
visibleSplices     :: [Text]
    , SpliceError -> Node
contextNode        :: X.Node
    , SpliceError -> Text
spliceMsg          :: Text
    } deriving ( Int -> SpliceError -> ShowS
[SpliceError] -> ShowS
SpliceError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SpliceError] -> ShowS
$cshowList :: [SpliceError] -> ShowS
show :: SpliceError -> [Char]
$cshow :: SpliceError -> [Char]
showsPrec :: Int -> SpliceError -> ShowS
$cshowsPrec :: Int -> SpliceError -> ShowS
Show, SpliceError -> SpliceError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpliceError -> SpliceError -> Bool
$c/= :: SpliceError -> SpliceError -> Bool
== :: SpliceError -> SpliceError -> Bool
$c== :: SpliceError -> SpliceError -> Bool
Eq )


------------------------------------------------------------------------------
-- | Transform a SpliceError record to a Text message.
spliceErrorText :: SpliceError -> Text
spliceErrorText :: SpliceError -> Text
spliceErrorText (SpliceError [(TPath, Maybe [Char], Text)]
hist Maybe [Char]
tf [Text]
splices Node
node Text
msg) =
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((forall a. Monoid a => a -> a -> a
`mappend` Text
": ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) Maybe [Char]
tf) Text -> Text -> Text
`T.append` Text
msg Text -> Text -> Text
`T.append`
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(TPath
_, Maybe [Char]
tf', Text
tag) -> ((Text
"\n   ... via " Text -> Text -> Text
`T.append`
                               (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((forall a. Monoid a => a -> a -> a
`mappend` Text
": ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack) Maybe [Char]
tf')
                               Text -> Text -> Text
`T.append` Text
tag) Text -> Text -> Text
`T.append`)) Text
T.empty [(TPath, Maybe [Char], Text)]
hist
    Text -> Text -> Text
`T.append`
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
splices
      then Text
T.empty
      else Text
"\nBound splices:" Text -> Text -> Text
`T.append`
         forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Text
x Text
y -> Text
x Text -> Text -> Text
`T.append` Text
" " Text -> Text -> Text
`T.append` Text
y) Text
T.empty [Text]
splices
    Text -> Text -> Text
`T.append`
    ([Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ [Char]
"\nNode: " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> [Char]
show Node
node))


------------------------------------------------------------------------------
-- | Exception type for splice compile errors.  Wraps the original
-- exception and provides context.
--data (Exception e) => CompileException e = CompileException
data CompileException = forall e . Exception e => CompileException
    { ()
originalException :: e
    -- The list of splice errors.  The head of it has the context
    -- related to the exception.
    , CompileException -> [SpliceError]
exceptionContext :: [SpliceError]
    } deriving ( Typeable )


instance Show CompileException where
    show :: CompileException -> [Char]
show (CompileException e
e []) =
      [Char]
"Heist load exception (unknown context): " forall a. [a] -> [a] -> [a]
++ (forall a. Show a => a -> [Char]
show e
e)
    show (CompileException e
_ (SpliceError
c:[SpliceError]
_)) = (Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ SpliceError -> Text
spliceErrorText SpliceError
c)


instance Exception CompileException


------------------------------------------------------------------------------
-- | Holds all the state information needed for template processing.  You will
-- build a @HeistState@ using 'initHeist' and any of Heist's @HeistState ->
-- HeistState@ \"filter\" functions.  Then you use the resulting @HeistState@
-- in calls to 'renderTemplate'.
--
-- m is the runtime monad
data HeistState m = HeistState {
    -- | A mapping of splice names to splice actions
      forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m m Template)
_spliceMap           :: HashMap Text (HeistT m m Template)
    -- | A mapping of template names to templates
    , forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap         :: HashMap TPath DocumentFile

    -- | A mapping of splice names to splice actions
    , forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap   :: HashMap Text (HeistT m IO (DList (Chunk m)))
    -- | A mapping of template names to templates
    --, _compiledTemplateMap :: HashMap TPath (m Builder, MIMEType)
    , forall (m :: * -> *).
HeistState m -> HashMap TPath ([Chunk m], ByteString)
_compiledTemplateMap :: !(HashMap TPath ([Chunk m], MIMEType))

    , forall (m :: * -> *). HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap       :: HashMap Text (AttrSplice m)

    -- | A flag to control splice recursion
    , forall (m :: * -> *). HeistState m -> Bool
_recurse             :: Bool
    -- | The path to the template currently being processed.
    , forall (m :: * -> *). HeistState m -> TPath
_curContext          :: TPath
    -- | Stack of the splices used.
    , forall (m :: * -> *). HeistState m -> [(TPath, Maybe [Char], Text)]
_splicePath          :: [(TPath, Maybe FilePath, Text)]
    -- | A counter keeping track of the current recursion depth to prevent
    -- infinite loops.
    , forall (m :: * -> *). HeistState m -> Int
_recursionDepth      :: Int
    -- | The doctypes encountered during template processing.
    , forall (m :: * -> *). HeistState m -> [DocType]
_doctypes            :: [X.DocType]
    -- | The full path to the current template's file on disk.
    , forall (m :: * -> *). HeistState m -> Maybe [Char]
_curTemplateFile     :: Maybe FilePath
    -- | A key generator used to produce new unique Promises.
    , forall (m :: * -> *). HeistState m -> KeyGen
_keygen              :: HE.KeyGen

    -- | Flag indicating whether we're in preprocessing mode.  During
    -- preprocessing, errors should stop execution and be reported.  During
    -- template rendering, it's better to skip the errors and render the page.
    , forall (m :: * -> *). HeistState m -> Bool
_preprocessingMode   :: Bool

    -- | This is needed because compiled templates are generated with a bunch
    -- of calls to renderFragment rather than a single call to render.
    , forall (m :: * -> *). HeistState m -> Markup
_curMarkup           :: Markup

    -- | A prefix for all splices (namespace ++ ":").
    , forall (m :: * -> *). HeistState m -> Text
_splicePrefix        :: Text

    -- | List of errors encountered during splice processing.
    , forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors        :: [SpliceError]

    -- | Whether to throw an error when a tag wih the heist namespace does not
    -- correspond to a bound splice.  When not using a namespace, this flag is
    -- ignored.
    , forall (m :: * -> *). HeistState m -> Bool
_errorNotBound       :: Bool
    , forall (m :: * -> *). HeistState m -> Int
_numNamespacedTags   :: Int
#if MIN_VERSION_base(4,7,0)
} deriving (Typeable)
#else
}
#endif

#if !MIN_VERSION_base(4,7,0)
-- NOTE: We got rid of the Monoid instance because it is absolutely not safe
-- to combine two compiledTemplateMaps.  All compiled templates must be known
-- at load time and processed in a single call to initHeist/loadTemplates or
-- whatever we end up calling it..

instance (Typeable1 m) => Typeable (HeistState m) where
    typeOf _ = mkTyConApp templateStateTyCon [typeOf1 (undefined :: m ())]

#endif

------------------------------------------------------------------------------
-- | HeistT is the monad transformer used for splice processing.  HeistT
-- intentionally does not expose any of its functionality via MonadState or
-- MonadReader functions.  We define passthrough instances for the most common
-- types of monads.  These instances allow the user to use HeistT in a monad
-- stack without needing calls to `lift`.
--
-- @n@ is the runtime monad (the parameter to HeistState).
--
-- @m@ is the monad being run now.  In this case, \"now\" is a variable
-- concept.  The type @HeistT n n@ means that \"now\" is runtime.  The type
-- @HeistT n IO@ means that \"now\" is @IO@, and more importantly it is NOT
-- runtime. In Heist, the rule of thumb is that @IO@ means load time and @n@
-- means runtime.
newtype HeistT n m a = HeistT {
    forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT :: X.Node
              -> HeistState n
              -> m (a, HeistState n)
#if MIN_VERSION_base(4,7,0)
} deriving Typeable
#else
}
#endif


------------------------------------------------------------------------------
-- | Gets the names of all the templates defined in a HeistState.
templateNames :: HeistState m -> [TPath]
templateNames :: forall (m :: * -> *). HeistState m -> [TPath]
templateNames HeistState m
ts = forall k v. HashMap k v -> [k]
H.keys forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap HeistState m
ts


------------------------------------------------------------------------------
-- | Gets the names of all the templates defined in a HeistState.
compiledTemplateNames :: HeistState m -> [TPath]
compiledTemplateNames :: forall (m :: * -> *). HeistState m -> [TPath]
compiledTemplateNames HeistState m
ts = forall k v. HashMap k v -> [k]
H.keys forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
HeistState m -> HashMap TPath ([Chunk m], ByteString)
_compiledTemplateMap HeistState m
ts


------------------------------------------------------------------------------
-- | Gets the names of all the interpreted splices defined in a HeistState.
spliceNames :: HeistState m -> [Text]
spliceNames :: forall (m :: * -> *). HeistState m -> [Text]
spliceNames HeistState m
ts = forall k v. HashMap k v -> [k]
H.keys forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m m Template)
_spliceMap HeistState m
ts


------------------------------------------------------------------------------
-- | Gets the names of all the compiled splices defined in a HeistState.
compiledSpliceNames :: HeistState m -> [Text]
compiledSpliceNames :: forall (m :: * -> *). HeistState m -> [Text]
compiledSpliceNames HeistState m
ts = forall k v. HashMap k v -> [k]
H.keys forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap HeistState m
ts


#if !MIN_VERSION_base(4,7,0)
------------------------------------------------------------------------------
-- | The Typeable instance is here so Heist can be dynamically executed with
-- Hint.
templateStateTyCon :: TyCon
templateStateTyCon = mkTyCon "Heist.HeistState"
{-# NOINLINE templateStateTyCon #-}
#endif


------------------------------------------------------------------------------
-- | Evaluates a template monad as a computation in the underlying monad.
evalHeistT :: (Monad m)
           => HeistT n m a
           -> X.Node
           -> HeistState n
           -> m a
evalHeistT :: forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
HeistT n m a -> Node -> HeistState n -> m a
evalHeistT HeistT n m a
m Node
r HeistState n
s = do
    (a
a, HeistState n
_) <- forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT HeistT n m a
m Node
r HeistState n
s
    forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINE evalHeistT #-}


------------------------------------------------------------------------------
-- | Functor instance
instance Functor m => Functor (HeistT n m) where
    fmap :: forall a b. (a -> b) -> HeistT n m a -> HeistT n m b
fmap a -> b
f (HeistT Node -> HeistState n -> m (a, HeistState n)
m) = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
r HeistState n
s -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node -> HeistState n -> m (a, HeistState n)
m Node
r HeistState n
s


------------------------------------------------------------------------------
-- | Applicative instance
instance (Monad m, Functor m) => Applicative (HeistT n m) where
    pure :: forall a. a -> HeistT n m a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
    <*> :: forall a b. HeistT n m (a -> b) -> HeistT n m a -> HeistT n m b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap


------------------------------------------------------------------------------
-- | Monad instance
instance Monad m => Monad (HeistT n m) where
    return :: forall a. a -> HeistT n m a
return a
a = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT (\Node
_ HeistState n
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, HeistState n
s))
    {-# INLINE return #-}
    HeistT Node -> HeistState n -> m (a, HeistState n)
m >>= :: forall a b. HeistT n m a -> (a -> HeistT n m b) -> HeistT n m b
>>= a -> HeistT n m b
k = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
r HeistState n
s -> do
        (a
a, HeistState n
s') <- Node -> HeistState n -> m (a, HeistState n)
m Node
r HeistState n
s
        forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT (a -> HeistT n m b
k a
a) Node
r HeistState n
s'
    {-# INLINE (>>=) #-}


#if MIN_VERSION_base(4,9,0)
------------------------------------------------------------------------------
-- | MonadFail instance
instance Fail.MonadFail m => Fail.MonadFail (HeistT n m) where
    fail :: forall a. [Char] -> HeistT n m a
fail = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => [Char] -> m a
Fail.fail
#endif


------------------------------------------------------------------------------
-- | MonadIO instance
instance MonadIO m => MonadIO (HeistT n m) where
    liftIO :: forall a. IO a -> HeistT n m a
liftIO = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO


------------------------------------------------------------------------------
-- | MonadTrans instance
instance MonadTrans (HeistT n) where
    lift :: forall (m :: * -> *) a. Monad m => m a -> HeistT n m a
lift m a
m = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
_ HeistState n
s -> do
        a
a <- m a
m
        forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, HeistState n
s)


instance MonadBase b m => MonadBase b (HeistT n m) where
    liftBase :: forall α. b α -> HeistT n m α
liftBase = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase

#if MIN_VERSION_monad_control(1,0,0)
instance MonadTransControl (HeistT n) where
    type StT (HeistT n) a = (a, HeistState n)
    liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (HeistT n) -> m a) -> HeistT n m a
liftWith Run (HeistT n) -> m a
f = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
n HeistState n
s -> do
        a
res <- Run (HeistT n) -> m a
f forall a b. (a -> b) -> a -> b
$ \(HeistT Node -> HeistState n -> n (b, HeistState n)
g) -> Node -> HeistState n -> n (b, HeistState n)
g Node
n HeistState n
s
        forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, HeistState n
s)
    restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (HeistT n) a) -> HeistT n m a
restoreT m (StT (HeistT n) a)
k = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
_ HeistState n
_ -> m (StT (HeistT n) a)
k
    {-# INLINE liftWith #-}
    {-# INLINE restoreT #-}


instance MonadBaseControl b m => MonadBaseControl b (HeistT n m) where
     type StM (HeistT n m) a = ComposeSt (HeistT n) m a
     liftBaseWith :: forall a. (RunInBase (HeistT n m) b -> b a) -> HeistT n m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
     restoreM :: forall a. StM (HeistT n m) a -> HeistT n m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
     {-# INLINE liftBaseWith #-}
     {-# INLINE restoreM #-}
#else
instance MonadTransControl (HeistT n) where
    newtype StT (HeistT n) a = StHeistT {unStHeistT :: (a, HeistState n)}
    liftWith f = HeistT $ \n s -> do
        res <- f $ \(HeistT g) -> liftM StHeistT $ g n s
        return (res, s)
    restoreT k = HeistT $ \_ _ -> liftM unStHeistT k
    {-# INLINE liftWith #-}
    {-# INLINE restoreT #-}


instance MonadBaseControl b m => MonadBaseControl b (HeistT n m) where
     newtype StM (HeistT n m) a = StMHeist {unStMHeist :: ComposeSt (HeistT n) m a}
     liftBaseWith = defaultLiftBaseWith StMHeist
     restoreM = defaultRestoreM unStMHeist
     {-# INLINE liftBaseWith #-}
     {-# INLINE restoreM #-}
#endif

------------------------------------------------------------------------------
-- | MonadFix passthrough instance
instance MonadFix m => MonadFix (HeistT n m) where
    mfix :: forall a. (a -> HeistT n m a) -> HeistT n m a
mfix a -> HeistT n m a
f = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
r HeistState n
s ->
        forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \ (a
a, HeistState n
_) -> forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT (a -> HeistT n m a
f a
a) Node
r HeistState n
s


------------------------------------------------------------------------------
-- | Alternative passthrough instance
instance (Functor m, MonadPlus m) => Alternative (HeistT n m) where
    empty :: forall a. HeistT n m a
empty = forall (m :: * -> *) a. MonadPlus m => m a
mzero
    <|> :: forall a. HeistT n m a -> HeistT n m a -> HeistT n m a
(<|>) = forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus


------------------------------------------------------------------------------
-- | MonadPlus passthrough instance
instance MonadPlus m => MonadPlus (HeistT n m) where
    mzero :: forall a. HeistT n m a
mzero = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *) a. MonadPlus m => m a
mzero
    HeistT n m a
m mplus :: forall a. HeistT n m a -> HeistT n m a -> HeistT n m a
`mplus` HeistT n m a
n = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
r HeistState n
s ->
        forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT HeistT n m a
m Node
r HeistState n
s forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT HeistT n m a
n Node
r HeistState n
s


------------------------------------------------------------------------------
-- | MonadState passthrough instance
instance MonadState s m => MonadState s (HeistT n m) where
    get :: HeistT n m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
    {-# INLINE get #-}
    put :: s -> HeistT n m ()
put = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => s -> m ()
put
    {-# INLINE put #-}


------------------------------------------------------------------------------
-- | MonadReader passthrough instance
instance MonadReader r m => MonadReader r (HeistT n m) where
    ask :: HeistT n m r
ask = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
_ HeistState n
s -> do
            r
r <- forall r (m :: * -> *). MonadReader r m => m r
ask
            forall (m :: * -> *) a. Monad m => a -> m a
return (r
r,HeistState n
s)
    local :: forall a. (r -> r) -> HeistT n m a -> HeistT n m a
local r -> r
f (HeistT Node -> HeistState n -> m (a, HeistState n)
m) =
        forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
r HeistState n
s -> forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (Node -> HeistState n -> m (a, HeistState n)
m Node
r HeistState n
s)


------------------------------------------------------------------------------
-- | Helper for MonadError instance.
_liftCatch
    :: (m (a,HeistState n)
        -> (e -> m (a,HeistState n))
        -> m (a,HeistState n))
    -> HeistT n m a
    -> (e -> HeistT n m a)
    -> HeistT n m a
_liftCatch :: forall (m :: * -> *) a (n :: * -> *) e.
(m (a, HeistState n)
 -> (e -> m (a, HeistState n)) -> m (a, HeistState n))
-> HeistT n m a -> (e -> HeistT n m a) -> HeistT n m a
_liftCatch m (a, HeistState n)
-> (e -> m (a, HeistState n)) -> m (a, HeistState n)
ce HeistT n m a
m e -> HeistT n m a
h =
    forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
r HeistState n
s ->
        (forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT HeistT n m a
m Node
r HeistState n
s m (a, HeistState n)
-> (e -> m (a, HeistState n)) -> m (a, HeistState n)
`ce`
        (\e
e -> forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT (e -> HeistT n m a
h e
e) Node
r HeistState n
s))


------------------------------------------------------------------------------
-- | MonadError passthrough instance
instance (MonadError e m) => MonadError e (HeistT n m) where
    throwError :: forall a. e -> HeistT n m a
throwError = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    catchError :: forall a. HeistT n m a -> (e -> HeistT n m a) -> HeistT n m a
catchError = forall (m :: * -> *) a (n :: * -> *) e.
(m (a, HeistState n)
 -> (e -> m (a, HeistState n)) -> m (a, HeistState n))
-> HeistT n m a -> (e -> HeistT n m a) -> HeistT n m a
_liftCatch forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError


------------------------------------------------------------------------------
-- | Helper for MonadCont instance.
_liftCallCC
    :: ((((a,HeistState n) -> m (b, HeistState n))
           -> m (a, HeistState n))
         -> m (a, HeistState n))
    -> ((a -> HeistT n m b) -> HeistT n m a)
    -> HeistT n m a
_liftCallCC :: forall a (n :: * -> *) (m :: * -> *) b.
((((a, HeistState n) -> m (b, HeistState n))
  -> m (a, HeistState n))
 -> m (a, HeistState n))
-> ((a -> HeistT n m b) -> HeistT n m a) -> HeistT n m a
_liftCallCC (((a, HeistState n) -> m (b, HeistState n)) -> m (a, HeistState n))
-> m (a, HeistState n)
ccc (a -> HeistT n m b) -> HeistT n m a
f = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
r HeistState n
s ->
    (((a, HeistState n) -> m (b, HeistState n)) -> m (a, HeistState n))
-> m (a, HeistState n)
ccc forall a b. (a -> b) -> a -> b
$ \(a, HeistState n) -> m (b, HeistState n)
c ->
    forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT ((a -> HeistT n m b) -> HeistT n m a
f (\a
a -> forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
_ HeistState n
_ -> (a, HeistState n) -> m (b, HeistState n)
c (a
a, HeistState n
s))) Node
r HeistState n
s


------------------------------------------------------------------------------
-- | MonadCont passthrough instance
instance (MonadCont m) => MonadCont (HeistT n m) where
    callCC :: forall a b. ((a -> HeistT n m b) -> HeistT n m a) -> HeistT n m a
callCC = forall a (n :: * -> *) (m :: * -> *) b.
((((a, HeistState n) -> m (b, HeistState n))
  -> m (a, HeistState n))
 -> m (a, HeistState n))
-> ((a -> HeistT n m b) -> HeistT n m a) -> HeistT n m a
_liftCallCC forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC


#if !MIN_VERSION_base(4,7,0)
------------------------------------------------------------------------------
-- | The Typeable instance is here so Heist can be dynamically executed with
-- Hint.
templateMonadTyCon :: TyCon
templateMonadTyCon = mkTyCon "Heist.HeistT"
{-# NOINLINE templateMonadTyCon #-}

instance (Typeable1 m) => Typeable1 (HeistT n m) where
    typeOf1 _ = mkTyConApp templateMonadTyCon [typeOf1 (undefined :: m ())]
#endif


------------------------------------------------------------------------------
-- Functions for our monad.
------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | Gets the node currently being processed.
--
--   > <speech author="Shakespeare">
--   >   To sleep, perchance to dream.
--   > </speech>
--
-- When you call @getParamNode@ inside the code for the @speech@ splice, it
-- returns the Node for the @speech@ tag and its children.  @getParamNode >>=
-- childNodes@ returns a list containing one 'TextNode' containing part of
-- Hamlet's speech.  @liftM (getAttribute \"author\") getParamNode@ would
-- return @Just \"Shakespeare\"@.
getParamNode :: Monad m => HeistT n m X.Node
getParamNode :: forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m Node
getParamNode = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE getParamNode #-}


------------------------------------------------------------------------------
-- | HeistT's 'local'.
localParamNode :: Monad m
               => (X.Node -> X.Node)
               -> HeistT n m a
               -> HeistT n m a
localParamNode :: forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode Node -> Node
f HeistT n m a
m = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
r HeistState n
s -> forall (n :: * -> *) (m :: * -> *) a.
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
runHeistT HeistT n m a
m (Node -> Node
f Node
r) HeistState n
s
{-# INLINE localParamNode #-}


------------------------------------------------------------------------------
-- | HeistT's 'gets'.
getsHS :: Monad m => (HeistState n -> r) -> HeistT n m r
getsHS :: forall (m :: * -> *) (n :: * -> *) r.
Monad m =>
(HeistState n -> r) -> HeistT n m r
getsHS HeistState n -> r
f = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
_ HeistState n
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (HeistState n -> r
f HeistState n
s, HeistState n
s)
{-# INLINE getsHS #-}


------------------------------------------------------------------------------
-- | HeistT's 'get'.
getHS :: Monad m => HeistT n m (HeistState n)
getHS :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
_ HeistState n
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (HeistState n
s, HeistState n
s)
{-# INLINE getHS #-}


------------------------------------------------------------------------------
-- | HeistT's 'put'.
putHS :: Monad m => HeistState n -> HeistT n m ()
putHS :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
putHS HeistState n
s = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
_ HeistState n
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ((), HeistState n
s)
{-# INLINE putHS #-}


------------------------------------------------------------------------------
-- | HeistT's 'modify'.
modifyHS :: Monad m
         => (HeistState n -> HeistState n)
         -> HeistT n m ()
modifyHS :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS HeistState n -> HeistState n
f = forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT forall a b. (a -> b) -> a -> b
$ \Node
_ HeistState n
s -> forall (m :: * -> *) a. Monad m => a -> m a
return ((), HeistState n -> HeistState n
f HeistState n
s)
{-# INLINE modifyHS #-}


------------------------------------------------------------------------------
-- | Restores the HeistState.  This function is almost like putHS except it
-- preserves the current doctypes and splice errors.  You should use this
-- function instead of @putHS@ to restore an old state.  This was needed
-- because doctypes needs to be in a "global scope" as opposed to the template
-- call "local scope" of state items such as recursionDepth, curContext, and
-- spliceMap.
restoreHS :: Monad m => HeistState n -> HeistT n m ()
restoreHS :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
restoreHS HeistState n
old = forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
cur -> HeistState n
old { _doctypes :: [DocType]
_doctypes = forall (m :: * -> *). HeistState m -> [DocType]
_doctypes HeistState n
cur
                                      , _numNamespacedTags :: Int
_numNamespacedTags =
                                        forall (m :: * -> *). HeistState m -> Int
_numNamespacedTags HeistState n
cur
                                      , _spliceErrors :: [SpliceError]
_spliceErrors = forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors HeistState n
cur })
{-# INLINE restoreHS #-}


------------------------------------------------------------------------------
-- | Abstracts the common pattern of running a HeistT computation with
-- a modified heist state.
localHS :: Monad m
        => (HeistState n -> HeistState n)
        -> HeistT n m a
        -> HeistT n m a
localHS :: forall (m :: * -> *) (n :: * -> *) a.
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
localHS HeistState n -> HeistState n
f HeistT n m a
k = do
    HeistState n
ts <- forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
    forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
putHS forall a b. (a -> b) -> a -> b
$ HeistState n -> HeistState n
f HeistState n
ts
    a
res <- HeistT n m a
k
    forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
restoreHS HeistState n
ts
    forall (m :: * -> *) a. Monad m => a -> m a
return a
res
{-# INLINE localHS #-}


------------------------------------------------------------------------------
-- | Modifies the recursion depth.
modRecursionDepth :: Monad m => (Int -> Int) -> HeistT n m ()
modRecursionDepth :: forall (m :: * -> *) (n :: * -> *).
Monad m =>
(Int -> Int) -> HeistT n m ()
modRecursionDepth Int -> Int
f =
    forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
st -> HeistState n
st { _recursionDepth :: Int
_recursionDepth = Int -> Int
f (forall (m :: * -> *). HeistState m -> Int
_recursionDepth HeistState n
st) })


------------------------------------------------------------------------------
-- | Increments the namespaced tag count
incNamespacedTags :: Monad m => HeistT n m ()
incNamespacedTags :: forall (m :: * -> *) (n :: * -> *). Monad m => HeistT n m ()
incNamespacedTags =
    forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\HeistState n
st -> HeistState n
st { _numNamespacedTags :: Int
_numNamespacedTags = forall (m :: * -> *). HeistState m -> Int
_numNamespacedTags HeistState n
st forall a. Num a => a -> a -> a
+ Int
1 })


------------------------------------------------------------------------------
-- | AST to hold attribute parsing structure.  This is necessary because
-- attoparsec doesn't support parsers running in another monad.
data AttAST = Literal Text
            | Ident   Text
  deriving (Int -> AttAST -> ShowS
[AttAST] -> ShowS
AttAST -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AttAST] -> ShowS
$cshowList :: [AttAST] -> ShowS
show :: AttAST -> [Char]
$cshow :: AttAST -> [Char]
showsPrec :: Int -> AttAST -> ShowS
$cshowsPrec :: Int -> AttAST -> ShowS
Show)


------------------------------------------------------------------------------
isIdent :: AttAST -> Bool
isIdent :: AttAST -> Bool
isIdent (Ident Text
_) = Bool
True
isIdent AttAST
_         = Bool
False