{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}

-- SPDX-License-Identifier: MPL-2.0

{- |
Copyright   :  (c) 2024 Sayo Koyoneda
License     :  MPL-2.0 (see the LICENSE file)
Maintainer  :  ymdfield@outlook.jp

Interpreters for the [Parallel]("Data.Effect.Concurrent.Parallel") effects.
-}
module Control.Monad.Hefty.Concurrent.Parallel (
    module Control.Monad.Hefty.Concurrent.Parallel,
    module Data.Effect.Concurrent.Parallel,
    module Data.Effect.Input,
)
where

#if ( __GLASGOW_HASKELL__ < 906 )
import Control.Applicative (liftA2)
#endif
import Control.Monad (forever)
import Control.Monad.Hefty (
    Eff,
    interpret,
    interpretH,
    raiseAllH,
    transform,
    type (<<|),
    type (<|),
    type (~>),
    type (~~>),
 )
import Control.Monad.Hefty.Coroutine (inputToYield, runCoroutine)
import Control.Monad.Hefty.Unlift (UnliftIO)
import Data.Effect.Concurrent.Parallel
import Data.Effect.Coroutine (Status (Continue, Done))
import Data.Effect.Input
import Data.Function (fix)
import UnliftIO (
    MonadIO,
    MonadUnliftIO,
    atomically,
    liftIO,
    mask,
    newEmptyTMVarIO,
    putTMVar,
    readTMVar,
    tryReadTMVar,
    uninterruptibleMask_,
    withRunInIO,
 )
import UnliftIO.Concurrent (forkIO, killThread, threadDelay)

runConcurrentIO
    :: (UnliftIO <<| eh, IO <| ef)
    => Eff (Parallel ': Race ': Poll ': eh) (Halt ': ef) ~> Eff eh ef
runConcurrentIO :: forall (eh :: [EffectH]) (ef :: [EffectF]).
(UnliftIO <<| eh, IO <| ef) =>
Eff (Parallel : Race : Poll : eh) (Halt : ef) ~> Eff eh ef
runConcurrentIO = Eff eh (Halt : ef) x -> Eff eh ef x
forall (ef :: [EffectF]) (eh :: [EffectH]).
(IO <| ef) =>
Eff eh (Halt : ef) ~> Eff eh ef
Eff eh (Halt : ef) ~> Eff eh ef
runHaltIO (Eff eh (Halt : ef) x -> Eff eh ef x)
-> (Eff (Parallel : Race : Poll : eh) (Halt : ef) x
    -> Eff eh (Halt : ef) x)
-> Eff (Parallel : Race : Poll : eh) (Halt : ef) x
-> Eff eh ef x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Poll : eh) (Halt : ef) x -> Eff eh (Halt : ef) x
forall (ef :: [EffectF]) (eh :: [EffectH]).
(IO <| ef, UnliftIO <<| eh) =>
Eff (Poll : eh) ef ~> Eff eh ef
Eff (Poll : eh) (Halt : ef) ~> Eff eh (Halt : ef)
runPollIO (Eff (Poll : eh) (Halt : ef) x -> Eff eh (Halt : ef) x)
-> (Eff (Parallel : Race : Poll : eh) (Halt : ef) x
    -> Eff (Poll : eh) (Halt : ef) x)
-> Eff (Parallel : Race : Poll : eh) (Halt : ef) x
-> Eff eh (Halt : ef) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Race : Poll : eh) (Halt : ef) x
-> Eff (Poll : eh) (Halt : ef) x
forall (ef :: [EffectF]) (eh :: [EffectH]).
(IO <| ef, UnliftIO <<| eh) =>
Eff (Race : eh) ef ~> Eff eh ef
Eff (Race : Poll : eh) (Halt : ef) ~> Eff (Poll : eh) (Halt : ef)
runRaceIO (Eff (Race : Poll : eh) (Halt : ef) x
 -> Eff (Poll : eh) (Halt : ef) x)
-> (Eff (Parallel : Race : Poll : eh) (Halt : ef) x
    -> Eff (Race : Poll : eh) (Halt : ef) x)
-> Eff (Parallel : Race : Poll : eh) (Halt : ef) x
-> Eff (Poll : eh) (Halt : ef) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Parallel : Race : Poll : eh) (Halt : ef) x
-> Eff (Race : Poll : eh) (Halt : ef) x
forall (eh :: [EffectH]) (ef :: [EffectF]).
(UnliftIO <<| eh, IO <| ef) =>
Eff (Parallel : eh) ef ~> Eff eh ef
Eff (Parallel : Race : Poll : eh) (Halt : ef)
~> Eff (Race : Poll : eh) (Halt : ef)
runParallelIO

runParallelIO :: (UnliftIO <<| eh, IO <| ef) => Eff (Parallel ': eh) ef ~> Eff eh ef
runParallelIO :: forall (eh :: [EffectH]) (ef :: [EffectF]).
(UnliftIO <<| eh, IO <| ef) =>
Eff (Parallel : eh) ef ~> Eff eh ef
runParallelIO = (Parallel ~~> Eff eh ef) -> Eff (Parallel : eh) ef ~> Eff eh ef
forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]).
HFunctor e =>
(e ~~> Eff eh ef) -> Eff (e : eh) ef ~> Eff eh ef
interpretH Parallel (Eff eh ef) x -> Eff eh ef x
Parallel ~~> Eff eh ef
forall (m :: EffectF). MonadUnliftIO m => Parallel ~~> m
parallelToIO

parallelToIO :: (MonadUnliftIO m) => Parallel ~~> m
parallelToIO :: forall (m :: EffectF). MonadUnliftIO m => Parallel ~~> m
parallelToIO (LiftP2 a1 -> b -> x
f m a1
a m b
b) =
    ((forall a. m a -> IO a) -> IO x) -> m x
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: EffectF) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. m a -> IO a
run -> do
        TMVar a1
var <- IO (TMVar a1)
forall (m :: EffectF) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
        ((forall a. IO a -> IO a) -> IO x) -> IO x
forall (m :: EffectF) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
mask \forall a. IO a -> IO a
restore -> do
            ThreadId
t <- IO () -> IO ThreadId
forall (m :: EffectF). MonadUnliftIO m => m () -> m ThreadId
forkIO do
                a1
x <- IO a1 -> IO a1
forall a. IO a -> IO a
restore (IO a1 -> IO a1) -> IO a1 -> IO a1
forall a b. (a -> b) -> a -> b
$ m a1 -> IO a1
forall a. m a -> IO a
run m a1
a
                STM () -> IO ()
forall (m :: EffectF) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar a1 -> a1 -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar a1
var a1
x

            b
y <- IO b -> IO b
forall a. IO a -> IO a
restore (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run m b
b

            STM x -> IO x
forall (m :: EffectF) a. MonadIO m => STM a -> m a
atomically do
                a1
x <- TMVar a1 -> STM a1
forall a. TMVar a -> STM a
readTMVar TMVar a1
var
                x -> STM x
forall a. a -> STM a
forall (f :: EffectF) a. Applicative f => a -> f a
pure (x -> STM x) -> x -> STM x
forall a b. (a -> b) -> a -> b
$ a1 -> b -> x
f a1
x b
y
                IO x -> IO () -> IO x
forall a b. IO a -> IO b -> IO a
forall (f :: EffectF) a b. Applicative f => f a -> f b -> f a
<* IO () -> IO ()
forall (m :: EffectF) a. MonadUnliftIO m => m a -> m a
uninterruptibleMask_ (ThreadId -> IO ()
forall (m :: EffectF). MonadIO m => ThreadId -> m ()
killThread ThreadId
t)
{-# INLINE parallelToIO #-}

runPollIO :: (IO <| ef, UnliftIO <<| eh) => Eff (Poll ': eh) ef ~> Eff eh ef
runPollIO :: forall (ef :: [EffectF]) (eh :: [EffectH]).
(IO <| ef, UnliftIO <<| eh) =>
Eff (Poll : eh) ef ~> Eff eh ef
runPollIO = (Poll ~~> Eff eh ef) -> Eff (Poll : eh) ef ~> Eff eh ef
forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]).
HFunctor e =>
(e ~~> Eff eh ef) -> Eff (e : eh) ef ~> Eff eh ef
interpretH Poll (Eff eh ef) x -> Eff eh ef x
Poll ~~> Eff eh ef
forall (m :: EffectF). MonadUnliftIO m => Poll ~~> m
pollToIO

runRaceIO :: (IO <| ef, UnliftIO <<| eh) => Eff (Race ': eh) ef ~> Eff eh ef
runRaceIO :: forall (ef :: [EffectF]) (eh :: [EffectH]).
(IO <| ef, UnliftIO <<| eh) =>
Eff (Race : eh) ef ~> Eff eh ef
runRaceIO = (Race ~~> Eff eh ef) -> Eff (Race : eh) ef ~> Eff eh ef
forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]).
HFunctor e =>
(e ~~> Eff eh ef) -> Eff (e : eh) ef ~> Eff eh ef
interpretH Race (Eff eh ef) x -> Eff eh ef x
Race ~~> Eff eh ef
forall (m :: EffectF). MonadUnliftIO m => Race ~~> m
raceToIO

runHaltIO :: (IO <| ef) => Eff eh (Halt ': ef) ~> Eff eh ef
runHaltIO :: forall (ef :: [EffectF]) (eh :: [EffectH]).
(IO <| ef) =>
Eff eh (Halt : ef) ~> Eff eh ef
runHaltIO = (Halt ~> Eff eh ef) -> Eff eh (Halt : ef) ~> Eff eh ef
forall (e :: EffectF) (ef :: [EffectF]) (eh :: [EffectH]).
(e ~> Eff eh ef) -> Eff eh (e : ef) ~> Eff eh ef
interpret Halt x -> Eff eh ef x
Halt ~> Eff eh ef
forall (m :: EffectF). MonadIO m => Halt ~> m
haltToIO

raceToIO :: (MonadUnliftIO m) => Race ~~> m
raceToIO :: forall (m :: EffectF). MonadUnliftIO m => Race ~~> m
raceToIO (Race m x
a m x
b) =
    ((forall a. m a -> IO a) -> IO x) -> m x
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: EffectF) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. m a -> IO a
run -> do
        TMVar x
var <- IO (TMVar x)
forall (m :: EffectF) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
        ((forall a. IO a -> IO a) -> IO x) -> IO x
forall (m :: EffectF) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
mask \forall a. IO a -> IO a
restore -> do
            let runThread :: m x -> IO ThreadId
runThread m x
m = IO () -> IO ThreadId
forall (m :: EffectF). MonadUnliftIO m => m () -> m ThreadId
forkIO do
                    x
x <- IO x -> IO x
forall a. IO a -> IO a
restore (IO x -> IO x) -> IO x -> IO x
forall a b. (a -> b) -> a -> b
$ m x -> IO x
forall a. m a -> IO a
run m x
m
                    STM () -> IO ()
forall (m :: EffectF) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar x -> x -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar x
var x
x

            ThreadId
t1 <- m x -> IO ThreadId
runThread m x
a
            ThreadId
t2 <- m x -> IO ThreadId
runThread m x
b

            STM x -> IO x
forall (m :: EffectF) a. MonadIO m => STM a -> m a
atomically (TMVar x -> STM x
forall a. TMVar a -> STM a
readTMVar TMVar x
var)
                IO x -> IO () -> IO x
forall a b. IO a -> IO b -> IO a
forall (f :: EffectF) a b. Applicative f => f a -> f b -> f a
<* IO () -> IO ()
forall (m :: EffectF) a. MonadUnliftIO m => m a -> m a
uninterruptibleMask_ (ThreadId -> IO ()
forall (m :: EffectF). MonadIO m => ThreadId -> m ()
killThread ThreadId
t1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: EffectF) a b. Applicative f => f a -> f b -> f b
*> ThreadId -> IO ()
forall (m :: EffectF). MonadIO m => ThreadId -> m ()
killThread ThreadId
t2)

pollToIO :: (MonadUnliftIO m) => Poll ~~> m
pollToIO :: forall (m :: EffectF). MonadUnliftIO m => Poll ~~> m
pollToIO (Poldl a1 -> Maybe b -> m (Either x a1)
f m a1
a m b
b) =
    ((forall a. m a -> IO a) -> IO x) -> m x
forall b. ((forall a. m a -> IO a) -> IO b) -> m b
forall (m :: EffectF) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. m a -> IO a
run -> do
        TMVar b
var <- IO (TMVar b)
forall (m :: EffectF) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
        ((forall a. IO a -> IO a) -> IO x) -> IO x
forall (m :: EffectF) b.
MonadUnliftIO m =>
((forall a. m a -> m a) -> m b) -> m b
mask \forall a. IO a -> IO a
restore -> do
            ThreadId
t <- IO () -> IO ThreadId
forall (m :: EffectF). MonadUnliftIO m => m () -> m ThreadId
forkIO do
                b
x <- IO b -> IO b
forall a. IO a -> IO a
restore (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ m b -> IO b
forall a. m a -> IO a
run m b
b
                STM () -> IO ()
forall (m :: EffectF) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar b -> b -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar b
var b
x

            IO a1 -> IO a1
forall a. IO a -> IO a
restore (m a1 -> IO a1
forall a. m a -> IO a
run m a1
a) IO a1 -> (a1 -> IO x) -> IO x
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: EffectF) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((a1 -> IO x) -> a1 -> IO x) -> a1 -> IO x
forall a. (a -> a) -> a
fix \a1 -> IO x
next a1
acc -> do
                Maybe b
poll <- STM (Maybe b) -> IO (Maybe b)
forall (m :: EffectF) a. MonadIO m => STM a -> m a
atomically (STM (Maybe b) -> IO (Maybe b)) -> STM (Maybe b) -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$ TMVar b -> STM (Maybe b)
forall a. TMVar a -> STM (Maybe a)
tryReadTMVar TMVar b
var
                IO (Either x a1) -> IO (Either x a1)
forall a. IO a -> IO a
restore (m (Either x a1) -> IO (Either x a1)
forall a. m a -> IO a
run (m (Either x a1) -> IO (Either x a1))
-> m (Either x a1) -> IO (Either x a1)
forall a b. (a -> b) -> a -> b
$ a1 -> Maybe b -> m (Either x a1)
f a1
acc Maybe b
poll) IO (Either x a1) -> (Either x a1 -> IO x) -> IO x
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: EffectF) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Left x
r -> do
                        IO () -> IO ()
forall (m :: EffectF) a. MonadUnliftIO m => m a -> m a
uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> IO ()
forall (m :: EffectF). MonadIO m => ThreadId -> m ()
killThread ThreadId
t
                        x -> IO x
forall a. a -> IO a
forall (f :: EffectF) a. Applicative f => a -> f a
pure x
r
                    Right a1
acc' -> a1 -> IO x
next a1
acc'

haltToIO :: (MonadIO m) => Halt ~> m
haltToIO :: forall (m :: EffectF). MonadIO m => Halt ~> m
haltToIO Halt x
Halt = IO x -> m x
forall a. IO a -> m a
forall (m :: EffectF) a. MonadIO m => IO a -> m a
liftIO (IO x -> m x) -> IO x -> m x
forall a b. (a -> b) -> a -> b
$ IO () -> IO x
forall (f :: EffectF) a b. Applicative f => f a -> f b
forever (IO () -> IO x) -> IO () -> IO x
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
forall (m :: EffectF). MonadIO m => Int -> m ()
threadDelay Int
forall a. Bounded a => a
maxBound

runParallelAsSequential :: Eff (Parallel ': eh) ef ~> Eff eh ef
runParallelAsSequential :: forall (eh :: [EffectH]) (ef :: [EffectF]) x.
Eff (Parallel : eh) ef x -> Eff eh ef x
runParallelAsSequential = (Parallel ~~> Eff eh ef) -> Eff (Parallel : eh) ef ~> Eff eh ef
forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]).
HFunctor e =>
(e ~~> Eff eh ef) -> Eff (e : eh) ef ~> Eff eh ef
interpretH Parallel (Eff eh ef) x -> Eff eh ef x
forall (eh :: [EffectH]) (ef :: [EffectF]) x.
Parallel (Eff eh ef) x -> Eff eh ef x
Parallel ~~> Eff eh ef
parallelToSequential

parallelToSequential :: Parallel ~~> Eff eh ef
parallelToSequential :: forall (eh :: [EffectH]) (ef :: [EffectF]) x.
Parallel (Eff eh ef) x -> Eff eh ef x
parallelToSequential (LiftP2 a1 -> b -> x
f Eff eh ef a1
a Eff eh ef b
b) = (a1 -> b -> x) -> Eff eh ef a1 -> Eff eh ef b -> Eff eh ef x
forall a b c.
(a -> b -> c) -> Eff eh ef a -> Eff eh ef b -> Eff eh ef c
forall (f :: EffectF) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a1 -> b -> x
f Eff eh ef a1
a Eff eh ef b
b

polling :: (Poll <<| eh) => Eff eh ef a -> Eff '[] (Input (Maybe a) ': ef) r -> Eff eh ef r
polling :: forall (eh :: [EffectH]) (ef :: [EffectF]) a r.
(Poll <<| eh) =>
Eff eh ef a -> Eff '[] (Input (Maybe a) : ef) r -> Eff eh ef r
polling Eff eh ef a
pollee Eff '[] (Input (Maybe a) : ef) r
poller =
    (Status (Eff '[] ef) () (Maybe a) r
 -> Maybe a
 -> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r)))
-> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r)
-> Eff eh ef a
-> Eff eh ef r
forall a b r (f :: EffectF).
SendHOE Poll f =>
(a -> Maybe b -> f (Either r a)) -> f a -> f b -> f r
poldl
        ( \case
            Done r
r -> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
-> Maybe a
-> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
forall a b. a -> b -> a
const (Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
 -> Maybe a
 -> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r)))
-> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
-> Maybe a
-> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
forall a b. (a -> b) -> a -> b
$ Either r (Status (Eff '[] ef) () (Maybe a) r)
-> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
forall a. a -> Eff eh ef a
forall (f :: EffectF) a. Applicative f => a -> f a
pure (Either r (Status (Eff '[] ef) () (Maybe a) r)
 -> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r)))
-> Either r (Status (Eff '[] ef) () (Maybe a) r)
-> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
forall a b. (a -> b) -> a -> b
$ r -> Either r (Status (Eff '[] ef) () (Maybe a) r)
forall a b. a -> Either a b
Left r
r
            Continue () Maybe a -> Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
k -> (Status (Eff '[] ef) () (Maybe a) r
 -> Either r (Status (Eff '[] ef) () (Maybe a) r))
-> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r)
-> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
forall a b. (a -> b) -> Eff eh ef a -> Eff eh ef b
forall (f :: EffectF) a b. Functor f => (a -> b) -> f a -> f b
fmap Status (Eff '[] ef) () (Maybe a) r
-> Either r (Status (Eff '[] ef) () (Maybe a) r)
forall a b. b -> Either a b
Right (Eff eh ef (Status (Eff '[] ef) () (Maybe a) r)
 -> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r)))
-> (Maybe a -> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r))
-> Maybe a
-> Eff eh ef (Either r (Status (Eff '[] ef) () (Maybe a) r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
-> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r)
forall (ef :: [EffectF]) (eh :: [EffectH]) x.
Eff '[] ef x -> Eff eh ef x
raiseAllH (Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
 -> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r))
-> (Maybe a -> Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r))
-> Maybe a
-> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe a -> Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
k
        )
        (Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
-> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r)
forall (ef :: [EffectF]) (eh :: [EffectH]) x.
Eff '[] ef x -> Eff eh ef x
raiseAllH (Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
 -> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r))
-> Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
-> Eff eh ef (Status (Eff '[] ef) () (Maybe a) r)
forall a b. (a -> b) -> a -> b
$ Eff '[] (Yield () (Maybe a) : ef) r
-> Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
forall a b ans (ef :: [EffectF]).
Eff '[] (Yield a b : ef) ans
-> Eff '[] ef (Status (Eff '[] ef) a b ans)
runCoroutine (Eff '[] (Yield () (Maybe a) : ef) r
 -> Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r))
-> Eff '[] (Yield () (Maybe a) : ef) r
-> Eff '[] ef (Status (Eff '[] ef) () (Maybe a) r)
forall a b. (a -> b) -> a -> b
$ (Input (Maybe a) ~> Yield () (Maybe a))
-> Eff '[] (Input (Maybe a) : ef)
   ~> Eff '[] (Yield () (Maybe a) : ef)
forall (e :: EffectF) (e' :: EffectF) (ef :: [EffectF])
       (eh :: [EffectH]).
(e ~> e') -> Eff eh (e : ef) ~> Eff eh (e' : ef)
transform Input (Maybe a) x -> Yield () (Maybe a) x
Input (Maybe a) ~> Yield () (Maybe a)
forall i x. Input i x -> Yield () i x
inputToYield Eff '[] (Input (Maybe a) : ef) r
poller)
        Eff eh ef a
pollee

runForAsParallel :: (Parallel <<| eh, Traversable t) => Eff (For t ': eh) ef ~> Eff eh ef
runForAsParallel :: forall (eh :: [EffectH]) (t :: EffectF) (ef :: [EffectF]).
(Parallel <<| eh, Traversable t) =>
Eff (For t : eh) ef ~> Eff eh ef
runForAsParallel = (For t ~~> Eff eh ef) -> Eff (For t : eh) ef ~> Eff eh ef
forall (e :: EffectH) (eh :: [EffectH]) (ef :: [EffectF]).
HFunctor e =>
(e ~~> Eff eh ef) -> Eff (e : eh) ef ~> Eff eh ef
interpretH For t (Eff eh ef) x -> Eff eh ef x
For t ~~> Eff eh ef
forall (f :: EffectF) (t :: EffectF).
(Parallel <<: f, Traversable t, Applicative f) =>
For t f ~> f
forToParallel