From 974922f64b4236ee01eb7ee9e469b584f3315102 Mon Sep 17 00:00:00 2001 From: Christopher King Date: Mon, 11 Dec 2017 14:17:52 -0700 Subject: [PATCH] Added Monad, MonadPlus, and MonadFix instance to Concurrently The Monad instance is in fact compatible with the Applicative instance. In as >>= asb, it will run concurrently if asb is lazy (such as used by `ap`) and sequential when strict Close #70 --- Control/Concurrent/Async.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/Control/Concurrent/Async.hs b/Control/Concurrent/Async.hs index 7f5751a..9cdac0a 100644 --- a/Control/Concurrent/Async.hs +++ b/Control/Concurrent/Async.hs @@ -138,6 +138,7 @@ import qualified Data.Foldable as F import Prelude hiding (catch) #endif import Control.Monad +import Control.Monad.Fix import Control.Applicative #if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid(mempty,mappend)) @@ -155,7 +156,6 @@ import Data.IORef import GHC.Exts import GHC.IO hiding (finally, onException) import GHC.Conc - -- ----------------------------------------------------------------------------- -- STM Async API @@ -815,6 +815,19 @@ instance Alternative Concurrently where Concurrently as <|> Concurrently bs = Concurrently $ either id id <$> race as bs +instance Monad Concurrently where + (Concurrently as) >>= asb = Concurrently $ do + aref <- newEmptyMVar + ((),b) <- concurrently (as >>= putMVar aref) (unsafeInterleaveIO (takeMVar aref) >>= runConcurrently . asb) + return b + +instance MonadPlus Concurrently where + mzero = empty + mplus = (<|>) + +instance MonadFix Concurrently where + mfix f = Concurrently . mfix $ runConcurrently . f + #if MIN_VERSION_base(4,9,0) -- | Only defined by @async@ for @base >= 4.9@ --