-- GENERATED by C->Haskell Compiler, version 0.28.3 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Codec/Compression/BZip/Foreign.chs" #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | This module uses exceptions behind the scenes
--
-- Consult the upstream [documentation](https://www.sourceware.org/bzip2/docs.html) for how to use this library.
--
-- For struct accessors, I recommend using [c2hs](http://hackage.haskell.org/package/c2hs).
module Codec.Compression.BZip.Foreign ( -- * Types
                                        BZAction (..)
                                      , BZError (..)
                                      , BzStream
                                      , BzStreamPtr
                                      , BzFile
                                      , BzFilePtr
                                      , FilePtr
                                      -- * Low-level functions
                                      , bZ2BzCompressInit
                                      , bZ2BzCompress
                                      , bZ2BzCompressEnd
                                      , bZ2BzDecompressInit
                                      , bZ2BzDecompress
                                      , bZ2BzDecompressEnd
                                      -- * High-level functions
                                      , bZ2BzReadOpen
                                      , bZ2BzReadClose
                                      , bZ2BzReadGetUnused
                                      , bZ2BzRead
                                      , bZ2BzWriteOpen
                                      , bZ2BzWrite
                                      , bZ2BzWriteClose
                                      , bZ2BzWriteClose64
                                      -- * Macros
                                      , bZMaxUnused
                                      -- * Utility functions
                                      , bZ2BzBuffToBuffCompress
                                      , bZ2BzBuffToBuffDecompress
                                      -- * Contributed functions
                                      , bZ2BzlibVersion
                                      ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import Control.Applicative
import Control.Exception (Exception, throw)
import Control.Monad ((<=<))
import Data.Typeable (Typeable)
import Foreign.C.Types (CInt, CUInt)
import Foreign.Marshal (alloca)
import Foreign.Ptr (castPtr, Ptr)
import Foreign.Storable (peek)



data BZAction = BzRun
              | BzFlush
              | BzFinish
instance Enum BZAction where
  succ BzRun = BzFlush
  succ BzFlush = BzFinish
  succ BzFinish = error "BZAction.succ: BzFinish has no successor"

  pred BzFlush = BzRun
  pred BzFinish = BzFlush
  pred BzRun = error "BZAction.pred: BzRun has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from BzFinish

  fromEnum BzRun = 0
  fromEnum BzFlush = 1
  fromEnum BzFinish = 2

  toEnum 0 = BzRun
  toEnum 1 = BzFlush
  toEnum 2 = BzFinish
  toEnum unmatched = error ("BZAction.toEnum: Cannot match " ++ show unmatched)

{-# LINE 56 "src/Codec/Compression/BZip/Foreign.chs" #-}


data BZError = BzConfigError
             | BzOutbuffFull
             | BzUnexpectedEof
             | BzIoError
             | BzDataErrorMagic
             | BzDataError
             | BzMemError
             | BzParamError
             | BzSequenceError
             | BzOk
             | BzRunOk
             | BzFlushOk
             | BzFinishOk
             | BzStreamEnd
  deriving (Eq,Show,Typeable)
instance Enum BZError where
  succ BzConfigError = BzOutbuffFull
  succ BzOutbuffFull = BzUnexpectedEof
  succ BzUnexpectedEof = BzIoError
  succ BzIoError = BzDataErrorMagic
  succ BzDataErrorMagic = BzDataError
  succ BzDataError = BzMemError
  succ BzMemError = BzParamError
  succ BzParamError = BzSequenceError
  succ BzSequenceError = BzOk
  succ BzOk = BzRunOk
  succ BzRunOk = BzFlushOk
  succ BzFlushOk = BzFinishOk
  succ BzFinishOk = BzStreamEnd
  succ BzStreamEnd = error "BZError.succ: BzStreamEnd has no successor"

  pred BzOutbuffFull = BzConfigError
  pred BzUnexpectedEof = BzOutbuffFull
  pred BzIoError = BzUnexpectedEof
  pred BzDataErrorMagic = BzIoError
  pred BzDataError = BzDataErrorMagic
  pred BzMemError = BzDataError
  pred BzParamError = BzMemError
  pred BzSequenceError = BzParamError
  pred BzOk = BzSequenceError
  pred BzRunOk = BzOk
  pred BzFlushOk = BzRunOk
  pred BzFinishOk = BzFlushOk
  pred BzStreamEnd = BzFinishOk
  pred BzConfigError = error "BZError.pred: BzConfigError has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from BzStreamEnd

  fromEnum BzConfigError = (-9)
  fromEnum BzOutbuffFull = (-8)
  fromEnum BzUnexpectedEof = (-7)
  fromEnum BzIoError = (-6)
  fromEnum BzDataErrorMagic = (-5)
  fromEnum BzDataError = (-4)
  fromEnum BzMemError = (-3)
  fromEnum BzParamError = (-2)
  fromEnum BzSequenceError = (-1)
  fromEnum BzOk = 0
  fromEnum BzRunOk = 1
  fromEnum BzFlushOk = 2
  fromEnum BzFinishOk = 3
  fromEnum BzStreamEnd = 4

  toEnum (-9) = BzConfigError
  toEnum (-8) = BzOutbuffFull
  toEnum (-7) = BzUnexpectedEof
  toEnum (-6) = BzIoError
  toEnum (-5) = BzDataErrorMagic
  toEnum (-4) = BzDataError
  toEnum (-3) = BzMemError
  toEnum (-2) = BzParamError
  toEnum (-1) = BzSequenceError
  toEnum 0 = BzOk
  toEnum 1 = BzRunOk
  toEnum 2 = BzFlushOk
  toEnum 3 = BzFinishOk
  toEnum 4 = BzStreamEnd
  toEnum unmatched = error ("BZError.toEnum: Cannot match " ++ show unmatched)

{-# LINE 73 "src/Codec/Compression/BZip/Foreign.chs" #-}


instance Exception BZError where

-- | Abstract type
data BzStream

-- | Abstract type
data BzFile

type BzStreamPtr = C2HSImp.Ptr (BzStream)
{-# LINE 83 "src/Codec/Compression/BZip/Foreign.chs" #-}

-- | @FILE*@ in C.
newtype FilePtr = FilePtr (C2HSImp.Ptr (FilePtr))
{-# LINE 85 "src/Codec/Compression/BZip/Foreign.chs" #-}

type BzFilePtr = C2HSImp.Ptr (BzFile)
{-# LINE 86 "src/Codec/Compression/BZip/Foreign.chs" #-}


-- Low-level functions
bZ2BzCompressInit :: (BzStreamPtr) -> (CInt) -> (CInt) -> (CInt) -> IO ()
bZ2BzCompressInit a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  bZ2BzCompressInit'_ a1' a2' a3' a4' >>= \res ->
  bzWrap res >>
  return ()

{-# LINE 89 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzCompress :: (BzStreamPtr) -> (BZAction) -> IO ((BZError))
bZ2BzCompress a1 a2 =
  let {a1' = id a1} in
  let {a2' = (fromIntegral . fromEnum) a2} in
  bZ2BzCompress'_ a1' a2' >>= \res ->
  bzWrap res >>= \res' ->
  return (res')

{-# LINE 90 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzCompressEnd :: (BzStreamPtr) -> IO ()
bZ2BzCompressEnd a1 =
  let {a1' = id a1} in
  bZ2BzCompressEnd'_ a1' >>= \res ->
  bzWrap res >>
  return ()

{-# LINE 91 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzDecompressInit :: (BzStreamPtr) -> (CInt) -> (Bool) -> IO ()
bZ2BzDecompressInit a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = C2HSImp.fromBool a3} in
  bZ2BzDecompressInit'_ a1' a2' a3' >>= \res ->
  bzWrap res >>
  return ()

{-# LINE 92 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzDecompress :: (BzStreamPtr) -> IO ((BZError))
bZ2BzDecompress a1 =
  let {a1' = id a1} in
  bZ2BzDecompress'_ a1' >>= \res ->
  bzWrap res >>= \res' ->
  return (res')

{-# LINE 93 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzDecompressEnd :: (BzStreamPtr) -> IO ()
bZ2BzDecompressEnd a1 =
  let {a1' = id a1} in
  bZ2BzDecompressEnd'_ a1' >>= \res ->
  bzWrap res >>
  return ()

{-# LINE 94 "src/Codec/Compression/BZip/Foreign.chs" #-}


-- High-level functions
bZ2BzReadOpen :: (FilePtr) -> (CInt) -> (Bool) -> (Ptr a) -> (CInt) -> IO ((BzFilePtr), (BZError))
bZ2BzReadOpen a2 a3 a4 a5 a6 =
  alloca $ \a1' ->
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = C2HSImp.fromBool a4} in
  let {a5' = castPtr a5} in
  let {a6' = fromIntegral a6} in
  bZ2BzReadOpen'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  peekBZError  a1'>>= \a1'' ->
  return (res', a1'')

{-# LINE 97 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzReadClose :: (BzFilePtr) -> IO ((BZError))
bZ2BzReadClose a2 =
  alloca $ \a1' ->
  let {a2' = id a2} in
  bZ2BzReadClose'_ a1' a2' >>
  peekBZError  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 98 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzReadGetUnused :: (BzFilePtr) -> IO ((BZError), (Ptr a), (CInt))
bZ2BzReadGetUnused a2 =
  alloca $ \a1' ->
  let {a2' = id a2} in
  alloca $ \a3' ->
  alloca $ \a4' ->
  bZ2BzReadGetUnused'_ a1' a2' a3' a4' >>
  peekBZError  a1'>>= \a1'' ->
  peekVoidPtr  a3'>>= \a3'' ->
  peek  a4'>>= \a4'' ->
  return (a1'', a3'', a4'')

{-# LINE 99 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzRead :: (BzFilePtr) -> (Ptr a) -> (CInt) -> IO ((CInt), (BZError))
bZ2BzRead a2 a3 a4 =
  alloca $ \a1' ->
  let {a2' = id a2} in
  let {a3' = castPtr a3} in
  let {a4' = fromIntegral a4} in
  bZ2BzRead'_ a1' a2' a3' a4' >>= \res ->
  let {res' = fromIntegral res} in
  peekBZError  a1'>>= \a1'' ->
  return (res', a1'')

{-# LINE 100 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzWriteOpen :: (FilePtr) -> (CInt) -> (CInt) -> (CInt) -> IO ((BzFilePtr), (BZError))
bZ2BzWriteOpen a2 a3 a4 a5 =
  alloca $ \a1' ->
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  bZ2BzWriteOpen'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  peekBZError  a1'>>= \a1'' ->
  return (res', a1'')

{-# LINE 101 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzWrite :: (BzFilePtr) -> (Ptr a) -> (CInt) -> IO ((BZError))
bZ2BzWrite a2 a3 a4 =
  alloca $ \a1' ->
  let {a2' = id a2} in
  let {a3' = castPtr a3} in
  let {a4' = fromIntegral a4} in
  bZ2BzWrite'_ a1' a2' a3' a4' >>
  peekBZError  a1'>>= \a1'' ->
  return (a1'')

{-# LINE 102 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzWriteClose :: (BzFilePtr) -> (Bool) -> IO ((BZError), (CUInt), (CUInt))
bZ2BzWriteClose a2 a3 =
  alloca $ \a1' ->
  let {a2' = id a2} in
  let {a3' = C2HSImp.fromBool a3} in
  alloca $ \a4' ->
  alloca $ \a5' ->
  bZ2BzWriteClose'_ a1' a2' a3' a4' a5' >>
  peekBZError  a1'>>= \a1'' ->
  peek  a4'>>= \a4'' ->
  peek  a5'>>= \a5'' ->
  return (a1'', a4'', a5'')

{-# LINE 103 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzWriteClose64 :: (BzFilePtr) -> (Bool) -> IO ((BZError), (CUInt), (CUInt), (CUInt), (CUInt))
bZ2BzWriteClose64 a2 a3 =
  alloca $ \a1' ->
  let {a2' = id a2} in
  let {a3' = C2HSImp.fromBool a3} in
  alloca $ \a4' ->
  alloca $ \a5' ->
  alloca $ \a6' ->
  alloca $ \a7' ->
  bZ2BzWriteClose64'_ a1' a2' a3' a4' a5' a6' a7' >>
  peekBZError  a1'>>= \a1'' ->
  peek  a4'>>= \a4'' ->
  peek  a5'>>= \a5'' ->
  peek  a6'>>= \a6'' ->
  peek  a7'>>= \a7'' ->
  return (a1'', a4'', a5'', a6'', a7'')

{-# LINE 104 "src/Codec/Compression/BZip/Foreign.chs" #-}


-- Macros
bZMaxUnused :: Integral a => a
bZMaxUnused = 5000
{-# LINE 108 "src/Codec/Compression/BZip/Foreign.chs" #-}


-- Utility functions
bZ2BzBuffToBuffCompress :: (Ptr a) -> (Ptr a) -> (CUInt) -> (CInt) -> (CInt) -> (CInt) -> IO ((CUInt))
bZ2BzBuffToBuffCompress a1 a3 a4 a5 a6 a7 =
  let {a1' = castPtr a1} in
  alloca $ \a2' ->
  let {a3' = castPtr a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = fromIntegral a5} in
  let {a6' = fromIntegral a6} in
  let {a7' = fromIntegral a7} in
  bZ2BzBuffToBuffCompress'_ a1' a2' a3' a4' a5' a6' a7' >>= \res ->
  bzWrap res >>
  peek  a2'>>= \a2'' ->
  return (a2'')

{-# LINE 111 "src/Codec/Compression/BZip/Foreign.chs" #-}

bZ2BzBuffToBuffDecompress :: (Ptr a) -> (Ptr a) -> (CUInt) -> (Bool) -> (CInt) -> IO ((BZError), (CUInt))
bZ2BzBuffToBuffDecompress a1 a3 a4 a5 a6 =
  let {a1' = castPtr a1} in
  alloca $ \a2' ->
  let {a3' = castPtr a3} in
  let {a4' = fromIntegral a4} in
  let {a5' = C2HSImp.fromBool a5} in
  let {a6' = fromIntegral a6} in
  bZ2BzBuffToBuffDecompress'_ a1' a2' a3' a4' a5' a6' >>= \res ->
  bzWrap res >>= \res' ->
  peek  a2'>>= \a2'' ->
  return (res', a2'')

{-# LINE 112 "src/Codec/Compression/BZip/Foreign.chs" #-}


-- Contributed functions
bZ2BzlibVersion :: (String)
bZ2BzlibVersion =
  C2HSImp.unsafePerformIO $
  bZ2BzlibVersion'_ >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 115 "src/Codec/Compression/BZip/Foreign.chs" #-}


peekVoidPtr :: Ptr (Ptr ()) -> IO (Ptr a)
peekVoidPtr = fmap castPtr . peek

peekBZError :: Ptr CInt -> IO BZError
peekBZError = bzWrap <=< peek

bzWrap :: CInt -> IO BZError
bzWrap err =
    let err' = toEnum (fromIntegral err) in
    case err' of
        BzOk        -> pure err'
        BzRunOk     -> pure err'
        BzFlushOk   -> pure err'
        BzFinishOk  -> pure err'
        BzStreamEnd -> pure err'
        x           -> throw x

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzCompressInit"
  bZ2BzCompressInit'_ :: ((BzStreamPtr) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzCompress"
  bZ2BzCompress'_ :: ((BzStreamPtr) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzCompressEnd"
  bZ2BzCompressEnd'_ :: ((BzStreamPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzDecompressInit"
  bZ2BzDecompressInit'_ :: ((BzStreamPtr) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzDecompress"
  bZ2BzDecompress'_ :: ((BzStreamPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzDecompressEnd"
  bZ2BzDecompressEnd'_ :: ((BzStreamPtr) -> (IO C2HSImp.CInt))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzReadOpen"
  bZ2BzReadOpen'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((FilePtr) -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (BzFilePtr))))))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzReadClose"
  bZ2BzReadClose'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((BzFilePtr) -> (IO ())))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzReadGetUnused"
  bZ2BzReadGetUnused'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((BzFilePtr) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO ())))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzRead"
  bZ2BzRead'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((BzFilePtr) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzWriteOpen"
  bZ2BzWriteOpen'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((FilePtr) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (BzFilePtr)))))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzWrite"
  bZ2BzWrite'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((BzFilePtr) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzWriteClose"
  bZ2BzWriteClose'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((BzFilePtr) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO ()))))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzWriteClose64"
  bZ2BzWriteClose64'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((BzFilePtr) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> (IO ()))))))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzBuffToBuffCompress"
  bZ2BzBuffToBuffCompress'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzBuffToBuffDecompress"
  bZ2BzBuffToBuffDecompress'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CUInt) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CUInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))))

foreign import ccall safe "Codec/Compression/BZip/Foreign.chs.h BZ2_bzlibVersion"
  bZ2BzlibVersion'_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))