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


{-# LINE 1 "src/Codec/Lzip/Raw.chs" #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | Consult the lzlib [documentation](https://www.nongnu.org/lzip/manual/lzlib_manual.html)
-- for more details
--
-- This library uses 'Foreign.ForeignPtr.ForeignPtr's; to convert a @'Ptr' 'LZDecoder'@ to a @'Foreign.ForeignPtr.ForeignPtr' 'LZDecoder'@, use 'Foreign.ForeignPtr.newForeignPtr'
module Codec.Lzip.Raw ( -- * Prolegomena
                        LZErrno
                          ( LzMemError
                          , LzHeaderError
                          , LzUnexpectedEof
                          , LzDataError
                          , LzLibraryError
                          )
                      , lZVersion
                      , lZMinDictionarySize
                      , UInt8
                      -- * Compression functions
                      , LZEncoder
                      , LZEncoderPtr
                      , lZCompressOpen
                      , lZCompressClose
                      , lZCompressFinish
                      , lZCompressRead
                      , lZCompressWrite
                      , lZCompressWriteSize
                      , lZCompressFinished
                      -- * Decompression functions
                      , LZDecoder
                      , LZDecoderPtr
                      , lZDecompressOpen
                      , lZDecompressClose
                      , lZDecompressFinish
                      , lZDecompressRead
                      , lZDecompressWrite
                      , lZDecompressWriteSize
                      , lZDecompressErrno
                      , lZDecompressFinished
                      -- * Macros
                      , lZApiVersion
                      ) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified System.IO.Unsafe as C2HSImp



import Control.Exception (Exception)
import Data.Typeable (Typeable)
import Foreign.C.Types
import Foreign.Ptr (Ptr)




-- | @since 0.3.1.0
lZApiVersion :: Integral a => a
lZApiVersion = 1
{-# LINE 53 "src/Codec/Lzip/Raw.chs" #-}


type UInt8 = (C2HSImp.CUChar)
{-# LINE 55 "src/Codec/Lzip/Raw.chs" #-}


{-# LINE 56 "src/Codec/Lzip/Raw.chs" #-}


{-# LINE 57 "src/Codec/Lzip/Raw.chs" #-}


data LZErrno = LzOk
             | LzBadArgument
             | LzMemError
             | LzSequenceError
             | LzHeaderError
             | LzUnexpectedEof
             | LzDataError
             | LzLibraryError
  deriving (Eq,Typeable)
instance Enum LZErrno where
  succ LzOk = LzBadArgument
  succ LzBadArgument = LzMemError
  succ LzMemError = LzSequenceError
  succ LzSequenceError = LzHeaderError
  succ LzHeaderError = LzUnexpectedEof
  succ LzUnexpectedEof = LzDataError
  succ LzDataError = LzLibraryError
  succ LzLibraryError = error "LZErrno.succ: LzLibraryError has no successor"

  pred LzBadArgument = LzOk
  pred LzMemError = LzBadArgument
  pred LzSequenceError = LzMemError
  pred LzHeaderError = LzSequenceError
  pred LzUnexpectedEof = LzHeaderError
  pred LzDataError = LzUnexpectedEof
  pred LzLibraryError = LzDataError
  pred LzOk = error "LZErrno.pred: LzOk 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 LzLibraryError

  fromEnum LzOk = 0
  fromEnum LzBadArgument = 1
  fromEnum LzMemError = 2
  fromEnum LzSequenceError = 3
  fromEnum LzHeaderError = 4
  fromEnum LzUnexpectedEof = 5
  fromEnum LzDataError = 6
  fromEnum LzLibraryError = 7

  toEnum 0 = LzOk
  toEnum 1 = LzBadArgument
  toEnum 2 = LzMemError
  toEnum 3 = LzSequenceError
  toEnum 4 = LzHeaderError
  toEnum 5 = LzUnexpectedEof
  toEnum 6 = LzDataError
  toEnum 7 = LzLibraryError
  toEnum unmatched = error ("LZErrno.toEnum: Cannot match " ++ show unmatched)

{-# LINE 59 "src/Codec/Lzip/Raw.chs" #-}


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

{-# LINE 61 "src/Codec/Lzip/Raw.chs" #-}

lZStrerror :: (LZErrno) -> (String)
lZStrerror a1 =
  C2HSImp.unsafePerformIO $
  let {a1' = (fromIntegral . fromEnum) a1} in
  lZStrerror'_ a1' >>= \res ->
  C2HSImp.peekCString res >>= \res' ->
  return (res')

{-# LINE 62 "src/Codec/Lzip/Raw.chs" #-}

lZMinDictionarySize :: (CInt)
lZMinDictionarySize =
  C2HSImp.unsafePerformIO $
  lZMinDictionarySize'_ >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 63 "src/Codec/Lzip/Raw.chs" #-}


instance Show LZErrno where
    show = lZStrerror

instance Exception LZErrno where

-- | Abstract data type
data LZEncoder

type LZEncoderPtr = C2HSImp.ForeignPtr (LZEncoder)
{-# LINE 73 "src/Codec/Lzip/Raw.chs" #-}


lZCompressOpen :: (CInt) -> (CInt) -> (CULLong) -> IO ((Ptr LZEncoder))
lZCompressOpen a1 a2 a3 =
  let {a1' = fromIntegral a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = id a3} in
  lZCompressOpen'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 75 "src/Codec/Lzip/Raw.chs" #-}

lZCompressFinish :: (LZEncoderPtr) -> IO ((CInt))
lZCompressFinish a1 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  lZCompressFinish'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 76 "src/Codec/Lzip/Raw.chs" #-}

lZCompressRead :: (LZEncoderPtr) -> (Ptr UInt8) -> (CInt) -> IO ((CInt))
lZCompressRead a1 a2 a3 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  lZCompressRead'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 77 "src/Codec/Lzip/Raw.chs" #-}

lZCompressWrite :: (LZEncoderPtr) -> (Ptr UInt8) -> (CInt) -> IO ((CInt))
lZCompressWrite a1 a2 a3 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  lZCompressWrite'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 78 "src/Codec/Lzip/Raw.chs" #-}

lZCompressWriteSize :: (LZEncoderPtr) -> IO ((CInt))
lZCompressWriteSize a1 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  lZCompressWriteSize'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 79 "src/Codec/Lzip/Raw.chs" #-}

lZCompressFinished :: (LZEncoderPtr) -> IO ((CInt))
lZCompressFinished a1 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  lZCompressFinished'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 80 "src/Codec/Lzip/Raw.chs" #-}


-- | Abstract data type
data LZDecoder

type LZDecoderPtr = C2HSImp.ForeignPtr (LZDecoder)
{-# LINE 85 "src/Codec/Lzip/Raw.chs" #-}


lZDecompressOpen :: IO ((Ptr LZDecoder))
lZDecompressOpen =
  lZDecompressOpen'_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 87 "src/Codec/Lzip/Raw.chs" #-}

lZDecompressFinish :: (LZDecoderPtr) -> IO ((CInt))
lZDecompressFinish a1 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  lZDecompressFinish'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 88 "src/Codec/Lzip/Raw.chs" #-}

lZDecompressRead :: (LZDecoderPtr) -> (Ptr UInt8) -> (CInt) -> IO ((CInt))
lZDecompressRead a1 a2 a3 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  lZDecompressRead'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 89 "src/Codec/Lzip/Raw.chs" #-}

lZDecompressWrite :: (LZDecoderPtr) -> (Ptr UInt8) -> (CInt) -> IO ((CInt))
lZDecompressWrite a1 a2 a3 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  lZDecompressWrite'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 90 "src/Codec/Lzip/Raw.chs" #-}

lZDecompressWriteSize :: (LZDecoderPtr) -> IO ((CInt))
lZDecompressWriteSize a1 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  lZDecompressWriteSize'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 91 "src/Codec/Lzip/Raw.chs" #-}

lZDecompressErrno :: (LZDecoderPtr) -> IO ((LZErrno))
lZDecompressErrno a1 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  lZDecompressErrno'_ a1' >>= \res ->
  let {res' = (toEnum . fromIntegral) res} in
  return (res')

{-# LINE 92 "src/Codec/Lzip/Raw.chs" #-}

lZDecompressFinished :: (LZDecoderPtr) -> IO ((CInt))
lZDecompressFinished a1 =
  C2HSImp.withForeignPtr a1 $ \a1' ->
  lZDecompressFinished'_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 93 "src/Codec/Lzip/Raw.chs" #-}


foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_version"
  lZVersion'_ :: (IO (C2HSImp.Ptr C2HSImp.CChar))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_strerror"
  lZStrerror'_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_min_dictionary_size"
  lZMinDictionarySize'_ :: (IO C2HSImp.CInt)

foreign import ccall "Codec/Lzip/Raw.chs.h &LZ_compress_close"
  lZCompressClose :: C2HSImp.FinalizerPtr ()

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_compress_open"
  lZCompressOpen'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CULLong -> (IO (C2HSImp.Ptr (LZEncoder))))))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_compress_finish"
  lZCompressFinish'_ :: ((C2HSImp.Ptr (LZEncoder)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_compress_read"
  lZCompressRead'_ :: ((C2HSImp.Ptr (LZEncoder)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_compress_write"
  lZCompressWrite'_ :: ((C2HSImp.Ptr (LZEncoder)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_compress_write_size"
  lZCompressWriteSize'_ :: ((C2HSImp.Ptr (LZEncoder)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_compress_finished"
  lZCompressFinished'_ :: ((C2HSImp.Ptr (LZEncoder)) -> (IO C2HSImp.CInt))

foreign import ccall "Codec/Lzip/Raw.chs.h &LZ_decompress_close"
  lZDecompressClose :: C2HSImp.FinalizerPtr ()

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_decompress_open"
  lZDecompressOpen'_ :: (IO (C2HSImp.Ptr (LZDecoder)))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_decompress_finish"
  lZDecompressFinish'_ :: ((C2HSImp.Ptr (LZDecoder)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_decompress_read"
  lZDecompressRead'_ :: ((C2HSImp.Ptr (LZDecoder)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_decompress_write"
  lZDecompressWrite'_ :: ((C2HSImp.Ptr (LZDecoder)) -> ((C2HSImp.Ptr UInt8) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_decompress_write_size"
  lZDecompressWriteSize'_ :: ((C2HSImp.Ptr (LZDecoder)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_decompress_errno"
  lZDecompressErrno'_ :: ((C2HSImp.Ptr (LZDecoder)) -> (IO C2HSImp.CInt))

foreign import ccall safe "Codec/Lzip/Raw.chs.h LZ_decompress_finished"
  lZDecompressFinished'_ :: ((C2HSImp.Ptr (LZDecoder)) -> (IO C2HSImp.CInt))