{-# 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 )

{-# LINE 66 "Codec/Compression/BZip/Stream.hsc" #-}
import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr )

{-# LINE 70 "Codec/Compression/BZip/Stream.hsc" #-}
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

{-# LINE 77 "Codec/Compression/BZip/Stream.hsc" #-}

{-# LINE 78 "Codec/Compression/BZip/Stream.hsc" #-}
import Control.Monad.ST.Strict

{-# LINE 82 "Codec/Compression/BZip/Stream.hsc" #-}
import Control.Monad.ST.Unsafe

{-# LINE 86 "Codec/Compression/BZip/Stream.hsc" #-}
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
  inAvail <- Stream Int
getInAvail
  assert (inAvail == 0) $ 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.
  inBuf <- getInBuf 
  unsafeLiftIO $ touchForeignPtr inBuf    

  -- now set the available input buffer ptr and length
  setInBuf   inBuf'
  setInAvail length
  setInNext  (unsafeForeignPtrToPtr inBuf' `plusPtr` 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

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

  -- there really should be something to pop, otherwise it's silly
  assert (inAvail > 0) $ return ()
  setInAvail 0

  return (inBuf, inNext `minusPtr` unsafeForeignPtrToPtr inBuf, 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
  outAvail <- Stream Int
getOutAvail
  assert (outAvail == 0) $ 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.

  outBuf <- getOutBuf
  unsafeLiftIO $ touchForeignPtr outBuf

  -- now set the available input buffer ptr and length
  setOutBuf  outBuf'
  setOutFree length
  setOutNext (unsafeForeignPtrToPtr outBuf' `plusPtr` offset)

  setOutOffset offset
  setOutAvail  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

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

  -- there really should be something to pop, otherwise it's silly
  assert (outAvail > 0) $ return ()

  setOutOffset (outOffset + outAvail)
  setOutAvail  0

  return (outBuf, outOffset, 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

  outFree <- Stream Int
getOutFree

  -- deflate needs free space in the output buffer
  assert (outFree > 0) $ return ()

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


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

  outFree <- Stream Int
getOutFree

  -- inflate needs free space in the output buffer
  assert (outFree > 0) $ return ()

  result <- decompress_
  outFree' <- getOutFree

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

  outAvail <- getOutAvail
  setOutAvail (outAvail + outExtra)
  return 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
--  m >>= f = (m `thenZ` \a -> consistencyCheck `thenZ_` returnZ a) `thenZ` f
  >> :: 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

{-# LINE 266 "Codec/Compression/BZip/Stream.hsc" #-}

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
  stream <- Int -> IO (ForeignPtr StreamState)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes (Int
80)
{-# LINE 303 "Codec/Compression/BZip/Stream.hsc" #-}
  withForeignPtr stream $ \ptr -> do
    (\hsc_ptr -> pokeByteOff hsc_ptr 56)   ptr nullPtr
{-# LINE 305 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 64)    ptr nullPtr
{-# LINE 306 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 72)    ptr nullPtr
{-# LINE 307 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 0)   ptr nullPtr
{-# LINE 308 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 24)  ptr nullPtr
{-# LINE 309 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 8)  ptr (0 :: CUInt)
{-# LINE 310 "Codec/Compression/BZip/Stream.hsc" #-}
    (\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr (0 :: CUInt)
{-# LINE 311 "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 <- IO a
m
  return (inBuf, outBuf, outOffset, outLength, 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
  inNext  <- Stream (Ptr Word8)
getInNext
  inAvail <- getInAvail

  outNext <- getOutNext
  outFree <- getOutFree
  outAvail <- getOutAvail
  outOffset <- getOutOffset

  unsafeLiftIO $ hPutStrLn stderr $
    "Stream {\n" ++
    "  inNext    = " ++ show inNext    ++ ",\n" ++
    "  inAvail   = " ++ show inAvail   ++ ",\n" ++
    "\n" ++
    "  outNext   = " ++ show outNext   ++ ",\n" ++
    "  outFree   = " ++ show outFree   ++ ",\n" ++
    "  outAvail  = " ++ show outAvail  ++ ",\n" ++
    "  outOffset = " ++ show outOffset ++ "\n"  ++
    "}"

  consistencyCheck

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

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

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

  assert (outBufPtr `plusPtr` (outOffset + outAvail) == outNext) $ 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 426 "Codec/Compression/BZip/Stream.hsc" #-}
  (1)     -> return Ok
{-# LINE 427 "Codec/Compression/BZip/Stream.hsc" #-}
  (2)   -> return Ok
{-# LINE 428 "Codec/Compression/BZip/Stream.hsc" #-}
  (3)  -> return Ok
{-# LINE 429 "Codec/Compression/BZip/Stream.hsc" #-}
  (4) -> return StreamEnd
{-# LINE 430 "Codec/Compression/BZip/Stream.hsc" #-}
  (-1)   -> err SequenceError  "incorrect sequence of calls"
{-# LINE 431 "Codec/Compression/BZip/Stream.hsc" #-}
  (-2)      -> err ParamError     "incorrect parameter"
{-# LINE 432 "Codec/Compression/BZip/Stream.hsc" #-}
  (-3)        -> err MemoryError    "not enough memory"
{-# LINE 433 "Codec/Compression/BZip/Stream.hsc" #-}
  (-4)       -> err DataError      "compressed data stream is corrupt"
{-# LINE 434 "Codec/Compression/BZip/Stream.hsc" #-}
  (-5) -> err DataErrorMagic "data stream is not a bzip2 file"
{-# LINE 435 "Codec/Compression/BZip/Stream.hsc" #-}
  (-9)     -> err ConfigError    "configuration error in bzip2 lib"
{-# LINE 436 "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 453 "Codec/Compression/BZip/Stream.hsc" #-}
fromAction Flush  = 1
{-# LINE 454 "Codec/Compression/BZip/Stream.hsc" #-}
fromAction Finish = 2
{-# LINE 455 "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
  stream <- Stream (ForeignPtr StreamState)
getStreamState
  unsafeLiftIO (withForeignPtr stream f)

withStreamState :: (StreamState -> IO a) -> Stream a
withStreamState :: forall a. (StreamState -> IO a) -> Stream a
withStreamState StreamState -> IO a
f = do
  stream <- Stream (ForeignPtr StreamState)
getStreamState
  unsafeLiftIO (withForeignPtr stream (f . 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 565 "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 569 "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 572 "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 575 "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 579 "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 583 "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 586 "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 589 "Codec/Compression/BZip/Stream.hsc" #-}

decompressInit :: Verbosity -> MemoryLevel -> Stream ()
decompressInit :: Verbosity -> MemoryLevel -> Stream ()
decompressInit Verbosity
verbosity MemoryLevel
memoryLevel = do
  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)
  failIfError err
  getStreamState >>= unsafeLiftIO . addForeignPtrFinalizer bzDecompressEnd

compressInit :: BlockSize -> Verbosity -> WorkFactor -> Stream ()
compressInit :: BlockSize -> Verbosity -> WorkFactor -> Stream ()
compressInit BlockSize
blockSize Verbosity
verbosity WorkFactor
workFactor = do
  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)
  failIfError err
  getStreamState >>= unsafeLiftIO . addForeignPtrFinalizer bzCompressEnd

decompress_ :: Stream Status
decompress_ :: Stream Status
decompress_ = do
  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
  toStatus err

compress_ :: Action -> Stream Status
compress_ :: Action -> Stream Status
compress_ Action
action = do
  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)
  toStatus 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