Assuming the stream is sorted by key, does it sound like this?
-- import Pipes.Group as G
-- import Lens.Family
foldGroups :: (Eq a, Monad m) => Producer a m r -> Producer a m r
foldGroups = G.folds (\s (_, a) -> merge s a) z id . view (G.groupsBy
sameKey)
where
sameKey :: a -> a -> Bool
merge :: s -> a -> s
Cheers,
Alexey.
On Friday, June 12, 2015 at 3:58:22 PM UTC+10, Jacob Stanley wrote:
>
> Thanks, so it looks like the only way to write this as a Pipe is to
> explicitly use the io-streams rule.
>
> On Friday, June 12, 2015 at 12:36:13 PM UTC+10, Michael Thompson wrote:
>>
>> 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.
