{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module      :   Grisette.Lib.Control.Monad.Coroutine
-- Copyright   :   (c) Sirui Lu 2021-2023
-- License     :   BSD-3-Clause (see the LICENSE file)
--
-- Maintainer  :   siruilu@cs.washington.edu
-- Stability   :   Experimental
-- Portability :   GHC only
module Grisette.Lib.Control.Monad.Coroutine
  ( mrgSuspend,
    mrgMapMonad,
    mrgMapSuspension,
    mrgMapFirstSuspension,
    mrgRunCoroutine,
    mrgBounce,
    mrgPogoStick,
    mrgPogoStickM,
    mrgFoldRun,
    MrgPairBinder,
    mrgSequentialBinder,
  )
where

import Control.Monad.Coroutine hiding (merge)
import Grisette.Core
import Grisette.Lib.Control.Monad

liftCoroEitherMergingStrategy ::
  (Mergeable1 s, Mergeable1 m) =>
  MergingStrategy x ->
  MergingStrategy (Either (s (Coroutine s m x)) x)
liftCoroEitherMergingStrategy :: forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m) =>
MergingStrategy x
-> MergingStrategy (Either (s (Coroutine s m x)) x)
liftCoroEitherMergingStrategy MergingStrategy x
ms =
  MergingStrategy (s (Coroutine s m x))
-> MergingStrategy x
-> MergingStrategy (Either (s (Coroutine s m x)) x)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 (MergingStrategy (Coroutine s m x)
-> MergingStrategy (s (Coroutine s m x))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy x -> MergingStrategy (Coroutine s m x)
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy x
ms)) MergingStrategy x
ms

coroEitherMergingStrategy ::
  (Mergeable1 s, Mergeable1 m, Mergeable x) =>
  MergingStrategy (Either (s (Coroutine s m x)) x)
coroEitherMergingStrategy :: forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m, Mergeable x) =>
MergingStrategy (Either (s (Coroutine s m x)) x)
coroEitherMergingStrategy = MergingStrategy (s (Coroutine s m x))
-> MergingStrategy x
-> MergingStrategy (Either (s (Coroutine s m x)) x)
forall (u :: * -> * -> *) a b.
Mergeable2 u =>
MergingStrategy a -> MergingStrategy b -> MergingStrategy (u a b)
liftRootStrategy2 MergingStrategy (s (Coroutine s m x))
forall a (u :: * -> *).
(Mergeable a, Mergeable1 u) =>
MergingStrategy (u a)
rootStrategy1 MergingStrategy x
forall a. Mergeable a => MergingStrategy a
rootStrategy

instance
  (Mergeable1 m, Mergeable a, Mergeable1 sus) =>
  Mergeable (Coroutine sus m a)
  where
  rootStrategy :: MergingStrategy (Coroutine sus m a)
rootStrategy =
    MergingStrategy (m (Either (sus (Coroutine sus m a)) a))
-> (m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a)
-> (Coroutine sus m a -> m (Either (sus (Coroutine sus m a)) a))
-> MergingStrategy (Coroutine sus m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (Either (sus (Coroutine sus m a)) a)
-> MergingStrategy (m (Either (sus (Coroutine sus m a)) a))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy (Either (sus (Coroutine sus m a)) a)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m, Mergeable x) =>
MergingStrategy (Either (s (Coroutine s m x)) x)
coroEitherMergingStrategy)
      m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine
      (\(Coroutine m (Either (sus (Coroutine sus m a)) a)
v) -> m (Either (sus (Coroutine sus m a)) a)
v)

instance (Mergeable1 m, Mergeable1 sus) => Mergeable1 (Coroutine sus m) where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Coroutine sus m a)
liftRootStrategy MergingStrategy a
m =
    MergingStrategy (m (Either (sus (Coroutine sus m a)) a))
-> (m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a)
-> (Coroutine sus m a -> m (Either (sus (Coroutine sus m a)) a))
-> MergingStrategy (Coroutine sus m a)
forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy
      (MergingStrategy (Either (sus (Coroutine sus m a)) a)
-> MergingStrategy (m (Either (sus (Coroutine sus m a)) a))
forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy (MergingStrategy (Either (sus (Coroutine sus m a)) a)
 -> MergingStrategy (m (Either (sus (Coroutine sus m a)) a)))
-> MergingStrategy (Either (sus (Coroutine sus m a)) a)
-> MergingStrategy (m (Either (sus (Coroutine sus m a)) a))
forall a b. (a -> b) -> a -> b
$ MergingStrategy a
-> MergingStrategy (Either (sus (Coroutine sus m a)) a)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m) =>
MergingStrategy x
-> MergingStrategy (Either (s (Coroutine s m x)) x)
liftCoroEitherMergingStrategy MergingStrategy a
m)
      m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine
      (\(Coroutine m (Either (sus (Coroutine sus m a)) a)
v) -> m (Either (sus (Coroutine sus m a)) a)
v)

instance
  (UnionLike m, Mergeable a, Mergeable1 sus) =>
  SimpleMergeable (Coroutine sus m a)
  where
  mrgIte :: SymBool
-> Coroutine sus m a -> Coroutine sus m a -> Coroutine sus m a
mrgIte = SymBool
-> Coroutine sus m a -> Coroutine sus m a -> Coroutine sus m a
forall (u :: * -> *) a.
(UnionLike u, Mergeable a) =>
SymBool -> u a -> u a -> u a
mrgIf

instance
  (UnionLike m, Mergeable1 sus) =>
  SimpleMergeable1 (Coroutine sus m)
  where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool
-> Coroutine sus m a
-> Coroutine sus m a
-> Coroutine sus m a
liftMrgIte SymBool -> a -> a -> a
m = MergingStrategy a
-> SymBool
-> Coroutine sus m a
-> Coroutine sus m a
-> Coroutine sus m a
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy ((SymBool -> a -> a -> a) -> MergingStrategy a
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> a -> a -> a
m)

instance
  (UnionLike m, Mergeable1 sus) =>
  UnionLike (Coroutine sus m)
  where
  mergeWithStrategy :: forall a.
MergingStrategy a -> Coroutine sus m a -> Coroutine sus m a
mergeWithStrategy MergingStrategy a
s ((Coroutine m (Either (sus (Coroutine sus m a)) a)
v) :: Coroutine sus m a) =
    m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a)
-> m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (Either (sus (Coroutine sus m a)) a)
-> m (Either (sus (Coroutine sus m a)) a)
-> m (Either (sus (Coroutine sus m a)) a)
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy (MergingStrategy a
-> MergingStrategy (Either (sus (Coroutine sus m a)) a)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m) =>
MergingStrategy x
-> MergingStrategy (Either (s (Coroutine s m x)) x)
liftCoroEitherMergingStrategy MergingStrategy a
s) m (Either (sus (Coroutine sus m a)) a)
v
  mrgIfWithStrategy :: forall a.
MergingStrategy a
-> SymBool
-> Coroutine sus m a
-> Coroutine sus m a
-> Coroutine sus m a
mrgIfWithStrategy MergingStrategy a
s SymBool
cond (Coroutine m (Either (sus (Coroutine sus m a)) a)
t) (Coroutine m (Either (sus (Coroutine sus m a)) a)
f) =
    m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a)
-> m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall a b. (a -> b) -> a -> b
$ MergingStrategy (Either (sus (Coroutine sus m a)) a)
-> SymBool
-> m (Either (sus (Coroutine sus m a)) a)
-> m (Either (sus (Coroutine sus m a)) a)
-> m (Either (sus (Coroutine sus m a)) a)
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> SymBool -> u a -> u a -> u a
mrgIfWithStrategy (MergingStrategy a
-> MergingStrategy (Either (sus (Coroutine sus m a)) a)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m) =>
MergingStrategy x
-> MergingStrategy (Either (s (Coroutine s m x)) x)
liftCoroEitherMergingStrategy MergingStrategy a
s) SymBool
cond m (Either (sus (Coroutine sus m a)) a)
t m (Either (sus (Coroutine sus m a)) a)
f
  single :: forall a. a -> Coroutine sus m a
single a
x = m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a)
-> m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall a b. (a -> b) -> a -> b
$ Either (sus (Coroutine sus m a)) a
-> m (Either (sus (Coroutine sus m a)) a)
forall (u :: * -> *) a. UnionLike u => a -> u a
single (Either (sus (Coroutine sus m a)) a
 -> m (Either (sus (Coroutine sus m a)) a))
-> Either (sus (Coroutine sus m a)) a
-> m (Either (sus (Coroutine sus m a)) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (sus (Coroutine sus m a)) a
forall a b. b -> Either a b
Right a
x
  unionIf :: forall a.
SymBool
-> Coroutine sus m a -> Coroutine sus m a -> Coroutine sus m a
unionIf SymBool
cond (Coroutine m (Either (sus (Coroutine sus m a)) a)
t) (Coroutine m (Either (sus (Coroutine sus m a)) a)
f) =
    m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a)
-> m (Either (sus (Coroutine sus m a)) a) -> Coroutine sus m a
forall a b. (a -> b) -> a -> b
$ SymBool
-> m (Either (sus (Coroutine sus m a)) a)
-> m (Either (sus (Coroutine sus m a)) a)
-> m (Either (sus (Coroutine sus m a)) a)
forall (u :: * -> *) a. UnionLike u => SymBool -> u a -> u a -> u a
unionIf SymBool
cond m (Either (sus (Coroutine sus m a)) a)
t m (Either (sus (Coroutine sus m a)) a)
f

instance
  (ExtractSymbolics (m (Either (sus (Coroutine sus m a)) a))) =>
  ExtractSymbolics (Coroutine sus m a)
  where
  extractSymbolics :: Coroutine sus m a -> SymbolSet
extractSymbolics (Coroutine m (Either (sus (Coroutine sus m a)) a)
v) = m (Either (sus (Coroutine sus m a)) a) -> SymbolSet
forall a. ExtractSymbolics a => a -> SymbolSet
extractSymbolics m (Either (sus (Coroutine sus m a)) a)
v

-- | Symbolic version of 'Control.Monad.Coroutine.suspend',
-- the result would be merged and propagate the mergeable knowledge.
mrgSuspend ::
  forall m s x.
  (Functor s, MonadUnion m, Mergeable x, Mergeable1 s) =>
  s (Coroutine s m x) ->
  Coroutine s m x
mrgSuspend :: forall (m :: * -> *) (s :: * -> *) x.
(Functor s, MonadUnion m, Mergeable x, Mergeable1 s) =>
s (Coroutine s m x) -> Coroutine s m x
mrgSuspend s (Coroutine s m x)
s =
  m (Either (s (Coroutine s m x)) x) -> Coroutine s m x
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine
    (m (Either (s (Coroutine s m x)) x) -> Coroutine s m x)
-> m (Either (s (Coroutine s m x)) x) -> Coroutine s m x
forall a b. (a -> b) -> a -> b
$ MergingStrategy (Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m x)) x)
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy
      MergingStrategy (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m, Mergeable x) =>
MergingStrategy (Either (s (Coroutine s m x)) x)
coroEitherMergingStrategy
    (m (Either (s (Coroutine s m x)) x)
 -> m (Either (s (Coroutine s m x)) x))
-> m (Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m x)) x)
forall a b. (a -> b) -> a -> b
$ Either (s (Coroutine s m x)) x
-> m (Either (s (Coroutine s m x)) x)
forall (m :: * -> *) a. Monad m => a -> m a
return (s (Coroutine s m x) -> Either (s (Coroutine s m x)) x
forall a b. a -> Either a b
Left s (Coroutine s m x)
s)
{-# INLINEABLE mrgSuspend #-}

-- | Symbolic version of 'Control.Monad.Coroutine.mapMonad',
-- the result would be merged and propagate the mergeable knowledge.
mrgMapMonad ::
  forall s m m' x.
  (Functor s, Mergeable1 s, Mergeable x, Monad m, MonadUnion m') =>
  (forall y. m y -> m' y) ->
  Coroutine s m x ->
  Coroutine s m' x
mrgMapMonad :: forall (s :: * -> *) (m :: * -> *) (m' :: * -> *) x.
(Functor s, Mergeable1 s, Mergeable x, Monad m, MonadUnion m') =>
(forall y. m y -> m' y) -> Coroutine s m x -> Coroutine s m' x
mrgMapMonad forall y. m y -> m' y
f (Coroutine m (Either (s (Coroutine s m x)) x)
r) =
  Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine
    { resume :: m' (Either (s (Coroutine s m' x)) x)
resume =
        m (Either (s (Coroutine s m x)) x)
-> m' (Either (s (Coroutine s m x)) x)
forall y. m y -> m' y
f m (Either (s (Coroutine s m x)) x)
r m' (Either (s (Coroutine s m x)) x)
-> (Either (s (Coroutine s m x)) x
    -> m' (Either (s (Coroutine s m' x)) x))
-> m' (Either (s (Coroutine s m' x)) x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either (s (Coroutine s m x)) x
x ->
          MergingStrategy (Either (s (Coroutine s m' x)) x)
-> m' (Either (s (Coroutine s m' x)) x)
-> m' (Either (s (Coroutine s m' x)) x)
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy
            MergingStrategy (Either (s (Coroutine s m' x)) x)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m, Mergeable x) =>
MergingStrategy (Either (s (Coroutine s m x)) x)
coroEitherMergingStrategy
            (m' (Either (s (Coroutine s m' x)) x)
 -> m' (Either (s (Coroutine s m' x)) x))
-> m' (Either (s (Coroutine s m' x)) x)
-> m' (Either (s (Coroutine s m' x)) x)
forall a b. (a -> b) -> a -> b
$ Either (s (Coroutine s m' x)) x
-> m' (Either (s (Coroutine s m' x)) x)
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Either (s (Coroutine s m' x)) x
 -> m' (Either (s (Coroutine s m' x)) x))
-> Either (s (Coroutine s m' x)) x
-> m' (Either (s (Coroutine s m' x)) x)
forall a b. (a -> b) -> a -> b
$ Either (s (Coroutine s m x)) x -> Either (s (Coroutine s m' x)) x
map' Either (s (Coroutine s m x)) x
x
    }
  where
    map' :: Either (s (Coroutine s m x)) x -> Either (s (Coroutine s m' x)) x
    map' :: Either (s (Coroutine s m x)) x -> Either (s (Coroutine s m' x)) x
map' (Right x
r1) = x -> Either (s (Coroutine s m' x)) x
forall a b. b -> Either a b
Right x
r1
    map' (Left s (Coroutine s m x)
s) = s (Coroutine s m' x) -> Either (s (Coroutine s m' x)) x
forall a b. a -> Either a b
Left (s (Coroutine s m' x) -> Either (s (Coroutine s m' x)) x)
-> s (Coroutine s m' x) -> Either (s (Coroutine s m' x)) x
forall a b. (a -> b) -> a -> b
$ (forall y. m y -> m' y) -> Coroutine s m x -> Coroutine s m' x
forall (s :: * -> *) (m :: * -> *) (m' :: * -> *) x.
(Functor s, Mergeable1 s, Mergeable x, Monad m, MonadUnion m') =>
(forall y. m y -> m' y) -> Coroutine s m x -> Coroutine s m' x
mrgMapMonad forall y. m y -> m' y
f (Coroutine s m x -> Coroutine s m' x)
-> s (Coroutine s m x) -> s (Coroutine s m' x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s (Coroutine s m x)
s
{-# INLINEABLE mrgMapMonad #-}

-- | Symbolic version of 'Control.Monad.Coroutine.mapSuspension',
-- the result would be merged and propagate the mergeable knowledge.
mrgMapSuspension ::
  forall s m x s'.
  (Functor s, MonadUnion m, Mergeable x, Mergeable1 s') =>
  (forall y. s y -> s' y) ->
  Coroutine s m x ->
  Coroutine s' m x
mrgMapSuspension :: forall (s :: * -> *) (m :: * -> *) x (s' :: * -> *).
(Functor s, MonadUnion m, Mergeable x, Mergeable1 s') =>
(forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
mrgMapSuspension forall y. s y -> s' y
f (Coroutine m (Either (s (Coroutine s m x)) x)
r) =
  Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine
    { resume :: m (Either (s' (Coroutine s' m x)) x)
resume =
        m (Either (s (Coroutine s m x)) x)
r m (Either (s (Coroutine s m x)) x)
-> (Either (s (Coroutine s m x)) x
    -> m (Either (s' (Coroutine s' m x)) x))
-> m (Either (s' (Coroutine s' m x)) x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either (s (Coroutine s m x)) x
x ->
          MergingStrategy (Either (s' (Coroutine s' m x)) x)
-> m (Either (s' (Coroutine s' m x)) x)
-> m (Either (s' (Coroutine s' m x)) x)
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy MergingStrategy (Either (s' (Coroutine s' m x)) x)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m, Mergeable x) =>
MergingStrategy (Either (s (Coroutine s m x)) x)
coroEitherMergingStrategy (m (Either (s' (Coroutine s' m x)) x)
 -> m (Either (s' (Coroutine s' m x)) x))
-> m (Either (s' (Coroutine s' m x)) x)
-> m (Either (s' (Coroutine s' m x)) x)
forall a b. (a -> b) -> a -> b
$ Either (s' (Coroutine s' m x)) x
-> m (Either (s' (Coroutine s' m x)) x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (s' (Coroutine s' m x)) x
 -> m (Either (s' (Coroutine s' m x)) x))
-> Either (s' (Coroutine s' m x)) x
-> m (Either (s' (Coroutine s' m x)) x)
forall a b. (a -> b) -> a -> b
$ Either (s (Coroutine s m x)) x -> Either (s' (Coroutine s' m x)) x
map' Either (s (Coroutine s m x)) x
x
    }
  where
    map' :: Either (s (Coroutine s m x)) x -> Either (s' (Coroutine s' m x)) x
    map' :: Either (s (Coroutine s m x)) x -> Either (s' (Coroutine s' m x)) x
map' (Right x
r1) = x -> Either (s' (Coroutine s' m x)) x
forall a b. b -> Either a b
Right x
r1
    map' (Left s (Coroutine s m x)
s) = s' (Coroutine s' m x) -> Either (s' (Coroutine s' m x)) x
forall a b. a -> Either a b
Left (s' (Coroutine s' m x) -> Either (s' (Coroutine s' m x)) x)
-> s' (Coroutine s' m x) -> Either (s' (Coroutine s' m x)) x
forall a b. (a -> b) -> a -> b
$ s (Coroutine s' m x) -> s' (Coroutine s' m x)
forall y. s y -> s' y
f (s (Coroutine s' m x) -> s' (Coroutine s' m x))
-> s (Coroutine s' m x) -> s' (Coroutine s' m x)
forall a b. (a -> b) -> a -> b
$ (forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
forall (s :: * -> *) (m :: * -> *) x (s' :: * -> *).
(Functor s, MonadUnion m, Mergeable x, Mergeable1 s') =>
(forall y. s y -> s' y) -> Coroutine s m x -> Coroutine s' m x
mrgMapSuspension forall y. s y -> s' y
f (Coroutine s m x -> Coroutine s' m x)
-> s (Coroutine s m x) -> s (Coroutine s' m x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s (Coroutine s m x)
s
{-# INLINEABLE mrgMapSuspension #-}

-- | Symbolic version of 'Control.Monad.Coroutine.mapFirstSuspension',
-- the result would be merged and propagate the mergeable knowledge.
mrgMapFirstSuspension ::
  forall s m x.
  (Functor s, Mergeable1 s, MonadUnion m, Mergeable x) =>
  (forall y. s y -> s y) ->
  Coroutine s m x ->
  Coroutine s m x
mrgMapFirstSuspension :: forall (s :: * -> *) (m :: * -> *) x.
(Functor s, Mergeable1 s, MonadUnion m, Mergeable x) =>
(forall y. s y -> s y) -> Coroutine s m x -> Coroutine s m x
mrgMapFirstSuspension forall y. s y -> s y
f (Coroutine m (Either (s (Coroutine s m x)) x)
r) =
  Coroutine :: forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine
    { resume :: m (Either (s (Coroutine s m x)) x)
resume =
        m (Either (s (Coroutine s m x)) x)
r m (Either (s (Coroutine s m x)) x)
-> (Either (s (Coroutine s m x)) x
    -> m (Either (s (Coroutine s m x)) x))
-> m (Either (s (Coroutine s m x)) x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either (s (Coroutine s m x)) x
s -> MergingStrategy (Either (s (Coroutine s m x)) x)
-> Either (s (Coroutine s m x)) x
-> m (Either (s (Coroutine s m x)) x)
forall (u :: * -> *) a.
MonadUnion u =>
MergingStrategy a -> a -> u a
mrgReturnWithStrategy MergingStrategy (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m, Mergeable x) =>
MergingStrategy (Either (s (Coroutine s m x)) x)
coroEitherMergingStrategy (Either (s (Coroutine s m x)) x
 -> m (Either (s (Coroutine s m x)) x))
-> Either (s (Coroutine s m x)) x
-> m (Either (s (Coroutine s m x)) x)
forall a b. (a -> b) -> a -> b
$
          case Either (s (Coroutine s m x)) x
s of
            Right x
x -> x -> Either (s (Coroutine s m x)) x
forall a b. b -> Either a b
Right x
x
            Left s (Coroutine s m x)
x -> s (Coroutine s m x) -> Either (s (Coroutine s m x)) x
forall a b. a -> Either a b
Left (s (Coroutine s m x) -> Either (s (Coroutine s m x)) x)
-> s (Coroutine s m x) -> Either (s (Coroutine s m x)) x
forall a b. (a -> b) -> a -> b
$ s (Coroutine s m x) -> s (Coroutine s m x)
forall y. s y -> s y
f s (Coroutine s m x)
x
    }

instance Mergeable (Naught x) where
  rootStrategy :: MergingStrategy (Naught x)
rootStrategy = (SymBool -> Naught x -> Naught x -> Naught x)
-> MergingStrategy (Naught x)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> Naught x -> Naught x -> Naught x
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte

instance Mergeable1 Naught where
  liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Naught a)
liftRootStrategy MergingStrategy a
_ = (SymBool -> Naught a -> Naught a -> Naught a)
-> MergingStrategy (Naught a)
forall a. (SymBool -> a -> a -> a) -> MergingStrategy a
SimpleStrategy SymBool -> Naught a -> Naught a -> Naught a
forall a. SimpleMergeable a => SymBool -> a -> a -> a
mrgIte

instance SimpleMergeable (Naught x) where
  mrgIte :: SymBool -> Naught x -> Naught x -> Naught x
mrgIte SymBool
_ Naught x
x Naught x
_ = Naught x
x

instance SimpleMergeable1 Naught where
  liftMrgIte :: forall a.
(SymBool -> a -> a -> a)
-> SymBool -> Naught a -> Naught a -> Naught a
liftMrgIte SymBool -> a -> a -> a
_ SymBool
_ Naught a
x Naught a
_ = Naught a
x

-- | Symbolic version of 'Control.Monad.Coroutine.mapFirstSuspension',
-- the result would be merged and propagate the mergeable knowledge.
mrgRunCoroutine ::
  (MonadUnion m, Mergeable x) =>
  Coroutine Naught m x ->
  m x
mrgRunCoroutine :: forall (m :: * -> *) x.
(MonadUnion m, Mergeable x) =>
Coroutine Naught m x -> m x
mrgRunCoroutine (Coroutine m (Either (Naught (Coroutine Naught m x)) x)
r) = do
  Either (Naught (Coroutine Naught m x)) x
v <- m (Either (Naught (Coroutine Naught m x)) x)
r
  case Either (Naught (Coroutine Naught m x)) x
v of
    Left Naught (Coroutine Naught m x)
_ -> [Char] -> m x
forall a. HasCallStack => [Char] -> a
error [Char]
"Won't happen"
    Right x
x -> x -> m x
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn x
x

-- | Symbolic version of 'Control.Monad.Coroutine.bounce',
-- the result would be merged and propagate the mergeable knowledge.
mrgBounce ::
  (Functor s, Mergeable1 s, MonadUnion m, Mergeable x) =>
  (s (Coroutine s m x) -> Coroutine s m x) ->
  Coroutine s m x ->
  Coroutine s m x
mrgBounce :: forall (s :: * -> *) (m :: * -> *) x.
(Functor s, Mergeable1 s, MonadUnion m, Mergeable x) =>
(s (Coroutine s m x) -> Coroutine s m x)
-> Coroutine s m x -> Coroutine s m x
mrgBounce s (Coroutine s m x) -> Coroutine s m x
f (Coroutine m (Either (s (Coroutine s m x)) x)
r) = m (Either (s (Coroutine s m x)) x) -> Coroutine s m x
forall (s :: * -> *) (m :: * -> *) r.
m (Either (s (Coroutine s m r)) r) -> Coroutine s m r
Coroutine (m (Either (s (Coroutine s m x)) x) -> Coroutine s m x)
-> m (Either (s (Coroutine s m x)) x) -> Coroutine s m x
forall a b. (a -> b) -> a -> b
$ MergingStrategy (Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m x)) x)
forall (u :: * -> *) a.
UnionLike u =>
MergingStrategy a -> u a -> u a
mergeWithStrategy MergingStrategy (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) x.
(Mergeable1 s, Mergeable1 m, Mergeable x) =>
MergingStrategy (Either (s (Coroutine s m x)) x)
coroEitherMergingStrategy (m (Either (s (Coroutine s m x)) x)
 -> m (Either (s (Coroutine s m x)) x))
-> m (Either (s (Coroutine s m x)) x)
-> m (Either (s (Coroutine s m x)) x)
forall a b. (a -> b) -> a -> b
$ do
  Either (s (Coroutine s m x)) x
r1 <- m (Either (s (Coroutine s m x)) x)
r
  case Either (s (Coroutine s m x)) x
r1 of
    Left s (Coroutine s m x)
s -> Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall (s :: * -> *) (m :: * -> *) r.
Coroutine s m r -> m (Either (s (Coroutine s m r)) r)
resume (Coroutine s m x -> m (Either (s (Coroutine s m x)) x))
-> Coroutine s m x -> m (Either (s (Coroutine s m x)) x)
forall a b. (a -> b) -> a -> b
$ s (Coroutine s m x) -> Coroutine s m x
f s (Coroutine s m x)
s
    Right x
x -> Either (s (Coroutine s m x)) x
-> m (Either (s (Coroutine s m x)) x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (s (Coroutine s m x)) x
 -> m (Either (s (Coroutine s m x)) x))
-> Either (s (Coroutine s m x)) x
-> m (Either (s (Coroutine s m x)) x)
forall a b. (a -> b) -> a -> b
$ x -> Either (s (Coroutine s m x)) x
forall a b. b -> Either a b
Right x
x

-- | Symbolic version of 'Control.Monad.Coroutine.pogoStick',
-- the result would be merged and propagate the mergeable knowledge.
mrgPogoStick ::
  (MonadUnion m, Mergeable x) =>
  (s (Coroutine s m x) -> Coroutine s m x) ->
  Coroutine s m x ->
  m x
mrgPogoStick :: forall (m :: * -> *) x (s :: * -> *).
(MonadUnion m, Mergeable x) =>
(s (Coroutine s m x) -> Coroutine s m x) -> Coroutine s m x -> m x
mrgPogoStick s (Coroutine s m x) -> Coroutine s m x
f (Coroutine m (Either (s (Coroutine s m x)) x)
r) = do
  Either (s (Coroutine s m x)) x
r1 <- m (Either (s (Coroutine s m x)) x)
r
  case Either (s (Coroutine s m x)) x
r1 of
    Left s (Coroutine s m x)
h -> (s (Coroutine s m x) -> Coroutine s m x) -> Coroutine s m x -> m x
forall (m :: * -> *) x (s :: * -> *).
(MonadUnion m, Mergeable x) =>
(s (Coroutine s m x) -> Coroutine s m x) -> Coroutine s m x -> m x
mrgPogoStick s (Coroutine s m x) -> Coroutine s m x
f (Coroutine s m x -> m x) -> Coroutine s m x -> m x
forall a b. (a -> b) -> a -> b
$ s (Coroutine s m x) -> Coroutine s m x
f s (Coroutine s m x)
h
    Right x
v -> x -> m x
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn x
v

-- | Symbolic version of 'Control.Monad.Coroutine.pogoStickM',
-- the result would be merged and propagate the mergeable knowledge.
mrgPogoStickM ::
  (MonadUnion m, Mergeable x) =>
  (s (Coroutine s m x) -> m (Coroutine s m x)) ->
  Coroutine s m x ->
  m x
mrgPogoStickM :: forall (m :: * -> *) x (s :: * -> *).
(MonadUnion m, Mergeable x) =>
(s (Coroutine s m x) -> m (Coroutine s m x))
-> Coroutine s m x -> m x
mrgPogoStickM s (Coroutine s m x) -> m (Coroutine s m x)
f (Coroutine m (Either (s (Coroutine s m x)) x)
r) = do
  Either (s (Coroutine s m x)) x
r1 <- m (Either (s (Coroutine s m x)) x)
r
  case Either (s (Coroutine s m x)) x
r1 of
    Left s (Coroutine s m x)
h -> do
      Coroutine s m x
cs <- s (Coroutine s m x) -> m (Coroutine s m x)
f s (Coroutine s m x)
h
      (s (Coroutine s m x) -> m (Coroutine s m x))
-> Coroutine s m x -> m x
forall (m :: * -> *) x (s :: * -> *).
(MonadUnion m, Mergeable x) =>
(s (Coroutine s m x) -> m (Coroutine s m x))
-> Coroutine s m x -> m x
mrgPogoStickM s (Coroutine s m x) -> m (Coroutine s m x)
f Coroutine s m x
cs
    Right x
v -> x -> m x
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn x
v

-- | Symbolic version of 'Control.Monad.Coroutine.foldRun',
-- the result would be merged and propagate the mergeable knowledge.
mrgFoldRun ::
  (MonadUnion m, Mergeable x, Mergeable a) =>
  (a -> s (Coroutine s m x) -> (a, Coroutine s m x)) ->
  a ->
  Coroutine s m x ->
  m (a, x)
mrgFoldRun :: forall (m :: * -> *) x a (s :: * -> *).
(MonadUnion m, Mergeable x, Mergeable a) =>
(a -> s (Coroutine s m x) -> (a, Coroutine s m x))
-> a -> Coroutine s m x -> m (a, x)
mrgFoldRun a -> s (Coroutine s m x) -> (a, Coroutine s m x)
f a
a (Coroutine m (Either (s (Coroutine s m x)) x)
r) = do
  Either (s (Coroutine s m x)) x
r1 <- m (Either (s (Coroutine s m x)) x)
r
  case Either (s (Coroutine s m x)) x
r1 of
    Left s (Coroutine s m x)
s -> case a -> s (Coroutine s m x) -> (a, Coroutine s m x)
f a
a s (Coroutine s m x)
s of
      (a
a1, Coroutine s m x
c1) -> (a -> s (Coroutine s m x) -> (a, Coroutine s m x))
-> a -> Coroutine s m x -> m (a, x)
forall (m :: * -> *) x a (s :: * -> *).
(MonadUnion m, Mergeable x, Mergeable a) =>
(a -> s (Coroutine s m x) -> (a, Coroutine s m x))
-> a -> Coroutine s m x -> m (a, x)
mrgFoldRun a -> s (Coroutine s m x) -> (a, Coroutine s m x)
f a
a1 Coroutine s m x
c1
    Right x
v -> (a, x) -> m (a, x)
forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn (a
a, x
v)

-- | Type of functions that can bind two monadic values together, used to
-- combine two coroutines' step results. The result type needs to be mergeable.
type MrgPairBinder bool m =
  forall x y r. (Mergeable r) => (x -> y -> m r) -> m x -> m y -> m r

-- | Symbolic version of 'Control.Monad.Coroutine.sequentialBinder',
-- the result would be merged and propagate the mergeable knowledge.
mrgSequentialBinder :: (MonadUnion m) => MrgPairBinder bool m
mrgSequentialBinder :: forall (m :: * -> *) bool. MonadUnion m => MrgPairBinder bool m
mrgSequentialBinder x -> y -> m r
f m x
ma m y
mb = m r -> m r
forall (u :: * -> *) a. (UnionLike u, Mergeable a) => u a -> u a
merge (m r -> m r) -> m r -> m r
forall a b. (a -> b) -> a -> b
$ do
  x
a <- m x
ma
  y
b <- m y
mb
  x -> y -> m r
f x
a y
b