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!