forked from maltem/zlib-enum
/
Enum.hs
80 lines (70 loc) · 2.78 KB
/
Enum.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
module Codec.Zlib.Enum (
-- * Enumeratees
compress, decompress,
-- * Re-exported from zlib-bindings
WindowBits, defaultWindowBits
) where
import Codec.Zlib
import Data.Enumerator as E
import Control.Monad.Trans (MonadIO, liftIO)
import Data.ByteString (ByteString)
import Control.Monad (join)
joinIO :: MonadIO m => IO (m (Step a m b)) -> Iteratee a m b
joinIO = Iteratee . join . liftIO
enumLoop :: Monad m =>
((Stream b -> Iteratee b m c) -> Iteratee a m (Step b m c))
-> ((Stream b -> Iteratee b m c) -> a -> Iteratee b m c)
-> Enumeratee a b m c
enumLoop done more = checkDone loop where
loop k = do maybe_x <- E.head
case maybe_x of
Nothing -> done k
Just x -> checkDone loop $$ more k x
-- |
-- Decompress (inflate) a stream of 'ByteString's. For example:
--
-- > run $ enumFile "test.z" $$ decompress defaultWindowBits $$ printChunks True
decompress :: MonadIO m
=> WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library)
-> Enumeratee ByteString ByteString m ()
decompress config step0 = do
inflate <- liftIO $ initInflate config
let done k = do lastChunk <- liftIO $ finishInflate inflate
return $$ k (Chunks [lastChunk])
more k x = joinIO $ withInflateInput inflate x (return . callback k)
enumLoop done more step0
-- |
-- Compress (deflate) a stream of 'ByteString's. The 'WindowBits' also control
-- the format (zlib vs. gzip).
compress :: MonadIO m
=> Int -- ^ Compression level
-> WindowBits -- ^ Zlib parameter (see the zlib-bindings package as well as the zlib C library)
-> Enumeratee ByteString ByteString m ()
compress level config step0 = do
deflate <- liftIO $ initDeflate level config
let done k = return $$ joinIO $ finishDeflate deflate (return . callback k)
more k x = joinIO $ withDeflateInput deflate x (return . callback k)
enumLoop done more step0
-- A callback function for withInflateInput / withDeflateInput
callback :: MonadIO m =>
(Stream a -> Iteratee a m b) -> IO (Maybe a) -> m (Step a m b)
callback k pop = maybe done more =<< liftIO pop
where
done = return (Continue k)
more y = do step <- runIteratee (k (Chunks [y]))
case step of
Continue k' -> callback k' pop
other -> return other
-- testInflate = do
-- h <- openBinaryFile "test-out" WriteMode
-- run $ enumFile "test.z"
-- $$ decompress defaultWindowBits
-- $$ iterHandle h
-- hClose h
--
-- testDeflate = do
-- h <- openBinaryFile "test.z" WriteMode
-- run $ enumFile "test"
-- $$ compress 7 defaultWindowBits
-- $$ iterHandle h
-- hClose h