{-# LINE 1 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
module Streamly.External.Zip.Internal.Foreign where

import Data.Int
import Foreign
import Foreign.C.String
import Foreign.C.Types


type Zip_flags_t = Word32
{-# LINE 10 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
type Zip_int64_t = Int64
{-# LINE 11 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
type Zip_uint64_t = Word64
{-# LINE 12 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}

zip_error_t_size :: Int
zip_error_t_size :: Int
zip_error_t_size = (Int
16)
{-# LINE 15 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}

data Zip_t

data Zip_file_t

data Zip_error_t

foreign import ccall safe "zip.h zip_open"
  c_zip_open :: CString -> CInt -> Ptr CInt -> IO (Ptr Zip_t)

foreign import ccall safe "zip.h &zip_discard"
  c_zip_discard_ptr :: FunPtr (Ptr Zip_t -> IO ())

-- As this library currently only does reading, we don’t export zip_close().

foreign import ccall safe "zip.h zip_get_num_entries"
  c_zip_get_num_entries :: Ptr Zip_t -> Zip_flags_t -> IO Zip_int64_t

foreign import ccall safe "zip.h zip_get_name"
  c_zip_get_name :: Ptr Zip_t -> Zip_uint64_t -> Zip_flags_t -> IO (Ptr CChar)

foreign import ccall safe "zip.h zip_fopen"
  c_zip_fopen :: Ptr Zip_t -> CString -> Zip_flags_t -> IO (Ptr Zip_file_t)

foreign import ccall safe "zip.h zip_fopen_index"
  c_zip_fopen_index :: Ptr Zip_t -> Zip_uint64_t -> Zip_flags_t -> IO (Ptr Zip_file_t)

foreign import ccall safe "zip.h zip_fclose"
  c_zip_fclose :: Ptr Zip_file_t -> IO CInt

foreign import ccall safe "zip.h zip_fread"
  c_zip_fread :: Ptr Zip_file_t -> Ptr CChar -> Zip_uint64_t -> IO Zip_int64_t

foreign import ccall safe "zip.h zip_strerror"
  c_zip_strerror :: Ptr Zip_t -> IO (Ptr CChar)

-- foreign import ccall safe "zip.h zip_file_strerror"
--   c_zip_file_strerror :: Ptr Zip_file_t -> IO (Ptr CChar)

foreign import ccall safe "zip.h zip_error_init_with_code"
  c_zip_error_init_with_code :: Ptr Zip_error_t -> CInt -> IO ()

foreign import ccall safe "zip.h zip_error_strerror"
  c_zip_error_strerror :: Ptr Zip_error_t -> IO (Ptr CChar)

foreign import ccall safe "zip.h zip_error_fini"
  c_zip_error_fini :: Ptr Zip_error_t -> IO ()

-- All flags relevant for the libzip functions we use.
zip_checkcons,
  zip_create,
  zip_excl,
  zip_truncate,
  zip_rdonly,
  zip_fl_compressed,
  zip_fl_unchanged,
  zip_fl_enc_raw,
  zip_fl_enc_guess,
  zip_fl_enc_strict ::
    (Num a) => a
zip_checkcons :: forall a. Num a => a
zip_checkcons = a
4
{-# LINE 76 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_create = 1
zip_excl :: forall a. Num a => a
{-# LINE 77 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_excl = 2
{-# LINE 78 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_truncate = 8
{-# LINE 79 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_rdonly = 16
{-# LINE 80 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_fl_compressed = 4
{-# LINE 81 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_fl_unchanged = 8
{-# LINE 82 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_fl_enc_raw = 64
{-# LINE 83 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_fl_enc_guess = 0
{-# LINE 84 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}
zip_fl_enc_strict = 128
{-# LINE 85 "src/Streamly/External/Zip/Internal/Foreign.hsc" #-}