Sorry for the delayed reply. The original pipes-group solution with this
type is the correct one:
Producer (k, v) m r -> Producer (k, v) m r
There is no way to transform a Consumer to pre-group values coming in
(without using something like Maybe). That is why you cannot make this into
a Pipe. An easy way to convince yourself of this is to just ask what would
your consumer ("c") do if you connected it to:
yield (k, v) >-> c
On Fri, Jun 12, 2015 at 7:58 AM Jacob Stanley <ja...@stanley.io> 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.
>
--
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.
