\begin{code}
module Zlib ( gzOpenFile, gzWriteFile, gzReadFile,
              gzWriteToFile, gzReadFromFile,
            ) where

import IO ( Handle, IOMode(..), hClose, hGetContents, hPutStr )
import Foreign.C.String ( CString, withCString )
import Foreign.Ptr ( Ptr )
import Foreign.Marshal.Utils ( with )
import Foreign.Storable ( peek )
import GHC.Handle ( openFd )
import GHC.IOBase ( FD )
import Monad ( when )
import Workaround ( renameFile )

import System.Posix.Internals ( FDType(..) )

import Lock ( withNamedTemp )
#include "impossible.h"

type Pthread = Int

fdToReadHandle :: FD -> FilePath -> IO Handle
fdToWriteHandle :: FD -> FilePath -> IO Handle
fdToReadHandle fd fn = openFd fd (Just RegularFile) fn ReadMode False False
fdToWriteHandle fd fn = openFd fd (Just RegularFile) fn WriteMode False False

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

withPthread :: (Ptr Pthread -> IO a) -> IO a
withPthread = with 0

gzOpenFile _ WriteMode = fail "I don't support gzOpenFile in write mode."
gzOpenFile f mode = do (h,thid) <- gzopen_private f mode
                       detach_gz thid
                       return h

gzopen_private :: FilePath -> IOMode -> IO (Handle,Pthread)
gzopen_private f ReadMode = withCString f $ \fstr ->
                            withPthread $ \pth -> do
                            fd <- gzreader fstr pth
                            when (fd < 0) $
                                 fail $ "Error opening file "++f
                            thid <- peek pth
                            h <- fdToReadHandle fd f
                            return (h,thid)
gzopen_private f WriteMode = withCString f $ \fstr ->
                             withPthread $ \pth -> do
                             fd <- gzwriter fstr pth
                             when (fd < 0) $
                                  fail $ "Error opening file "++f
                             thid <- peek pth
                             h <- fdToWriteHandle fd f
                             return (h,thid)
gzopen_private _ _ = bug "gzopen_private only works in WriteMode or ReadMode"

gzWriteFile f s = do (h,thid) <- gzopen_private f WriteMode
                     hPutStr h s
                     hClose h
                     err <- wait_on_gz thid
                     when (err /= 0) $
                          fail $ "Error gzwriting to file "++f

gzReadFile f = do h <- gzOpenFile f ReadMode
                  hGetContents h

gzWriteToFile :: FilePath -> (Handle -> IO ()) -> IO ()
gzWriteToFile f job =
    withNamedTemp f $ \newf -> do
    (h,thid) <- gzopen_private newf WriteMode
    job h
    hClose h
    err <- wait_on_gz thid
    when (err /= 0) $ fail $ "Error gzwriting to file "++f
    renameFile newf f

gzReadFromFile :: FilePath -> (Handle -> IO a) -> IO a
gzReadFromFile f job = do (h,thid) <- gzopen_private f ReadMode
                          out <- job h
                          hClose h
                          err <- wait_on_gz thid
                          when (err /= 0) $
                               fail $ "Error gzreading file "++f
                          return out

foreign import ccall unsafe "static zlib_helper.h gzreader" gzreader
    :: CString -> Ptr Pthread -> IO Int
foreign import ccall unsafe "static zlib_helper.h gzwriter" gzwriter
    :: CString -> Ptr Pthread -> IO Int

foreign import ccall unsafe "static zlib_helper.h wait_on_gz" wait_on_gz
    :: Pthread -> IO Int
foreign import ccall unsafe "static zlib_helper.h detach_gz" detach_gz
    :: Pthread -> IO ()
\end{code}