{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Grisette.Lib.Control.Monad.Coroutine.SuspensionFunctors
( mrgYield,
mrgAwait,
mrgRequest,
)
where
import Control.Monad.Coroutine
import Control.Monad.Coroutine.SuspensionFunctors
import Grisette.Core
import Grisette.Lib.Control.Monad
import Grisette.Lib.Control.Monad.Coroutine
instance (Mergeable x, Mergeable y) => Mergeable (Yield x y) where
rootStrategy :: MergingStrategy (Yield x y)
rootStrategy = forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy forall x y. x -> y -> Yield x y
Yield (\(Yield x
x y
y) -> (x
x, y
y)) forall a. Mergeable a => MergingStrategy a
rootStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy
instance (Mergeable x) => Mergeable1 (Yield x) where
liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Yield x a)
liftRootStrategy = forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy forall x y. x -> y -> Yield x y
Yield (\(Yield x
x a
y) -> (x
x, a
y)) forall a. Mergeable a => MergingStrategy a
rootStrategy
instance (Mergeable x, Mergeable y) => Mergeable (Await x y) where
rootStrategy :: MergingStrategy (Await x y)
rootStrategy = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy forall x y. (x -> y) -> Await x y
Await (\(Await x -> y
x) -> x -> y
x)
instance (Mergeable x) => Mergeable1 (Await x) where
liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Await x a)
liftRootStrategy MergingStrategy a
m = forall a b.
MergingStrategy a -> (a -> b) -> (b -> a) -> MergingStrategy b
wrapStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m) forall x y. (x -> y) -> Await x y
Await (\(Await x -> a
x) -> x -> a
x)
instance
(Mergeable req, Mergeable res, Mergeable x) =>
Mergeable (Request req res x)
where
rootStrategy :: MergingStrategy (Request req res x)
rootStrategy = forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy forall request response x.
request -> (response -> x) -> Request request response x
Request (\(Request req
x res -> x
y) -> (req
x, res -> x
y)) forall a. Mergeable a => MergingStrategy a
rootStrategy forall a. Mergeable a => MergingStrategy a
rootStrategy
instance (Mergeable req, Mergeable res) => Mergeable1 (Request req res) where
liftRootStrategy :: forall a. MergingStrategy a -> MergingStrategy (Request req res a)
liftRootStrategy MergingStrategy a
m = forall a b r.
(a -> b -> r)
-> (r -> (a, b))
-> MergingStrategy a
-> MergingStrategy b
-> MergingStrategy r
product2Strategy forall request response x.
request -> (response -> x) -> Request request response x
Request (\(Request req
x res -> a
y) -> (req
x, res -> a
y)) forall a. Mergeable a => MergingStrategy a
rootStrategy (forall (u :: * -> *) a.
Mergeable1 u =>
MergingStrategy a -> MergingStrategy (u a)
liftRootStrategy MergingStrategy a
m)
mrgYield :: (MonadUnion m, Mergeable x) => x -> Coroutine (Yield x) m ()
mrgYield :: forall (m :: * -> *) x.
(MonadUnion m, Mergeable x) =>
x -> Coroutine (Yield x) m ()
mrgYield x
x = forall (m :: * -> *) (s :: * -> *) x.
(Functor s, MonadUnion m, Mergeable x, Mergeable1 s) =>
s (Coroutine s m x) -> Coroutine s m x
mrgSuspend (forall x y. x -> y -> Yield x y
Yield x
x forall a b. (a -> b) -> a -> b
$ forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn ())
{-# INLINEABLE mrgYield #-}
mrgAwait :: (MonadUnion m, Mergeable x) => Coroutine (Await x) m x
mrgAwait :: forall (m :: * -> *) x.
(MonadUnion m, Mergeable x) =>
Coroutine (Await x) m x
mrgAwait = forall (m :: * -> *) (s :: * -> *) x.
(Functor s, MonadUnion m, Mergeable x, Mergeable1 s) =>
s (Coroutine s m x) -> Coroutine s m x
mrgSuspend (forall x y. (x -> y) -> Await x y
Await forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn)
{-# INLINEABLE mrgAwait #-}
mrgRequest :: (MonadUnion m, Mergeable x, Mergeable y) => x -> Coroutine (Request x y) m y
mrgRequest :: forall (m :: * -> *) x y.
(MonadUnion m, Mergeable x, Mergeable y) =>
x -> Coroutine (Request x y) m y
mrgRequest x
x = forall (m :: * -> *) (s :: * -> *) x.
(Functor s, MonadUnion m, Mergeable x, Mergeable1 s) =>
s (Coroutine s m x) -> Coroutine s m x
mrgSuspend (forall request response x.
request -> (response -> x) -> Request request response x
Request x
x forall (u :: * -> *) a. (MonadUnion u, Mergeable a) => a -> u a
mrgReturn)
{-# INLINEABLE mrgRequest #-}