Attoparsec + Zlib decompression example.

Parser.hs

import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.State.Class (get, put)
import Control.Monad.State.Strict (StateT, evalStateT)
import Data.Attoparsec.ByteString
import qualified Data.Attoparsec.ByteString as A
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Monoid ((<>))
import qualified Data.Streaming.Zlib as Z

type Prsr a = ExceptT String (StateT ByteString IO) a

runPrsr :: Prsr a -> ByteString -> IO (Either String a)
runPrsr = evalStateT . runExceptT

atto :: A.Parser a -> Prsr a
atto p = do
  input <- get
  case A.parseOnly (match p) input of
    Left error -> throwError error
    Right (parsedBytes, a) -> do
      put $ BS.drop (BS.length parsedBytes) input
      return a

inflate :: Prsr ByteString
inflate = do
  input <- get
  (inflated, remainder) <- lift $ lift $ inflateWithRemainder input
  put $ inflated <> remainder
  return inflated

compressed :: A.Parser a -> Prsr a
compressed p = do
  input <- get
  (inflated, remainder) <- lift $ lift $ inflateWithRemainder input
  put $ inflated <> remainder
  atto p
  
inflateWithRemainder :: ByteString -> IO (ByteString, ByteString)
inflateWithRemainder bs = do
  inf <- Z.initInflate Z.defaultWindowBits
  popper <- Z.feedInflate inf bs
  poppedBytes <- popAll popper
  flushedBytes <- Z.flushInflate inf
  remainder <- Z.getUnusedInflate inf
  return (poppedBytes <> flushedBytes, remainder)

popAll :: Z.Popper -> IO ByteString
popAll popper = loop ""
  where
    loop bytes = do
      pop <- popper
      case pop of
        Z.PRDone -> return bytes
        Z.PRNext bytes' -> loop (bytes <> bytes')
        Z.PRError e -> throwIO e