module Control.Quiver.Interleave
( spinterleave
) where
import Control.Quiver.Internal (P (..))
import Control.Quiver.SP
import Data.Bool (bool)
import Data.Either (partitionEithers)
import Data.Function (on)
import Data.List (sortBy)
spinterleave :: (Monad f) => (b -> b -> Ordering) -> [P a a' b () f (SPResult e)] -> P a a' b () f (SPResult e)
spinterleave cmp ps = do
(errs, aps) <- qlift (partitionEithers <$> mapM spnext ps)
case filter isErr errs of
(e:_) -> deliver e
_ -> go aps
where
go [] = spcomplete
go [(a,p)] = a >:> p
go aps = do let (a,p):aps' = sortBy (cmp`on`fst) aps
emit_ a
eap' <- qlift $ spnext p
either (\e -> bool (go aps') (deliver e) (isErr e))
(go . (:aps'))
eap'
isErr SPComplete = False
isErr _ = True
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)