{- 
    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.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 (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 (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))