module Text.XML.Monad.Core
(
XmlT(..)
, Xml
, runXmlT
, runXml
, inList
, elName
, elAttribs
, elContent
, elLine
, attrKey
, attrVal
, cdVerbatim
, cdLine
, cdData
, qName
, qURI
, qPrefix
)
where
import Control.Applicative
import Control.Monad.Compose.Class
import Control.Monad.Error
import Control.Monad.Reader
import Data.Functor.Identity
import qualified Text.XML.Light as L
newtype XmlT e s m a = XmlT { fromXmlT :: ErrorT e (ReaderT s m) a }
deriving (Functor, Monad, Applicative, MonadPlus, Alternative)
type Xml e s a = XmlT e s Identity a
instance Error e => MonadTrans (XmlT e s) where
lift = XmlT . lift . lift
instance (Monad m, Error e) => MonadReader s (XmlT e s m) where
ask = XmlT ask
local f m = XmlT $ local f (fromXmlT m)
instance (Monad m, Error e) => MonadError e (XmlT e s m) where
throwError e = XmlT $ throwError e
catchError m f = XmlT $ catchError (fromXmlT m) (fromXmlT . f)
instance (Monad m, Error e) => MonadCompose (XmlT e s m) (XmlT e t m) s t where
mcompose m n = XmlT $ mcompose (fromXmlT m) (fromXmlT n)
instance (MonadIO m, Error e) => MonadIO (XmlT e s m) where
liftIO = XmlT . liftIO
runXmlT :: XmlT e s m a -> s -> m (Either e a)
runXmlT = runReaderT . runErrorT . fromXmlT
runXml :: Xml e s a -> s -> Either e a
runXml = runIdentity .: runXmlT
where (.:) = (.).(.)
inList :: (MonadCompose m n s t, MonadReader [s] n) => m a -> n [a]
inList m = ask >>= mapM (mapply m)
elName :: MonadReader L.Element m => m L.QName
elName = asks L.elName
elAttribs :: MonadReader L.Element m => m [L.Attr]
elAttribs = asks L.elAttribs
elContent :: MonadReader L.Element m => m [L.Content]
elContent = asks L.elContent
elLine :: MonadReader L.Element m => m (Maybe L.Line)
elLine = asks L.elLine
attrKey :: MonadReader L.Attr m => m L.QName
attrKey = asks L.attrKey
attrVal :: MonadReader L.Attr m => m String
attrVal = asks L.attrVal
cdVerbatim :: MonadReader L.CData m => m L.CDataKind
cdVerbatim = asks L.cdVerbatim
cdLine :: MonadReader L.CData m => m (Maybe L.Line)
cdLine = asks L.cdLine
cdData :: MonadReader L.CData m => m String
cdData = asks L.cdData
qName :: MonadReader L.QName m => m String
qName = asks L.qName
qURI :: MonadReader L.QName m => m (Maybe String)
qURI = asks L.qURI
qPrefix :: MonadReader L.QName m => m (Maybe String)
qPrefix = asks L.qPrefix