#include #include -- | This module provides automatic low-level bindings to @libzip@ -- library, version 0.10. See also: -- -- * @libzip@ documention: and @zip.h@ -- -- * @bindings-DSL@ documentation: -- -- -- Higher-level interface is provided by a separate LibZip package: -- -- * -- module Bindings.LibZip where #strict_import #opaque_t zip #opaque_t zip_file #opaque_t zip_source -- flags for zip_open #num ZIP_CREATE #num ZIP_EXCL #num ZIP_CHECKCONS -- flags for zip_name_locate, zip_fopen, zip_stat, ... #num ZIP_FL_NOCASE #num ZIP_FL_NODIR #num ZIP_FL_COMPRESSED #num ZIP_FL_UNCHANGED #num ZIP_FL_RECOMPRESS #num ZIP_FL_ENCRYPTED -- archive global flags flags #num ZIP_AFL_TORRENT #num ZIP_AFL_RDONLY -- flags for compression and encryption sources #num ZIP_CODEC_ENCODE -- libzip error codes #num ZIP_ER_OK #num ZIP_ER_MULTIDISK #num ZIP_ER_RENAME #num ZIP_ER_CLOSE #num ZIP_ER_SEEK #num ZIP_ER_READ #num ZIP_ER_WRITE #num ZIP_ER_CRC #num ZIP_ER_ZIPCLOSED #num ZIP_ER_NOENT #num ZIP_ER_EXISTS #num ZIP_ER_OPEN #num ZIP_ER_TMPOPEN #num ZIP_ER_ZLIB #num ZIP_ER_MEMORY #num ZIP_ER_CHANGED #num ZIP_ER_COMPNOTSUPP #num ZIP_ER_EOF #num ZIP_ER_INVAL #num ZIP_ER_NOZIP #num ZIP_ER_INTERNAL #num ZIP_ER_INCONS #num ZIP_ER_REMOVE #num ZIP_ER_DELETED #num ZIP_ER_ENCRNOTSUPP #num ZIP_ER_RDONLY #num ZIP_ER_NOPASSWD #num ZIP_ER_WRONGPASSWD -- type of system error value #num ZIP_ET_NONE #num ZIP_ET_SYS #num ZIP_ET_ZLIB -- compression methods #num ZIP_CM_DEFAULT #num ZIP_CM_STORE #num ZIP_CM_SHRINK #num ZIP_CM_REDUCE_1 #num ZIP_CM_REDUCE_2 #num ZIP_CM_REDUCE_3 #num ZIP_CM_REDUCE_4 #num ZIP_CM_IMPLODE #num ZIP_CM_DEFLATE #num ZIP_CM_DEFLATE64 #num ZIP_CM_PKWARE_IMPLODE #num ZIP_CM_BZIP2 #num ZIP_CM_LZMA #num ZIP_CM_TERSE #num ZIP_CM_LZ77 #num ZIP_CM_WAVPACK #num ZIP_CM_PPMD -- encryption methods #num ZIP_EM_NONE #num ZIP_EM_TRAD_PKWARE #num ZIP_EM_UNKNOWN #integral_t enum zip_source_cmd #num ZIP_SOURCE_OPEN #num ZIP_SOURCE_READ #num ZIP_SOURCE_CLOSE #num ZIP_SOURCE_STAT #num ZIP_SOURCE_ERROR #num ZIP_SOURCE_FREE -- typedef zip_int64_t (*zip_source_callback)(void *, void *, zip_uint64_t, enum zip_source_cmd); #callback zip_source_callback , Ptr () -> Ptr () -> CULLong -> -> IO CULLong #num ZIP_SOURCE_ERR_LOWER #num ZIP_STAT_NAME #num ZIP_STAT_INDEX #num ZIP_STAT_SIZE #num ZIP_STAT_COMP_SIZE #num ZIP_STAT_MTIME #num ZIP_STAT_CRC #num ZIP_STAT_COMP_METHOD #num ZIP_STAT_ENCRYPTION_METHOD #num ZIP_STAT_FLAGS #opaque_t time_t -- struct zip_stat { -- zip_uint64_t valid; /* which fields have valid values */ -- const char *name; /* name of the file */ -- zip_uint64_t index; /* index within archive */ -- zip_uint64_t size; /* size of file (uncompressed) */ -- zip_uint64_t comp_size; /* size of file (compressed) */ -- time_t mtime; /* modification time */ -- zip_uint32_t crc; /* crc of file data */ -- zip_uint16_t comp_method; /* compression method used */ -- zip_uint16_t encryption_method; /* encryption method used */ -- zip_uint32_t flags; /* reserved for future use */ -- }; #starttype struct zip_stat #field valid, CULLong #field name, Ptr CChar #field index, CULLong #field size, CULLong #field comp_size, CULLong #field mtime, CTime #field crc, CUInt #field comp_method, CUShort #field encryption_method, CUShort #field flags, CUInt #stoptype -- make every declaration one-line, and replace -- ZIP_EXTERN -> -- const char * -> CString -- char * -> Ptr CChar -- struct foo * -> Ptr -- with regexps -- FILE -> CFile -- int -> CInt -- zip_int64_t -> CLLong -- zip_uint64_t -> CULLong -- void -> () -- zip_source_callback -> -- foo * -> Ptr foo -- with regexps -- regexp-replace "\(.*\)\(zip_[a-z0-9_]+\)(\(.*\));" "#ccall \2 , \3 -> IO (\1)" #ccall zip_add , Ptr -> CString -> Ptr -> IO (CLLong) #ccall zip_add_dir , Ptr -> CString -> IO (CLLong) #ccall zip_close , Ptr -> IO (CInt) #ccall zip_delete , Ptr -> CULLong -> IO (CInt) #ccall zip_error_clear , Ptr -> IO () #ccall zip_error_get , Ptr -> Ptr CInt -> Ptr CInt -> IO () #ccall zip_error_get_sys_type , CInt -> IO (CInt) #ccall zip_error_to_str , Ptr CChar -> CULLong -> CInt -> CInt -> IO (CInt) #ccall zip_fclose , Ptr -> IO (CInt) #ccall zip_fdopen , CInt -> CInt -> Ptr CInt -> IO (Ptr ) #ccall zip_file_error_clear , Ptr -> IO () #ccall zip_file_error_get , Ptr -> Ptr CInt -> Ptr CInt -> IO () #ccall zip_file_strerror , Ptr -> IO (CString) #ccall zip_fopen , Ptr -> CString -> CInt -> IO (Ptr ) #ccall zip_fopen_encrypted , Ptr -> CString -> CInt -> CString -> IO (Ptr ) #ccall zip_fopen_index , Ptr -> CULLong -> CInt -> IO (Ptr ) #ccall zip_fopen_index_encrypted , Ptr -> CULLong -> CInt -> CString -> IO (Ptr ) #ccall zip_fread , Ptr -> Ptr () -> CULLong -> IO (CLLong) #ccall zip_get_archive_comment , Ptr -> Ptr CInt -> CInt -> IO (CString) #ccall zip_get_archive_flag , Ptr -> CInt -> CInt -> IO (CInt) #ccall zip_get_file_comment , Ptr -> CULLong -> Ptr CInt -> CInt -> IO (CString) #ccall zip_get_file_extra , Ptr -> CULLong -> Ptr CInt -> CInt -> IO (CString) #ccall zip_get_name , Ptr -> CULLong -> CInt -> IO (CString) #ccall zip_get_num_entries , Ptr -> CInt -> IO (CULLong) #ccall zip_get_num_files , Ptr -> IO (CInt) #ccall zip_name_locate , Ptr -> CString -> CInt -> IO (CInt) #ccall zip_open , CString -> CInt -> Ptr CInt -> IO (Ptr ) #ccall zip_rename , Ptr -> CULLong -> CString -> IO (CInt) #ccall zip_replace , Ptr -> CULLong -> Ptr -> IO (CInt) #ccall zip_set_archive_comment , Ptr -> CString -> CInt -> IO (CInt) #ccall zip_set_archive_flag , Ptr -> CInt -> CInt -> IO (CInt) #ccall zip_set_default_password , Ptr -> CString -> IO (CInt) #ccall zip_set_file_comment , Ptr -> CULLong -> CString -> CInt -> IO (CInt) #ccall zip_set_file_extra , Ptr -> CULLong -> CString -> CInt -> IO (CInt) #ccall zip_source_buffer , Ptr -> Ptr () -> CULLong -> CInt -> IO (Ptr ) #ccall zip_source_file , Ptr -> CString -> CULLong -> CLLong -> IO (Ptr ) #ccall zip_source_filep , Ptr -> Ptr CFile -> CULLong -> CLLong -> IO (Ptr ) #ccall zip_source_free , Ptr -> IO () #ccall zip_source_function , Ptr -> -> Ptr () -> IO (Ptr ) #ccall zip_source_zip , Ptr -> Ptr -> CULLong -> CInt -> CULLong -> CLLong -> IO (Ptr ) #ccall zip_stat , Ptr -> CString -> CInt -> Ptr -> IO (CInt) #ccall zip_stat_index , Ptr -> CULLong -> CInt -> Ptr -> IO (CInt) #ccall zip_stat_init , Ptr -> IO () #ccall zip_strerror , Ptr -> IO (CString) #ccall zip_unchange , Ptr -> CULLong -> IO (CInt) #ccall zip_unchange_all , Ptr -> IO (CInt) #ccall zip_unchange_archive , Ptr -> IO (CInt)