~singpolyma/network-protocol-xmpp

8ef50c319eff5e8544d14c2bc2e9a5090fd3d3a5 — John Millikin 12 years ago 3f0afb2
Fix build in GHC 7.4.1.
2 files changed, 6 insertions(+), 3 deletions(-)

M Network/Protocol/XMPP/ErrorT.hs
M Network/Protocol/XMPP/Monad.hs
M Network/Protocol/XMPP/ErrorT.hs => Network/Protocol/XMPP/ErrorT.hs +4 -2
@@ 25,7 25,9 @@ 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
import           Control.Monad.Error (ErrorType)
import qualified Control.Monad.Reader as R
import           Control.Monad.Reader (EnvType)

-- A custom version of ErrorT, without the 'Error' class restriction.



@@ 43,7 45,7 @@ instance Monad m => Monad (ErrorT e m) where
			Right r -> runErrorT (k r)

instance Monad m => E.MonadError (ErrorT e m) where
	type E.ErrorType (ErrorT e m) = e
	type ErrorType (ErrorT e m) = e
	throwError = ErrorT . return . Left
	catchError m h = ErrorT $ do
		x <- runErrorT m


@@ 55,7 57,7 @@ instance MonadTrans (ErrorT e) where
	lift = ErrorT . liftM Right

instance R.MonadReader m => R.MonadReader (ErrorT e m) where
	type R.EnvType (ErrorT e m) = R.EnvType m
	type EnvType (ErrorT e m) = EnvType m
	ask = lift R.ask
	local = mapErrorT . R.local


M Network/Protocol/XMPP/Monad.hs => Network/Protocol/XMPP/Monad.hs +2 -1
@@ 42,6 42,7 @@ import           Control.Monad (ap)
import           Control.Monad.Fix (MonadFix, mfix)
import           Control.Monad.Trans (MonadIO, liftIO)
import qualified Control.Monad.Error as E
import           Control.Monad.Error (ErrorType)
import qualified Control.Monad.Reader as R
import qualified Data.ByteString
import           Data.ByteString (ByteString)


@@ 96,7 97,7 @@ instance MonadIO XMPP where
	liftIO = XMPP . liftIO

instance E.MonadError XMPP where
	type E.ErrorType XMPP = Error
	type ErrorType XMPP = Error
	throwError = XMPP . E.throwError
	catchError m h = XMPP (E.catchError (unXMPP m) (unXMPP . h))