{-# LANGUAGE ExistentialQuantification, FlexibleContexts, TypeOperators #-}
module Test.IOSpec.Fork
(
ForkS
, forkIO
)
where
import Test.IOSpec.VirtualMachine
import Test.IOSpec.Types
data ForkS a =
forall f b . Executable f => Fork (IOSpec f b) (ThreadId -> a)
instance Functor ForkS where
fmap :: (a -> b) -> ForkS a -> ForkS b
fmap f :: a -> b
f (Fork l :: IOSpec f b
l io :: ThreadId -> a
io) = IOSpec f b -> (ThreadId -> b) -> ForkS b
forall a (f :: * -> *) b.
Executable f =>
IOSpec f b -> (ThreadId -> a) -> ForkS a
Fork IOSpec f b
l (a -> b
f (a -> b) -> (ThreadId -> a) -> ThreadId -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> a
io)
forkIO :: (Executable f, ForkS :<: g) => IOSpec f a -> IOSpec g ThreadId
forkIO :: IOSpec f a -> IOSpec g ThreadId
forkIO p :: IOSpec f a
p = ForkS (IOSpec g ThreadId) -> IOSpec g ThreadId
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (IOSpec f a) -> IOSpec f a
inject (IOSpec f a
-> (ThreadId -> IOSpec g ThreadId) -> ForkS (IOSpec g ThreadId)
forall a (f :: * -> *) b.
Executable f =>
IOSpec f b -> (ThreadId -> a) -> ForkS a
Fork IOSpec f a
p ThreadId -> IOSpec g ThreadId
forall (m :: * -> *) a. Monad m => a -> m a
return)
instance Executable ForkS where
step :: ForkS a -> VM (Step a)
step (Fork t :: IOSpec f b
t p :: ThreadId -> a
p) = do
ThreadId
tid <- VM ThreadId
freshThreadId
ThreadId -> IOSpec f b -> VM ()
forall (f :: * -> *) a.
Executable f =>
ThreadId -> IOSpec f a -> VM ()
updateSoup ThreadId
tid IOSpec f b
t
Step a -> VM (Step a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Step a
forall a. a -> Step a
Step (ThreadId -> a
p ThreadId
tid))