{-# LINE 1 "Codec/Compression/BZip/Stream.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
-----------------------------------------------------------------------------
-- |
-- Copyright   :  (c) 2006-2008 Duncan Coutts
-- License     :  BSD-style
--
-- Maintainer  :  duncan.coutts@worc.ox.ac.uk
-- Stability   :  experimental
-- Portability :  portable (H98 + FFI)
--
-- BZlib wrapper layer
--
-----------------------------------------------------------------------------
module Codec.Compression.BZip.Stream (

  -- * The Zlib state monad
  Stream,
  State,
  mkState,
  runStream,
  unsafeLiftIO,
  finalise,

  -- * Initialisation
  compressInit, 
  decompressInit,

  -- ** Initialisation parameters
  BlockSize(..),
  WorkFactor(..),
  MemoryLevel(..),
  Verbosity(..),

  -- * The business
  compress,
  decompress,
  Status(..),
  Action(..),
  ErrorCode(..),

  -- * Buffer management
  -- ** Input buffer
  pushInputBuffer,
  inputBufferEmpty,
  popRemainingInputBuffer,

  -- ** Output buffer
  pushOutputBuffer,
  popOutputBuffer,
  outputBufferBytesAvailable,
  outputBufferSpaceRemaining,
  outputBufferFull,

  -- * Debugging
  consistencyCheck,
  dump,
  trace,

  ) where

import Foreign
         ( Word8, Ptr, nullPtr, plusPtr, peekByteOff, pokeByteOff
         , ForeignPtr, FinalizerPtr, mallocForeignPtrBytes, addForeignPtrFinalizer
         , finalizeForeignPtr, withForeignPtr, touchForeignPtr, minusPtr )
import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr )
import Foreign.C
import Data.ByteString.Internal (nullForeignPtr)
import System.IO (hPutStrLn, stderr)
import Control.Applicative (Applicative(..))
import Control.Monad (liftM, ap)
import qualified Control.Monad.Fail as Fail
import Control.Monad.ST.Strict
import Control.Monad.ST.Unsafe
import Control.Exception (assert)

import Prelude (Int, IO, Bool, String, Functor, Monad(..), Show(..), return, (>>), (>>=), fmap, (.), ($), fromIntegral, error, otherwise, (<=), (&&), (>=), show, (++), (+), (==), (-), (>))




pushInputBuffer :: ForeignPtr Word8 -> Int -> Int -> Stream ()
pushInputBuffer :: ForeignPtr Word8 -> Int -> Int -> Stream ()
pushInputBuffer ForeignPtr Word8
inBuf' Int
offset Int
length = do

  -- must not push a new input buffer if the last one is not used up
  Int
inAvail <- Stream Int
getInAvail
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
inAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- Now that we're setting a new input buffer, we can be sure that zlib no
  -- longer has a reference to the old one. Therefore this is the last point
  -- at which the old buffer had to be retained. It's safe to release now.
  ForeignPtr Word8
inBuf <- Stream (ForeignPtr Word8)
getInBuf 
  IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ()) -> IO () -> Stream ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
inBuf    

  -- now set the available input buffer ptr and length
  ForeignPtr Word8 -> Stream ()
setInBuf   ForeignPtr Word8
inBuf'
  Int -> Stream ()
setInAvail Int
length
  Ptr Word8 -> Stream ()
setInNext  (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
inBuf' Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)
  -- Note the 'unsafe'. We are passing the raw ptr inside inBuf' to zlib.
  -- To make this safe we need to hold on to the ForeignPtr for at least as
  -- long as zlib is using the underlying raw ptr.


inputBufferEmpty :: Stream Bool
inputBufferEmpty :: Stream Bool
inputBufferEmpty = Stream Int
getInAvail Stream Int -> (Int -> Stream Bool) -> Stream Bool
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream Bool
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Stream Bool) -> (Int -> Bool) -> Int -> Stream Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)


popRemainingInputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popRemainingInputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popRemainingInputBuffer = do

  ForeignPtr Word8
inBuf    <- Stream (ForeignPtr Word8)
getInBuf
  Ptr Word8
inNext   <- Stream (Ptr Word8)
getInNext
  Int
inAvail  <- Stream Int
getInAvail

  -- there really should be something to pop, otherwise it's silly
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
inAvail Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Int -> Stream ()
setInAvail Int
0

  (ForeignPtr Word8, Int, Int) -> Stream (ForeignPtr Word8, Int, Int)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, Ptr Word8
inNext Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
inBuf, Int
inAvail)


pushOutputBuffer :: ForeignPtr Word8 -> Int -> Int -> Stream ()
pushOutputBuffer :: ForeignPtr Word8 -> Int -> Int -> Stream ()
pushOutputBuffer ForeignPtr Word8
outBuf' Int
offset Int
length = do

  --must not push a new buffer if there is still data in the old one
  Int
outAvail <- Stream Int
getOutAvail
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outAvail Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Note that there may still be free space in the output buffer, that's ok,
  -- you might not want to bother completely filling the output buffer say if
  -- there's only a few free bytes left.

  ForeignPtr Word8
outBuf <- Stream (ForeignPtr Word8)
getOutBuf
  IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ()) -> IO () -> Stream ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
outBuf

  -- now set the available input buffer ptr and length
  ForeignPtr Word8 -> Stream ()
setOutBuf  ForeignPtr Word8
outBuf'
  Int -> Stream ()
setOutFree Int
length
  Ptr Word8 -> Stream ()
setOutNext (ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
outBuf' Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset)

  Int -> Stream ()
setOutOffset Int
offset
  Int -> Stream ()
setOutAvail  Int
0


-- get that part of the output buffer that is currently full
-- (might be 0, use outputBufferBytesAvailable to check)
-- this may leave some space remaining in the buffer, use
-- outputBufferSpaceRemaining to check.
popOutputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popOutputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popOutputBuffer = do

  ForeignPtr Word8
outBuf    <- Stream (ForeignPtr Word8)
getOutBuf
  Int
outOffset <- Stream Int
getOutOffset
  Int
outAvail  <- Stream Int
getOutAvail

  -- there really should be something to pop, otherwise it's silly
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outAvail Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Int -> Stream ()
setOutOffset (Int
outOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outAvail)
  Int -> Stream ()
setOutAvail  Int
0

  (ForeignPtr Word8, Int, Int) -> Stream (ForeignPtr Word8, Int, Int)
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
outBuf, Int
outOffset, Int
outAvail)


-- this is the number of bytes available in the output buffer
outputBufferBytesAvailable :: Stream Int
outputBufferBytesAvailable :: Stream Int
outputBufferBytesAvailable = Stream Int
getOutAvail


-- you needn't get all the output immediately, you can continue until
-- there is no more output space available, this tells you that amount
outputBufferSpaceRemaining :: Stream Int
outputBufferSpaceRemaining :: Stream Int
outputBufferSpaceRemaining = Stream Int
getOutFree


-- you only need to supply a new buffer when there is no more output buffer
-- space remaining
outputBufferFull :: Stream Bool
outputBufferFull :: Stream Bool
outputBufferFull = Stream Int
getOutFree Stream Int -> (Int -> Stream Bool) -> Stream Bool
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> Stream Bool
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Stream Bool) -> (Int -> Bool) -> Int -> Stream Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0)


-- you can only run this when the output buffer is not empty
-- you can run it when the input buffer is empty but it doesn't do anything
-- after running deflate either the output buffer will be full
-- or the input buffer will be empty (or both)
compress :: Action -> Stream Status
compress :: Action -> Stream Status
compress Action
action = do

  Int
outFree <- Stream Int
getOutFree

  -- deflate needs free space in the output buffer
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outFree Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Status
result <- Action -> Stream Status
compress_ Action
action
  Int
outFree' <- Stream Int
getOutFree
    
  -- number of bytes of extra output there is available as a result of
  -- the call to deflate:
  let outExtra :: Int
outExtra = Int
outFree Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
outFree'
  
  Int
outAvail <- Stream Int
getOutAvail
  Int -> Stream ()
setOutAvail (Int
outAvail Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outExtra)
  Status -> Stream Status
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
result


decompress :: Stream Status
decompress :: Stream Status
decompress = do

  Int
outFree <- Stream Int
getOutFree

  -- inflate needs free space in the output buffer
  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
outFree Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  Status
result <- Stream Status
decompress_
  Int
outFree' <- Stream Int
getOutFree

  -- number of bytes of extra output there is available as a result of
  -- the call to inflate:
  let outExtra :: Int
outExtra = Int
outFree Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
outFree'

  Int
outAvail <- Stream Int
getOutAvail
  Int -> Stream ()
setOutAvail (Int
outAvail Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outExtra)
  Status -> Stream Status
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
result


----------------------------
-- Stream monad
--

newtype Stream a = BZ {
    forall a.
Stream a
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
unZ :: ForeignPtr StreamState
        -> ForeignPtr Word8
        -> ForeignPtr Word8
        -> Int -> Int
        -> IO (ForeignPtr Word8
              ,ForeignPtr Word8
              ,Int, Int, a)
  }

instance Functor Stream where
    fmap :: forall a b. (a -> b) -> Stream a -> Stream b
fmap = (a -> b) -> Stream a -> Stream b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative Stream where
    pure :: forall a. a -> Stream a
pure  = a -> Stream a
forall a. a -> Stream a
returnZ
    <*> :: forall a b. Stream (a -> b) -> Stream a -> Stream b
(<*>) = Stream (a -> b) -> Stream a -> Stream b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
    *> :: forall a b. Stream a -> Stream b -> Stream b
(*>) = Stream a -> Stream b -> Stream b
forall a b. Stream a -> Stream b -> Stream b
thenZ_

instance Monad Stream where
  >>= :: forall a b. Stream a -> (a -> Stream b) -> Stream b
(>>=)  = Stream a -> (a -> Stream b) -> Stream b
forall a b. Stream a -> (a -> Stream b) -> Stream b
thenZ
  >> :: forall a b. Stream a -> Stream b -> Stream b
(>>)   = Stream a -> Stream b -> Stream b
forall a b. Stream a -> Stream b -> Stream b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  return :: forall a. a -> Stream a
return = a -> Stream a
forall a. a -> Stream a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Fail.MonadFail Stream where
  fail :: forall a. String -> Stream a
fail   = (Stream ()
finalise Stream () -> Stream a -> Stream a
forall a b. Stream a -> Stream b -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>) (Stream a -> Stream a)
-> (String -> Stream a) -> String -> Stream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Stream a
forall a. String -> Stream a
failZ

returnZ :: a -> Stream a
returnZ :: forall a. a -> Stream a
returnZ a
a = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
 -> Stream a)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_ ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength ->
                  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, a
a)
{-# INLINE returnZ #-}

thenZ :: Stream a -> (a -> Stream b) -> Stream b
thenZ :: forall a b. Stream a -> (a -> Stream b) -> Stream b
thenZ (BZ ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m) a -> Stream b
f =
  (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> Stream b
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
 -> Stream b)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> Stream b
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength ->
    ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> ((ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \(ForeignPtr Word8
inBuf', ForeignPtr Word8
outBuf', Int
outOffset', Int
outLength', a
a) ->
        Stream b
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b)
forall a.
Stream a
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
unZ (a -> Stream b
f a
a) ForeignPtr StreamState
stream ForeignPtr Word8
inBuf' ForeignPtr Word8
outBuf' Int
outOffset' Int
outLength'
{-# INLINE thenZ #-}

thenZ_ :: Stream a -> Stream b -> Stream b
thenZ_ :: forall a b. Stream a -> Stream b -> Stream b
thenZ_ (BZ ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m) Stream b
f =
  (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> Stream b
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
 -> Stream b)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> Stream b
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength ->
    ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> ((ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b))
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \(ForeignPtr Word8
inBuf', ForeignPtr Word8
outBuf', Int
outOffset', Int
outLength', a
_) ->
        Stream b
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, b)
forall a.
Stream a
-> ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
unZ Stream b
f ForeignPtr StreamState
stream ForeignPtr Word8
inBuf' ForeignPtr Word8
outBuf' Int
outOffset' Int
outLength'
{-# INLINE thenZ_ #-}

failZ :: String -> Stream a
failZ :: forall a. String -> Stream a
failZ String
msg = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ (\ForeignPtr StreamState
_ ForeignPtr Word8
_ ForeignPtr Word8
_ Int
_ Int
_ -> String -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail (String
"Codec.Compression.BZip: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg))

data State s = State !(ForeignPtr StreamState)
                     !(ForeignPtr Word8)
                     !(ForeignPtr Word8)
       {-# UNPACK #-} !Int
       {-# UNPACK #-} !Int

mkState :: ST s (State s)
mkState :: forall s. ST s (State s)
mkState = IO (State s) -> ST s (State s)
forall a s. IO a -> ST s a
unsafeIOToST (IO (State s) -> ST s (State s)) -> IO (State s) -> ST s (State s)
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr StreamState
stream <- Int -> IO (ForeignPtr StreamState)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Int
80)
{-# LINE 287 "Codec/Compression/BZip/Stream.hsc" #-}
  withForeignPtr stream $ \ptr -> do
    (\hsc_ptr -> pokeByteOff hsc_ptr 56)   ptr nullPtr
{-# LINE 289 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 64)    ptr nullPtr
{-# LINE 290 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 72)    ptr nullPtr
{-# LINE 291 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 0)   ptr nullPtr
{-# LINE 292 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 24)  ptr nullPtr
{-# LINE 293 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8)  ptr (0 :: CUInt)
{-# LINE 294 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr (0 :: CUInt)
{-# LINE 295 "Codec/Compression/BZip/Stream.hsc" #-}
  return (State stream nullForeignPtr nullForeignPtr 0 0)

runStream :: Stream a -> State s -> ST s (a, State s)
runStream :: forall a s. Stream a -> State s -> ST s (a, State s)
runStream (BZ ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m) (State ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength) =
  IO (a, State s) -> ST s (a, State s)
forall a s. IO a -> ST s a
unsafeIOToST (IO (a, State s) -> ST s (a, State s))
-> IO (a, State s) -> ST s (a, State s)
forall a b. (a -> b) -> a -> b
$
    ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int
-> Int
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
m ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> ((ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
    -> IO (a, State s))
-> IO (a, State s)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
      \(ForeignPtr Word8
inBuf', ForeignPtr Word8
outBuf', Int
outOffset', Int
outLength', a
a) ->
        (a, State s) -> IO (a, State s)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, ForeignPtr StreamState
-> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> Int -> State s
forall s.
ForeignPtr StreamState
-> ForeignPtr Word8 -> ForeignPtr Word8 -> Int -> Int -> State s
State ForeignPtr StreamState
stream ForeignPtr Word8
inBuf' ForeignPtr Word8
outBuf' Int
outOffset' Int
outLength')

unsafeLiftIO :: IO a -> Stream a
unsafeLiftIO :: forall a. IO a -> Stream a
unsafeLiftIO IO a
m = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
 -> Stream a)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  a
a <- IO a
m
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, a
a)

getStreamState :: Stream (ForeignPtr StreamState)
getStreamState :: Stream (ForeignPtr StreamState)
getStreamState = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO
      (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
       ForeignPtr StreamState))
-> Stream (ForeignPtr StreamState)
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO
       (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
        ForeignPtr StreamState))
 -> Stream (ForeignPtr StreamState))
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO
         (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
          ForeignPtr StreamState))
-> Stream (ForeignPtr StreamState)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
 ForeignPtr StreamState)
-> IO
     (ForeignPtr Word8, ForeignPtr Word8, Int, Int,
      ForeignPtr StreamState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ForeignPtr StreamState
stream)

getInBuf :: Stream (ForeignPtr Word8)
getInBuf :: Stream (ForeignPtr Word8)
getInBuf = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO
      (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
-> Stream (ForeignPtr Word8)
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO
       (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
 -> Stream (ForeignPtr Word8))
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO
         (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
-> Stream (ForeignPtr Word8)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8)
-> IO
     (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ForeignPtr Word8
inBuf)

getOutBuf :: Stream (ForeignPtr Word8)
getOutBuf :: Stream (ForeignPtr Word8)
getOutBuf = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO
      (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
-> Stream (ForeignPtr Word8)
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO
       (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
 -> Stream (ForeignPtr Word8))
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO
         (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8))
-> Stream (ForeignPtr Word8)
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8)
-> IO
     (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ForeignPtr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ForeignPtr Word8
outBuf)

getOutOffset :: Stream Int
getOutOffset :: Stream Int
getOutOffset = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
-> Stream Int
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
 -> Stream Int)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
-> Stream Int
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int)
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, Int
outOffset)

getOutAvail :: Stream Int
getOutAvail :: Stream Int
getOutAvail = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
-> Stream Int
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
 -> Stream Int)
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int))
-> Stream Int
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int)
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, Int
outLength)

setInBuf :: ForeignPtr Word8 -> Stream ()
setInBuf :: ForeignPtr Word8 -> Stream ()
setInBuf ForeignPtr Word8
inBuf = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
 -> Stream ())
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
_ ForeignPtr Word8
outBuf Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ())

setOutBuf :: ForeignPtr Word8 -> Stream ()
setOutBuf :: ForeignPtr Word8 -> Stream ()
setOutBuf ForeignPtr Word8
outBuf = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
 -> Stream ())
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
_ Int
outOffset Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ())

setOutOffset :: Int -> Stream ()
setOutOffset :: Int -> Stream ()
setOutOffset Int
outOffset = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
 -> Stream ())
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
_ Int
outLength -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ())

setOutAvail :: Int -> Stream ()
setOutAvail :: Int -> Stream ()
setOutAvail Int
outLength = (ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a.
(ForeignPtr StreamState
 -> ForeignPtr Word8
 -> ForeignPtr Word8
 -> Int
 -> Int
 -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, a))
-> Stream a
BZ ((ForeignPtr StreamState
  -> ForeignPtr Word8
  -> ForeignPtr Word8
  -> Int
  -> Int
  -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
 -> Stream ())
-> (ForeignPtr StreamState
    -> ForeignPtr Word8
    -> ForeignPtr Word8
    -> Int
    -> Int
    -> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ()))
-> Stream ()
forall a b. (a -> b) -> a -> b
$ \ForeignPtr StreamState
_stream ForeignPtr Word8
inBuf ForeignPtr Word8
outBuf Int
outOffset Int
_ -> do
  (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
-> IO (ForeignPtr Word8, ForeignPtr Word8, Int, Int, ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr Word8
inBuf, ForeignPtr Word8
outBuf, Int
outOffset, Int
outLength, ())

----------------------------
-- Debug stuff
--

trace :: String -> Stream ()
trace :: String -> Stream ()
trace = IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ()) -> (String -> IO ()) -> String -> Stream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr

dump :: Stream ()
dump :: Stream ()
dump = do
  Ptr Word8
inNext  <- Stream (Ptr Word8)
getInNext
  Int
inAvail <- Stream Int
getInAvail

  Ptr Word8
outNext <- Stream (Ptr Word8)
getOutNext
  Int
outFree <- Stream Int
getOutFree
  Int
outAvail <- Stream Int
getOutAvail
  Int
outOffset <- Stream Int
getOutOffset

  IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ()) -> IO () -> Stream ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
    String
"Stream {\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"  inNext    = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ptr Word8 -> String
forall a. Show a => a -> String
show Ptr Word8
inNext    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"  inAvail   = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
inAvail   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"  outNext   = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ptr Word8 -> String
forall a. Show a => a -> String
show Ptr Word8
outNext   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"  outFree   = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outFree   String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"  outAvail  = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outAvail  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
",\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"  outOffset = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
outOffset String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"  String -> String -> String
forall a. [a] -> [a] -> [a]
++
    String
"}"

  Stream ()
consistencyCheck

consistencyCheck :: Stream ()
consistencyCheck :: Stream ()
consistencyCheck = do

  ForeignPtr Word8
outBuf    <- Stream (ForeignPtr Word8)
getOutBuf
  Int
outOffset <- Stream Int
getOutOffset
  Int
outAvail  <- Stream Int
getOutAvail
  Ptr Word8
outNext   <- Stream (Ptr Word8)
getOutNext

  let outBufPtr :: Ptr Word8
outBufPtr = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
outBuf

  Bool -> Stream () -> Stream ()
forall a. HasCallStack => Bool -> a -> a
assert (Ptr Word8
outBufPtr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
outOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outAvail) Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
outNext) (Stream () -> Stream ()) -> Stream () -> Stream ()
forall a b. (a -> b) -> a -> b
$ () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


----------------------------
-- zlib wrapper layer
--

data Status =
    Ok         -- ^ The requested action was completed successfully.
  | StreamEnd  -- ^ Compression of data was completed, or the logical stream
               --   end was detected during decompression.
  | Error ErrorCode String

data ErrorCode =
    SequenceError
  | ParamError
  | MemoryError
  | DataError
  | DataErrorMagic
  | ConfigError
  | Unexpected

toStatus :: CInt -> Stream Status
toStatus :: CInt -> Stream Status
toStatus CInt
errno = case CInt
errno of
  (CInt
0)         -> Status -> Stream Status
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return Status
Ok
{-# LINE 410 "Codec/Compression/BZip/Stream.hsc" #-}
  (1)     -> return Ok
{-# LINE 411 "Codec/Compression/BZip/Stream.hsc" #-}
  (2)   -> return Ok
{-# LINE 412 "Codec/Compression/BZip/Stream.hsc" #-}
  (3)  -> return Ok
{-# LINE 413 "Codec/Compression/BZip/Stream.hsc" #-}
  (4) -> return StreamEnd
{-# LINE 414 "Codec/Compression/BZip/Stream.hsc" #-}
  (-1)   -> err SequenceError  "incorrect sequence of calls"
{-# LINE 415 "Codec/Compression/BZip/Stream.hsc" #-}
  (-2)      -> err ParamError     "incorrect parameter"
{-# LINE 416 "Codec/Compression/BZip/Stream.hsc" #-}
  (-3)        -> err MemoryError    "not enough memory"
{-# LINE 417 "Codec/Compression/BZip/Stream.hsc" #-}
  (-4)       -> err DataError      "compressed data stream is corrupt"
{-# LINE 418 "Codec/Compression/BZip/Stream.hsc" #-}
  (-5) -> err DataErrorMagic "data stream is not a bzip2 file"
{-# LINE 419 "Codec/Compression/BZip/Stream.hsc" #-}
  (-9)     -> err ConfigError    "configuration error in bzip2 lib"
{-# LINE 420 "Codec/Compression/BZip/Stream.hsc" #-}
  other                          -> err Unexpected
                                      ("unexpected bzip2 status: " ++ show other)
 where
  err :: ErrorCode -> String -> m Status
err ErrorCode
errCode String
msg = Status -> m Status
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ErrorCode -> String -> Status
Error ErrorCode
errCode String
msg)

failIfError :: CInt -> Stream ()
failIfError :: CInt -> Stream ()
failIfError CInt
errno = CInt -> Stream Status
toStatus CInt
errno Stream Status -> (Status -> Stream ()) -> Stream ()
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
status -> case Status
status of
  (Error ErrorCode
_ String
msg) -> String -> Stream ()
forall a. String -> Stream a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg
  Status
_             -> () -> Stream ()
forall a. a -> Stream a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

data Action =
    Run
  | Flush
  | Finish

fromAction :: Action -> CInt
fromAction :: Action -> CInt
fromAction Action
Run    = CInt
0
{-# LINE 437 "Codec/Compression/BZip/Stream.hsc" #-}
fromAction Flush  = 1
{-# LINE 438 "Codec/Compression/BZip/Stream.hsc" #-}
fromAction Finish = 2
{-# LINE 439 "Codec/Compression/BZip/Stream.hsc" #-}

-- | The block size affects both the compression ratio achieved, and the amount
-- of memory needed for compression and decompression.
--
-- @'BlockSize' 1@ through @'BlockSize' 9@ specify the block size to be 100,000
-- bytes through 900,000 bytes respectively. The default is to use the maximum
-- block size.
--
-- Larger block sizes give rapidly diminishing marginal returns. Most of the
-- compression comes from the first two or three hundred k of block size, a
-- fact worth bearing in mind when using bzip2 on small machines. It is also
-- important to appreciate that the decompression memory requirement is set at
-- compression time by the choice of block size.
--
-- * In general, try and use the largest block size memory constraints allow,
-- since that maximises the compression achieved.
--
-- * Compression and decompression speed are virtually unaffected by block
-- size.
--
-- Another significant point applies to files which fit in a single block -
-- that means most files you'd encounter using a large block size. The amount
-- of real memory touched is proportional to the size of the file, since the
-- file is smaller than a block. For example, compressing a file 20,000 bytes
-- long with the flag @'BlockSize' 9@ will cause the compressor to allocate
-- around 7600k of memory, but only touch 400k + 20000 * 8 = 560 kbytes of it.
-- Similarly, the decompressor will allocate 3700k but only touch 100k + 20000
-- * 4 = 180 kbytes.
--
data BlockSize =
    DefaultBlockSize -- ^ The default block size is also the maximum.
  | BlockSize Int    -- ^ A specific block size between 1 and 9.
  deriving (Int -> BlockSize -> String -> String
[BlockSize] -> String -> String
BlockSize -> String
(Int -> BlockSize -> String -> String)
-> (BlockSize -> String)
-> ([BlockSize] -> String -> String)
-> Show BlockSize
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> BlockSize -> String -> String
showsPrec :: Int -> BlockSize -> String -> String
$cshow :: BlockSize -> String
show :: BlockSize -> String
$cshowList :: [BlockSize] -> String -> String
showList :: [BlockSize] -> String -> String
Show)

fromBlockSize :: BlockSize -> CInt
fromBlockSize :: BlockSize -> CInt
fromBlockSize BlockSize
DefaultBlockSize = CInt
9
fromBlockSize (BlockSize Int
n)
            | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
            | Bool
otherwise        = String -> CInt
forall a. HasCallStack => String -> a
error String
"BlockSize must be in the range 1..9"

-- | For files compressed with the default 900k block size, decompression will
-- require about 3700k to decompress. To support decompression of any file in
-- less than 4Mb there is the option to decompress using approximately half
-- this amount of memory, about 2300k. Decompression speed is also halved,
-- so you should use this option only where necessary. 
--
data MemoryLevel =
    DefaultMemoryLevel -- ^ The default.
  | MinMemoryLevel     -- ^ Use minimum memory during decompression. This
                       --   halves the memory needed but also halves the
                       --   decompression speed.
  deriving (Int -> MemoryLevel -> String -> String
[MemoryLevel] -> String -> String
MemoryLevel -> String
(Int -> MemoryLevel -> String -> String)
-> (MemoryLevel -> String)
-> ([MemoryLevel] -> String -> String)
-> Show MemoryLevel
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> MemoryLevel -> String -> String
showsPrec :: Int -> MemoryLevel -> String -> String
$cshow :: MemoryLevel -> String
show :: MemoryLevel -> String
$cshowList :: [MemoryLevel] -> String -> String
showList :: [MemoryLevel] -> String -> String
Show)

fromMemoryLevel :: MemoryLevel -> CInt
fromMemoryLevel :: MemoryLevel -> CInt
fromMemoryLevel MemoryLevel
DefaultMemoryLevel = CInt
0
fromMemoryLevel MemoryLevel
MinMemoryLevel     = CInt
1

-- | The 'WorkFactor' parameter controls how the compression phase behaves when
-- presented with worst case, highly repetitive, input data. If compression
-- runs into difficulties caused by repetitive data, the library switches from
-- the standard sorting algorithm to a fallback algorithm. The fallback is
-- slower than the standard algorithm by perhaps a factor of three, but always
-- behaves reasonably, no matter how bad the input.
--
-- Lower values of 'WorkFactor' reduce the amount of effort the standard
-- algorithm will expend before resorting to the fallback. You should set this
-- parameter carefully; too low, and many inputs will be handled by the
-- fallback algorithm and so compress rather slowly, too high, and your
-- average-to-worst case compression times can become very large. The default
-- value of 30 gives reasonable behaviour over a wide range of circumstances.
--
-- * Note that the compressed output generated is the same regardless of
-- whether or not the fallback algorithm is used.
--
data WorkFactor =
    DefaultWorkFactor -- ^ The default work factor is 30.
  | WorkFactor Int    -- ^ Allowable values range from 1 to 250 inclusive.
  deriving (Int -> WorkFactor -> String -> String
[WorkFactor] -> String -> String
WorkFactor -> String
(Int -> WorkFactor -> String -> String)
-> (WorkFactor -> String)
-> ([WorkFactor] -> String -> String)
-> Show WorkFactor
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> WorkFactor -> String -> String
showsPrec :: Int -> WorkFactor -> String -> String
$cshow :: WorkFactor -> String
show :: WorkFactor -> String
$cshowList :: [WorkFactor] -> String -> String
showList :: [WorkFactor] -> String -> String
Show)

fromWorkFactor :: WorkFactor -> CInt
fromWorkFactor :: WorkFactor -> CInt
fromWorkFactor WorkFactor
DefaultWorkFactor = CInt
0
fromWorkFactor (WorkFactor Int
n)
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
250 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
      | Bool
otherwise          = String -> CInt
forall a. HasCallStack => String -> a
error String
"WorkFactor must be in the range 1..250"

-- | The 'Verbosity' parameter is a number between 0 and 4. 0 is silent, and
-- greater numbers give increasingly verbose monitoring\/debugging output.
--
data Verbosity = Silent        -- ^ No output. This is the default.
               | Verbosity Int -- ^ A specific level between 0 and 4.

fromVerbosity :: Verbosity -> CInt
fromVerbosity :: Verbosity -> CInt
fromVerbosity Verbosity
Silent        = CInt
0
fromVerbosity (Verbosity Int
n)
         | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
4 = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n
         | Bool
otherwise        = String -> CInt
forall a. HasCallStack => String -> a
error String
"Verbosity must be in the range 0..4"

withStreamPtr :: (Ptr StreamState -> IO a) -> Stream a
withStreamPtr :: forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr Ptr StreamState -> IO a
f = do
  ForeignPtr StreamState
stream <- Stream (ForeignPtr StreamState)
getStreamState
  IO a -> Stream a
forall a. IO a -> Stream a
unsafeLiftIO (ForeignPtr StreamState -> (Ptr StreamState -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr StreamState
stream Ptr StreamState -> IO a
f)

withStreamState :: (StreamState -> IO a) -> Stream a
withStreamState :: forall a. (StreamState -> IO a) -> Stream a
withStreamState StreamState -> IO a
f = do
  ForeignPtr StreamState
stream <- Stream (ForeignPtr StreamState)
getStreamState
  IO a -> Stream a
forall a. IO a -> Stream a
unsafeLiftIO (ForeignPtr StreamState -> (Ptr StreamState -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr StreamState
stream (StreamState -> IO a
f (StreamState -> IO a)
-> (Ptr StreamState -> StreamState) -> Ptr StreamState -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr StreamState -> StreamState
StreamState))

setInAvail :: Int -> Stream ()
setInAvail :: Int -> Stream ()
setInAvail Int
val = (Ptr StreamState -> IO ()) -> Stream ()
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((Ptr StreamState -> IO ()) -> Stream ())
-> (Ptr StreamState -> IO ()) -> Stream ()
forall a b. (a -> b) -> a -> b
$ \Ptr StreamState
ptr ->
  (\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StreamState
hsc_ptr Int
8) Ptr StreamState
ptr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val :: CUInt)
{-# LINE 549 "Codec/Compression/BZip/Stream.hsc" #-}

getInAvail :: Stream Int
getInAvail :: Stream Int
getInAvail = (CUInt -> Int) -> Stream CUInt -> Stream Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: CUInt -> Int) (Stream CUInt -> Stream Int) -> Stream CUInt -> Stream Int
forall a b. (a -> b) -> a -> b
$
  (Ptr StreamState -> IO CUInt) -> Stream CUInt
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StreamState
hsc_ptr Int
8))
{-# LINE 553 "Codec/Compression/BZip/Stream.hsc" #-}

setInNext :: Ptr Word8 -> Stream ()
setInNext :: Ptr Word8 -> Stream ()
setInNext Ptr Word8
val = (Ptr StreamState -> IO ()) -> Stream ()
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr (\Ptr StreamState
ptr -> (\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> Ptr Word8 -> IO ()
forall b. Ptr b -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StreamState
hsc_ptr Int
0) Ptr StreamState
ptr Ptr Word8
val)
{-# LINE 556 "Codec/Compression/BZip/Stream.hsc" #-}

getInNext :: Stream (Ptr Word8)
getInNext :: Stream (Ptr Word8)
getInNext = (Ptr StreamState -> IO (Ptr Word8)) -> Stream (Ptr Word8)
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> IO (Ptr Word8)
forall b. Ptr b -> Int -> IO (Ptr Word8)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StreamState
hsc_ptr Int
0))
{-# LINE 559 "Codec/Compression/BZip/Stream.hsc" #-}

setOutFree :: Int -> Stream ()
setOutFree :: Int -> Stream ()
setOutFree Int
val = (Ptr StreamState -> IO ()) -> Stream ()
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((Ptr StreamState -> IO ()) -> Stream ())
-> (Ptr StreamState -> IO ()) -> Stream ()
forall a b. (a -> b) -> a -> b
$ \Ptr StreamState
ptr ->
  (\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StreamState
hsc_ptr Int
32) Ptr StreamState
ptr (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
val :: CUInt)
{-# LINE 563 "Codec/Compression/BZip/Stream.hsc" #-}

getOutFree :: Stream Int
getOutFree :: Stream Int
getOutFree = (CUInt -> Int) -> Stream CUInt -> Stream Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: CUInt -> Int) (Stream CUInt -> Stream Int) -> Stream CUInt -> Stream Int
forall a b. (a -> b) -> a -> b
$
  (Ptr StreamState -> IO CUInt) -> Stream CUInt
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StreamState
hsc_ptr Int
32))
{-# LINE 567 "Codec/Compression/BZip/Stream.hsc" #-}

setOutNext  :: Ptr Word8 -> Stream ()
setOutNext :: Ptr Word8 -> Stream ()
setOutNext Ptr Word8
val = (Ptr StreamState -> IO ()) -> Stream ()
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr (\Ptr StreamState
ptr -> (\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> Ptr Word8 -> IO ()
forall b. Ptr b -> Int -> Ptr Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr StreamState
hsc_ptr Int
24) Ptr StreamState
ptr Ptr Word8
val)
{-# LINE 570 "Codec/Compression/BZip/Stream.hsc" #-}

getOutNext :: Stream (Ptr Word8)
getOutNext :: Stream (Ptr Word8)
getOutNext = (Ptr StreamState -> IO (Ptr Word8)) -> Stream (Ptr Word8)
forall a. (Ptr StreamState -> IO a) -> Stream a
withStreamPtr ((\Ptr StreamState
hsc_ptr -> Ptr StreamState -> Int -> IO (Ptr Word8)
forall b. Ptr b -> Int -> IO (Ptr Word8)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr StreamState
hsc_ptr Int
24))
{-# LINE 573 "Codec/Compression/BZip/Stream.hsc" #-}

decompressInit :: Verbosity -> MemoryLevel -> Stream ()
decompressInit :: Verbosity -> MemoryLevel -> Stream ()
decompressInit Verbosity
verbosity MemoryLevel
memoryLevel = do
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
bzstream ->
    StreamState -> CInt -> CInt -> IO CInt
bzDecompressInit StreamState
bzstream
      (Verbosity -> CInt
fromVerbosity Verbosity
verbosity)
      (MemoryLevel -> CInt
fromMemoryLevel MemoryLevel
memoryLevel)
  CInt -> Stream ()
failIfError CInt
err
  Stream (ForeignPtr StreamState)
getStreamState Stream (ForeignPtr StreamState)
-> (ForeignPtr StreamState -> Stream ()) -> Stream ()
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ())
-> (ForeignPtr StreamState -> IO ())
-> ForeignPtr StreamState
-> Stream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr StreamState -> ForeignPtr StreamState -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr StreamState
bzDecompressEnd

compressInit :: BlockSize -> Verbosity -> WorkFactor -> Stream ()
compressInit :: BlockSize -> Verbosity -> WorkFactor -> Stream ()
compressInit BlockSize
blockSize Verbosity
verbosity WorkFactor
workFactor = do
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
bzstream ->
    StreamState -> CInt -> CInt -> CInt -> IO CInt
bzCompressInit StreamState
bzstream
      (BlockSize -> CInt
fromBlockSize BlockSize
blockSize)
      (Verbosity -> CInt
fromVerbosity Verbosity
verbosity)
      (WorkFactor -> CInt
fromWorkFactor WorkFactor
workFactor)
  CInt -> Stream ()
failIfError CInt
err
  Stream (ForeignPtr StreamState)
getStreamState Stream (ForeignPtr StreamState)
-> (ForeignPtr StreamState -> Stream ()) -> Stream ()
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ())
-> (ForeignPtr StreamState -> IO ())
-> ForeignPtr StreamState
-> Stream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr StreamState -> ForeignPtr StreamState -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
addForeignPtrFinalizer FinalizerPtr StreamState
bzCompressEnd

decompress_ :: Stream Status
decompress_ :: Stream Status
decompress_ = do
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
bzstream ->
    StreamState -> IO CInt
bzDecompress StreamState
bzstream
  CInt -> Stream Status
toStatus CInt
err

compress_ :: Action -> Stream Status
compress_ :: Action -> Stream Status
compress_ Action
action = do
  CInt
err <- (StreamState -> IO CInt) -> Stream CInt
forall a. (StreamState -> IO a) -> Stream a
withStreamState ((StreamState -> IO CInt) -> Stream CInt)
-> (StreamState -> IO CInt) -> Stream CInt
forall a b. (a -> b) -> a -> b
$ \StreamState
bzstream ->
    StreamState -> CInt -> IO CInt
bzCompress StreamState
bzstream (Action -> CInt
fromAction Action
action)
  CInt -> Stream Status
toStatus CInt
err

-- | This never needs to be used as the stream's resources will be released
-- automatically when no longer needed, however this can be used to release
-- them early. Only use this when you can guarantee that the stream will no
-- longer be needed, for example if an error occurs or if the stream ends.
--
finalise :: Stream ()
finalise :: Stream ()
finalise = Stream (ForeignPtr StreamState)
getStreamState Stream (ForeignPtr StreamState)
-> (ForeignPtr StreamState -> Stream ()) -> Stream ()
forall a b. Stream a -> (a -> Stream b) -> Stream b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Stream ()
forall a. IO a -> Stream a
unsafeLiftIO (IO () -> Stream ())
-> (ForeignPtr StreamState -> IO ())
-> ForeignPtr StreamState
-> Stream ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr StreamState -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr

----------------------
-- The foreign imports

newtype StreamState = StreamState (Ptr StreamState)

foreign import ccall unsafe "bzlib.h BZ2_bzDecompressInit"
  bzDecompressInit :: StreamState -> CInt -> CInt -> IO CInt

foreign import ccall unsafe "bzlib.h BZ2_bzDecompress"
  bzDecompress :: StreamState -> IO CInt

foreign import ccall unsafe "hs-bzlib.h &_hs_bzlib_bzDecompressEnd"
  bzDecompressEnd :: FinalizerPtr StreamState


foreign import ccall unsafe "bzlib.h BZ2_bzCompressInit"
  bzCompressInit :: StreamState -> CInt -> CInt -> CInt -> IO CInt

foreign import ccall unsafe "bzlib.h BZ2_bzCompress"
  bzCompress :: StreamState -> CInt -> IO CInt

foreign import ccall unsafe "hs-bzlib.h &_hs_bzlib_bzCompressEnd"
  bzCompressEnd :: FinalizerPtr StreamState