I meant to agree that the pipes-group method was the true path, but I think
you can always produce this sort of effect if you make something like the
io-stream rule explicit, it's just a little tiresome. My impression was
that there was no way to support it systematically without making a mess of
everything, but see e.g.
import Pipes
import qualified Pipes.Prelude as P
import Pipes.Group
import Lens.Simple
import Control.Monad
foldValues :: (Monad m, Eq k) => (v -> v -> v) -> Producer (k, v) m r
-> Producer (k, v) m r
foldValues append xs = P.concat <-< folds step Nothing id (view
(groupsBy keyEq) xs)
where
keyEq (k, _) (k', _) = k == k'
step (Nothing) (k, v) = Just (k, v)
step (Just (_, v0)) (k, v) = Just (k, v0 `append` v)
pipeFoldValues :: (Monad m, Eq k) => (v -> v -> v) -> Pipe (k,v) (k, v)
m r
pipeFoldValues append = go Nothing where
go (Just (k,v)) = do
a <- await
case a of
(k',v') | k == k' -> go (Just (k,append v v'))
(k',v') -> do
yield (k,v)
go (Just (k',v'))
go Nothing = do
a <- await
go (Just a)
pipeFoldValues' :: (Monad m, Eq k) => (v -> v -> v) -> Pipe (Maybe
(k,v)) (Maybe (k, v)) m r
pipeFoldValues' append = go Nothing where
go (Just (k,v)) = do
a <- await
case a of
Nothing -> yield (Just (k,v)) >> forever (yield Nothing)
Just (k',v') | k == k' -> go (Just (k,append v v'))
Just (k',v') -> do
yield (Just (k,v))
go (Just (k',v'))
go Nothing = do
a <- await
go a
pipeFoldValues''
:: (Monad m, Eq k)
=> (v -> v -> v) -> Pipe (Either r (k,v)) (Either r (k, v)) m x
pipeFoldValues'' append = go Nothing where
go (Just (k,v)) = do
e <- await
case e of
Left r -> yield (Right (k,v)) >> forever (yield (Left r))
Right (k',v') | k == k' -> go (Just (k,append v v'))
Right (k',v') -> do
yield (Right (k,v))
go (Just (k',v'))
go Nothing = do
a <- await
case a of
Left r -> forever (yield (Left r))
Right (k,v) -> go (Just (k,v))
-- dubious kit for Nothing or Left ending streams:
eof p = do
p >-> P.map Just
forever $ yield Nothing
uneof = do
n <- await
case n of
Nothing -> return ()
Just a -> yield a >> uneof
internalize p = do
r <- p >-> P.map Right
forever $ yield (Left r)
externalize = do
e <- await
case e of
Left r -> return r
Right a -> yield a >> externalize
-- demo --
q = each (zip ["hi","hi","ho","ho","hi","hi"] (repeat 2))
run p = runEffect $ p >-> P.print
p1 = foldValues (+) q
p2 = q >-> pipeFoldValues (+)
p3 = eof q >-> pipeFoldValues' (+) >-> uneof
p4 = internalize q >-> pipeFoldValues'' (+) >-> externalize
p4' = internalize (q >> return "hi") >-> (P.tee P.print) >->
pipeFoldValues'' (+) >-> externalize
-- [*Main]
-- > run p1
-- ("hi",4)
-- ("ho",4)
-- ("hi",4)
-- [*Main]
-- > run p2
-- ("hi",4)
-- ("ho",4) -- <- missing last group
-- [*Main]
-- > run p3
-- ("hi",4)
-- ("ho",4)
-- ("hi",4)
-- [*Main]
-- > run p4
-- ("hi",4)
-- ("ho",4)
-- ("hi",4)
-- [*Main]
-- > run p4'
-- Right ("hi",2)
-- Right ("hi",2)
-- Right ("ho",2)
-- ("hi",4)
-- Right ("ho",2)
-- Right ("hi",2)
-- ("ho",4)
-- Right ("hi",2)
-- Left "hi"
-- ("hi",4)
-- "hi"
--
You received this message because you are subscribed to the Google Groups
"Haskell Pipes" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to haskell-pipes+unsubscr...@googlegroups.com.
To post to this group, send email to haskell-pipes@googlegroups.com.
