module Text.XML.Monad.Error
(
XmlError(..)
, FromXmlError(..)
, raise
, raiseXml
, maybeRaise
, maybeRaiseXml
, raises
, raisesXml
, asksEither
, asksEitherXml
, asksMaybe
, asksMaybeXml
, try
, tryMaybe
, tryBool
)
where
import Control.Monad.Error
import Control.Monad.Reader
import Data.Typeable
import qualified Control.Exception as C
import qualified Text.XML.Light as L
data XmlError
= EmptyDocument
| InvalidXml
| XmlChildNotFound
| XmlChildNotFoundQ L.QName
| XmlElementNotFound
| XmlElementNotFoundQ L.QName
| XmlAttributeNotFound
| XmlAttributeNotFoundQ L.QName
| UnexpectedElementNameQ L.QName L.QName
| UnexpectedElementContentQ String String
| UnexpectedAttributeNameQ L.QName L.QName
| UnexpectedAttributeValueQ String String
| XmlError String
| EncodingError String
| OtherError String
| UnspecifiedError
deriving (Show, Typeable)
instance Error XmlError where
noMsg = UnspecifiedError
strMsg = OtherError
instance C.Exception XmlError
class FromXmlError a where
fromXmlError :: XmlError -> a
instance FromXmlError XmlError where
fromXmlError = id
maybeRaise :: MonadError i m => i -> Maybe a -> m a
maybeRaise err Nothing = throwError err
maybeRaise _ (Just x) = return x
maybeRaiseXml :: (MonadError i m, FromXmlError i) => XmlError -> Maybe a -> m a
maybeRaiseXml = maybeRaise . fromXmlError
raise :: MonadError i m => i -> m a
raise = throwError
raiseXml :: (MonadError i m, FromXmlError i) => XmlError -> m a
raiseXml = raise . fromXmlError
raises :: MonadError i m => Either i a -> m a
raises (Left err) = throwError err
raises (Right x) = return x
raisesXml :: (MonadError i m, FromXmlError i) => Either XmlError a -> m a
raisesXml (Left err) = raiseXml err
raisesXml (Right x) = return x
asksEither :: (MonadReader s m, MonadError e m) => (s -> Either e a) -> m a
asksEither f = ask >>= raises . f
asksEitherXml :: (MonadReader s m, MonadError e m, FromXmlError e) => (s -> Either XmlError a) -> m a
asksEitherXml f = ask >>= raisesXml . f
asksMaybe :: (MonadReader s m, MonadError e m) => e -> (s -> Maybe a) -> m a
asksMaybe err f = ask >>= maybeRaise err . f
asksMaybeXml :: (MonadReader s m, MonadError e m, FromXmlError e) => XmlError -> (s -> Maybe a) -> m a
asksMaybeXml err f = ask >>= maybeRaiseXml err . f
try :: MonadError e m => m a -> m (Either e a)
try m = catchError (liftM Right m) (return . Left)
tryMaybe :: MonadError e m => m a -> m (Maybe a)
tryMaybe a = either (const Nothing) Just `liftM` try a
tryBool :: MonadError e m => m a -> m Bool
tryBool a = either (const False) (const True) `liftM` try a