{-# LINE 1 "src/Data/Conduit/BZlib/Internal.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}




module Data.Conduit.BZlib.Internal where

import Foreign.Ptr (Ptr,FunPtr,plusPtr)
import Foreign.Ptr (wordPtrToPtr,castPtrToFunPtr)
import Foreign.Storable
import Foreign.C.Types
import Foreign.C.String (CString,CStringLen,CWString,CWStringLen)
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (peekArray,pokeArray)
import Data.Int
import Data.Word

{-# LINE 9 "src/Data/Conduit/BZlib/Internal.hsc" #-}

c'BZ_RUN = 0
c'BZ_RUN :: (Num a) => a

{-# LINE 11 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_FLUSH = 1
c'BZ_FLUSH :: (Num a) => a

{-# LINE 12 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_FINISH = 2
c'BZ_FINISH :: (Num a) => a

{-# LINE 13 "src/Data/Conduit/BZlib/Internal.hsc" #-}

c'BZ_OK = 0
c'BZ_OK :: (Num a) => a

{-# LINE 15 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_RUN_OK = 1
c'BZ_RUN_OK :: (Num a) => a

{-# LINE 16 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_FLUSH_OK = 2
c'BZ_FLUSH_OK :: (Num a) => a

{-# LINE 17 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_FINISH_OK = 3
c'BZ_FINISH_OK :: (Num a) => a

{-# LINE 18 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_STREAM_END = 4
c'BZ_STREAM_END :: (Num a) => a

{-# LINE 19 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_SEQUENCE_ERROR = -1
c'BZ_SEQUENCE_ERROR :: (Num a) => a

{-# LINE 20 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_PARAM_ERROR = -2
c'BZ_PARAM_ERROR :: (Num a) => a

{-# LINE 21 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_MEM_ERROR = -3
c'BZ_MEM_ERROR :: (Num a) => a

{-# LINE 22 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_DATA_ERROR = -4
c'BZ_DATA_ERROR :: (Num a) => a

{-# LINE 23 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_DATA_ERROR_MAGIC = -5
c'BZ_DATA_ERROR_MAGIC :: (Num a) => a

{-# LINE 24 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_IO_ERROR = -6
c'BZ_IO_ERROR :: (Num a) => a

{-# LINE 25 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_UNEXPECTED_EOF = -7
c'BZ_UNEXPECTED_EOF :: (Num a) => a

{-# LINE 26 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_OUTBUFF_FULL = -8
c'BZ_OUTBUFF_FULL :: (Num a) => a

{-# LINE 27 "src/Data/Conduit/BZlib/Internal.hsc" #-}
c'BZ_CONFIG_ERROR = -9
c'BZ_CONFIG_ERROR :: (Num a) => a

{-# LINE 28 "src/Data/Conduit/BZlib/Internal.hsc" #-}


{-# LINE 30 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 31 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 32 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 33 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 34 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 35 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 36 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 37 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 38 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 39 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 40 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 41 "src/Data/Conduit/BZlib/Internal.hsc" #-}

{-# LINE 42 "src/Data/Conduit/BZlib/Internal.hsc" #-}
data C'bz_stream = C'bz_stream{
  c'bz_stream'next_in :: Ptr CChar,
  c'bz_stream'avail_in :: CUInt,
  c'bz_stream'total_in_lo32 :: CUInt,
  c'bz_stream'total_in_hi32 :: CUInt,
  c'bz_stream'next_out :: Ptr CChar,
  c'bz_stream'avail_out :: CUInt,
  c'bz_stream'total_out_lo32 :: CUInt,
  c'bz_stream'total_out_hi32 :: CUInt,
  c'bz_stream'state :: Ptr (),
  c'bz_stream'bzalloc :: Ptr (),
  c'bz_stream'bzfree :: Ptr (),
  c'bz_stream'opaque :: Ptr ()
} deriving (Eq,Show)
p'bz_stream'next_in :: Ptr C'bz_stream -> Ptr (Ptr CChar)
p'bz_stream'next_in Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
0
p'bz_stream'next_in :: Ptr (C'bz_stream) -> Ptr (Ptr CChar)
p'bz_stream'avail_in :: Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'avail_in Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
8
p'bz_stream'avail_in :: Ptr (C'bz_stream) -> Ptr (CUInt)
p'bz_stream'total_in_lo32 :: Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'total_in_lo32 Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
12
p'bz_stream'total_in_lo32 :: Ptr (C'bz_stream) -> Ptr (CUInt)
p'bz_stream'total_in_hi32 :: Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'total_in_hi32 Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
16
p'bz_stream'total_in_hi32 :: Ptr (C'bz_stream) -> Ptr (CUInt)
p'bz_stream'next_out :: Ptr C'bz_stream -> Ptr (Ptr CChar)
p'bz_stream'next_out Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
24
p'bz_stream'next_out :: Ptr (C'bz_stream) -> Ptr (Ptr CChar)
p'bz_stream'avail_out :: Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'avail_out Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
32
p'bz_stream'avail_out :: Ptr (C'bz_stream) -> Ptr (CUInt)
p'bz_stream'total_out_lo32 :: Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'total_out_lo32 Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
36
p'bz_stream'total_out_lo32 :: Ptr (C'bz_stream) -> Ptr (CUInt)
p'bz_stream'total_out_hi32 :: Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'total_out_hi32 Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
40
p'bz_stream'total_out_hi32 :: Ptr (C'bz_stream) -> Ptr (CUInt)
p'bz_stream'state :: Ptr C'bz_stream -> Ptr (Ptr ())
p'bz_stream'state Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
48
p'bz_stream'state :: Ptr (C'bz_stream) -> Ptr (Ptr ())
p'bz_stream'bzalloc :: Ptr C'bz_stream -> Ptr (Ptr ())
p'bz_stream'bzalloc Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
56
p'bz_stream'bzalloc :: Ptr (C'bz_stream) -> Ptr (Ptr ())
p'bz_stream'bzfree :: Ptr C'bz_stream -> Ptr (Ptr ())
p'bz_stream'bzfree Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
64
p'bz_stream'bzfree :: Ptr (C'bz_stream) -> Ptr (Ptr ())
p'bz_stream'opaque :: Ptr C'bz_stream -> Ptr (Ptr ())
p'bz_stream'opaque Ptr C'bz_stream
p = Ptr C'bz_stream -> Int -> Ptr (Ptr ())
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr C'bz_stream
p Int
72
p'bz_stream'opaque :: Ptr (C'bz_stream) -> Ptr (Ptr ())
instance Storable C'bz_stream where
  sizeOf :: C'bz_stream -> Int
sizeOf C'bz_stream
_ = Int
80
  alignment :: C'bz_stream -> Int
alignment C'bz_stream
_ = Int
8
  peek :: Ptr C'bz_stream -> IO C'bz_stream
peek Ptr C'bz_stream
_p = do
    Ptr CChar
v0 <- Ptr C'bz_stream -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
0
    CUInt
v1 <- Ptr C'bz_stream -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
8
    CUInt
v2 <- Ptr C'bz_stream -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
12
    CUInt
v3 <- Ptr C'bz_stream -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
16
    Ptr CChar
v4 <- Ptr C'bz_stream -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
24
    CUInt
v5 <- Ptr C'bz_stream -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
32
    CUInt
v6 <- Ptr C'bz_stream -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
36
    CUInt
v7 <- Ptr C'bz_stream -> Int -> IO CUInt
forall b. Ptr b -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
40
    Ptr ()
v8 <- Ptr C'bz_stream -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
48
    Ptr ()
v9 <- Ptr C'bz_stream -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
56
    Ptr ()
v10 <- Ptr C'bz_stream -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
64
    Ptr ()
v11 <- Ptr C'bz_stream -> Int -> IO (Ptr ())
forall b. Ptr b -> Int -> IO (Ptr ())
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr C'bz_stream
_p Int
72
    C'bz_stream -> IO C'bz_stream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (C'bz_stream -> IO C'bz_stream) -> C'bz_stream -> IO C'bz_stream
forall a b. (a -> b) -> a -> b
$ Ptr CChar
-> CUInt
-> CUInt
-> CUInt
-> Ptr CChar
-> CUInt
-> CUInt
-> CUInt
-> Ptr ()
-> Ptr ()
-> Ptr ()
-> Ptr ()
-> C'bz_stream
C'bz_stream Ptr CChar
v0 CUInt
v1 CUInt
v2 CUInt
v3 Ptr CChar
v4 CUInt
v5 CUInt
v6 CUInt
v7 Ptr ()
v8 Ptr ()
v9 Ptr ()
v10 Ptr ()
v11
  poke :: Ptr C'bz_stream -> C'bz_stream -> IO ()
poke Ptr C'bz_stream
_p (C'bz_stream Ptr CChar
v0 CUInt
v1 CUInt
v2 CUInt
v3 Ptr CChar
v4 CUInt
v5 CUInt
v6 CUInt
v7 Ptr ()
v8 Ptr ()
v9 Ptr ()
v10 Ptr ()
v11) = do
    Ptr C'bz_stream -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
0 Ptr CChar
v0
    Ptr C'bz_stream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
8 CUInt
v1
    Ptr C'bz_stream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
12 CUInt
v2
    Ptr C'bz_stream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
16 CUInt
v3
    Ptr C'bz_stream -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
24 Ptr CChar
v4
    Ptr C'bz_stream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
32 CUInt
v5
    Ptr C'bz_stream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
36 CUInt
v6
    Ptr C'bz_stream -> Int -> CUInt -> IO ()
forall b. Ptr b -> Int -> CUInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
40 CUInt
v7
    Ptr C'bz_stream -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
48 Ptr ()
v8
    Ptr C'bz_stream -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
56 Ptr ()
v9
    Ptr C'bz_stream -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
64 Ptr ()
v10
    Ptr C'bz_stream -> Int -> Ptr () -> IO ()
forall b. Ptr b -> Int -> Ptr () -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr C'bz_stream
_p Int
72 Ptr ()
v11
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-# LINE 43 "src/Data/Conduit/BZlib/Internal.hsc" #-}

foreign import ccall "BZ2_bzCompressInit" c'BZ2_bzCompressInit
  :: Ptr C'bz_stream -> CInt -> CInt -> CInt -> IO CInt
foreign import ccall "&BZ2_bzCompressInit" p'BZ2_bzCompressInit
  :: FunPtr (Ptr C'bz_stream -> CInt -> CInt -> CInt -> IO CInt)

{-# LINE 45 "src/Data/Conduit/BZlib/Internal.hsc" #-}
foreign import ccall "BZ2_bzCompress" c'BZ2_bzCompress
  :: Ptr C'bz_stream -> CInt -> IO CInt
foreign import ccall "&BZ2_bzCompress" p'BZ2_bzCompress
  :: FunPtr (Ptr C'bz_stream -> CInt -> IO CInt)

{-# LINE 46 "src/Data/Conduit/BZlib/Internal.hsc" #-}
foreign import ccall "BZ2_bzCompressEnd" c'BZ2_bzCompressEnd
  :: Ptr C'bz_stream -> IO CInt
foreign import ccall "&BZ2_bzCompressEnd" p'BZ2_bzCompressEnd
  :: FunPtr (Ptr C'bz_stream -> IO CInt)

{-# LINE 47 "src/Data/Conduit/BZlib/Internal.hsc" #-}

foreign import ccall "BZ2_bzDecompressInit" c'BZ2_bzDecompressInit
  :: Ptr C'bz_stream -> CInt -> CInt -> IO CInt
foreign import ccall "&BZ2_bzDecompressInit" p'BZ2_bzDecompressInit
  :: FunPtr (Ptr C'bz_stream -> CInt -> CInt -> IO CInt)

{-# LINE 49 "src/Data/Conduit/BZlib/Internal.hsc" #-}
foreign import ccall "BZ2_bzDecompress" c'BZ2_bzDecompress
  :: Ptr C'bz_stream -> IO CInt
foreign import ccall "&BZ2_bzDecompress" p'BZ2_bzDecompress
  :: FunPtr (Ptr C'bz_stream -> IO CInt)

{-# LINE 50 "src/Data/Conduit/BZlib/Internal.hsc" #-}
foreign import ccall "BZ2_bzDecompressEnd" c'BZ2_bzDecompressEnd
  :: Ptr C'bz_stream -> IO CInt
foreign import ccall "&BZ2_bzDecompressEnd" p'BZ2_bzDecompressEnd
  :: FunPtr (Ptr C'bz_stream -> IO CInt)

{-# LINE 51 "src/Data/Conduit/BZlib/Internal.hsc" #-}