{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
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
type Splices s = MapSyntax Text s
type Template = [X.Node]
type MIMEType = ByteString
type TPath = [ByteString]
data DocumentFile = DocumentFile
{ DocumentFile -> Document
dfDoc :: X.Document
, DocumentFile -> Maybe FilePath
dfFile :: Maybe FilePath
} deriving ( DocumentFile -> DocumentFile -> Bool
(DocumentFile -> DocumentFile -> Bool)
-> (DocumentFile -> DocumentFile -> Bool) -> Eq DocumentFile
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 -> FilePath
(Int -> DocumentFile -> ShowS)
-> (DocumentFile -> FilePath)
-> ([DocumentFile] -> ShowS)
-> Show DocumentFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DocumentFile] -> ShowS
$cshowList :: [DocumentFile] -> ShowS
show :: DocumentFile -> FilePath
$cshow :: DocumentFile -> FilePath
showsPrec :: Int -> DocumentFile -> ShowS
$cshowsPrec :: Int -> DocumentFile -> ShowS
Show
#if MIN_VERSION_base(4,7,0)
, Typeable
#endif
)
data Markup = Xml | Html
newtype RuntimeSplice m a = RuntimeSplice {
RuntimeSplice m a -> StateT HeterogeneousEnvironment m a
unRT :: StateT HeterogeneousEnvironment m a
} deriving ( Functor (RuntimeSplice m)
a -> RuntimeSplice m a
Functor (RuntimeSplice m) =>
(forall a. a -> RuntimeSplice m a)
-> (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 a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b)
-> (forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m a)
-> Applicative (RuntimeSplice m)
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m a
RuntimeSplice m (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
(a -> b -> c)
-> RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m c
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
<* :: 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
*> :: 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 :: (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
<*> :: 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 :: a -> RuntimeSplice m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> RuntimeSplice m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (RuntimeSplice m)
Applicative
, a -> RuntimeSplice m b -> RuntimeSplice m a
(a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
(forall a b. (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b)
-> (forall a b. a -> RuntimeSplice m b -> RuntimeSplice m a)
-> Functor (RuntimeSplice m)
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
<$ :: a -> RuntimeSplice m b -> RuntimeSplice m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> RuntimeSplice m b -> RuntimeSplice m a
fmap :: (a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RuntimeSplice m a -> RuntimeSplice m b
Functor
, Applicative (RuntimeSplice m)
a -> RuntimeSplice m a
Applicative (RuntimeSplice m) =>
(forall a b.
RuntimeSplice m a -> (a -> RuntimeSplice m b) -> RuntimeSplice m b)
-> (forall a b.
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b)
-> (forall a. a -> RuntimeSplice m a)
-> Monad (RuntimeSplice m)
RuntimeSplice m a -> (a -> RuntimeSplice m b) -> RuntimeSplice m b
RuntimeSplice m a -> RuntimeSplice m b -> RuntimeSplice m b
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 :: a -> RuntimeSplice m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> RuntimeSplice m a
>> :: 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
>>= :: 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
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (RuntimeSplice m)
Monad
, Monad (RuntimeSplice m)
Monad (RuntimeSplice m) =>
(forall a. IO a -> RuntimeSplice m a) -> MonadIO (RuntimeSplice m)
IO a -> RuntimeSplice m a
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 :: IO a -> RuntimeSplice m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> RuntimeSplice m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (RuntimeSplice m)
MonadIO
, MonadState HeterogeneousEnvironment
, m a -> RuntimeSplice m a
(forall (m :: * -> *) a. Monad m => m a -> RuntimeSplice m a)
-> MonadTrans RuntimeSplice
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 :: 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
a :: RuntimeSplice m a
a <> :: RuntimeSplice m a -> RuntimeSplice m a -> RuntimeSplice m a
<> b :: RuntimeSplice m a
b = do
!a
x <- RuntimeSplice m a
a
!a
y <- RuntimeSplice m a
b
a -> RuntimeSplice m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> RuntimeSplice m a) -> a -> RuntimeSplice m a
forall a b. (a -> b) -> a -> b
$! a
x a -> a -> a
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 = a -> RuntimeSplice m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
#if !MIN_VERSION_base(4,11,0)
mappend = (<>)
#endif
data Chunk m = Pure !ByteString
| RuntimeHtml !(RuntimeSplice m Builder)
| RuntimeAction !(RuntimeSplice m ())
#if MIN_VERSION_base(4,7,0)
deriving Typeable
#endif
instance Show (Chunk m) where
show :: Chunk m -> FilePath
show (Pure _) = "Pure"
show (RuntimeHtml _) = "RuntimeHtml"
show (RuntimeAction _) = "RuntimeAction"
showChunk :: Chunk m -> String
showChunk :: Chunk m -> FilePath
showChunk (Pure b :: ByteString
b) = Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
b
showChunk (RuntimeHtml _) = "RuntimeHtml"
showChunk (RuntimeAction _) = "RuntimeAction"
isPureChunk :: Chunk m -> Bool
isPureChunk :: Chunk m -> Bool
isPureChunk (Pure _) = Bool
True
isPureChunk _ = Bool
False
type AttrSplice m = Text -> RuntimeSplice m [(Text, Text)]
data SpliceError = SpliceError
{ SpliceError -> [(TPath, Maybe FilePath, Text)]
spliceHistory :: [(TPath, Maybe FilePath, Text)]
, SpliceError -> Maybe FilePath
spliceTemplateFile :: Maybe FilePath
, SpliceError -> [Text]
visibleSplices :: [Text]
, SpliceError -> Node
contextNode :: X.Node
, SpliceError -> Text
spliceMsg :: Text
} deriving ( Int -> SpliceError -> ShowS
[SpliceError] -> ShowS
SpliceError -> FilePath
(Int -> SpliceError -> ShowS)
-> (SpliceError -> FilePath)
-> ([SpliceError] -> ShowS)
-> Show SpliceError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SpliceError] -> ShowS
$cshowList :: [SpliceError] -> ShowS
show :: SpliceError -> FilePath
$cshow :: SpliceError -> FilePath
showsPrec :: Int -> SpliceError -> ShowS
$cshowsPrec :: Int -> SpliceError -> ShowS
Show, SpliceError -> SpliceError -> Bool
(SpliceError -> SpliceError -> Bool)
-> (SpliceError -> SpliceError -> Bool) -> Eq SpliceError
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 )
spliceErrorText :: SpliceError -> Text
spliceErrorText :: SpliceError -> Text
spliceErrorText (SpliceError hist :: [(TPath, Maybe FilePath, Text)]
hist tf :: Maybe FilePath
tf splices :: [Text]
splices node :: Node
node msg :: Text
msg) =
(Text -> (FilePath -> Text) -> Maybe FilePath -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ((Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` ": ") (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) Maybe FilePath
tf) Text -> Text -> Text
`T.append` Text
msg Text -> Text -> Text
`T.append`
((TPath, Maybe FilePath, Text) -> Text -> Text)
-> Text -> [(TPath, Maybe FilePath, Text)] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(_, tf' :: Maybe FilePath
tf', tag :: Text
tag) -> (("\n ... via " Text -> Text -> Text
`T.append`
(Text -> (FilePath -> Text) -> Maybe FilePath -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" ((Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` ": ") (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) Maybe FilePath
tf')
Text -> Text -> Text
`T.append` Text
tag) Text -> Text -> Text
`T.append`)) Text
T.empty [(TPath, Maybe FilePath, Text)]
hist
Text -> Text -> Text
`T.append`
if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
splices
then Text
T.empty
else "\nBound splices:" Text -> Text -> Text
`T.append`
(Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\x :: Text
x y :: Text
y -> Text
x Text -> Text -> Text
`T.append` " " Text -> Text -> Text
`T.append` Text
y) Text
T.empty [Text]
splices
Text -> Text -> Text
`T.append`
(FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ "\nNode: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (Node -> FilePath
forall a. Show a => a -> FilePath
show Node
node))
data CompileException = forall e . Exception e => CompileException
{ ()
originalException :: e
, CompileException -> [SpliceError]
exceptionContext :: [SpliceError]
} deriving ( Typeable )
instance Show CompileException where
show :: CompileException -> FilePath
show (CompileException e :: e
e []) =
"Heist load exception (unknown context): " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ (e -> FilePath
forall a. Show a => a -> FilePath
show e
e)
show (CompileException _ (c :: SpliceError
c:_)) = (Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ SpliceError -> Text
spliceErrorText SpliceError
c)
instance Exception CompileException
data HeistState m = HeistState {
HeistState m -> HashMap Text (HeistT m m Template)
_spliceMap :: HashMap Text (HeistT m m Template)
, HeistState m -> HashMap TPath DocumentFile
_templateMap :: HashMap TPath DocumentFile
, HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap :: HashMap Text (HeistT m IO (DList (Chunk m)))
, HeistState m -> HashMap TPath ([Chunk m], ByteString)
_compiledTemplateMap :: !(HashMap TPath ([Chunk m], MIMEType))
, HeistState m -> HashMap Text (AttrSplice m)
_attrSpliceMap :: HashMap Text (AttrSplice m)
, HeistState m -> Bool
_recurse :: Bool
, HeistState m -> TPath
_curContext :: TPath
, HeistState m -> [(TPath, Maybe FilePath, Text)]
_splicePath :: [(TPath, Maybe FilePath, Text)]
, HeistState m -> Int
_recursionDepth :: Int
, HeistState m -> [DocType]
_doctypes :: [X.DocType]
, HeistState m -> Maybe FilePath
_curTemplateFile :: Maybe FilePath
, HeistState m -> KeyGen
_keygen :: HE.KeyGen
, HeistState m -> Bool
_preprocessingMode :: Bool
, HeistState m -> Markup
_curMarkup :: Markup
, HeistState m -> Text
_splicePrefix :: Text
, HeistState m -> [SpliceError]
_spliceErrors :: [SpliceError]
, HeistState m -> Bool
_errorNotBound :: Bool
, HeistState m -> Int
_numNamespacedTags :: Int
#if MIN_VERSION_base(4,7,0)
} deriving (Typeable)
#else
}
#endif
#if !MIN_VERSION_base(4,7,0)
instance (Typeable1 m) => Typeable (HeistState m) where
typeOf _ = mkTyConApp templateStateTyCon [typeOf1 (undefined :: m ())]
#endif
newtype HeistT n m a = HeistT {
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
templateNames :: HeistState m -> [TPath]
templateNames :: HeistState m -> [TPath]
templateNames ts :: HeistState m
ts = HashMap TPath DocumentFile -> [TPath]
forall k v. HashMap k v -> [k]
H.keys (HashMap TPath DocumentFile -> [TPath])
-> HashMap TPath DocumentFile -> [TPath]
forall a b. (a -> b) -> a -> b
$ HeistState m -> HashMap TPath DocumentFile
forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap HeistState m
ts
compiledTemplateNames :: HeistState m -> [TPath]
compiledTemplateNames :: HeistState m -> [TPath]
compiledTemplateNames ts :: HeistState m
ts = HashMap TPath ([Chunk m], ByteString) -> [TPath]
forall k v. HashMap k v -> [k]
H.keys (HashMap TPath ([Chunk m], ByteString) -> [TPath])
-> HashMap TPath ([Chunk m], ByteString) -> [TPath]
forall a b. (a -> b) -> a -> b
$ HeistState m -> HashMap TPath ([Chunk m], ByteString)
forall (m :: * -> *).
HeistState m -> HashMap TPath ([Chunk m], ByteString)
_compiledTemplateMap HeistState m
ts
spliceNames :: HeistState m -> [Text]
spliceNames :: HeistState m -> [Text]
spliceNames ts :: HeistState m
ts = HashMap Text (HeistT m m Template) -> [Text]
forall k v. HashMap k v -> [k]
H.keys (HashMap Text (HeistT m m Template) -> [Text])
-> HashMap Text (HeistT m m Template) -> [Text]
forall a b. (a -> b) -> a -> b
$ HeistState m -> HashMap Text (HeistT m m Template)
forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m m Template)
_spliceMap HeistState m
ts
compiledSpliceNames :: HeistState m -> [Text]
compiledSpliceNames :: HeistState m -> [Text]
compiledSpliceNames ts :: HeistState m
ts = HashMap Text (HeistT m IO (DList (Chunk m))) -> [Text]
forall k v. HashMap k v -> [k]
H.keys (HashMap Text (HeistT m IO (DList (Chunk m))) -> [Text])
-> HashMap Text (HeistT m IO (DList (Chunk m))) -> [Text]
forall a b. (a -> b) -> a -> b
$ HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap HeistState m
ts
#if !MIN_VERSION_base(4,7,0)
templateStateTyCon :: TyCon
templateStateTyCon = mkTyCon "Heist.HeistState"
{-# NOINLINE templateStateTyCon #-}
#endif
evalHeistT :: (Monad m)
=> HeistT n m a
-> X.Node
-> HeistState n
-> m a
evalHeistT :: HeistT n m a -> Node -> HeistState n -> m a
evalHeistT m :: HeistT n m a
m r :: Node
r s :: HeistState n
s = do
(a :: a
a, _) <- HeistT n m a -> Node -> HeistState n -> m (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
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINE evalHeistT #-}
instance Functor m => Functor (HeistT n m) where
fmap :: (a -> b) -> HeistT n m a -> HeistT n m b
fmap f :: a -> b
f (HeistT m :: Node -> HeistState n -> m (a, HeistState n)
m) = (Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b)
-> (Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b
forall a b. (a -> b) -> a -> b
$ \r :: Node
r s :: HeistState n
s -> (a -> b) -> (a, HeistState n) -> (b, HeistState n)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a -> b
f ((a, HeistState n) -> (b, HeistState n))
-> m (a, HeistState n) -> m (b, HeistState n)
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
instance (Monad m, Functor m) => Applicative (HeistT n m) where
pure :: a -> HeistT n m a
pure = a -> HeistT n m a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: HeistT n m (a -> b) -> HeistT n m a -> HeistT n m 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
instance Monad m => Monad (HeistT n m) where
return :: a -> HeistT n m a
return a :: a
a = (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT (\_ s :: HeistState n
s -> (a, HeistState n) -> m (a, HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, HeistState n
s))
{-# INLINE return #-}
HeistT m :: Node -> HeistState n -> m (a, HeistState n)
m >>= :: HeistT n m a -> (a -> HeistT n m b) -> HeistT n m b
>>= k :: a -> HeistT n m b
k = (Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b)
-> (Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b
forall a b. (a -> b) -> a -> b
$ \r :: Node
r s :: HeistState n
s -> do
(a :: a
a, s' :: HeistState n
s') <- Node -> HeistState n -> m (a, HeistState n)
m Node
r HeistState n
s
HeistT n m b -> Node -> HeistState n -> m (b, HeistState n)
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)
instance Fail.MonadFail m => Fail.MonadFail (HeistT n m) where
fail :: FilePath -> HeistT n m a
fail = m a -> HeistT n m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HeistT n m a)
-> (FilePath -> m a) -> FilePath -> HeistT n m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Fail.fail
#endif
instance MonadIO m => MonadIO (HeistT n m) where
liftIO :: IO a -> HeistT n m a
liftIO = m a -> HeistT n m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HeistT n m a) -> (IO a -> m a) -> IO a -> HeistT n m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadTrans (HeistT n) where
lift :: m a -> HeistT n m a
lift m :: m a
m = (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \_ s :: HeistState n
s -> do
a
a <- m a
m
(a, HeistState n) -> m (a, HeistState n)
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 :: b α -> HeistT n m α
liftBase = m α -> HeistT n m α
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m α -> HeistT n m α) -> (b α -> m α) -> b α -> HeistT n m α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b α -> m α
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 :: (Run (HeistT n) -> m a) -> HeistT n m a
liftWith f :: Run (HeistT n) -> m a
f = (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \n :: Node
n s :: HeistState n
s -> do
a
res <- Run (HeistT n) -> m a
f (Run (HeistT n) -> m a) -> Run (HeistT n) -> m a
forall a b. (a -> b) -> a -> b
$ \(HeistT g :: Node -> HeistState n -> n (b, HeistState n)
g) -> Node -> HeistState n -> n (b, HeistState n)
g Node
n HeistState n
s
(a, HeistState n) -> m (a, HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, HeistState n
s)
restoreT :: m (StT (HeistT n) a) -> HeistT n m a
restoreT k :: m (StT (HeistT n) a)
k = (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \_ _ -> m (a, 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 :: (RunInBase (HeistT n m) b -> b a) -> HeistT n m a
liftBaseWith = (RunInBase (HeistT n m) b -> b a) -> HeistT n m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: StM (HeistT n m) a -> HeistT n m a
restoreM = StM (HeistT n m) a -> HeistT n m a
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
instance MonadFix m => MonadFix (HeistT n m) where
mfix :: (a -> HeistT n m a) -> HeistT n m a
mfix f :: a -> HeistT n m a
f = (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \r :: Node
r s :: HeistState n
s ->
((a, HeistState n) -> m (a, HeistState n)) -> m (a, HeistState n)
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (((a, HeistState n) -> m (a, HeistState n)) -> m (a, HeistState n))
-> ((a, HeistState n) -> m (a, HeistState n))
-> m (a, HeistState n)
forall a b. (a -> b) -> a -> b
$ \ (a :: a
a, _) -> HeistT n m a -> Node -> HeistState n -> m (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
instance (Functor m, MonadPlus m) => Alternative (HeistT n m) where
empty :: HeistT n m a
empty = HeistT n m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
<|> :: HeistT n m a -> HeistT n m a -> HeistT n m 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
instance MonadPlus m => MonadPlus (HeistT n m) where
mzero :: HeistT n m a
mzero = m a -> HeistT n m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
m :: HeistT n m a
m mplus :: HeistT n m a -> HeistT n m a -> HeistT n m a
`mplus` n :: HeistT n m a
n = (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \r :: Node
r s :: HeistState n
s ->
HeistT n m a -> Node -> HeistState n -> m (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 m (a, HeistState n) -> m (a, HeistState n) -> m (a, HeistState n)
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
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
instance MonadState s m => MonadState s (HeistT n m) where
get :: HeistT n m s
get = m s -> HeistT n m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
{-# INLINE get #-}
put :: s -> HeistT n m ()
put = m () -> HeistT n m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HeistT n m ()) -> (s -> m ()) -> s -> HeistT n m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
{-# INLINE put #-}
instance MonadReader r m => MonadReader r (HeistT n m) where
ask :: HeistT n m r
ask = (Node -> HeistState n -> m (r, HeistState n)) -> HeistT n m r
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (r, HeistState n)) -> HeistT n m r)
-> (Node -> HeistState n -> m (r, HeistState n)) -> HeistT n m r
forall a b. (a -> b) -> a -> b
$ \_ s :: HeistState n
s -> do
r
r <- m r
forall r (m :: * -> *). MonadReader r m => m r
ask
(r, HeistState n) -> m (r, HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return (r
r,HeistState n
s)
local :: (r -> r) -> HeistT n m a -> HeistT n m a
local f :: r -> r
f (HeistT m :: Node -> HeistState n -> m (a, HeistState n)
m) =
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \r :: Node
r s :: HeistState n
s -> (r -> r) -> m (a, HeistState n) -> m (a, HeistState n)
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)
_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 :: (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 ce :: m (a, HeistState n)
-> (e -> m (a, HeistState n)) -> m (a, HeistState n)
ce m :: HeistT n m a
m h :: e -> HeistT n m a
h =
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \r :: Node
r s :: HeistState n
s ->
(HeistT n m a -> Node -> HeistState n -> m (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 m (a, HeistState n)
-> (e -> m (a, HeistState n)) -> m (a, HeistState n)
`ce`
(\e :: e
e -> HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
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))
instance (MonadError e m) => MonadError e (HeistT n m) where
throwError :: e -> HeistT n m a
throwError = m a -> HeistT n m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HeistT n m a) -> (e -> m a) -> e -> HeistT n m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
catchError :: HeistT n m a -> (e -> HeistT n m a) -> HeistT n m a
catchError = (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
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)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError
_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 :: ((((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 ccc :: (((a, HeistState n) -> m (b, HeistState n)) -> m (a, HeistState n))
-> m (a, HeistState n)
ccc f :: (a -> HeistT n m b) -> HeistT n m a
f = (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \r :: Node
r s :: HeistState n
s ->
(((a, HeistState n) -> m (b, HeistState n)) -> m (a, HeistState n))
-> m (a, HeistState n)
ccc ((((a, HeistState n) -> m (b, HeistState n))
-> m (a, HeistState n))
-> m (a, HeistState n))
-> (((a, HeistState n) -> m (b, HeistState n))
-> m (a, HeistState n))
-> m (a, HeistState n)
forall a b. (a -> b) -> a -> b
$ \c :: (a, HeistState n) -> m (b, HeistState n)
c ->
HeistT n m a -> Node -> HeistState n -> m (a, HeistState n)
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
a -> (Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b)
-> (Node -> HeistState n -> m (b, HeistState n)) -> HeistT n m b
forall a b. (a -> b) -> a -> b
$ \_ _ -> (a, HeistState n) -> m (b, HeistState n)
c (a
a, HeistState n
s))) Node
r HeistState n
s
instance (MonadCont m) => MonadCont (HeistT n m) where
callCC :: ((a -> HeistT n m b) -> HeistT n m a) -> HeistT n m a
callCC = ((((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
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)
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC
#if !MIN_VERSION_base(4,7,0)
templateMonadTyCon :: TyCon
templateMonadTyCon = mkTyCon "Heist.HeistT"
{-# NOINLINE templateMonadTyCon #-}
instance (Typeable1 m) => Typeable1 (HeistT n m) where
typeOf1 _ = mkTyConApp templateMonadTyCon [typeOf1 (undefined :: m ())]
#endif
getParamNode :: Monad m => HeistT n m X.Node
getParamNode :: HeistT n m Node
getParamNode = (Node -> HeistState n -> m (Node, HeistState n)) -> HeistT n m Node
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (Node, HeistState n))
-> HeistT n m Node)
-> (Node -> HeistState n -> m (Node, HeistState n))
-> HeistT n m Node
forall a b. (a -> b) -> a -> b
$ ((Node, HeistState n) -> m (Node, HeistState n))
-> Node -> HeistState n -> m (Node, HeistState n)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Node, HeistState n) -> m (Node, HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE getParamNode #-}
localParamNode :: Monad m
=> (X.Node -> X.Node)
-> HeistT n m a
-> HeistT n m a
localParamNode :: (Node -> Node) -> HeistT n m a -> HeistT n m a
localParamNode f :: Node -> Node
f m :: HeistT n m a
m = (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a)
-> (Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
forall a b. (a -> b) -> a -> b
$ \r :: Node
r s :: HeistState n
s -> HeistT n m a -> Node -> HeistState n -> m (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 -> Node
f Node
r) HeistState n
s
{-# INLINE localParamNode #-}
getsHS :: Monad m => (HeistState n -> r) -> HeistT n m r
getsHS :: (HeistState n -> r) -> HeistT n m r
getsHS f :: HeistState n -> r
f = (Node -> HeistState n -> m (r, HeistState n)) -> HeistT n m r
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (r, HeistState n)) -> HeistT n m r)
-> (Node -> HeistState n -> m (r, HeistState n)) -> HeistT n m r
forall a b. (a -> b) -> a -> b
$ \_ s :: HeistState n
s -> (r, HeistState n) -> m (r, HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return (HeistState n -> r
f HeistState n
s, HeistState n
s)
{-# INLINE getsHS #-}
getHS :: Monad m => HeistT n m (HeistState n)
getHS :: HeistT n m (HeistState n)
getHS = (Node -> HeistState n -> m (HeistState n, HeistState n))
-> HeistT n m (HeistState n)
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m (HeistState n, HeistState n))
-> HeistT n m (HeistState n))
-> (Node -> HeistState n -> m (HeistState n, HeistState n))
-> HeistT n m (HeistState n)
forall a b. (a -> b) -> a -> b
$ \_ s :: HeistState n
s -> (HeistState n, HeistState n) -> m (HeistState n, HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return (HeistState n
s, HeistState n
s)
{-# INLINE getHS #-}
putHS :: Monad m => HeistState n -> HeistT n m ()
putHS :: HeistState n -> HeistT n m ()
putHS s :: HeistState n
s = (Node -> HeistState n -> m ((), HeistState n)) -> HeistT n m ()
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m ((), HeistState n)) -> HeistT n m ())
-> (Node -> HeistState n -> m ((), HeistState n)) -> HeistT n m ()
forall a b. (a -> b) -> a -> b
$ \_ _ -> ((), HeistState n) -> m ((), HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), HeistState n
s)
{-# INLINE putHS #-}
modifyHS :: Monad m
=> (HeistState n -> HeistState n)
-> HeistT n m ()
modifyHS :: (HeistState n -> HeistState n) -> HeistT n m ()
modifyHS f :: HeistState n -> HeistState n
f = (Node -> HeistState n -> m ((), HeistState n)) -> HeistT n m ()
forall (n :: * -> *) (m :: * -> *) a.
(Node -> HeistState n -> m (a, HeistState n)) -> HeistT n m a
HeistT ((Node -> HeistState n -> m ((), HeistState n)) -> HeistT n m ())
-> (Node -> HeistState n -> m ((), HeistState n)) -> HeistT n m ()
forall a b. (a -> b) -> a -> b
$ \_ s :: HeistState n
s -> ((), HeistState n) -> m ((), HeistState n)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), HeistState n -> HeistState n
f HeistState n
s)
{-# INLINE modifyHS #-}
restoreHS :: Monad m => HeistState n -> HeistT n m ()
restoreHS :: HeistState n -> HeistT n m ()
restoreHS old :: HeistState n
old = (HeistState n -> HeistState n) -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\cur :: HeistState n
cur -> HeistState n
old { _doctypes :: [DocType]
_doctypes = HeistState n -> [DocType]
forall (m :: * -> *). HeistState m -> [DocType]
_doctypes HeistState n
cur
, _numNamespacedTags :: Int
_numNamespacedTags =
HeistState n -> Int
forall (m :: * -> *). HeistState m -> Int
_numNamespacedTags HeistState n
cur
, _spliceErrors :: [SpliceError]
_spliceErrors = HeistState n -> [SpliceError]
forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors HeistState n
cur })
{-# INLINE restoreHS #-}
localHS :: Monad m
=> (HeistState n -> HeistState n)
-> HeistT n m a
-> HeistT n m a
localHS :: (HeistState n -> HeistState n) -> HeistT n m a -> HeistT n m a
localHS f :: HeistState n -> HeistState n
f k :: HeistT n m a
k = do
HeistState n
ts <- HeistT n m (HeistState n)
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistT n m (HeistState n)
getHS
HeistState n -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
putHS (HeistState n -> HeistT n m ()) -> HeistState n -> HeistT n m ()
forall a b. (a -> b) -> a -> b
$ HeistState n -> HeistState n
f HeistState n
ts
a
res <- HeistT n m a
k
HeistState n -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
HeistState n -> HeistT n m ()
restoreHS HeistState n
ts
a -> HeistT n m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
{-# INLINE localHS #-}
modRecursionDepth :: Monad m => (Int -> Int) -> HeistT n m ()
modRecursionDepth :: (Int -> Int) -> HeistT n m ()
modRecursionDepth f :: Int -> Int
f =
(HeistState n -> HeistState n) -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\st :: HeistState n
st -> HeistState n
st { _recursionDepth :: Int
_recursionDepth = Int -> Int
f (HeistState n -> Int
forall (m :: * -> *). HeistState m -> Int
_recursionDepth HeistState n
st) })
incNamespacedTags :: Monad m => HeistT n m ()
incNamespacedTags :: HeistT n m ()
incNamespacedTags =
(HeistState n -> HeistState n) -> HeistT n m ()
forall (m :: * -> *) (n :: * -> *).
Monad m =>
(HeistState n -> HeistState n) -> HeistT n m ()
modifyHS (\st :: HeistState n
st -> HeistState n
st { _numNamespacedTags :: Int
_numNamespacedTags = HeistState n -> Int
forall (m :: * -> *). HeistState m -> Int
_numNamespacedTags HeistState n
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 })
data AttAST = Literal Text
| Ident Text
deriving (Int -> AttAST -> ShowS
[AttAST] -> ShowS
AttAST -> FilePath
(Int -> AttAST -> ShowS)
-> (AttAST -> FilePath) -> ([AttAST] -> ShowS) -> Show AttAST
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AttAST] -> ShowS
$cshowList :: [AttAST] -> ShowS
show :: AttAST -> FilePath
$cshow :: AttAST -> FilePath
showsPrec :: Int -> AttAST -> ShowS
$cshowsPrec :: Int -> AttAST -> ShowS
Show)
isIdent :: AttAST -> Bool
isIdent :: AttAST -> Bool
isIdent (Ident _) = Bool
True
isIdent _ = Bool
False