2 files changed, 16 insertions(+), 0 deletions(-)

M Network/Protocol/XMPP/ErrorT.hs
M Network/Protocol/XMPP/Monad.hs

@@ 20,6 20,7 @@ module Network.Protocol.XMPP.ErrorT
 	) where
 
 import Control.Monad (liftM)
+import Control.Monad.Fix (MonadFix, mfix)
 import Control.Monad.Trans (MonadIO, liftIO)
 import Control.Monad.Trans.Class (MonadTrans, lift)
 import qualified Control.Monad.Error as E


@@ 60,6 61,11 @@ instance R.MonadReader m => R.MonadReader (ErrorT e m) where
 instance MonadIO m => MonadIO (ErrorT e m) where
 	liftIO = lift . liftIO
 
+instance MonadFix m => MonadFix (ErrorT e m) where
+	mfix f = ErrorT $ mfix $ \ex -> runErrorT $ f $ case ex of
+		Right x -> x
+		_        -> error "empty mfix parameter"
+
 mapErrorT :: (m (Either e a) -> n (Either e' b))
            -> ErrorT e m a
            -> ErrorT e' n b

@@ 34,6 34,9 @@ module Network.Protocol.XMPP.Monad
 	, putElement
 	, putStanza
 	) where
+import qualified Control.Applicative as A
+import Control.Monad (ap)
+import Control.Monad.Fix (MonadFix, mfix)
 import Control.Monad.Trans (MonadIO, liftIO)
 import qualified Control.Monad.Error as E
 import qualified Control.Monad.Reader as R


@@ 78,6 81,13 @@ instance E.MonadError XMPP where
 	throwError = XMPP . E.throwError
 	catchError m h = XMPP $ E.catchError (unXMPP m) (unXMPP . h)
 
+instance A.Applicative XMPP where
+	pure = return
+	(<*>) = ap
+
+instance MonadFix XMPP where
+	mfix f = XMPP $ mfix $ unXMPP . f
+
 runXMPP :: Context -> XMPP a -> IO (Either Error a)
 runXMPP ctx xmpp = R.runReaderT (runErrorT (unXMPP xmpp)) ctx