← Back to branch summary

~ubuntu-branches/ubuntu/precise/haskell-wai-extra/precise

« back to all changes in this revision

Viewing changes to Network/Wai/Zlib.hs

  • Committer: Bazaar Package Importer
  • Author(s): Clint Adams
  • Date: 2011-06-01 23:22:01 UTC
  • Revision ID: james.westby@ubuntu.com-20110601232201-y6ygzozvhbcjdaoq
Tags: upstream-0.2.4.2
Import upstream version 0.2.4.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
Network/Wai/Zlib.hs
 
1
module Network.Wai.Zlib (compress) where
 
2
 
 
3
import Prelude
 
4
import Network.Wai
 
5
import Data.ByteString (ByteString)
 
6
 
 
7
import Codec.Zlib
 
8
 
 
9
compress :: Enumerator -> Enumerator
 
10
compress enum =
 
11
    Enumerator $ \iter acc -> do
 
12
        def <- initDeflate 7 $ WindowBits 31
 
13
        compressInner iter acc enum def
 
14
 
 
15
compressInner :: (acc -> ByteString -> IO (Either acc acc))
 
16
              -> acc
 
17
              -> Enumerator
 
18
              -> Deflate
 
19
              -> IO (Either acc acc)
 
20
compressInner iter acc enum def = do
 
21
    eacc <- runEnumerator enum (compressIter iter def) acc
 
22
    case eacc of
 
23
        Left acc' -> return $ Left acc'
 
24
        Right acc' -> finishStream iter def acc'
 
25
 
 
26
finishStream :: (acc -> ByteString -> IO (Either acc acc))
 
27
             -> Deflate
 
28
             -> acc
 
29
             -> IO (Either acc acc)
 
30
finishStream iter def acc = finishDeflate def $ drain iter acc
 
31
 
 
32
compressIter :: (acc -> ByteString -> IO (Either acc acc))
 
33
             -> Deflate
 
34
             -> acc
 
35
             -> ByteString
 
36
             -> IO (Either acc acc)
 
37
compressIter iter def acc bsI = withDeflateInput def bsI $ drain iter acc
 
38
 
 
39
drain :: (acc -> ByteString -> IO (Either acc acc))
 
40
      -> acc
 
41
      -> IO (Maybe ByteString)
 
42
      -> IO (Either acc acc)
 
43
drain iter acc pop = do
 
44
    mbs <- pop
 
45
    case mbs of
 
46
        Nothing -> return $ Right acc
 
47
        Just bs -> do
 
48
            eacc' <- iter acc bs
 
49
            case eacc' of
 
50
                Left acc' -> return $ Left acc'
 
51
                Right acc' -> drain iter acc' pop