module Text.XML.Monad.Error
(
XmlError(..)
, FromXmlError(..)
, raise
, maybeRaise
, raises
, asksEither
, asksMaybe
, try
, tryMaybe
, tryBool
)
where
import Control.Monad.Error
import Control.Monad.Reader
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
| XmlError String
| OtherError String
| UnspecifiedError
deriving (Show)
instance Error XmlError where
noMsg = UnspecifiedError
strMsg = OtherError
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
raise :: MonadError i m => i -> m a
raise = throwError
raises :: MonadError i m => Either i a -> m a
raises (Left err) = throwError err
raises (Right x) = return x
asksEither :: (MonadReader s m, MonadError e m) => (s -> Either e a) -> m a
asksEither f = ask >>= raises . f
asksMaybe :: (MonadReader s m, MonadError e m) => e -> (s -> Maybe a) -> m a
asksMaybe err f = ask >>= maybeRaise 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