Slight API refactoring. Fix spinning pipeline when other end disconne…

…cts. Handle response flags correctly

Control/Monad/Context.hs

@@ -1,4 +1,4 @@
-{- | This is just like Control.Monad.Reader.Class except you can access the context of any Reader in the monad stack instead of just the top one as long as the context types are different. If two or more readers in the stack have the same context type you get the context of the top one. -}
+{- | This is just like "Control.Monad.Reader.Class" except you can access the context of any Reader in the monad stack instead of just the top one as long as the context types are different. If two or more readers in the stack have the same context type you get the context of the top one. -}
 
 {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverlappingInstances #-}
 
@@ -8,7 +8,7 @@ import Control.Monad.Reader
 import Control.Monad.Error
 
 -- | Same as 'MonadReader' but without functional dependency so the same monad can have multiple contexts with different types
-class Context x m where
+class (Monad m) => Context x m where
 	context :: m x
 	-- ^ Get the context in the Reader in the monad stack that has @x@ context type. Analogous to 'ask'.
 	push :: (x -> x) -> m a -> m a 
@@ -18,10 +18,10 @@ instance (Monad m) => Context x (ReaderT x m) where
 	context = ask
 	push = local
 
-instance (Monad m, Context x m) => Context x (ReaderT r m) where
+instance (Context x m) => Context x (ReaderT r m) where
 	context = lift context
 	push f m = ReaderT (push f . runReaderT m)
 
-instance (Monad m, Context x m, Error e) => Context x (ErrorT e m) where
+instance (Context x m, Error e) => Context x (ErrorT e m) where
 	context = lift context
 	push f = ErrorT . push f . runErrorT

Control/Monad/Throw.hs

@@ -0,0 +1,36 @@
+{- | This is just like "Control.Monad.Error.Class" except you can throw/catch the error of any ErrorT in the monad stack instead of just the top one as long as the error types are different. If two or more ErrorTs in the stack have the same error type you get the error of the top one. -}
+
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, OverlappingInstances #-}
+
+module Control.Monad.Throw where
+
+import Prelude hiding (catch)
+import Control.Monad.Reader
+import Control.Monad.Error
+
+-- | Same as 'MonadError' but without functional dependency so the same monad can have multiple errors with different types
+class (Monad m) => Throw e m where
+	throw :: e -> m a
+	-- ^ Abort action and throw give exception. Analogous to 'throwError'.
+	catch :: m a -> (e -> m a) -> m a 
+	-- ^ If first action aborts with exception then execute second action. Analogous to 'catchError'
+
+throwLeft :: (Throw e m) => m (Either e a) -> m a
+-- ^ Execute action and throw exception if result is Left, otherwise return the Right result
+throwLeft = (either throw return =<<)
+
+instance (Error e) => Throw e (Either e) where
+	throw = throwError
+	catch = catchError
+
+instance (Error e, Monad m) => Throw e (ErrorT e m) where
+	throw = throwError
+	catch = catchError
+
+instance (Error e, Throw e m, Error x) => Throw e (ErrorT x m) where
+	throw = lift . throw
+	catch a h = ErrorT $ catch (runErrorT a) (runErrorT . h)
+
+instance (Throw e m) => Throw e (ReaderT x m) where
+	throw = lift . throw
+	catch a h = ReaderT $ \x -> catch (runReaderT a x) (flip runReaderT x . h)

Control/Pipeline.hs

@@ -17,7 +17,7 @@ import Prelude hiding (length)
 import Control.Applicative ((<$>))
 import Control.Monad (forever)
 import Control.Exception (assert)
-import System.IO.Error (try)
+import System.IO.Error (try, mkIOError, eofErrorType)
 import System.IO (Handle, hFlush, hClose, hIsClosed)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
@@ -43,7 +43,9 @@ instance Length L.ByteString where
 
 class Resource m r where
 	close :: r -> m ()
+	-- ^ Close resource
 	isClosed :: r -> m Bool
+	-- ^ Is resource closed
 
 instance Resource IO Handle where
 	close = hClose
@@ -64,16 +66,16 @@ class (Length bytes, Monoid bytes, Flush handle) => Stream handle bytes where
 	put :: handle -> bytes -> IO ()
 	-- ^ Write bytes to handle
 	get :: handle -> Int -> IO bytes
-	-- ^ Read up to N bytes from handle, block until at least 1 byte is available
+	-- ^ Read up to N bytes from handle; if EOF return empty bytes, otherwise block until at least 1 byte is available
 
 getN :: (Stream h b) => h -> Int -> IO b
--- ^ Read N bytes from hande, blocking until all N bytes are read. Unlike 'get' which only blocks if no bytes are available.
+-- ^ Read N bytes from hande, blocking until all N bytes are read. If EOF is reached before N bytes then throw EOF exception.
 getN h n = assert (n >= 0) $ do
 	bytes <- get h n
 	let x = length bytes
-	if x >= n then return bytes else do
-		remainingBytes <- getN h (n - x)
-		return (mappend bytes remainingBytes)
+	if x >= n then return bytes
+		else if x == 0 then ioError (mkIOError eofErrorType "Control.Pipeline" Nothing Nothing)
+			else mappend bytes <$> getN h (n - x)
 
 instance Stream Handle S.ByteString where
 	put = S.hPut

Database/MongoDB/Admin.hs

@@ -28,7 +28,7 @@ module Database.MongoDB.Admin (
 import Prelude hiding (lookup)
 import Control.Applicative ((<$>))
 import Database.MongoDB.Internal.Protocol (pwHash, pwKey)
-import Database.MongoDB.Connection (Server, showHostPort)
+import Database.MongoDB.Connection (Host, showHostPort)
 import Database.MongoDB.Query
 import Data.Bson
 import Data.UString (pack, unpack, append, intercalate)
@@ -191,12 +191,12 @@ removeUser user = delete (select ["user" =: user] "system.users")
 
 -- ** Database
 
-cloneDatabase :: (Conn m) => Database -> Server -> m Document
--- ^ Copy database from given server to the server I am connected to. Fails and returns @"ok" = 0@ if we don't have permission to read from given server (use copyDatabase in this case).
+cloneDatabase :: (Conn m) => Database -> Host -> m Document
+-- ^ Copy database from given host to the server I am connected to. Fails and returns @"ok" = 0@ if we don't have permission to read from given server (use copyDatabase in this case).
 cloneDatabase db fromHost = useDb db $ runCommand ["clone" =: showHostPort fromHost]
 
-copyDatabase :: (Conn m) => Database -> Server -> Maybe (Username, Password) -> Database -> m Document
--- ^ Copy database from given server to the server I am connected to. If username & password is supplied use them to read from given server.
+copyDatabase :: (Conn m) => Database -> Host -> Maybe (Username, Password) -> Database -> m Document
+-- ^ Copy database from given host to the server I am connected to. If username & password is supplied use them to read from given host.
 copyDatabase fromDb fromHost mup toDb = do
 	let c = ["copydb" =: (1 :: Int), "fromhost" =: showHostPort fromHost, "fromdb" =: fromDb, "todb" =: toDb]
 	useDb "admin" $ case mup of