[Haskell-cafe] ANNOUNCE: pipes-core 0.1.0

Twan van Laarhoven twanvl at gmail.com
Tue Apr 10 17:50:07 CEST 2012


On 09/04/12 23:49, Paolo Capriotti wrote:
> I'm pleased to announce the release of version 0.1.0 of pipes-core, a
> library for efficient, safe and compositional IO, similar in scope to
> iteratee and conduits.
>
> http://hackage.haskell.org/package/pipes-core
>

I have some issues with the function names used

     firstP :: Monad m => Pipe a b m r
               -> Pipe (Either a c) (Either b c) m r
     secondP :: Monad m => Pipe a b m r
               -> Pipe (Either c a) (Either c b) m r

Why are firstP and secondP not called leftP and rightP? Those are the 
corresponding functions in Arrow. Similarly (***) should be called (+++).


I also don't like `intersperse`, which does something completely 
different from its Data.List counterpart.

     intersperse :: Monad m => (a -> Bool) -> Pipe a (Maybe a) m r
     Data.List.intersperse :: a -> [a] -> [a]

The documentation is also a bit misleading "Yield Nothing when an input 
satisfying the predicate is received." To me this suggests that could 
behave like some kind of filter,

     intersperse p = pipe $ \x -> if p x then Nothing else Just x

A true intersperse analogue would be

     intersperse x = do
         y0 <- await
         yield y0
         forever $ do
            y <- await
            yield x
            yield y

The function you have defined is something like 
`yieldNothingBeforeMatching`. Do you have a use case for this function?


Perhaps an interesting combinator would be

     -- | Run the first pipe until it yields a value, then run the 
second pipe until it yields, the the first pipe again, etc.
     alternate :: Pipe a b m r -> Pipe a b m r -> Pipe a b m r

     intersperse x = alternate idP (forever (yield x))

Although I have no idea if it is actually useful in practice.


Twan



More information about the Haskell-Cafe mailing list