From 17738f2baed3c3fd3805162bbbe111bc7cb94c3a Mon Sep 17 00:00:00 2001
From: Christopher King <Chris.D.King.42@gmail.com>
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 #69
---
 Control/Concurrent/Async.hs | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/Control/Concurrent/Async.hs b/Control/Concurrent/Async.hs
index 7f5751a..c5a0355 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))
@@ -815,6 +816,21 @@ 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@
 --