{-# 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 [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
)
data Markup = Xml | Html
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
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 -> [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 AttrSplice m = Text -> RuntimeSplice m [(Text, Text)]
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 )
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))
data CompileException = forall e . Exception e => CompileException
{ ()
originalException :: e
, 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
data HeistState m = HeistState {
forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m m Template)
_spliceMap :: HashMap Text (HeistT m m Template)
, forall (m :: * -> *). HeistState m -> HashMap TPath DocumentFile
_templateMap :: HashMap TPath DocumentFile
, forall (m :: * -> *).
HeistState m -> HashMap Text (HeistT m IO (DList (Chunk m)))
_compiledSpliceMap :: HashMap Text (HeistT m IO (DList (Chunk m)))
, 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)
, forall (m :: * -> *). HeistState m -> Bool
_recurse :: Bool
, forall (m :: * -> *). HeistState m -> TPath
_curContext :: TPath
, forall (m :: * -> *). HeistState m -> [(TPath, Maybe [Char], Text)]
_splicePath :: [(TPath, Maybe FilePath, Text)]
, forall (m :: * -> *). HeistState m -> Int
_recursionDepth :: Int
, forall (m :: * -> *). HeistState m -> [DocType]
_doctypes :: [X.DocType]
, forall (m :: * -> *). HeistState m -> Maybe [Char]
_curTemplateFile :: Maybe FilePath
, forall (m :: * -> *). HeistState m -> KeyGen
_keygen :: HE.KeyGen
, forall (m :: * -> *). HeistState m -> Bool
_preprocessingMode :: Bool
, forall (m :: * -> *). HeistState m -> Markup
_curMarkup :: Markup
, forall (m :: * -> *). HeistState m -> Text
_splicePrefix :: Text
, forall (m :: * -> *). HeistState m -> [SpliceError]
_spliceErrors :: [SpliceError]
, 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)
instance (Typeable1 m) => Typeable (HeistState m) where
typeOf _ = mkTyConApp templateStateTyCon [typeOf1 (undefined :: m ())]
#endif
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
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
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
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
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)
templateStateTyCon :: TyCon
templateStateTyCon = mkTyCon "Heist.HeistState"
{-# NOINLINE templateStateTyCon #-}
#endif
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 #-}
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
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
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)
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
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
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
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
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
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
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 #-}
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)
_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))
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
_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
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)
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 :: 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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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) })
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 })
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