{- 
    Copyright 2010 Mario Blazevic

    This file is part of the Streaming Component Combinators (SCC) project.

    The SCC project is free software: you can redistribute it and/or modify it under the terms of the GNU General Public
    License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later
    version.

    SCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty
    of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more details.

    You should have received a copy of the GNU General Public License along with SCC.  If not, see
    <http://www.gnu.org/licenses/>.
-}

-- | This module defines classes of monads that can perform multiple computations in parallel and, more importantly,
-- combine the results of those parallel computations.
-- 
-- There are two classes exported by this module, 'MonadParallel' and 'MonadFork'. The former is more generic, but the
-- latter is easier to use: when invoking any expensive computation that could be performed in parallel, simply wrap the
-- call in 'forkExec'. The function immediately returns a handle to the running computation. The handle can be used to
-- obtain the result of the computation when needed:
--
-- @
--   do child <- forkExec expensive
--      otherStuff
--      result <- child
-- @
--
-- In this example, the computations /expensive/ and /otherStuff/ would be performed in parallel. When using the
-- 'MonadParallel' class, both parallel computations must be specified at once:
--
-- @
--   bindM2 (\\ childResult otherResult -> ...) expensive otherStuff
-- @
--
-- In either case, for best results the costs of the two computations should be roughly equal.
--
-- Any monad that is an instance of the 'MonadFork' class is also an instance of the 'MonadParallel' class, and the
-- following law should hold:
-- 
-- @ bindM2 f ma mb = do {a' <- forkExec ma; b <- mb; a <- a'; f a b} @ 
--
-- When operating with monads free of side-effects, such as 'Identity' or 'Maybe', 'forkExec' is equivalent to 'return'
-- and 'bindM2' is equivalent to @ \\ f ma mb -> do {a <- ma; b <- mb; f a b} @ &#x2014; the only difference is in the
-- resource utilisation. With the 'IO' monad, on the other hand, there may be visible difference in the results because
-- the side effects of /ma/ and /mb/ may be arbitrarily reordered.

{-# LANGUAGE ScopedTypeVariables #-}

module Control.Monad.Parallel
   (
    -- * Classes
    MonadParallel(..), MonadFork(..),
    bindM3,
    -- * Control.Monad equivalents
    ap, forM, forM_, liftM2, liftM3, mapM, mapM_, replicateM, replicateM_, sequence, sequence_
   )
where

import Prelude ()
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar, readMVar)
import Control.Exception (SomeException, throwIO, mask, try)
import Control.Monad (Monad, (>>=), return, liftM)
import Control.Monad.Trans.Identity (IdentityT(IdentityT, runIdentityT))
import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT))
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
import Control.Monad.Trans.List (ListT(ListT, runListT))
import Control.Monad.Trans.Reader (ReaderT(ReaderT, runReaderT))
import Control.Parallel (par, pseq)
import Data.Either (Either(..), either)
import Data.Function (($), (.), const)
import Data.Functor.Identity (Identity)
import Data.Int (Int)
import Data.List ((++), foldr, map, replicate)
import Data.Maybe (Maybe(Just, Nothing))
import System.IO (IO)

-- | Class of monads that can perform two computations in parallel and bind their results together.
class Monad m => MonadParallel m where
   -- | Perform two monadic computations in parallel; when they are both finished, pass the results to the function.
   -- Apart from the possible ordering of side effects, this function is equivalent to
   -- @\\f ma mb-> do {a <- ma; b <- mb; f a b}@
   bindM2 :: (a -> b -> m c) -> m a -> m b -> m c
   bindM2 a -> b -> m c
f m a
ma m b
mb = let ma' :: m a
ma' = m a
ma m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                        mb' :: m b
mb' = m b
mb m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return
                    in m a
ma' m a -> m c -> m c
forall a b. a -> b -> b
`par` (m b
mb' m b -> m c -> m c
forall a b. a -> b -> b
`pseq` do {a
a <- m a
ma'; b
b <- m b
mb'; a -> b -> m c
f a
a b
b})

-- | Class of monads that can fork a parallel computation.
class MonadParallel m => MonadFork m where
   -- | Fork a child monadic computation to be performed in parallel with the current one.
   forkExec :: m a -> m (m a)
   forkExec m a
e = let result :: m a
result = m a
e m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                in m a
result m a -> m (m a) -> m (m a)
forall a b. a -> b -> b
`par` (m a -> m (m a)
forall (m :: * -> *) a. Monad m => a -> m a
return m a
result)

-- | Perform three monadic computations in parallel; when they are all finished, pass their results to the function.
bindM3 :: MonadParallel m => (a -> b -> c -> m d) -> m a -> m b -> m c -> m d
bindM3 :: (a -> b -> c -> m d) -> m a -> m b -> m c -> m d
bindM3 a -> b -> c -> m d
f m a
ma m b
mb m c
mc = ((c -> m d) -> c -> m d) -> m (c -> m d) -> m c -> m d
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 (\c -> m d
f' c
c-> c -> m d
f' c
c) ((a -> b -> c -> m d) -> m a -> m b -> m (c -> m d)
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2 a -> b -> c -> m d
f m a
ma m b
mb) m c
mc

-- | Like 'Control.Monad.liftM2', but evaluating its two monadic arguments in parallel.
liftM2 :: MonadParallel m => (a -> b -> c) -> m a -> m b -> m c
liftM2 :: (a -> b -> c) -> m a -> m b -> m c
liftM2 a -> b -> c
f m a
m1 m b
m2 = (a -> b -> m c) -> m a -> m b -> m c
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 (\a
a b
b-> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> c
f a
a b
b)) m a
m1 m b
m2

-- | Like 'Control.Monad.liftM3', but evaluating its three monadic arguments in parallel.
liftM3  :: (MonadParallel m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 :: (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 a1 -> a2 -> a3 -> r
f m a1
m1 m a2
m2 m a3
m3 = (a1 -> a2 -> a3 -> m r) -> m a1 -> m a2 -> m a3 -> m r
forall (m :: * -> *) a b c d.
MonadParallel m =>
(a -> b -> c -> m d) -> m a -> m b -> m c -> m d
bindM3 (\a1
a a2
b a3
c-> r -> m r
forall (m :: * -> *) a. Monad m => a -> m a
return (a1 -> a2 -> a3 -> r
f a1
a a2
b a3
c)) m a1
m1 m a2
m2 m a3
m3

-- | Like 'Control.Monad.ap', but evaluating the function and its argument in parallel.
ap :: MonadParallel m => m (a -> b) -> m a -> m b
ap :: m (a -> b) -> m a -> m b
ap m (a -> b)
mf m a
ma = ((a -> b) -> a -> m b) -> m (a -> b) -> m a -> m b
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 (\a -> b
f a
a-> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a)) m (a -> b)
mf m a
ma

-- | Like 'Control.Monad.sequence', but executing the actions in parallel.
sequence :: MonadParallel m => [m a] -> m [a]
sequence :: [m a] -> m [a]
sequence [m a]
ms = (m a -> m [a] -> m [a]) -> m [a] -> [m a] -> m [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr m a -> m [a] -> m [a]
forall (m :: * -> *) a. MonadParallel m => m a -> m [a] -> m [a]
k ([a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []) [m a]
ms where
   k :: m a -> m [a] -> m [a]
k m a
m m [a]
m' = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2 (:) m a
m m [a]
m'

-- | Like 'Control.Monad.sequence_', but executing the actions in parallel.
sequence_ :: MonadParallel m => [m a] -> m () 
sequence_ :: [m a] -> m ()
sequence_ [m a]
ms = (m a -> m () -> m ()) -> m () -> [m a] -> m ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> () -> ()) -> m a -> m () -> m ()
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> c) -> m a -> m b -> m c
liftM2 (\ a
_ ()
_ -> ())) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) [m a]
ms

-- | Like 'Control.Monad.mapM', but applying the function to the individual list items in parallel.
mapM :: MonadParallel m => (a -> m b) -> [a] -> m [b]
mapM :: (a -> m b) -> [a] -> m [b]
mapM a -> m b
f [a]
list = [m b] -> m [b]
forall (m :: * -> *) a. MonadParallel m => [m a] -> m [a]
sequence ((a -> m b) -> [a] -> [m b]
forall a b. (a -> b) -> [a] -> [b]
map a -> m b
f [a]
list)

-- | Like 'Control.Monad.mapM_', but applying the function to the individual list items in parallel.
mapM_ :: MonadParallel m => (a -> m b) -> [a] -> m ()
mapM_ :: (a -> m b) -> [a] -> m ()
mapM_ a -> m b
f [a]
list = [m b] -> m ()
forall (m :: * -> *) a. MonadParallel m => [m a] -> m ()
sequence_ ((a -> m b) -> [a] -> [m b]
forall a b. (a -> b) -> [a] -> [b]
map a -> m b
f [a]
list)

-- | Like 'Control.Monad.forM', but applying the function to the individual list items in parallel.
forM :: MonadParallel m => [a] -> (a -> m b) -> m [b]
forM :: [a] -> (a -> m b) -> m [b]
forM [a]
list a -> m b
f = [m b] -> m [b]
forall (m :: * -> *) a. MonadParallel m => [m a] -> m [a]
sequence ((a -> m b) -> [a] -> [m b]
forall a b. (a -> b) -> [a] -> [b]
map a -> m b
f [a]
list)

-- | Like 'Control.Monad.forM_', but applying the function to the individual list items in parallel.
forM_ :: MonadParallel m => [a] -> (a -> m b) -> m ()
forM_ :: [a] -> (a -> m b) -> m ()
forM_ [a]
list a -> m b
f = [m b] -> m ()
forall (m :: * -> *) a. MonadParallel m => [m a] -> m ()
sequence_ ((a -> m b) -> [a] -> [m b]
forall a b. (a -> b) -> [a] -> [b]
map a -> m b
f [a]
list)

-- | Like 'Control.Monad.replicateM', but executing the action multiple times in parallel.
replicateM :: MonadParallel m => Int -> m a -> m [a]
replicateM :: Int -> m a -> m [a]
replicateM Int
n m a
action = [m a] -> m [a]
forall (m :: * -> *) a. MonadParallel m => [m a] -> m [a]
sequence (Int -> m a -> [m a]
forall a. Int -> a -> [a]
replicate Int
n m a
action)

-- | Like 'Control.Monad.replicateM_', but executing the action multiple times in parallel.
replicateM_ :: MonadParallel m => Int -> m a -> m ()
replicateM_ :: Int -> m a -> m ()
replicateM_ Int
n m a
action = [m a] -> m ()
forall (m :: * -> *) a. MonadParallel m => [m a] -> m ()
sequence_ (Int -> m a -> [m a]
forall a. Int -> a -> [a]
replicate Int
n m a
action)

-- | Any monad that allows the result value to be extracted, such as `Identity` or `Maybe` monad, can implement
-- `bindM2` by using `par`.
instance MonadParallel Identity
instance MonadParallel Maybe
instance MonadParallel []

instance MonadParallel ((->) r) where
   bindM2 :: (a -> b -> r -> c) -> (r -> a) -> (r -> b) -> r -> c
bindM2 a -> b -> r -> c
f r -> a
ma r -> b
mb r
r = let a :: a
a = r -> a
ma r
r
                          b :: b
b = r -> b
mb r
r
                      in a
a a -> c -> c
forall a b. a -> b -> b
`par` (b
b b -> c -> c
forall a b. a -> b -> b
`pseq` a -> b -> r -> c
f a
a b
b r
r)

-- | IO is parallelizable by `forkIO`.
instance MonadParallel IO where
   bindM2 :: (a -> b -> IO c) -> IO a -> IO b -> IO c
bindM2 a -> b -> IO c
f IO a
ma IO b
mb = do IO b
waitForB <- IO b -> IO (IO b)
forall (m :: * -> *) a. MonadFork m => m a -> m (m a)
forkExec IO b
mb
                       a
a <- IO a
ma
                       b
b <- IO b
waitForB
                       a -> b -> IO c
f a
a b
b

instance MonadParallel m => MonadParallel (IdentityT m) where
   bindM2 :: (a -> b -> IdentityT m c)
-> IdentityT m a -> IdentityT m b -> IdentityT m c
bindM2 a -> b -> IdentityT m c
f IdentityT m a
ma IdentityT m b
mb = m c -> IdentityT m c
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT ((a -> b -> m c) -> m a -> m b -> m c
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 a -> b -> m c
f' (IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT IdentityT m a
ma) (IdentityT m b -> m b
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT IdentityT m b
mb))
     where f' :: a -> b -> m c
f' a
a b
b = IdentityT m c -> m c
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (a -> b -> IdentityT m c
f a
a b
b)

instance MonadParallel m => MonadParallel (MaybeT m) where
   bindM2 :: (a -> b -> MaybeT m c) -> MaybeT m a -> MaybeT m b -> MaybeT m c
bindM2 a -> b -> MaybeT m c
f MaybeT m a
ma MaybeT m b
mb = m (Maybe c) -> MaybeT m c
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ((Maybe a -> Maybe b -> m (Maybe c))
-> m (Maybe a) -> m (Maybe b) -> m (Maybe c)
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Maybe a -> Maybe b -> m (Maybe c)
f' (MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
ma) (MaybeT m b -> m (Maybe b)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m b
mb))
     where f' :: Maybe a -> Maybe b -> m (Maybe c)
f' (Just a
a) (Just b
b) = MaybeT m c -> m (Maybe c)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (a -> b -> MaybeT m c
f a
a b
b)
           f' Maybe a
_ Maybe b
_ = Maybe c -> m (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing

instance MonadParallel m => MonadParallel (ExceptT e m) where
   bindM2 :: (a -> b -> ExceptT e m c)
-> ExceptT e m a -> ExceptT e m b -> ExceptT e m c
bindM2 a -> b -> ExceptT e m c
f ExceptT e m a
ma ExceptT e m b
mb = m (Either e c) -> ExceptT e m c
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((Either e a -> Either e b -> m (Either e c))
-> m (Either e a) -> m (Either e b) -> m (Either e c)
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 Either e a -> Either e b -> m (Either e c)
f' (ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
ma) (ExceptT e m b -> m (Either e b)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m b
mb))
     where f' :: Either e a -> Either e b -> m (Either e c)
f' (Right a
a) (Right b
b) = ExceptT e m c -> m (Either e c)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (a -> b -> ExceptT e m c
f a
a b
b)
           f' (Left e
e) Either e b
_ = Either e c -> m (Either e c)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e c
forall a b. a -> Either a b
Left e
e)
           f' Either e a
_ (Left e
e) = Either e c -> m (Either e c)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e c
forall a b. a -> Either a b
Left e
e)

instance MonadParallel m => MonadParallel (ListT m) where
   bindM2 :: (a -> b -> ListT m c) -> ListT m a -> ListT m b -> ListT m c
bindM2 a -> b -> ListT m c
f ListT m a
ma ListT m b
mb = m [c] -> ListT m c
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (([a] -> [b] -> m [c]) -> m [a] -> m [b] -> m [c]
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 [a] -> [b] -> m [c]
f' (ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT ListT m a
ma) (ListT m b -> m [b]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT ListT m b
mb))
     where f' :: [a] -> [b] -> m [c]
f' [a]
as [b]
bs = (m [c] -> m [c] -> m [c]) -> m [c] -> [m [c]] -> m [c]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr m [c] -> m [c] -> m [c]
forall (m :: * -> *) a. Monad m => m [a] -> m [a] -> m [a]
concat ([c] -> m [c]
forall (m :: * -> *) a. Monad m => a -> m a
return []) [ListT m c -> m [c]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT (a -> b -> ListT m c
f a
a b
b) | a
a <- [a]
as, b
b <- [b]
bs]
           concat :: m [a] -> m [a] -> m [a]
concat m [a]
m m [a]
m' = do {[a]
x <- m [a]
m; [a]
y <- m [a]
m'; [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
x [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
y)}

instance MonadParallel m => MonadParallel (ReaderT r m) where
   bindM2 :: (a -> b -> ReaderT r m c)
-> ReaderT r m a -> ReaderT r m b -> ReaderT r m c
bindM2 a -> b -> ReaderT r m c
f ReaderT r m a
ma ReaderT r m b
mb = (r -> m c) -> ReaderT r m c
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\r
r-> (a -> b -> m c) -> m a -> m b -> m c
forall (m :: * -> *) a b c.
MonadParallel m =>
(a -> b -> m c) -> m a -> m b -> m c
bindM2 (r -> a -> b -> m c
f' r
r) (ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
ma r
r) (ReaderT r m b -> r -> m b
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m b
mb r
r))
     where f' :: r -> a -> b -> m c
f' r
r a
a b
b = ReaderT r m c -> r -> m c
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (a -> b -> ReaderT r m c
f a
a b
b) r
r

instance MonadFork Maybe
instance MonadFork []

instance MonadFork ((->) r) where
   forkExec :: (r -> a) -> r -> r -> a
forkExec r -> a
e = \r
r-> let result :: a
result = r -> a
e r
r
                     in a
result a -> (r -> a) -> r -> a
forall a b. a -> b -> b
`par` (a -> r -> a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result)

-- | IO is forkable by `forkIO`.
instance MonadFork IO where
   forkExec :: IO a -> IO (IO a)
forkExec IO a
ma = do
      MVar (Either SomeException a)
v <- IO (MVar (Either SomeException a))
forall a. IO (MVar a)
newEmptyMVar
      ThreadId
_ <- ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId)
-> ((forall a. IO a -> IO a) -> IO ThreadId) -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> IO a
forall a. IO a -> IO a
restore IO a
ma) IO (Either SomeException a)
-> (Either SomeException a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Either SomeException a) -> Either SomeException a -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException a)
v
      IO a -> IO (IO a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO a -> IO (IO a)) -> IO a -> IO (IO a)
forall a b. (a -> b) -> a -> b
$ MVar (Either SomeException a) -> IO (Either SomeException a)
forall a. MVar a -> IO a
readMVar MVar (Either SomeException a)
v IO (Either SomeException a)
-> (Either SomeException a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> IO a)
-> (a -> IO a) -> Either SomeException a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\SomeException
e -> SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO (SomeException
e :: SomeException)) a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance MonadFork m => MonadFork (IdentityT m) where
   forkExec :: IdentityT m a -> IdentityT m (IdentityT m a)
forkExec IdentityT m a
ma = m (IdentityT m a) -> IdentityT m (IdentityT m a)
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT ((m a -> IdentityT m a) -> m (m a) -> m (IdentityT m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM m a -> IdentityT m a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT (m (m a) -> m (IdentityT m a)) -> m (m a) -> m (IdentityT m a)
forall a b. (a -> b) -> a -> b
$ m a -> m (m a)
forall (m :: * -> *) a. MonadFork m => m a -> m (m a)
forkExec (IdentityT m a -> m a
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT IdentityT m a
ma))

instance MonadFork m => MonadFork (MaybeT m) where
   forkExec :: MaybeT m a -> MaybeT m (MaybeT m a)
forkExec MaybeT m a
ma = m (Maybe (MaybeT m a)) -> MaybeT m (MaybeT m a)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT ((m (Maybe a) -> Maybe (MaybeT m a))
-> m (m (Maybe a)) -> m (Maybe (MaybeT m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (MaybeT m a -> Maybe (MaybeT m a)
forall a. a -> Maybe a
Just (MaybeT m a -> Maybe (MaybeT m a))
-> (m (Maybe a) -> MaybeT m a) -> m (Maybe a) -> Maybe (MaybeT m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT) (m (m (Maybe a)) -> m (Maybe (MaybeT m a)))
-> m (m (Maybe a)) -> m (Maybe (MaybeT m a))
forall a b. (a -> b) -> a -> b
$ m (Maybe a) -> m (m (Maybe a))
forall (m :: * -> *) a. MonadFork m => m a -> m (m a)
forkExec (MaybeT m a -> m (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
ma))

instance MonadFork m => MonadFork (ExceptT e m) where
   forkExec :: ExceptT e m a -> ExceptT e m (ExceptT e m a)
forkExec ExceptT e m a
ma = m (Either e (ExceptT e m a)) -> ExceptT e m (ExceptT e m a)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT ((m (Either e a) -> Either e (ExceptT e m a))
-> m (m (Either e a)) -> m (Either e (ExceptT e m a))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ExceptT e m a -> Either e (ExceptT e m a)
forall a b. b -> Either a b
Right (ExceptT e m a -> Either e (ExceptT e m a))
-> (m (Either e a) -> ExceptT e m a)
-> m (Either e a)
-> Either e (ExceptT e m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT) (m (m (Either e a)) -> m (Either e (ExceptT e m a)))
-> m (m (Either e a)) -> m (Either e (ExceptT e m a))
forall a b. (a -> b) -> a -> b
$ m (Either e a) -> m (m (Either e a))
forall (m :: * -> *) a. MonadFork m => m a -> m (m a)
forkExec (ExceptT e m a -> m (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
ma))

instance MonadFork m => MonadFork (ListT m) where
   forkExec :: ListT m a -> ListT m (ListT m a)
forkExec ListT m a
ma = m [ListT m a] -> ListT m (ListT m a)
forall (m :: * -> *) a. m [a] -> ListT m a
ListT ((m [a] -> [ListT m a]) -> m (m [a]) -> m [ListT m a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((ListT m a -> [ListT m a] -> [ListT m a]
forall a. a -> [a] -> [a]
:[]) (ListT m a -> [ListT m a])
-> (m [a] -> ListT m a) -> m [a] -> [ListT m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT) (m (m [a]) -> m [ListT m a]) -> m (m [a]) -> m [ListT m a]
forall a b. (a -> b) -> a -> b
$ m [a] -> m (m [a])
forall (m :: * -> *) a. MonadFork m => m a -> m (m a)
forkExec (ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT ListT m a
ma))

instance MonadFork m => MonadFork (ReaderT r m) where
   forkExec :: ReaderT r m a -> ReaderT r m (ReaderT r m a)
forkExec ReaderT r m a
ma = (r -> m (ReaderT r m a)) -> ReaderT r m (ReaderT r m a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\r
r-> (m a -> ReaderT r m a) -> m (m a) -> m (ReaderT r m a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a)
-> (m a -> r -> m a) -> m a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> r -> m a
forall a b. a -> b -> a
const) (m (m a) -> m (ReaderT r m a)) -> m (m a) -> m (ReaderT r m a)
forall a b. (a -> b) -> a -> b
$ m a -> m (m a)
forall (m :: * -> *) a. MonadFork m => m a -> m (m a)
forkExec (ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
ma r
r))