2 files changed, 20 insertions(+), 2 deletions(-)

M lib/Network/Protocol/TLS/GNU.hs
M lib/Network/Protocol/TLS/GNU/ErrorT.hs

@@ 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

@@ 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