{-# LINE 1 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, DeriveDataTypeable #-}
{-# LINE 3 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LINE 5 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LINE 6 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LINE 8 "Codec/Compression/Zlib/Stream.hsc" #-}
module Codec.Compression.Zlib.Stream (
Stream,
State,
mkState,
runStream,
unsafeLiftIO,
finalise,
deflateInit,
inflateInit,
Format(..),
gzipFormat,
zlibFormat,
rawFormat,
gzipOrZlibFormat,
formatSupportsDictionary,
CompressionLevel(..),
defaultCompression,
noCompression,
bestSpeed,
bestCompression,
compressionLevel,
Method(..),
deflateMethod,
WindowBits(..),
defaultWindowBits,
windowBits,
MemoryLevel(..),
defaultMemoryLevel,
minMemoryLevel,
maxMemoryLevel,
memoryLevel,
CompressionStrategy(..),
defaultStrategy,
filteredStrategy,
huffmanOnlyStrategy,
deflate,
inflate,
Status(..),
Flush(..),
ErrorCode(..),
inflateReset,
pushInputBuffer,
inputBufferEmpty,
popRemainingInputBuffer,
pushOutputBuffer,
popOutputBuffer,
outputBufferBytesAvailable,
outputBufferSpaceRemaining,
outputBufferFull,
deflateSetDictionary,
inflateSetDictionary,
DictionaryHash,
dictionaryHash,
zeroDictionaryHash,
{-# LINE 97 "Codec/Compression/Zlib/Stream.hsc" #-}
) where
import Foreign
( Word8, Ptr, nullPtr, plusPtr, peekByteOff, pokeByteOff
, ForeignPtr, FinalizerPtr, mallocForeignPtrBytes, addForeignPtrFinalizer
, withForeignPtr, touchForeignPtr, minusPtr )
{-# LINE 109 "Codec/Compression/Zlib/Stream.hsc" #-}
import Foreign.ForeignPtr.Unsafe ( unsafeForeignPtrToPtr )
import System.IO.Unsafe ( unsafePerformIO )
{-# LINE 114 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LINE 115 "Codec/Compression/Zlib/Stream.hsc" #-}
import Foreign
( finalizeForeignPtr )
{-# LINE 118 "Codec/Compression/Zlib/Stream.hsc" #-}
import Foreign.C
import Data.ByteString.Internal (nullForeignPtr)
import qualified Data.ByteString.Unsafe as B
import Data.ByteString (ByteString)
{-# LINE 125 "Codec/Compression/Zlib/Stream.hsc" #-}
import Control.Monad (ap,liftM)
{-# LINE 127 "Codec/Compression/Zlib/Stream.hsc" #-}
import qualified Control.Monad.Fail as Fail
{-# LINE 129 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LINE 130 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LINE 131 "Codec/Compression/Zlib/Stream.hsc" #-}
import Control.Monad.ST.Strict
{-# LINE 135 "Codec/Compression/Zlib/Stream.hsc" #-}
import Control.Monad.ST.Unsafe
{-# LINE 139 "Codec/Compression/Zlib/Stream.hsc" #-}
import Control.Exception (assert)
import Data.Typeable (Typeable)
{-# LINE 142 "Codec/Compression/Zlib/Stream.hsc" #-}
import GHC.Generics (Generic)
{-# LINE 144 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LINE 147 "Codec/Compression/Zlib/Stream.hsc" #-}
import Prelude hiding (length)
pushInputBuffer :: ForeignPtr Word8 -> Int -> Int -> Stream ()
pushInputBuffer inBuf' offset length = do
inAvail <- getInAvail
assert (inAvail == 0) $ return ()
inBuf <- getInBuf
unsafeLiftIO $ touchForeignPtr inBuf
setInBuf inBuf'
setInAvail length
setInNext (unsafeForeignPtrToPtr inBuf' `plusPtr` offset)
inputBufferEmpty :: Stream Bool
inputBufferEmpty = getInAvail >>= return . (==0)
popRemainingInputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popRemainingInputBuffer = do
inBuf <- getInBuf
inNext <- getInNext
inAvail <- getInAvail
assert (inAvail > 0) $ return ()
setInAvail 0
return (inBuf, inNext `minusPtr` unsafeForeignPtrToPtr inBuf, inAvail)
pushOutputBuffer :: ForeignPtr Word8 -> Int -> Int -> Stream ()
pushOutputBuffer outBuf' offset length = do
outAvail <- getOutAvail
assert (outAvail == 0) $ return ()
outBuf <- getOutBuf
unsafeLiftIO $ touchForeignPtr outBuf
setOutBuf outBuf'
setOutFree length
setOutNext (unsafeForeignPtrToPtr outBuf' `plusPtr` offset)
setOutOffset offset
setOutAvail 0
popOutputBuffer :: Stream (ForeignPtr Word8, Int, Int)
popOutputBuffer = do
outBuf <- getOutBuf
outOffset <- getOutOffset
outAvail <- getOutAvail
assert (outAvail > 0) $ return ()
setOutOffset (outOffset + outAvail)
setOutAvail 0
return (outBuf, outOffset, outAvail)
outputBufferBytesAvailable :: Stream Int
outputBufferBytesAvailable = getOutAvail
outputBufferSpaceRemaining :: Stream Int
outputBufferSpaceRemaining = getOutFree
outputBufferFull :: Stream Bool
outputBufferFull = liftM (==0) outputBufferSpaceRemaining
deflate :: Flush -> Stream Status
deflate flush = do
outFree <- getOutFree
assert (outFree > 0) $ return ()
result <- deflate_ flush
outFree' <- getOutFree
let outExtra = outFree - outFree'
outAvail <- getOutAvail
setOutAvail (outAvail + outExtra)
return result
inflate :: Flush -> Stream Status
inflate flush = do
outFree <- getOutFree
assert (outFree > 0) $ return ()
result <- inflate_ flush
outFree' <- getOutFree
let outExtra = outFree - outFree'
outAvail <- getOutAvail
setOutAvail (outAvail + outExtra)
return result
inflateReset :: Stream ()
inflateReset = do
outAvail <- getOutAvail
inAvail <- getInAvail
assert (outAvail == 0 && inAvail == 0) $ return ()
err <- withStreamState $ \zstream ->
c_inflateReset zstream
failIfError err
deflateSetDictionary :: ByteString -> Stream Status
deflateSetDictionary dict = do
err <- withStreamState $ \zstream ->
B.unsafeUseAsCStringLen dict $ \(ptr, len) ->
c_deflateSetDictionary zstream ptr (fromIntegral len)
toStatus err
inflateSetDictionary :: ByteString -> Stream Status
inflateSetDictionary dict = do
err <- withStreamState $ \zstream -> do
B.unsafeUseAsCStringLen dict $ \(ptr, len) ->
c_inflateSetDictionary zstream ptr (fromIntegral len)
toStatus err
newtype DictionaryHash = DictHash CULong
deriving (Eq, Ord, Read, Show)
dictionaryHash :: DictionaryHash -> ByteString -> DictionaryHash
dictionaryHash (DictHash adler) dict =
unsafePerformIO $
B.unsafeUseAsCStringLen dict $ \(ptr, len) ->
liftM DictHash $ c_adler32 adler ptr (fromIntegral len)
zeroDictionaryHash :: DictionaryHash
zeroDictionaryHash = DictHash 0
newtype Stream a = Z {
unZ :: ForeignPtr StreamState
-> ForeignPtr Word8
-> ForeignPtr Word8
-> Int -> Int
-> IO (ForeignPtr Word8
,ForeignPtr Word8
,Int, Int, a)
}
instance Functor Stream where
fmap = liftM
instance Applicative Stream where
pure = returnZ
(<*>) = ap
(*>) = thenZ_
instance Monad Stream where
(>>=) = thenZ
(>>) = (*>)
{-# LINE 383 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LINE 389 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LINE 391 "Codec/Compression/Zlib/Stream.hsc" #-}
instance Fail.MonadFail Stream where
fail = (finalise >>) . failZ
{-# LINE 394 "Codec/Compression/Zlib/Stream.hsc" #-}
returnZ :: a -> Stream a
returnZ a = Z $ \_ inBuf outBuf outOffset outLength ->
return (inBuf, outBuf, outOffset, outLength, a)
{-# INLINE returnZ #-}
thenZ :: Stream a -> (a -> Stream b) -> Stream b
thenZ (Z m) f =
Z $ \stream inBuf outBuf outOffset outLength ->
m stream inBuf outBuf outOffset outLength >>=
\(inBuf', outBuf', outOffset', outLength', a) ->
unZ (f a) stream inBuf' outBuf' outOffset' outLength'
{-# INLINE thenZ #-}
thenZ_ :: Stream a -> Stream b -> Stream b
thenZ_ (Z m) f =
Z $ \stream inBuf outBuf outOffset outLength ->
m stream inBuf outBuf outOffset outLength >>=
\(inBuf', outBuf', outOffset', outLength', _) ->
unZ f stream inBuf' outBuf' outOffset' outLength'
{-# INLINE thenZ_ #-}
failZ :: String -> Stream a
failZ msg = Z (\_ _ _ _ _ -> fail ("Codec.Compression.Zlib: " ++ msg))
data State s = State !(ForeignPtr StreamState)
!(ForeignPtr Word8)
!(ForeignPtr Word8)
{-# UNPACK #-} !Int
{-# UNPACK #-} !Int
mkState :: ST s (State s)
mkState = unsafeIOToST $ do
stream <- mallocForeignPtrBytes (112)
{-# LINE 428 "Codec/Compression/Zlib/Stream.hsc" #-}
withForeignPtr stream $ \ptr -> do
(\hsc_ptr -> pokeByteOff hsc_ptr 48) ptr nullPtr
{-# LINE 430 "Codec/Compression/Zlib/Stream.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 64) ptr nullPtr
{-# LINE 431 "Codec/Compression/Zlib/Stream.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 72) ptr nullPtr
{-# LINE 432 "Codec/Compression/Zlib/Stream.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 80) ptr nullPtr
{-# LINE 433 "Codec/Compression/Zlib/Stream.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr nullPtr
{-# LINE 434 "Codec/Compression/Zlib/Stream.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr nullPtr
{-# LINE 435 "Codec/Compression/Zlib/Stream.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (0 :: CUInt)
{-# LINE 436 "Codec/Compression/Zlib/Stream.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr (0 :: CUInt)
{-# LINE 437 "Codec/Compression/Zlib/Stream.hsc" #-}
return (State stream nullForeignPtr nullForeignPtr 0 0)
runStream :: Stream a -> State s -> ST s (a, State s)
runStream (Z m) (State stream inBuf outBuf outOffset outLength) =
unsafeIOToST $
m stream inBuf outBuf outOffset outLength >>=
\(inBuf', outBuf', outOffset', outLength', a) ->
return (a, State stream inBuf' outBuf' outOffset' outLength')
unsafeLiftIO :: IO a -> Stream a
unsafeLiftIO m = Z $ \_stream inBuf outBuf outOffset outLength -> do
a <- m
return (inBuf, outBuf, outOffset, outLength, a)
getStreamState :: Stream (ForeignPtr StreamState)
getStreamState = Z $ \stream inBuf outBuf outOffset outLength -> do
return (inBuf, outBuf, outOffset, outLength, stream)
getInBuf :: Stream (ForeignPtr Word8)
getInBuf = Z $ \_stream inBuf outBuf outOffset outLength -> do
return (inBuf, outBuf, outOffset, outLength, inBuf)
getOutBuf :: Stream (ForeignPtr Word8)
getOutBuf = Z $ \_stream inBuf outBuf outOffset outLength -> do
return (inBuf, outBuf, outOffset, outLength, outBuf)
getOutOffset :: Stream Int
getOutOffset = Z $ \_stream inBuf outBuf outOffset outLength -> do
return (inBuf, outBuf, outOffset, outLength, outOffset)
getOutAvail :: Stream Int
getOutAvail = Z $ \_stream inBuf outBuf outOffset outLength -> do
return (inBuf, outBuf, outOffset, outLength, outLength)
setInBuf :: ForeignPtr Word8 -> Stream ()
setInBuf inBuf = Z $ \_stream _ outBuf outOffset outLength -> do
return (inBuf, outBuf, outOffset, outLength, ())
setOutBuf :: ForeignPtr Word8 -> Stream ()
setOutBuf outBuf = Z $ \_stream inBuf _ outOffset outLength -> do
return (inBuf, outBuf, outOffset, outLength, ())
setOutOffset :: Int -> Stream ()
setOutOffset outOffset = Z $ \_stream inBuf outBuf _ outLength -> do
return (inBuf, outBuf, outOffset, outLength, ())
setOutAvail :: Int -> Stream ()
setOutAvail outLength = Z $ \_stream inBuf outBuf outOffset _ -> do
return (inBuf, outBuf, outOffset, outLength, ())
{-# LINE 532 "Codec/Compression/Zlib/Stream.hsc" #-}
data Status =
Ok
| StreamEnd
| Error ErrorCode String
data ErrorCode =
NeedDict DictionaryHash
| FileError
| StreamError
| DataError
| MemoryError
| BufferError
| VersionError
| Unexpected
toStatus :: CInt -> Stream Status
toStatus errno = case errno of
(0) -> return Ok
{-# LINE 559 "Codec/Compression/Zlib/Stream.hsc" #-}
(1) -> return StreamEnd
{-# LINE 560 "Codec/Compression/Zlib/Stream.hsc" #-}
(2) -> do
{-# LINE 561 "Codec/Compression/Zlib/Stream.hsc" #-}
adler <- withStreamPtr ((\hsc_ptr -> peekByteOff hsc_ptr 96))
{-# LINE 562 "Codec/Compression/Zlib/Stream.hsc" #-}
err (NeedDict (DictHash adler)) "custom dictionary needed"
(-5) -> err BufferError "buffer error"
{-# LINE 564 "Codec/Compression/Zlib/Stream.hsc" #-}
(-1) -> err FileError "file error"
{-# LINE 565 "Codec/Compression/Zlib/Stream.hsc" #-}
(-2) -> err StreamError "stream error"
{-# LINE 566 "Codec/Compression/Zlib/Stream.hsc" #-}
(-3) -> err DataError "data error"
{-# LINE 567 "Codec/Compression/Zlib/Stream.hsc" #-}
(-4) -> err MemoryError "insufficient memory"
{-# LINE 568 "Codec/Compression/Zlib/Stream.hsc" #-}
(-6) -> err VersionError "incompatible zlib version"
{-# LINE 569 "Codec/Compression/Zlib/Stream.hsc" #-}
other -> return $ Error Unexpected
("unexpected zlib status: " ++ show other)
where
err errCode altMsg = liftM (Error errCode) $ do
msgPtr <- withStreamPtr ((\hsc_ptr -> peekByteOff hsc_ptr 48))
{-# LINE 574 "Codec/Compression/Zlib/Stream.hsc" #-}
if msgPtr /= nullPtr
then unsafeLiftIO (peekCAString msgPtr)
else return altMsg
failIfError :: CInt -> Stream ()
failIfError errno = toStatus errno >>= \status -> case status of
(Error _ msg) -> fail msg
_ -> return ()
data Flush =
NoFlush
| SyncFlush
| FullFlush
| Finish
fromFlush :: Flush -> CInt
fromFlush NoFlush = 0
{-# LINE 593 "Codec/Compression/Zlib/Stream.hsc" #-}
fromFlush SyncFlush = 2
{-# LINE 594 "Codec/Compression/Zlib/Stream.hsc" #-}
fromFlush FullFlush = 3
{-# LINE 595 "Codec/Compression/Zlib/Stream.hsc" #-}
fromFlush Finish = 4
{-# LINE 596 "Codec/Compression/Zlib/Stream.hsc" #-}
data Format = GZip | Zlib | Raw | GZipOrZlib
deriving (Eq, Ord, Enum, Bounded, Show, Typeable
{-# LINE 605 "Codec/Compression/Zlib/Stream.hsc" #-}
, Generic
{-# LINE 607 "Codec/Compression/Zlib/Stream.hsc" #-}
)
{-# DEPRECATED GZip "Use gzipFormat. Format constructors will be hidden in version 0.7" #-}
{-# DEPRECATED Zlib "Use zlibFormat. Format constructors will be hidden in version 0.7" #-}
{-# DEPRECATED Raw "Use rawFormat. Format constructors will be hidden in version 0.7" #-}
{-# DEPRECATED GZipOrZlib "Use gzipOrZlibFormat. Format constructors will be hidden in version 0.7" #-}
gzipFormat :: Format
gzipFormat = GZip
zlibFormat :: Format
zlibFormat = Zlib
rawFormat :: Format
rawFormat = Raw
gzipOrZlibFormat :: Format
gzipOrZlibFormat = GZipOrZlib
formatSupportsDictionary :: Format -> Bool
formatSupportsDictionary Zlib = True
formatSupportsDictionary Raw = True
formatSupportsDictionary _ = False
data Method = Deflated
deriving (Eq, Ord, Enum, Bounded, Show, Typeable
{-# LINE 654 "Codec/Compression/Zlib/Stream.hsc" #-}
, Generic
{-# LINE 656 "Codec/Compression/Zlib/Stream.hsc" #-}
)
{-# DEPRECATED Deflated "Use deflateMethod. Method constructors will be hidden in version 0.7" #-}
deflateMethod :: Method
deflateMethod = Deflated
fromMethod :: Method -> CInt
fromMethod Deflated = 8
{-# LINE 668 "Codec/Compression/Zlib/Stream.hsc" #-}
data CompressionLevel =
DefaultCompression
| NoCompression
| BestSpeed
| BestCompression
| CompressionLevel Int
deriving (Eq, Show, Typeable
{-# LINE 682 "Codec/Compression/Zlib/Stream.hsc" #-}
, Generic
{-# LINE 684 "Codec/Compression/Zlib/Stream.hsc" #-}
)
{-# DEPRECATED DefaultCompression "Use defaultCompression. CompressionLevel constructors will be hidden in version 0.7" #-}
{-# DEPRECATED NoCompression "Use noCompression. CompressionLevel constructors will be hidden in version 0.7" #-}
{-# DEPRECATED BestSpeed "Use bestSpeed. CompressionLevel constructors will be hidden in version 0.7" #-}
{-# DEPRECATED BestCompression "Use bestCompression. CompressionLevel constructors will be hidden in version 0.7" #-}
defaultCompression :: CompressionLevel
defaultCompression = DefaultCompression
noCompression :: CompressionLevel
noCompression = CompressionLevel 0
bestSpeed :: CompressionLevel
bestSpeed = CompressionLevel 1
bestCompression :: CompressionLevel
bestCompression = CompressionLevel 9
compressionLevel :: Int -> CompressionLevel
compressionLevel n
| n >= 0 && n <= 9 = CompressionLevel n
| otherwise = error "CompressionLevel must be in the range 0..9"
fromCompressionLevel :: CompressionLevel -> CInt
fromCompressionLevel DefaultCompression = -1
fromCompressionLevel NoCompression = 0
fromCompressionLevel BestSpeed = 1
fromCompressionLevel BestCompression = 9
fromCompressionLevel (CompressionLevel n)
| n >= 0 && n <= 9 = fromIntegral n
| otherwise = error "CompressLevel must be in the range 1..9"
data WindowBits = WindowBits Int
| DefaultWindowBits
deriving (Eq, Ord, Show, Typeable
{-# LINE 746 "Codec/Compression/Zlib/Stream.hsc" #-}
, Generic
{-# LINE 748 "Codec/Compression/Zlib/Stream.hsc" #-}
)
{-# DEPRECATED DefaultWindowBits "Use defaultWindowBits. WindowBits constructors will be hidden in version 0.7" #-}
defaultWindowBits :: WindowBits
defaultWindowBits = WindowBits 15
windowBits :: Int -> WindowBits
windowBits n
| n >= 9 && n <= 15 = WindowBits n
| otherwise = error "WindowBits must be in the range 9..15"
fromWindowBits :: Format -> WindowBits-> CInt
fromWindowBits format bits = (formatModifier format) (checkWindowBits bits)
where checkWindowBits DefaultWindowBits = 15
checkWindowBits (WindowBits n)
| n >= 9 && n <= 15 = fromIntegral n
| otherwise = error "WindowBits must be in the range 9..15"
formatModifier Zlib = id
formatModifier GZip = (+16)
formatModifier GZipOrZlib = (+32)
formatModifier Raw = negate
data MemoryLevel =
DefaultMemoryLevel
| MinMemoryLevel
| MaxMemoryLevel
| MemoryLevel Int
deriving (Eq, Show, Typeable
{-# LINE 806 "Codec/Compression/Zlib/Stream.hsc" #-}
, Generic
{-# LINE 808 "Codec/Compression/Zlib/Stream.hsc" #-}
)
{-# DEPRECATED DefaultMemoryLevel "Use defaultMemoryLevel. MemoryLevel constructors will be hidden in version 0.7" #-}
{-# DEPRECATED MinMemoryLevel "Use minMemoryLevel. MemoryLevel constructors will be hidden in version 0.7" #-}
{-# DEPRECATED MaxMemoryLevel "Use maxMemoryLevel. MemoryLevel constructors will be hidden in version 0.7" #-}
defaultMemoryLevel :: MemoryLevel
defaultMemoryLevel = MemoryLevel 8
minMemoryLevel :: MemoryLevel
minMemoryLevel = MemoryLevel 1
maxMemoryLevel :: MemoryLevel
maxMemoryLevel = MemoryLevel 9
memoryLevel :: Int -> MemoryLevel
memoryLevel n
| n >= 1 && n <= 9 = MemoryLevel n
| otherwise = error "MemoryLevel must be in the range 1..9"
fromMemoryLevel :: MemoryLevel -> CInt
fromMemoryLevel DefaultMemoryLevel = 8
fromMemoryLevel MinMemoryLevel = 1
fromMemoryLevel MaxMemoryLevel = 9
fromMemoryLevel (MemoryLevel n)
| n >= 1 && n <= 9 = fromIntegral n
| otherwise = error "MemoryLevel must be in the range 1..9"
data CompressionStrategy =
DefaultStrategy
| Filtered
| HuffmanOnly
deriving (Eq, Ord, Enum, Bounded, Show, Typeable
{-# LINE 860 "Codec/Compression/Zlib/Stream.hsc" #-}
, Generic
{-# LINE 862 "Codec/Compression/Zlib/Stream.hsc" #-}
)
{-# DEPRECATED DefaultStrategy "Use defaultStrategy. CompressionStrategy constructors will be hidden in version 0.7" #-}
{-# DEPRECATED Filtered "Use filteredStrategy. CompressionStrategy constructors will be hidden in version 0.7" #-}
{-# DEPRECATED HuffmanOnly "Use huffmanOnlyStrategy. CompressionStrategy constructors will be hidden in version 0.7" #-}
defaultStrategy :: CompressionStrategy
defaultStrategy = DefaultStrategy
filteredStrategy :: CompressionStrategy
filteredStrategy = Filtered
huffmanOnlyStrategy :: CompressionStrategy
huffmanOnlyStrategy = HuffmanOnly
fromCompressionStrategy :: CompressionStrategy -> CInt
fromCompressionStrategy DefaultStrategy = 0
{-# LINE 902 "Codec/Compression/Zlib/Stream.hsc" #-}
fromCompressionStrategy Filtered = 1
{-# LINE 903 "Codec/Compression/Zlib/Stream.hsc" #-}
fromCompressionStrategy HuffmanOnly = 2
{-# LINE 904 "Codec/Compression/Zlib/Stream.hsc" #-}
withStreamPtr :: (Ptr StreamState -> IO a) -> Stream a
withStreamPtr f = do
stream <- getStreamState
unsafeLiftIO (withForeignPtr stream f)
withStreamState :: (StreamState -> IO a) -> Stream a
withStreamState f = do
stream <- getStreamState
unsafeLiftIO (withForeignPtr stream (f . StreamState))
setInAvail :: Int -> Stream ()
setInAvail val = withStreamPtr $ \ptr ->
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (fromIntegral val :: CUInt)
{-# LINE 921 "Codec/Compression/Zlib/Stream.hsc" #-}
getInAvail :: Stream Int
getInAvail = liftM (fromIntegral :: CUInt -> Int) $
withStreamPtr ((\hsc_ptr -> peekByteOff hsc_ptr 8))
{-# LINE 925 "Codec/Compression/Zlib/Stream.hsc" #-}
setInNext :: Ptr Word8 -> Stream ()
setInNext val = withStreamPtr (\ptr -> (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr val)
{-# LINE 928 "Codec/Compression/Zlib/Stream.hsc" #-}
getInNext :: Stream (Ptr Word8)
getInNext = withStreamPtr ((\hsc_ptr -> peekByteOff hsc_ptr 0))
{-# LINE 931 "Codec/Compression/Zlib/Stream.hsc" #-}
setOutFree :: Int -> Stream ()
setOutFree val = withStreamPtr $ \ptr ->
(\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr (fromIntegral val :: CUInt)
{-# LINE 935 "Codec/Compression/Zlib/Stream.hsc" #-}
getOutFree :: Stream Int
getOutFree = liftM (fromIntegral :: CUInt -> Int) $
withStreamPtr ((\hsc_ptr -> peekByteOff hsc_ptr 32))
{-# LINE 939 "Codec/Compression/Zlib/Stream.hsc" #-}
setOutNext :: Ptr Word8 -> Stream ()
setOutNext val = withStreamPtr (\ptr -> (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr val)
{-# LINE 942 "Codec/Compression/Zlib/Stream.hsc" #-}
{-# LINE 947 "Codec/Compression/Zlib/Stream.hsc" #-}
inflateInit :: Format -> WindowBits -> Stream ()
inflateInit format bits = do
checkFormatSupported format
err <- withStreamState $ \zstream ->
c_inflateInit2 zstream (fromIntegral (fromWindowBits format bits))
failIfError err
getStreamState >>= unsafeLiftIO . addForeignPtrFinalizer c_inflateEnd
deflateInit :: Format
-> CompressionLevel
-> Method
-> WindowBits
-> MemoryLevel
-> CompressionStrategy
-> Stream ()
deflateInit format compLevel method bits memLevel strategy = do
checkFormatSupported format
err <- withStreamState $ \zstream ->
c_deflateInit2 zstream
(fromCompressionLevel compLevel)
(fromMethod method)
(fromWindowBits format bits)
(fromMemoryLevel memLevel)
(fromCompressionStrategy strategy)
failIfError err
getStreamState >>= unsafeLiftIO . addForeignPtrFinalizer c_deflateEnd
inflate_ :: Flush -> Stream Status
inflate_ flush = do
err <- withStreamState $ \zstream ->
c_inflate zstream (fromFlush flush)
toStatus err
deflate_ :: Flush -> Stream Status
deflate_ flush = do
err <- withStreamState $ \zstream ->
c_deflate zstream (fromFlush flush)
toStatus err
finalise :: Stream ()
{-# LINE 994 "Codec/Compression/Zlib/Stream.hsc" #-}
finalise = getStreamState >>= unsafeLiftIO . finalizeForeignPtr
{-# LINE 999 "Codec/Compression/Zlib/Stream.hsc" #-}
checkFormatSupported :: Format -> Stream ()
checkFormatSupported format = do
version <- unsafeLiftIO (peekCAString =<< c_zlibVersion)
case version of
('1':'.':'1':'.':_)
| format == GZip
|| format == GZipOrZlib
-> fail $ "version 1.1.x of the zlib C library does not support the"
++ " 'gzip' format via the in-memory api, only the 'raw' and "
++ " 'zlib' formats."
_ -> return ()
newtype StreamState = StreamState (Ptr StreamState)
#ifdef NON_BLOCKING_FFI
#define SAFTY safe
#else
#define SAFTY unsafe
#endif
{-# LINE 1042 "Codec/Compression/Zlib/Stream.hsc" #-}
foreign import capi unsafe "zlib.h inflateInit2"
c_inflateInit2 :: StreamState -> CInt -> IO CInt
foreign import capi unsafe "zlib.h deflateInit2"
c_deflateInit2 :: StreamState
-> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt
{-# LINE 1069 "Codec/Compression/Zlib/Stream.hsc" #-}
foreign import ccall SAFTY "zlib.h inflate"
c_inflate :: StreamState -> CInt -> IO CInt
foreign import ccall unsafe "zlib.h &inflateEnd"
c_inflateEnd :: FinalizerPtr StreamState
foreign import ccall unsafe "zlib.h inflateReset"
c_inflateReset :: StreamState -> IO CInt
foreign import ccall unsafe "zlib.h deflateSetDictionary"
c_deflateSetDictionary :: StreamState
-> Ptr CChar
-> CUInt
-> IO CInt
foreign import ccall unsafe "zlib.h inflateSetDictionary"
c_inflateSetDictionary :: StreamState
-> Ptr CChar
-> CUInt
-> IO CInt
foreign import ccall SAFTY "zlib.h deflate"
c_deflate :: StreamState -> CInt -> IO CInt
foreign import ccall unsafe "zlib.h &deflateEnd"
c_deflateEnd :: FinalizerPtr StreamState
foreign import ccall unsafe "zlib.h zlibVersion"
c_zlibVersion :: IO CString
foreign import ccall unsafe "zlib.h adler32"
c_adler32 :: CULong
-> Ptr CChar
-> CUInt
-> IO CULong