zlib binding providing Handle to compressed file.

[David Roundy]

I've just created a binding to the gzopen function of zlib which causes it
to create a Handle.  The code currently only supports ReadMode and
WriteMode, and hFileSize won't work properly when reading a file.  In fact,
pretty much nothing but plain old reading and writing will work, but such
is life.

Anyhow in case anyone is interested, I'm attaching the code.  It creates a
pipe using pipe(2) and spawns a thread to pass the data between the pipe
and gzread or gzwrite.  It's not pretty, but it's better than any other
solution I could think of.  Suggestions or criticisms are welcome.
-- 
David Roundy
http://www.abridgegame.org/darcs
-------------- next part --------------
\begin{code}
module Zlib ( gzOpenFile, gzWriteFile, gzReadFile ) where

import IO
import System.IO ( hGetBuf, hPutBuf )
import Control.Concurrent ( forkIO )
import Monad ( when )
import Foreign.C.String ( CString, withCString )
import Foreign.Marshal.Array ( mallocArray, withArray, peekArray )
import Foreign.Marshal.Alloc ( free )
import Foreign.Ptr ( Ptr )
import Data.Word
import GHC.Handle ( openFd )

fdToReadHandle fd fn = openFd fd Nothing fn ReadMode False False
fdToWriteHandle fd fn = openFd fd Nothing fn WriteMode False False

gzOpenFile :: FilePath -> IOMode -> IO Handle
gzWriteFile :: FilePath -> String -> IO ()

gzOpenFile f ReadMode = 
    withCString f $ \fstr -> withCString "rb" $ \rb-> do
    gzf <- c_gzopen fstr rb
    withArray [0,0] $ \fds -> do
      err <- c_pipe fds
      when (err /= 0) $ error "Pipe problem!"
      [infd,outfd] <- peekArray 2 fds
      writeH <- fdToWriteHandle (fromIntegral outfd) f
      buf <- mallocArray 1024
      forkIO $ gzreader gzf writeH buf
      fdToReadHandle (fromIntegral infd) f
          where gzreader gzf h buf =
                    do done <- hIsClosed h
                       if done
                          then do c_gzclose gzf
                                  free buf
                                  hClose h
                          else do l <- c_gzread gzf buf 1024
                                  hPutBuf h buf l
                                  if l < 1024
                                     then do free buf
                                             c_gzclose gzf
                                             hClose h
                                     else gzreader gzf h buf
gzOpenFile f WriteMode = 
    withCString f $ \fstr -> withCString "wb" $ \wb-> do
    gzf <- c_gzopen fstr wb
    withArray [0,0] $ \fds -> do
      err <- c_pipe fds
      when (err /= 0) $ error "Pipe problem!"
      [infd,outfd] <- peekArray 2 fds
      readH <- fdToReadHandle (fromIntegral infd) f
      buf <- mallocArray 1024
      forkIO $ gzwriter gzf readH buf
      fdToWriteHandle (fromIntegral outfd) f
          where gzwriter gzf h buf =
                    do done <- hIsEOF h
                       if done
                          then do c_gzclose gzf
                                  free buf
                                  hClose h
                          else do l <- hGetBuf h buf 1024
                                  c_gzwrite gzf buf l
                                  gzwriter gzf h buf

gzWriteFile f s = do h <- gzOpenFile f WriteMode
                     hPutStr h s
                     hClose h

gzReadFile f s = do h <- gzOpenFile f WriteMode
                    hGetContents h

foreign import ccall unsafe "static unistd.h pipe" c_pipe
    :: Ptr Int -> IO Int
foreign import ccall unsafe "static unistd.h read" c_read
    :: Ptr Word8 -> Int -> IO Int

foreign import ccall unsafe "static zlib.h gzopen" c_gzopen
    :: CString -> CString -> IO (Ptr ())
foreign import ccall unsafe "static zlib.h gzclose" c_gzclose
    :: Ptr () -> IO ()
foreign import ccall unsafe "static zlib.h gzread" c_gzread
    :: Ptr () -> Ptr Word8 -> Int -> IO Int
foreign import ccall unsafe "static zlib.h gzwrite" c_gzwrite
    :: Ptr () -> Ptr Word8 -> Int -> IO ()
\end{code}