diff --git a/Data/Iteratee/BZip.hsc b/Data/Iteratee/BZip.hsc --- a/Data/Iteratee/BZip.hsc +++ b/Data/Iteratee/BZip.hsc @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE ScopedTypeVariables #-} module Data.Iteratee.BZip ( -- * Enumerators @@ -287,19 +286,19 @@ => Int -> (BZStream -> CInt -> IO CInt) -> Initial - -> Enumerator ByteString m a -insertOut size run (Initial bzstr) iter = return $! do + -> Enumeratee ByteString ByteString m a +insertOut size run (Initial bzstr) iter = do _out <- liftIO $ putOutBuffer size bzstr #ifdef DEBUG liftIO $ IO.hPutStrLn stderr $ "Inserted out buffer of size " ++ show size #endif - joinIM $ fill size run (EmptyIn bzstr _out) iter + fill size run (EmptyIn bzstr _out) iter fill :: MonadIO m => Int -> (BZStream -> CInt -> IO CInt) -> EmptyIn - -> Enumerator ByteString m a + -> Enumeratee ByteString ByteString m a fill size run (EmptyIn bzstr _out) iter = let fill' (Chunk _in) | not (BS.null _in) = do @@ -308,16 +307,15 @@ liftIO $ IO.hPutStrLn stderr $ "Inserted in buffer of size " ++ show (BS.length _in) #endif - joinIM $ doRun size run (Invalid bzstr _in _out) iter + doRun size run (Invalid bzstr _in _out) iter | otherwise = fillI fill' (EOF Nothing) = do - out <- liftIO $ pullOutBuffer bzstr _out + out <- liftIO $ pullOutBuffer bzstr _out iter' <- lift $ enumPure1Chunk out iter - joinIM $ finish size run (Finishing bzstr BS.empty) iter' + finish size run (Finishing bzstr BS.empty) iter' fill' (EOF (Just err)) = case fromException err of - Just err' -> - joinIM $ flush size run (Flushing bzstr err' _out) iter + Just err' -> flush size run (Flushing bzstr err' _out) iter Nothing -> throwRecoverableErr err fill' #ifdef DEBUG fillI = do @@ -326,26 +324,26 @@ #else fillI = liftI fill' #endif - in return $! fillI + in fillI swapOut :: MonadIO m => Int -> (BZStream -> CInt -> IO CInt) -> FullOut - -> Enumerator ByteString m a -swapOut size run (FullOut bzstr _in) iter = return $! do + -> Enumeratee ByteString ByteString m a +swapOut size run (FullOut bzstr _in) iter = do _out <- liftIO $ putOutBuffer size bzstr #ifdef DEBUG liftIO $ IO.hPutStrLn stderr $ "Swapped out buffer of size " ++ show size #endif - joinIM $ doRun size run (Invalid bzstr _in _out) iter + doRun size run (Invalid bzstr _in _out) iter doRun :: MonadIO m => Int -> (BZStream -> CInt -> IO CInt) -> Invalid - -> Enumerator ByteString m a -doRun size run (Invalid bzstr _in _out) iter = return $! do + -> Enumeratee ByteString ByteString m a +doRun size run (Invalid bzstr _in _out) iter = do #ifdef DEBUG liftIO $ IO.hPutStrLn stderr $ "About to run" liftIO $ dumpZStream bzstr @@ -355,15 +353,14 @@ liftIO $ IO.hPutStrLn stderr $ "Runned" #endif case fromErrno status of - Left err -> joinIM $ enumErr err iter + Left err -> do + _ <- joinIM $ enumErr err iter + throwErr (toException err) Right False -> do -- End of stream remaining <- liftIO $ pullInBuffer bzstr _in out <- liftIO $ pullOutBuffer bzstr _out iter' <- lift $ enumPure1Chunk out iter - res <- lift $ tryRun iter' - case res of - Left err@(SomeException _) -> throwErr err - Right x -> idone x (Chunk remaining) + idone iter' (Chunk remaining) Right True -> do -- Continue (avail_in, avail_out) <- liftIO $ withBZStream bzstr $ \bzptr -> do avail_in <- liftIO $ #{peek bz_stream, avail_in} bzptr @@ -373,29 +370,30 @@ 0 -> do out <- liftIO $ pullOutBuffer bzstr _out iter' <- lift $ enumPure1Chunk out iter - joinIM $ case avail_in of + case avail_in of 0 -> insertOut size run (Initial bzstr) iter' _ -> swapOut size run (FullOut bzstr _in) iter' - _ -> joinIM $ case avail_in of + _ -> case avail_in of 0 -> fill size run (EmptyIn bzstr _out) iter - _ -> enumErr IncorrectState iter + _ -> do + _ <- joinIM $ enumErr IncorrectState iter + throwErr (toException IncorrectState) flush :: MonadIO m => Int -> (BZStream -> CInt -> IO CInt) -> Flushing - -> Enumerator ByteString m a -flush size run fin@(Flushing bzstr _flush _out) iter = return $! do + -> Enumeratee ByteString ByteString m a +flush size run fin@(Flushing bzstr _flush _out) iter = do status <- liftIO $ run bzstr (fromFlush _flush) case fromErrno status of - Left err -> joinIM $ enumErr err iter + Left err -> do + _ <- joinIM $ enumErr err iter + throwErr (toException err) Right False -> do -- Finished out <- liftIO $ pullOutBuffer bzstr _out iter' <- lift $ enumPure1Chunk out iter - res <- lift $ tryRun iter' - case res of - Left err@(SomeException _) -> throwErr err - Right x -> idone x (Chunk BS.empty) + idone iter' (Chunk BS.empty) Right True -> do (avail_in, avail_out) <- liftIO $ withBZStream bzstr $ \bzptr -> do avail_in <- liftIO $ #{peek bz_stream, avail_in} bzptr @@ -406,15 +404,15 @@ out <- liftIO $ pullOutBuffer bzstr _out iter' <- lift $ enumPure1Chunk out iter out' <- liftIO $ putOutBuffer size bzstr - joinIM $ flush size run (Flushing bzstr _flush out') iter' - _ -> joinIM $ insertOut size run (Initial bzstr) iter + flush size run (Flushing bzstr _flush out') iter' + _ -> insertOut size run (Initial bzstr) iter finish :: MonadIO m => Int -> (BZStream -> CInt -> IO CInt) -> Finishing - -> Enumerator ByteString m a -finish size run fin@(Finishing bzstr _in) iter = return $! do + -> Enumeratee ByteString ByteString m a +finish size run fin@(Finishing bzstr _in) iter = do #ifdef DEBUG liftIO $ IO.hPutStrLn stderr $ "Finishing with out buffer of size " ++ show size @@ -422,15 +420,14 @@ _out <- liftIO $ putOutBuffer size bzstr status <- liftIO $ run bzstr #{const BZ_FINISH} case fromErrno status of - Left err -> joinIM $ enumErr err iter + Left err -> do + _ <- lift $ enumErr err iter + throwErr (toException err) Right False -> do -- Finished remaining <- liftIO $ pullInBuffer bzstr _in out <- liftIO $ pullOutBuffer bzstr _out iter' <- lift $ enumPure1Chunk out iter - res <- lift $ tryRun iter' - case res of - Left err@(SomeException _) -> throwErr err - Right x -> idone x (Chunk remaining) + idone iter' (Chunk remaining) Right True -> do (avail_in, avail_out) <- liftIO $ withBZStream bzstr $ \bzptr -> do avail_in <- liftIO $ #{peek bz_stream, avail_in} bzptr @@ -441,8 +438,10 @@ out <- liftIO $ withBZStream bzstr $ \bzptr -> pullOutBuffer bzstr _out iter' <- lift $ enumPure1Chunk out iter - joinIM $ finish size run fin iter' - _ -> throwErr $! SomeException IncorrectState + finish size run fin iter' + _ -> do + _ <- lift $ enumErr (toException IncorrectState) iter + throwErr $! toException IncorrectState foreign import ccall unsafe "BZ2_bzCompressInit" compressInit :: Ptr BZStream -> CInt -> CInt @@ -511,20 +510,24 @@ -- | Compress the input and send to inner iteratee. enumCompress :: MonadIO m => CompressParams -- ^ Parameters of compression - -> Enumerator ByteString m a + -> Enumeratee ByteString ByteString m a enumCompress cp@(CompressParams _ _ size) iter = do cmp <- liftIO $ mkCompress cp case cmp of - Left err -> enumErr err iter + Left err -> do + _ <- lift $ enumErr err iter + throwErr (toException err) Right init -> insertOut size compress' init iter -- | Decompress the input and send to inner iteratee. If there is end of -- zlib stream it is left unprocessed. enumDecompress :: MonadIO m => DecompressParams - -> Enumerator ByteString m a + -> Enumeratee ByteString ByteString m a enumDecompress dp@(DecompressParams _ size) iter = do dcmp <- liftIO $ mkDecompress dp case dcmp of - Left err -> enumErr err iter + Left err -> do + _ <- lift $ enumErr err iter + throwErr (toException err) Right init -> insertOut size decompress' init iter diff --git a/Data/Iteratee/ZLib.hsc b/Data/Iteratee/ZLib.hsc --- a/Data/Iteratee/ZLib.hsc +++ b/Data/Iteratee/ZLib.hsc @@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE ScopedTypeVariables #-} module Data.Iteratee.ZLib ( -- * Enumerators @@ -434,19 +433,19 @@ => Int -> (ZStream -> CInt -> IO CInt) -> Initial - -> Enumerator ByteString m a -insertOut size run (Initial zstr) iter = return $! do + -> Enumeratee ByteString ByteString m a +insertOut size run (Initial zstr) iter = do _out <- liftIO $ putOutBuffer size zstr #ifdef DEBUG liftIO $ IO.hPutStrLn stderr $ "Inserted out buffer of size " ++ show size #endif - joinIM $ fill size run (EmptyIn zstr _out) iter + fill size run (EmptyIn zstr _out) iter fill :: MonadIO m => Int -> (ZStream -> CInt -> IO CInt) -> EmptyIn - -> Enumerator ByteString m a + -> Enumeratee ByteString ByteString m a fill size run (EmptyIn zstr _out) iter = let fill' (Chunk _in) | not (BS.null _in) = do @@ -455,16 +454,15 @@ liftIO $ IO.hPutStrLn stderr $ "Inserted in buffer of size " ++ show (BS.length _in) #endif - joinIM $ doRun size run (Invalid zstr _in _out) iter + doRun size run (Invalid zstr _in _out) iter | otherwise = fillI fill' (EOF Nothing) = do - out <- liftIO $ pullOutBuffer zstr _out + out <- liftIO $ pullOutBuffer zstr _out iter' <- lift $ enumPure1Chunk out iter - joinIM $ finish size run (Finishing zstr BS.empty) iter' + finish size run (Finishing zstr BS.empty) iter' fill' (EOF (Just err)) = case fromException err of - Just err' -> - joinIM $ flush size run (Flushing zstr err' _out) iter + Just err' -> flush size run (Flushing zstr err' _out) iter Nothing -> throwRecoverableErr err fill' #ifdef DEBUG fillI = do @@ -473,26 +471,26 @@ #else fillI = liftI fill' #endif - in return $! fillI + in fillI swapOut :: MonadIO m => Int -> (ZStream -> CInt -> IO CInt) -> FullOut - -> Enumerator ByteString m a -swapOut size run (FullOut zstr _in) iter = return $! do + -> Enumeratee ByteString ByteString m a +swapOut size run (FullOut zstr _in) iter = do _out <- liftIO $ putOutBuffer size zstr #ifdef DEBUG liftIO $ IO.hPutStrLn stderr $ "Swapped out buffer of size " ++ show size #endif - joinIM $ doRun size run (Invalid zstr _in _out) iter + doRun size run (Invalid zstr _in _out) iter doRun :: MonadIO m => Int -> (ZStream -> CInt -> IO CInt) -> Invalid - -> Enumerator ByteString m a -doRun size run (Invalid zstr _in _out) iter = return $! do + -> Enumeratee ByteString ByteString m a +doRun size run (Invalid zstr _in _out) iter = do #ifdef DEBUG liftIO $ IO.hPutStrLn stderr $ "About to run" liftIO $ dumpZStream zstr @@ -502,15 +500,14 @@ liftIO $ IO.hPutStrLn stderr $ "Runned" #endif case fromErrno status of - Left err -> joinIM $ enumErr err iter + Left err -> do + _ <- joinIM $ enumErr err iter + throwErr (toException err) Right False -> do -- End of stream remaining <- liftIO $ pullInBuffer zstr _in out <- liftIO $ pullOutBuffer zstr _out iter' <- lift $ enumPure1Chunk out iter - res <- lift $ tryRun iter' - case res of - Left err@(SomeException _) -> throwErr err - Right x -> idone x (Chunk remaining) + idone iter' (Chunk remaining) Right True -> do -- Continue (avail_in, avail_out) <- liftIO $ withZStream zstr $ \zptr -> do avail_in <- liftIO $ #{peek z_stream, avail_in} zptr @@ -520,29 +517,30 @@ 0 -> do out <- liftIO $ pullOutBuffer zstr _out iter' <- lift $ enumPure1Chunk out iter - joinIM $ case avail_in of + case avail_in of 0 -> insertOut size run (Initial zstr) iter' _ -> swapOut size run (FullOut zstr _in) iter' - _ -> joinIM $ case avail_in of + _ -> case avail_in of 0 -> fill size run (EmptyIn zstr _out) iter - _ -> enumErr IncorrectState iter + _ -> do + _ <- joinIM $ enumErr IncorrectState iter + throwErr (toException IncorrectState) flush :: MonadIO m => Int -> (ZStream -> CInt -> IO CInt) -> Flushing - -> Enumerator ByteString m a -flush size run fin@(Flushing zstr _flush _out) iter = return $! do + -> Enumeratee ByteString ByteString m a +flush size run fin@(Flushing zstr _flush _out) iter = do status <- liftIO $ run zstr (fromFlush _flush) case fromErrno status of - Left err -> joinIM $ enumErr err iter + Left err -> do + _ <- joinIM $ enumErr err iter + throwErr (toException err) Right False -> do -- Finished out <- liftIO $ pullOutBuffer zstr _out iter' <- lift $ enumPure1Chunk out iter - res <- lift $ tryRun iter' - case res of - Left err@(SomeException _) -> throwErr err - Right x -> idone x (Chunk BS.empty) + idone iter' (Chunk BS.empty) Right True -> do (avail_in, avail_out) <- liftIO $ withZStream zstr $ \zptr -> do avail_in <- liftIO $ #{peek z_stream, avail_in} zptr @@ -553,15 +551,15 @@ out <- liftIO $ pullOutBuffer zstr _out iter' <- lift $ enumPure1Chunk out iter out' <- liftIO $ putOutBuffer size zstr - joinIM $ flush size run (Flushing zstr _flush out') iter' - _ -> joinIM $ insertOut size run (Initial zstr) iter + flush size run (Flushing zstr _flush out') iter' + _ -> insertOut size run (Initial zstr) iter finish :: MonadIO m => Int -> (ZStream -> CInt -> IO CInt) -> Finishing - -> Enumerator ByteString m a -finish size run fin@(Finishing zstr _in) iter = return $! do + -> Enumeratee ByteString ByteString m a +finish size run fin@(Finishing zstr _in) iter = do #ifdef DEBUG liftIO $ IO.hPutStrLn stderr $ "Finishing with out buffer of size " ++ show size @@ -569,15 +567,14 @@ _out <- liftIO $ putOutBuffer size zstr status <- liftIO $ run zstr #{const Z_FINISH} case fromErrno status of - Left err -> joinIM $ enumErr err iter + Left err -> do + _ <- lift $ enumErr err iter + throwErr (toException err) Right False -> do -- Finished remaining <- liftIO $ pullInBuffer zstr _in out <- liftIO $ pullOutBuffer zstr _out iter' <- lift $ enumPure1Chunk out iter - res <- lift $ tryRun iter' - case res of - Left err@(SomeException _) -> throwErr err - Right x -> idone x (Chunk remaining) + idone iter' (Chunk remaining) Right True -> do (avail_in, avail_out) <- liftIO $ withZStream zstr $ \zptr -> do avail_in <- liftIO $ #{peek z_stream, avail_in} zptr @@ -588,8 +585,10 @@ out <- liftIO $ withZStream zstr $ \zptr -> pullOutBuffer zstr _out iter' <- lift $ enumPure1Chunk out iter - joinIM $ finish size run fin iter' - _ -> throwErr $! SomeException IncorrectState + finish size run fin iter' + _ -> do + _ <- lift $ enumErr (toException IncorrectState) iter + throwErr $! toException IncorrectState foreign import ccall unsafe deflateInit2_ :: Ptr ZStream -> CInt -> CInt -> CInt -> CInt -> CInt @@ -663,11 +662,13 @@ enumDeflate :: MonadIO m => Format -- ^ Format of input -> CompressParams -- ^ Parameters of compression - -> Enumerator ByteString m a + -> Enumeratee ByteString ByteString m a enumDeflate f cp@(CompressParams _ _ _ _ _ size) iter = do cmp <- liftIO $ mkCompress f cp case cmp of - Left err -> enumErr err iter + Left err -> do + _ <- lift $ enumErr err iter + throwErr (toException err) Right init -> insertOut size deflate' init iter -- | Decompress the input and send to inner iteratee. If there is end of @@ -675,9 +676,11 @@ enumInflate :: MonadIO m => Format -> DecompressParams - -> Enumerator ByteString m a + -> Enumeratee ByteString ByteString m a enumInflate f dp@(DecompressParams _ size) iter = do dcmp <- liftIO $ mkDecompress f dp case dcmp of - Left err -> enumErr err iter + Left err -> do + _ <- lift $ enumErr err iter + throwErr (toException err) Right init -> insertOut size inflate' init iter diff --git a/iteratee-compress.cabal b/iteratee-compress.cabal --- a/iteratee-compress.cabal +++ b/iteratee-compress.cabal @@ -1,5 +1,5 @@ Name: iteratee-compress -Version: 0.2.1.0 +Version: 0.3.0.0 Synopsis: An enumerators for compressing and decompressing streams Description: An enumerators for compressing and decompressing streams License: BSD3 @@ -14,7 +14,7 @@ Flag Debug Description: Enable debug support - Default: True + Default: False Library Exposed-modules: Data.Iteratee.BZip, @@ -26,8 +26,7 @@ Build-tools: c2hs Extensions: CPP, DeriveDataTypeable, - ForeignFunctionInterface, - ScopedTypeVariables + ForeignFunctionInterface Extra-libraries: z, bz2 if flag(debug) CPP-Options: -DDEBUG