-- 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" #-}
-- | 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 Control.Applicative
import Control.Exception (Exception, throw)
import Control.Monad ((<=<))
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 53 "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)
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 70 "src/Codec/Compression/BZip/Foreign.chs" #-}


instance Exception BZError where

-- | Abstract type
data BzStream

-- | Abstract type
data BzFile

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

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

type BzFilePtr = C2HSImp.Ptr (BzFile)
{-# LINE 83 "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 86 "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 87 "src/Codec/Compression/BZip/Foreign.chs" #-}

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

{-# LINE 88 "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 89 "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 90 "src/Codec/Compression/BZip/Foreign.chs" #-}

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

{-# LINE 91 "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 94 "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 95 "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 96 "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 97 "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 98 "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 99 "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 100 "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 101 "src/Codec/Compression/BZip/Foreign.chs" #-}


-- Macros
bZMaxUnused :: Integral a => a
bZMaxUnused = 5000
{-# LINE 105 "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 108 "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 109 "src/Codec/Compression/BZip/Foreign.chs" #-}


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

{-# LINE 112 "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))