Skip to content

Commit

Permalink
Added Monad, MonadPlus, and MonadFix instance to Concurrently
Browse files Browse the repository at this point in the history
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 simonmar#70
  • Loading branch information
ChristopherKing42 committed Dec 11, 2017
1 parent c9bddda commit 3172b96
Showing 1 changed file with 16 additions and 0 deletions.
16 changes: 16 additions & 0 deletions Control/Concurrent/Async.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down Expand Up @@ -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@
--
Expand Down

0 comments on commit 3172b96

Please sign in to comment.