1. Sergey Astanin
  2. hs-libzip

Commits

Sergey Astanin  committed 09e1b0a

Monadic API in Codec.Archive.LibZip: source from a pure function.

  • Participants
  • Parent commits cf69455
  • Branches 0.1-bindings-dsl

Comments (0)

Files changed (2)

File Codec/Archive/LibZip.hs

View file
     , addFile, addDirectory
     , replaceFile, replaceFileIx
     , sourceBuffer, sourceFile, sourceZip
+    , PureSource(..), sourcePure
     , getComment, setComment, removeComment
     , getFileComment, getFileCommentIx
     , setFileComment, setFileCommentIx
 import Codec.Archive.LibZip.Types
 import Codec.Archive.LibZip.Errors
 
+import Data.Time.Clock (UTCTime, getCurrentTime)
+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
 import Data.Word (Word8)
 import Control.Monad.State.Strict
     (StateT(..), MonadState(..), MonadTrans(..), lift, liftM)
+import Foreign.C.Error (Errno(..), eINVAL)
 import Foreign.C.String (withCString, withCStringLen, peekCString)
-import Foreign.C.Types ()
+import Foreign.C.Types (CInt, CSize)
 import Foreign.Marshal.Alloc (alloca)
-import Foreign.Marshal.Array (allocaArray, peekArray, withArrayLen)
-import Foreign.Ptr (nullPtr, castPtr)
-import Foreign.Storable (peek)
+import Foreign.Marshal.Array (allocaArray, peekArray, withArrayLen, pokeArray)
+import Foreign.Marshal.Utils (with)
+import Foreign.Ptr (Ptr, nullPtr, castPtr)
+import Foreign.Storable (Storable, peek, poke, pokeElemOff, sizeOf)
 import qualified Control.Exception as E
 
 --
   lift $
        withCString name $ \name' ->
        alloca $ \stat -> do
+       c'zip_stat_init stat
        r <- c'zip_stat z name' (combine flags) stat
        doIf' (r == 0) z $ toZipStat =<< peek stat
 
        then get_error z >>= E.throwIO
        else return zs
 
+-- | Create a data source from a 'PureSource'.
+-- Note: input of @[a]@ is converted to @[Word8]@ internally.
+sourcePure :: (Enum a, Storable a, Storable st)
+           => PureSource a st -> Archive ZipSource
+sourcePure pureSrc = do
+  z <- getZip
+  lift $ do
+    cb <- mk'zip_source_callback (runPureSource pureSrc)
+    zs <- with (srcState pureSrc) $
+          \pState -> c'zip_source_function z cb (castPtr pState)
+    if zs == nullPtr
+       then get_error z >>= E.throwIO
+       else return zs
+
+-- | Wrapper for a user-provided pure function to be used with 'sourcePure'.
+-- Data size should be known in advance ('srcSize').
+-- The function should support reading by chunks ('readSrc').
+data (Enum a, Storable a, Storable st) => PureSource a st = PureSource {
+    srcState :: st   -- ^ Initial state of the source.
+  , srcSize  :: Int  -- ^ Total size of the data.
+  , srcMTime :: Maybe UTCTime  -- ^ Modification time (current time if Nothing).
+  , readSrc  :: Int -> st -> Maybe (Int, [a], st) -- ^ Read a chunk of the data,
+                -- return @Just@ the size of data read, the data themselves and
+                -- the new state of the source, or @Nothing@ on error.
+  }
+
+runPureSource :: (Enum a, Storable a, Storable st)
+              => PureSource a st
+              -> (Ptr () -> Ptr () -> CSize -> C'zip_source_cmd -> IO CSize)
+runPureSource src pState pData len cmd
+  | cmd == c'ZIP_SOURCE_OPEN = return 0
+  | cmd == c'ZIP_SOURCE_READ = do
+      state <- peek (castPtr pState :: Ptr st)
+      case readSrc (src { srcState = state }) (fromIntegral len) state of
+        Just (len',bs,state') -> do
+          pokeArray (castPtr pData :: Ptr Word8) (map (toEnum.fromEnum) bs)
+          poke (castPtr pState) state'
+          return (fromIntegral len')
+        Nothing -> return (-1)
+  | cmd == c'ZIP_SOURCE_CLOSE = return 0
+  | cmd == c'ZIP_SOURCE_STAT = do
+      t <- maybe getCurrentTime return (srcMTime src)
+      let pt = fromInteger . round . utcTimeToPOSIXSeconds $ t
+      let pStat = castPtr pData
+      c'zip_stat_init pStat
+      stat <- peek pStat
+      let stat' = stat { c'zip_stat'mtime = pt
+                       , c'zip_stat'size = fromIntegral $ srcSize src }
+      poke pStat stat'
+      return $ fromIntegral (sizeOf stat')
+  | cmd == c'ZIP_SOURCE_ERROR = do
+      let pErrs = castPtr pData :: Ptr CInt
+      poke pErrs (fromIntegral . fromEnum $ ErrINVAL)
+      let (Errno esys) = eINVAL
+      pokeElemOff pErrs 1 esys
+      return $ fromIntegral (2 * sizeOf esys)
+  | cmd == c'ZIP_SOURCE_FREE = return 0
+  | otherwise = return (-1)
+        
 -- | Get zip archive comment.
 getComment :: [FileFlag]  -- ^ 'FileUNCHANGED' can be used.
            -> Archive (Maybe String)
        else return ()
 
 -- | Undo global changes to zip archive (revert changes to the archive
--- comment and global flags.
+-- comment and global flags).
 unchangeArchive :: Archive ()
 unchangeArchive = do
   z <- getZip

File Codec/Archive/LibZip/LowLevel.hsc

View file
 
 -- typedef ssize_t (*zip_source_callback)(void *state, void *data,
 --                                        size_t len, enum zip_source_cmd cmd);
-#callback zip_source_callback , Ptr () -> Ptr () -> CString -> <zip_source_cmd> -> IO CSize
+#callback zip_source_callback , Ptr () -> Ptr () -> CSize -> <zip_source_cmd> -> IO CSize
 
 #opaque_t time_t