LibZip.chs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- | Partial Haskell bindings to @libzip@ library.
-- These bindings provide read-only access to zip archives.
-- Produced with @c2hs@ for @libzip@ ver. 0.9.
--
-- API is not stabilized yet, especially high-level part. If you use it, please
-- let me know. Feedback and suggestions are welcome.
module Codec.Archive.LibZip
  (-- * Types
   Zip,ZipFile,OpenFlag(..),FileFlag(..),ZipError(..)
   ,Word8
   -- * High-level interface
   -- These functions are intended to reduce boiler-plate. They acquire and
   -- release relevant resources automatically (open and close archives, files).
   ,withZip,getFiles,getFileSize
   ,readZipFile,readZipFile',readZipFileHead,readZipFileHead'
   -- * Low-level direct bindings to @libzip@ functions
   -- These functions correspond to their C namesakes with @zip_@ prefix.
   -- Please refer to @libzip@ documentation to learn about their semantics.
   ,open,close,get_num_files,get_name
   ,fopen,fclose,fread
   -- * Utilities
   ,catchZipError,isFile,isDir
  ) where

import C2HS

import qualified Control.Exception as E
import qualified Data.ByteString as B
import Control.Applicative ((<$>))
import Data.Typeable

#include "zip.h"

{# context lib="zip" prefix="zip_" #}

-- | Flags for 'withZip'.
{# enum define OpenFlag
  { ZIP_CREATE as CreateFlag
  , ZIP_EXCL as ExclFlag
  , ZIP_CHECKCONS as CheckConsFlag
  } deriving (Show,Eq) #}

-- | Flags for 'getFiles', 'getFileSize', 'readZipFile', ...
-- Please consult @libzip@ documentation about their use.
{# enum define FileFlag
  { ZIP_FL_NOCASE as FileNOCASE
  , ZIP_FL_NODIR as FileNODIR
  , ZIP_FL_COMPRESSED as FileCOMPRESSED
  , ZIP_FL_UNCHANGED as FileUNCHANGED
  , ZIP_FL_RECOMPRESS as FileRECOMPRESS
  } deriving (Show,Eq) #}

-- | @libzip@ error codes.
{# enum define ZipError
  { ZIP_ER_OK as ErrOK
  , ZIP_ER_MULTIDISK as ErrMULTIDISK
  , ZIP_ER_RENAME as ErrRENAME
  , ZIP_ER_CLOSE as ErrCLOSE
  , ZIP_ER_SEEK as ErrSEEK
  , ZIP_ER_READ as ErrREAD
  , ZIP_ER_WRITE as ErrWRITE
  , ZIP_ER_CRC as ErrCRC
  , ZIP_ER_ZIPCLOSED as ErrZIPCLOSED
  , ZIP_ER_NOENT as ErrNOENT
  , ZIP_ER_EXISTS as ErrEXISTS
  , ZIP_ER_OPEN as ErrOPEN
  , ZIP_ER_TMPOPEN as ErrTMPOPEN
  , ZIP_ER_ZLIB as ErrZLIB
  , ZIP_ER_MEMORY as ErrMEMORY
  , ZIP_ER_CHANGED as ErrCHANGED
  , ZIP_ER_COMPNOTSUPP as ErrCOMPNOTSUPP
  , ZIP_ER_EOF as ErrEOF
  , ZIP_ER_INVAL as ErrINVAL
  , ZIP_ER_NOZIP as ErrNOZIP
  , ZIP_ER_INTERNAL as ErrINTERNAL
  , ZIP_ER_INCONS as ErrINCONS
  , ZIP_ER_REMOVE as ErrREMOVE
  , ZIP_ER_DELETED as ErrDELETED
  } deriving (Eq,Typeable) #}

instance E.Exception ZipError

instance Show ZipError where
  show ErrOK             =  "No error"
  show ErrMULTIDISK      =  "Multi-disk zip archives not supported"
  show ErrRENAME         =  "Renaming temporary file failed"
  show ErrCLOSE          =  "Closing zip archive failed"
  show ErrSEEK           =  "Seek error"
  show ErrREAD           =  "Read error"
  show ErrWRITE          =  "Write error"
  show ErrCRC            =  "CRC error"
  show ErrZIPCLOSED      =  "Containing zip archive was closed"
  show ErrNOENT          =  "No such file"
  show ErrEXISTS         =  "File already exists"
  show ErrOPEN           =  "Can't open file"
  show ErrTMPOPEN        =  "Failure to create temporary file"
  show ErrZLIB           =  "Zlib error"
  show ErrMEMORY         =  "Malloc failure"
  show ErrCHANGED        =  "Entry has been changed"
  show ErrCOMPNOTSUPP    =  "Compression method not supported"
  show ErrEOF            =  "Premature EOF"
  show ErrINVAL          =  "Invalid argument"
  show ErrNOZIP          =  "Not a zip archive"
  show ErrINTERNAL       =  "Internal error"
  show ErrINCONS         =  "Zip archive inconsistent"
  show ErrREMOVE         =  "Can't remove file"
  show ErrDELETED        =  "Entry has been deleted"

-- | Handler of the open zip file.
{# pointer *zip as Zip newtype #}

instance Show Zip where
  show z@(Zip p)
    | isOpen z  = "Zip[open:" ++ (show p) ++ "]"
    | otherwise = "Zip[closed]"

isOpen :: Zip -> Bool
isOpen (Zip p) = p /= nullPtr

-- | Handler for an open file in the zip archive.
{# pointer *zip_file as ZipFile newtype #}

instance Show ZipFile where
  show (ZipFile p)
    | p /= nullPtr = "ZipFile[open:" ++ (show p) ++ "]"
    | otherwise    = "ZipFile[closed]"

#c
typedef struct zip_stat *zip_stat_t;
#endc

{-
{# enum define CompMethod
   { ZIP_CM_DEFAULT as CompDEFAULT
   , ZIP_CM_STORE as CompSTORE
   , ZIP_CM_SHRINK as CompSHRINK
   , ZIP_CM_REDUCE_1 as CompREDUCE_1
   , ZIP_CM_REDUCE_2 as CompREDUCE_2
   , ZIP_CM_REDUCE_3 as CompREDUCE_3
   , ZIP_CM_REDUCE_4 as CompREDUCE_4
   , ZIP_CM_IMPLODE as CompIMPLODE
   , ZIP_CM_DEFLATE as CompDEFLATE
   , ZIP_CM_DEFLATE64 as CompDEFLATE64
   , ZIP_CM_PKWARE_IMPLODE as CompPKWARE_IMPLODE
   , ZIP_CM_BZIP2 as CompBZIP2
   , ZIP_CM_LZMA as CompLZMA
   , ZIP_CM_TERSE as CompTERSE
   , ZIP_CM_LZ77 as CompLZ77
   , ZIP_CM_WAVPACK as CompWAVPACK
   , ZIP_CM_PPMD as CompPPMD
   } deriving (Show,Eq) #}

{# enum define EncryptMethod
   { ZIP_EM_NONE as EncryptNONE
   , ZIP_EM_TRAD_PKWARE as EncryptTRAD_PKWARE
   , ZIP_EM_UNKNOWN as EncryptUNKNOWN
   } deriving (Show,Eq) #}
-}

-- struct zip *zip_open(const char *, int, int *);
{# fun open as open_
   { `String'
   , combineBitMasks `[OpenFlag]'
   , alloca- `ZipError' peekError*
   } -> `Zip' id #}
   where peekError i = peek i >>= return . toEnum . cIntConv

-- | Open zip archive specified by /path/ and return its handler on success.
open :: String     -- ^ /path/ of the file to open
     -> [OpenFlag] -- ^ open mode
     -> IO Zip
open path flags = do
  (z,e) <- open_ path flags
  if isOpen z
    then return z
    else E.throwIO e

-- int zip_close(struct zip *);
{# fun close as close_
   { id `Zip'
   } -> `Int' #}

-- | Close zip archive.
close :: Zip -> IO ()
close z = do
  r <- close_ z
  if r == 0
    then return ()
    else E.throwIO ErrINTERNAL -- FIXME

-- int zip_get_num_files(struct zip *);
--
-- | Return the number of files in the archive.
{# fun get_num_files
   { id `Zip'
   } -> `Int' errorOnNegative* #}
  where errorOnNegative i | i < 0 = E.throwIO ErrZIPCLOSED
        errorOnNegative i = return $ cIntConv i

-- const char *zip_get_name(struct zip *, int, int);
--
-- | Get name of file by index.
{# fun get_name
   { id `Zip'
   , `Int'
   , combineBitMasks `[FileFlag]'
   } -> `String' errorOnNull* #}
   where errorOnNull p | p /= nullPtr = peekCString p
         errorOnNull _ | otherwise = E.throwIO ErrINVAL -- FIXME

-- struct zip_file *zip_fopen(struct zip *, const char *, int);
{# fun zip_fopen as fopen_
   { id `Zip'
   , `String'
   , combineBitMasks `[FileFlag]'
   } -> `ZipFile' id #}

-- | Open file in zip archive for reading.
fopen :: Zip -> String -> [FileFlag] -> IO ZipFile
fopen z fn flags = do
  zf@(ZipFile ptr) <- fopen_ z fn flags
  if ptr == nullPtr
    then E.throwIO ErrNOENT -- FIXME
    else return zf

-- int zip_fclose(struct zip_file *);
--
-- | Close file in zip archive.
{# fun zip_fclose as fclose
   { id `ZipFile'
   } -> `()' errorOrNothing* #}
   where errorOrNothing 0 = return ()
         errorOrNothing _ = E.throwIO ErrINVAL -- FIXME

-- ssize_t zip_fread(struct zip_file *, void *, size_t);
--
-- | Read from file in zip archive.
fread :: ZipFile -> Int -> IO [Word8]
fread zf count = do
  allocaBuf $ \ptr -> do
     rcount <- {#call zip_fread#} zf ptr (cIntConv count)
     if rcount < 0
       then E.throwIO ErrREAD
       else peekBuf ptr >>= return . take (cIntConv rcount)
  where
    -- Nasty pointer casts to deal with void*
    allocaBuf :: (Ptr () -> IO [Word8]) -> IO [Word8]
    allocaBuf f =
        let alloc = allocaArray count :: (Ptr Word8 -> IO [Word8]) -> IO [Word8]
            castFun :: (Ptr () -> IO [a]) -> (Ptr a -> IO [a])
            castFun fun = \ptrb -> let ptra = castPtr ptrb in fun ptra
        in  alloc $ castFun f
    peekBuf :: Ptr () -> IO [Word8]
    peekBuf p = peekArray count $ castPtr p

-- High level Haskell wrappers

-- | Open zip archive, do something, and close the archive.
withZip :: String -- ^ /path/ of the file to open
        -> [OpenFlag] -- ^ open mode
        -> (Zip -> IO a) -- ^ action to do on zip arhive
        -> IO a
withZip filename flags action = do
  z <- open filename flags
  result <- action z
  close z
  return result

-- | Get names of the files in archive.
getFiles :: Zip -> [FileFlag] -> IO [String]
getFiles z flags = do
  n <- get_num_files z
  mapM (\i -> get_name z i flags) [0..(n-1)]

-- | Get size of the file in archive.
getFileSize :: Zip -- ^ zip archive
            -> String -- ^ name of the file in the archive
            -> [FileFlag] -- ^ file name mode
            -> IO Int
getFileSize z name flags =
  withCString name $ \name' ->
  allocaBytes {# sizeof zip_stat_t #} $ \st -> do
    {# call zip_stat_init #} st
    ret <- {# call zip_stat #} z name' (combineBitMasks flags) st
    if ret /= 0
      then E.throwIO ErrINTERNAL -- FIXME
      else fromIntegral <$> {# get zip_stat_t->size #} st

-- | Read uncompressed file from the archive. Produce a strict ByteString.
readZipFile :: Zip -- ^ zip archive
         -> String -- ^ name of the file in the archive
         -> [FileFlag] -- ^ file name mode
         -> IO B.ByteString
readZipFile z fname flags = return . B.pack =<< readZipFile' z fname flags

-- | Read uncompressed file from the archive. Produce a list of 'Word8'.
readZipFile' :: Zip -- ^ zip archive
         -> String -- ^ name of the file in the archive
         -> [FileFlag] -- ^ file name mode
         -> IO [Word8]
readZipFile' z fname flags = do
  sz <- getFileSize z fname flags
  readZipFileHead' z fname flags sz

-- | Read beginning of the uncompressed file from the archive. Produce a list of 'Word8'.
readZipFileHead' :: Zip -- ^ zip archive
         -> String -- ^ name of the file in the archive
         -> [FileFlag] -- ^ file name mode
         -> Int -- ^ how many bytes to read
         -> IO [Word8]
readZipFileHead' z fname flags n = do
  f <- fopen z fname flags
  bytes <- fread f n
  fclose f
  return bytes

-- | Read beginning of the uncompressed file from the archive. Produce a strict ByteString.
readZipFileHead :: Zip -- ^ zip archive
         -> String -- ^ name of the file in the archive
         -> [FileFlag] -- ^ file name mode
         -> Int -- ^ how many bytes to read
         -> IO B.ByteString
readZipFileHead z fname flags n = return . B.pack =<< readZipFileHead' z fname flags n

-- Helpers

-- | Wrapper to catch library errors.
catchZipError :: IO a -> (ZipError -> IO a) -> IO a
catchZipError f h = E.catchJust ifZipError f h
  where
    ifZipError :: (Typeable e, E.Exception e) => e -> Maybe e
    ifZipError x | typeOf x == typeOf ErrOK = Just x
    ifZipError _ | otherwise = Nothing

-- | Return True if path is a file name, not a directory name (does not end with '/').
isFile :: String -> Bool
isFile filename = (lastMay filename /= Just '/')

-- | Return True if path is a directory name (ends with '/').
isDir :: String -> Bool
isDir = not . isFile

lastMay :: [a] -> Maybe a
lastMay [] = Nothing
lastMay xs = Just $ last xs

-- vim: set expandtab ts=2 sw=2 ai si: