On 3/27/11 11:38 AM, John A. De Goes wrote:

Enumeratees solve some use cases but not others. Let's say you want to incrementally 
compress a 2 GB file. If you use an enumeratee to do this, your "transformer" 
iteratee has to do IO. I'd prefer an abstraction to incrementally and purely produce the 
output from a stream of input.

I don't see why? In pseudocode we could have,

    enumRead2GBFile :: FilePath -> Enumerator IO ByteString
    enumRead2GBFile file iter0 = do
        fd <- open file
        let loop iter = do
                mline <- read fd
                case mline of
                    Nothing -> return iter
                    Just line -> do
                        iter' <- feed iter line
                        if isDone iter'
                            then return iter'
                            else loop iter'
        iterF <- loop iter0
        close fd
        return iterF

    compress :: Monad m => Enumeratee m ByteString ByteString
    compress = go state0
        where
        go state = do
            chunk <- get
            let (state',hash) = compressify state chunk
            put hash
            go state'

    compressify :: Foo -> ByteString -> (Foo,ByteString)

it's just a pipeline like function composition or shell pipes. There's no reason intermediate points of the pipeline have do anything impure.

--
Live well,
~wren

_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to