-- 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 (..)
                      , lZVersion
                      , lZStrerror
                      , lZMinDictionarySize
                      , lZMaxDictionarySize
                      , UInt8
                      -- * Compression functions
                      , LZEncoder
                      , LZEncoderPtr
                      , lZCompressOpen
                      , lZCompressClose
                      , lZCompressFinish
                      , lZCompressRead
                      , lZCompressWrite
                      , lZCompressWriteSize
                      , lZCompressErrno
                      , 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 50 "src/Codec/Lzip/Raw.chs" #-}


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


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


{-# LINE 54 "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 56 "src/Codec/Lzip/Raw.chs" #-}


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

{-# LINE 58 "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 59 "src/Codec/Lzip/Raw.chs" #-}

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

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

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

{-# LINE 61 "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 71 "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 73 "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 74 "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 75 "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 76 "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 77 "src/Codec/Lzip/Raw.chs" #-}

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

{-# LINE 78 "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 79 "src/Codec/Lzip/Raw.chs" #-}


-- | Abstract data type
data LZDecoder

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


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

{-# LINE 86 "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 87 "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 88 "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 89 "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 90 "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 91 "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 92 "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 safe "Codec/Lzip/Raw.chs.h LZ_max_dictionary_size"
  lZMaxDictionarySize'_ :: (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_errno"
  lZCompressErrno'_ :: ((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))