LibZip (empty) → 0.0.1

raw patch · 5 files changed

+616/−0 lines, 5 filesdep +basedep +bytestringdep +haskell98setup-changed

Dependencies added: base, bytestring, haskell98

Files

• C2HS.hs +220/−0
• Codec/Archive/LibZip.chs +314/−0
• LICENSE +25/−0
• LibZip.cabal +33/−0
• Setup.lhs +24/−0

@@ -0,0 +1,220 @@+--  C->Haskell Compiler: Marshalling library+--+--  Copyright (c) [1999...2005] Manuel M T Chakravarty+--+--  Redistribution and use in source and binary forms, with or without+--  modification, are permitted provided that the following conditions are met:+-- +--  1. Redistributions of source code must retain the above copyright notice,+--     this list of conditions and the following disclaimer. +--  2. Redistributions in binary form must reproduce the above copyright+--     notice, this list of conditions and the following disclaimer in the+--     documentation and/or other materials provided with the distribution. +--  3. The name of the author may not be used to endorse or promote products+--     derived from this software without specific prior written permission. +--+--  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR+--  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+--  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+--  NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +--  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED+--  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+--  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+--  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+--  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+--  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+--+--- Description ---------------------------------------------------------------+--+--  Language: Haskell 98+--+--  This module provides the marshaling routines for Haskell files produced by +--  C->Haskell for binding to C library interfaces.  It exports all of the+--  low-level FFI (language-independent plus the C-specific parts) together+--  with the C->HS-specific higher-level marshalling routines.+--++module C2HS (++  -- * Re-export the language-independent component of the FFI +  module Foreign,++  -- * Re-export the C language component of the FFI+  module CForeign,++  -- * Composite marshalling functions+  withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,+  peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,++  -- * Conditional results using 'Maybe'+  nothingIf, nothingIfNull,++  -- * Bit masks+  combineBitMasks, containsBitMask, extractBitMasks,++  -- * Conversion between C and Haskell types+  cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum+) where +++import Foreign+       hiding       (Word)+		    -- Should also hide the Foreign.Marshal.Pool exports in+		    -- compilers that export them+import CForeign++import Monad        (when, liftM)+++-- Composite marshalling functions+-- -------------------------------++-- Strings with explicit length+--+withCStringLenIntConv s f    = withCStringLen s $ \(p, n) -> f (p, cIntConv n)+peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)++-- Marshalling of numerals+--++withIntConv   :: (Storable b, Integral a, Integral b) +	      => a -> (Ptr b -> IO c) -> IO c+withIntConv    = with . cIntConv++withFloatConv :: (Storable b, RealFloat a, RealFloat b) +	      => a -> (Ptr b -> IO c) -> IO c+withFloatConv  = with . cFloatConv++peekIntConv   :: (Storable a, Integral a, Integral b) +	      => Ptr a -> IO b+peekIntConv    = liftM cIntConv . peek++peekFloatConv :: (Storable a, RealFloat a, RealFloat b) +	      => Ptr a -> IO b+peekFloatConv  = liftM cFloatConv . peek++-- Passing Booleans by reference+--++withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b+withBool  = with . fromBool++peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool+peekBool  = liftM toBool . peek+++-- Passing enums by reference+--++withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c+withEnum  = with . cFromEnum++peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a+peekEnum  = liftM cToEnum . peek+++-- Storing of 'Maybe' values+-- -------------------------++instance Storable a => Storable (Maybe a) where+  sizeOf    _ = sizeOf    (undefined :: Ptr ())+  alignment _ = alignment (undefined :: Ptr ())++  peek p = do+	     ptr <- peek (castPtr p)+	     if ptr == nullPtr+	       then return Nothing+	       else liftM Just $ peek ptr++  poke p v = do+	       ptr <- case v of+		        Nothing -> return nullPtr+			Just v' -> new v'+               poke (castPtr p) ptr+++-- Conditional results using 'Maybe'+-- ---------------------------------++-- Wrap the result into a 'Maybe' type.+--+-- * the predicate determines when the result is considered to be non-existing,+--   ie, it is represented by `Nothing'+--+-- * the second argument allows to map a result wrapped into `Just' to some+--   other domain+--+nothingIf       :: (a -> Bool) -> (a -> b) -> a -> Maybe b+nothingIf p f x  = if p x then Nothing else Just $ f x++-- |Instance for special casing null pointers.+--+nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b+nothingIfNull  = nothingIf (== nullPtr)+++-- Support for bit masks+-- ---------------------++-- Given a list of enumeration values that represent bit masks, combine these+-- masks using bitwise disjunction.+--+combineBitMasks :: (Enum a, Bits b) => [a] -> b+combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)++-- Tests whether the given bit mask is contained in the given bit pattern+-- (i.e., all bits set in the mask are also set in the pattern).+--+containsBitMask :: (Bits a, Enum b) => a -> b -> Bool+bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm+			    in+			    bm' .&. bits == bm'++-- |Given a bit pattern, yield all bit masks that it contains.+--+-- * This does *not* attempt to compute a minimal set of bit masks that when+--   combined yield the bit pattern, instead all contained bit masks are+--   produced.+--+extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]+extractBitMasks bits = +  [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]+++-- Conversion routines+-- -------------------++-- |Integral conversion+--+cIntConv :: (Integral a, Integral b) => a -> b+cIntConv  = fromIntegral++-- |Floating conversion+--+cFloatConv :: (RealFloat a, RealFloat b) => a -> b+cFloatConv  = realToFrac+-- As this conversion by default goes via `Rational', it can be very slow...+{-# RULES +  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;+  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x+ #-}++-- |Obtain C value from Haskell 'Bool'.+--+cFromBool :: Num a => Bool -> a+cFromBool  = fromBool++-- |Obtain Haskell 'Bool' from C value.+--+cToBool :: Num a => a -> Bool+cToBool  = toBool++-- |Convert a C enumeration to Haskell.+--+cToEnum :: (Integral i, Enum e) => i -> e+cToEnum  = toEnum . cIntConv++-- |Convert a Haskell enumeration to C.+--+cFromEnum :: (Enum e, Integral i) => e -> i+cFromEnum  = cIntConv . fromEnum

@@ -0,0 +1,314 @@+{-# 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.+module Codec.Archive.LibZip+  (-- * Types+   Zip,ZipFile,OpenFlag(..),FileFlag(..),ZipError(..)+   -- * High-level Haskell functions+   ,withZip,getFiles,getFileSize,readZipFile+   -- * 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', ...+{# 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.+readZipFile :: Zip -- ^ zip archive+         -> String -- ^ name of the file in the archive+         -> [FileFlag] -- ^ file name mode+         -> IO B.ByteString+readZipFile z fname flags = do+  sz <- getFileSize z fname flags+  f <- fopen z fname flags+  bytes <- fread f sz+  fclose f+  return $ B.pack bytes++-- 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 [] = Nothing+lastMay xs = Just $ last xs++-- vim: set expandtab ts=2 sw=2 ai si:

@@ -0,0 +1,25 @@+Copyright (c) 2009, Sergey Astanin+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright notice,+      this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice,+      this list of conditions and the following disclaimer in the documentation+      and/or other materials provided with the distribution.+    * Neither the name of the Sergey Astanin nor the names of other+      contributors may be used to endorse or promote products derived from this+      software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,33 @@+Name:          LibZip+Version:       0.0.1+License:       BSD3+License-File:  LICENSE+Author:        Sergey Astanin+Maintainer:    Sergey Astanin <s.astanin@gmail.com>+Homepage:      http://bitbucket.org/jetxee/hs-libzip/+Bug-reports:   http://bitbucket.org/jetxee/hs-libzip/issues/++Category:      Codec, Foreign+Synopsis:      Partial bindings to libzip to read zip archives.+Description:+  This package provides basic read-only access to zip-archives.+  It is produced with @c2hs@ for @libzip@ ver. 0.9.+Exposed-modules: Codec.Archive.LibZip, C2HS++Build-Type:     Simple+Cabal-Version:  >= 1.2.3+Extra-Tmp-Files:+                Codec/Archive/LibZip.hs+              , Codec/Archive/LibZip.chs.h+Build-Tools:    c2hs+Build-Depends:	base >= 4.0 && < 4.2+              , bytestring+              , haskell98+GHC-Options:    -Wall+Extensions:     ForeignFunctionInterface+              , FlexibleContexts+              , DeriveDataTypeable+              , CPP++Tested-with:   GHC == 6.10.4+

@@ -0,0 +1,24 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> import System.Cmd (system)+> import System.Exit (ExitCode(..))+> import Distribution.PackageDescription (emptyHookedBuildInfo)+>+> main = defaultMainWithHooks simpleUserHooks+>   { preBuild = generateC2HSdoths+>   , runTests = runUnitTests+>   }+>+> generateC2HSdoths _ _ =+>   system "c2hs -l" >>=+>   onExit "Cannot copy C2HS.hs library module in." emptyHookedBuildInfo+>+> runUnitTests _ _ _ _ =+>   system "cd tests && runhaskell -lzip Tests.hs" >>=+>   onExit "Some tests did not pass." ()+>+> onExit :: String -> a -> ExitCode -> IO a+> onExit errmsg okvalue r =+>   case r of+>     ExitSuccess -> return okvalue+>     _           -> fail errmsg