module Control.Quiver.Interleave
( spinterleave
) where
import Control.Quiver
import Control.Quiver.Internal (P (..))
import Data.Either (rights)
import Data.Function (on)
import Data.List (sortBy)
spinterleave :: (Monad f) => (b -> b -> Ordering) -> [P a a' b () f e] -> P a a' b () f ()
spinterleave cmp ps = do
aps <- qlift (rights <$> mapM spnext ps)
go aps
where
go [] = return ()
go aps = do let (a,p):aps' = sortBy (cmp`on`fst) aps
emit_ a
eap' <- qlift $ spnext p
go (either (const aps') (:aps') eap')
spnext :: (Monad f) => P a a' b () f r -> f (Either r (b, P a a' b () f r))
spnext = go
where
go p = case p of
Consume _ _ p' -> go p'
Produce b pr _ -> return (Right (b, pr ()))
Enclose f -> f >>= go
Deliver r -> return (Left r)