~singpolyma/haskell-gnutls

a8b816730b106bce0a4f68246bb0579f51872cea — Michael Alan Dorman 7 years ago 5588ba4
Fixups for AMP changes.
2 files changed, 20 insertions(+), 2 deletions(-)

M lib/Network/Protocol/TLS/GNU.hs
M lib/Network/Protocol/TLS/GNU/ErrorT.hs
M lib/Network/Protocol/TLS/GNU.hs => lib/Network/Protocol/TLS/GNU.hs +6 -1
@@ 42,8 42,9 @@ module Network.Protocol.TLS.GNU
	, CertificateType (..)
	) where

import           Control.Applicative (Applicative, pure, (<*>))
import qualified Control.Concurrent.MVar as M
import           Control.Monad (when, foldM, foldM_)
import           Control.Monad (ap, when, foldM, foldM_)
import qualified Control.Monad.Error as E
import           Control.Monad.Error (ErrorType)
import qualified Control.Monad.Reader as R


@@ 95,6 96,10 @@ newtype TLS a = TLS { unTLS :: ErrorT Error (R.ReaderT Session IO) a }
instance Functor TLS where
	fmap f = TLS . fmap f . unTLS

instance Applicative TLS where
	pure = TLS . return
	(<*>) = ap

instance Monad TLS where
	return = TLS . return
	m >>= f = TLS $ unTLS m >>= unTLS . f

M lib/Network/Protocol/TLS/GNU/ErrorT.hs => lib/Network/Protocol/TLS/GNU/ErrorT.hs +14 -1
@@ 20,7 20,8 @@ module Network.Protocol.TLS.GNU.ErrorT
	, mapErrorT
	) where

import           Control.Monad (liftM)
import           Control.Applicative (Applicative, pure, (<*>))
import           Control.Monad (ap,liftM)
import           Control.Monad.Trans (MonadIO, liftIO)
import           Control.Monad.Trans.Class (MonadTrans, lift)
import qualified Control.Monad.Error as E


@@ 35,6 36,18 @@ newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
instance Functor m => Functor (ErrorT e m) where
	fmap f = ErrorT . fmap (fmap f) . runErrorT

instance (Functor m, Monad m) => Applicative (ErrorT e m) where
	pure a  = ErrorT $ return (Right a)
	f <*> v = ErrorT $ do
		mf <- runErrorT f
		case mf of
			Left  e -> return (Left e)
			Right k -> do
				mv <- runErrorT v
				case mv of
					Left  e -> return (Left e)
					Right x -> return (Right (k x))

instance Monad m => Monad (ErrorT e m) where
	return = ErrorT . return . Right
	(>>=) m k = ErrorT $ do