I was trying to figure this out and noticed I got a pretty good
optimization and also a unification of code if I started from this
unpleasantly typed function:
evertMaster
:: (Monad m, Monad m1) =>
(Stream (Of a) (Stream ((->) (Feed a)) m) () -> Stream ((->) (Feed
a')) m1 (Of b ()))
-> FoldM m1 a' b
evertMaster consumer = FoldM step begin done
where
begin = return (consumer cat)
step str i = case str of
Return _ -> error stoppedBeforeEOF
Step f -> return (f (Input i))
Effect m -> m >>= \str' -> step str' i
done str = do
e <- inspect str
case e of
Left _ -> error stoppedBeforeEOF
Right f -> do
e <- inspect (f EOF)
case e of
Left (a :> ()) -> return a
Right _ -> error continuedAfterEOF
cat :: Monad m => Stream (Of a) (Stream ((->)(Feed a)) m) ()
cat = do
r <- Effect (Step (Return . Return))
case r of
Input a -> Step (a :> cat_ )
EOF -> Return ()
evert_ :: Eversible a b -> Fold a b
evert_ (Eversible psi) = Foldl.simplify (evertMaster psi)
evertM_ :: Monad m => EversibleM m a b -> FoldM m a b
evertM_ (EversibleM psi) = evertMaster psi
evertMIO_ :: MonadIO m => EversibleMIO m a b -> FoldM m a b
evertMIO_ (EversibleMIO psi) = evertMaster psi
This uses the constructors directly for the internal `step` function, which
is repeatedly applied, and the internal `cat` stream, which is repeatedly
deconstructed. Using the constructors directly is black magic, so some
gruesome mistake could emerge on cases more complicated than the trivial
one I was testing. It was about 10 times as fast for this case but less of
a win in the pure `Fold a b` case
main = print =<< L.foldM (evertM_ (EversibleM S.sum))
[1..1000000::Int]
-- main = print =<< L.foldM (evertM (EversibleM S.sum))
[1..1000000::Int]
The more prudent implementation would use `inspect` (~ `runFreeT`) in
`step`, pattern matching on the Either, like in `done` above. I think that
was still distinctly faster. Similarly, the 'correct' `cat` /
`evertedStreamM` would be like so
cat :: Monad m => Stream (Of a) (Stream ((->)(Feed a)) m) ()
cat = do
r <- lift (yields id)
case r of
Input a -> do
yield a
cat
EOF -> return ()
The idea of using `evertedStreamM` like this is pretty amazing. In the
`Streaming.Prelude` module there is the dubious `store` function
store :: Monad m => (Stream (Of a) (Stream (Of a) m) r -> t) ->
Stream (Of a) m r -> t
store f str = f (copy str)
This is meant to be used at types like
S.store :: Monad m => EvertibleM m a b -> Stream (Of a) m r -> Stream
(Of a) m (Of b r)
S.store :: Monad m => Evertible a b -> Stream (Of a) m r -> Stream
(Of a) m (Of b r)
(taking `Evertible` and company as rank-2 type synonyms, not newtypes).
The idea was to permit you to apply more than one eliminating operation to
the same stream of items. You apply a fold and still have your stream! Of
course if the eliminations of the stream that you envisage are with
`Control.Foldl.Fold(M)`s there is no point in since we already know how to
do apply them together, but (as I was thinking) not every elimination
reduces to a `Fold` or `FoldM` The way it uses the `copy` function
S.copy :: Monad m => Stream (Of a) m r -> Stream (Of a) (Stream (Of
a) m) r
is some sort of dual to the way `evert` uses `evertedStream` I couldn't
figure out a simple way of dealing with the differences parallel to `evert`
`evertM` `evertMIO`, so basically
I just ended up exporting the equivalent of my `evertMaster` above with
some comments on use. I'm not sure there would be any harm by the way in
exporting three functions corresponding to `evert(M(IO))` that just take
the rank two functions directly. I wasn't having trouble with the 'raw'
everted_ :: (forall m r. Monad m => Stream (Of a) m r -> m (Of x r)) ->
Fold a x
everted_ phi = evert_ (Eversible phi)
evertedM_ :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) =>
Stream (Of a) (t m) r -> t m (Of x r)) -> FoldM m a x
evertedM_ phi = evertM_ (EversibleM phi)
evertedMIO_ :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m))
=> Stream (Of a) (t m) r -> t m (Of x r))
-> FoldM m a x
evertedMIO_ phi = evertMIO_ (EversibleMIO phi)
Then treat the wrapped versions as making complicated cases easier to get
past the compiler: you separate out the task of `Eversible` so that it
type checks and so on. I think edwardk does this sometimes, using both a
direct rank-2 version and a wrapped version.
Sorry, this is a bit of a mess, I still haven't got to figuring out the
`Transvertible` bit!
--
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.
