lifted-async 0.2.0.2 → 0.3.0

raw patch · 9 files changed

+441/−34 lines, 9 filesdep +constraintsdep ~asyncdep ~basedep ~lifted-basePVP ok

version bump matches the API change (PVP)

Dependencies added: constraints

Dependency ranges changed: async, base, lifted-base, monad-control, transformers-base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• README.md +1/−0
• lifted-async.cabal +24/−7
• src/Control/Concurrent/Async/Lifted.hs +59/−24
• src/Control/Concurrent/Async/Lifted/Safe.hs +331/−0
• tests/Test/Async/Common.hs +0/−2
• tests/Test/Async/IO.hs +6/−0
• tests/Test/Async/State.hs +9/−1
• tests/TestSuite.hs +2/−0

@@ -1,3 +1,12 @@+=======+## v0.3.0 - 2014-12-28++* Support for `monad-control == 1.0.*`+    * `waitEither_` and `race_` now discard monadic effects besides `IO`. This is a breaking change.+    * `Control.Concurrent.Async.Lifted.Safe` is added.+* Add `Monad` instance for `Concurrently`+* Relax upper bound for base+ ## v0.2.0.2 - 2014-08-20  * Fix build failure in the test suite (#6)

@@ -2,6 +2,7 @@ ========== [![Build Status](https://secure.travis-ci.org/maoe/lifted-async.png)](http://travis-ci.org/maoe/lifted-async) [![Coverage Status](https://coveralls.io/repos/maoe/lifted-async/badge.png)](https://coveralls.io/r/maoe/lifted-async)+[![Gitter chat](https://badges.gitter.im/maoe/lifted-async.png)](https://gitter.im/maoe/lifted-async)  This package provides IO operations from [async](http://hackage.haskell.org/package/async) package lifted to any instance of `MonadBase` or `MonadBaseControl` from [monad-control](http://hackage.haskell.org/package/monad-control) package. 

@@ -1,5 +1,5 @@ name:                lifted-async-version:             0.2.0.2+version:             0.3.0 synopsis:            Run lifted IO operations asynchronously and wait for their results homepage:            https://github.com/maoe/lifted-async bug-reports:         https://github.com/maoe/lifted-async/issues@@ -20,15 +20,32 @@   This package provides IO operations from @async@ package lifted to any   instance of 'MonadBase' or 'MonadBaseControl'. +flag monad-control-1+  description: User moand-control == 1.*+  default: True+  manual: False+ library   exposed-modules:     Control.Concurrent.Async.Lifted+    Control.Concurrent.Async.Lifted.Safe   build-depends:-      base >= 4.3 && < 4.8-    , async >= 2.0.1-    , lifted-base >= 0.2-    , monad-control >= 0.3.1-    , transformers-base >= 0.4+      base >= 4.3 && < 4.9+    , async >= 2.0.1 && < 2.1+    , lifted-base >= 0.2 && < 0.3+    , transformers-base >= 0.4 && < 0.5+  if flag(monad-control-1)+    build-depends:+      monad-control == 1.0.*+    if impl(ghc >= 7.8)+      build-depends:+        constraints >= 0.2 && < 0.5+    else+      build-depends:+        constraints >= 0.2 && <= 0.4+  else+    build-depends:+      monad-control == 0.*   ghc-options: -Wall   hs-source-dirs: src @@ -95,5 +112,5 @@  source-repository this   type: git-  tag: v0.2.0.2+  tag: v0.3.0   location: https://github.com/maoe/lifted-async.git

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-}@@ -10,15 +11,25 @@ Maintainer  : Mitsutoshi Aoe <maoe@foldr.in> Stability   : experimental -This is a wrapped version of "Control.Concurrent.Async" with types generalized+This is a wrapped version of @Control.Concurrent.Async@ with types generalized from 'IO' to all monads in either 'MonadBase' or 'MonadBaseControl'.++All the functions restore the monadic effects in the forked computation+unless specified otherwise.++#if MIN_VERSION_monad_control(1, 0, 0)+If your monad stack satisfies @'StM' m a ~ a@ (e.g. the reader monad), consider+using @Control.Concurrent.Async.Lifted.Safe@ module, which prevents you from+messing up monadic effects.+#endif -}  module Control.Concurrent.Async.Lifted   ( -- * Asynchronous actions     A.Async     -- ** Spawning-  , async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask+  , async, asyncBound, asyncOn+  , asyncWithUnmask, asyncOnWithUnmask      -- ** Spawning with automatic 'cancel'ation   , withAsync, withAsyncBound, withAsyncOn@@ -47,7 +58,7 @@  import Control.Applicative import Control.Concurrent (threadDelay)-import Control.Monad ((>=>), forever, liftM, void)+import Control.Monad ((>=>), forever, liftM) import Data.Traversable (Traversable(..)) import GHC.IO (unsafeUnmask) import Prelude hiding (mapM)@@ -172,6 +183,20 @@   liftBase (A.poll a) >>=   maybe (return Nothing) (liftM Just . sequenceEither) +-- | Generalized version of 'A.cancel'.+--+-- NOTE: This function discards the monadic effects besides IO in the forked+-- computation.+cancel :: MonadBase IO m => Async a -> m ()+cancel = liftBase . A.cancel++-- | Generalized version of 'A.cancelWith'.+--+-- NOTE: This function discards the monadic effects besides IO in the forked+-- computation.+cancelWith :: (MonadBase IO m, Exception e) => Async a -> e -> m ()+cancelWith = (liftBase .) . A.cancelWith+ -- | Generalized version of 'A.waitCatch'. waitCatch   :: MonadBaseControl IO m@@ -179,14 +204,6 @@   -> m (Either SomeException a) waitCatch a = liftBase (A.waitCatch a) >>= sequenceEither --- | Generalized version of 'A.cancel'.-cancel :: MonadBase IO m => Async (StM m a) -> m ()-cancel = liftBase . A.cancel---- | Generalized version of 'A.cancelWith'.-cancelWith :: (MonadBase IO m, Exception e) => Async (StM m a) -> e -> m ()-cancelWith = (liftBase .) . A.cancelWith- -- | Generalized version of 'A.waitAny'. waitAny :: MonadBaseControl IO m => [Async (StM m a)] -> m (Async (StM m a), a) waitAny as = do@@ -205,8 +222,14 @@   return (a, r)  -- | Generalized version of 'A.waitAnyCancel'.-waitAnyCancel :: MonadBase IO m => [Async a] -> m (Async a, a)-waitAnyCancel = liftBase . A.waitAnyCancel+waitAnyCancel+  :: MonadBaseControl IO m+  => [Async (StM m a)]+  -> m (Async (StM m a), a)+waitAnyCancel as = do+  (a, s) <- liftBase $ A.waitAnyCancel as+  r <- restoreM s+  return (a, r)  -- | Generalized version of 'A.waitAnyCatchCancel'. waitAnyCatchCancel@@ -259,12 +282,15 @@   either (liftM Left . sequenceEither) (liftM Right . sequenceEither)  -- | Generalized version of 'A.waitEither_'.+--+-- NOTE: This function discards the monadic effects besides IO in the forked+-- computation. waitEither_   :: MonadBaseControl IO m-  => Async (StM m a)-  -> Async (StM m b)+  => Async a+  -> Async b   -> m ()-waitEither_ = (void .) . waitEither+waitEither_ a b = liftBase (A.waitEither_ a b)  -- | Generalized version of 'A.waitBoth'. waitBoth@@ -280,11 +306,11 @@ {-# INLINABLE waitBoth #-}  -- | Generalized version of 'A.link'.-link :: MonadBase IO m => Async (StM m a) -> m ()+link :: MonadBase IO m => Async a -> m () link = liftBase . A.link  -- | Generalized version of 'A.link2'.-link2 :: MonadBase IO m => Async (StM m a) -> Async (StM m b) -> m ()+link2 :: MonadBase IO m => Async a -> Async a -> m () link2 = (liftBase .) . A.link2  -- | Generalized version of 'A.race'.@@ -296,6 +322,9 @@ {-# INLINABLE race #-}  -- | Generalized version of 'A.race_'.+--+-- NOTE: This function discards the monadic effects besides IO in the forked+-- computation. race_ :: MonadBaseControl IO m => m a -> m b -> m () race_ left right =   withAsync left $ \a ->@@ -321,20 +350,22 @@  -- | Generalized version of 'A.Concurrently'. ----- A value of type @Concurrently b m a@ is an IO-based operation that can be+-- A value of type @'Concurrently' b m a@ is an IO-based operation that can be -- composed with other 'Concurrently' values, using the 'Applicative' and -- 'Alternative' instances. ----- Calling 'runConcurrently' on a value of type @Concurrently b m a@ will+-- Calling 'runConcurrently' on a value of type @'Concurrently' b m a@ will -- execute the IO-based lifted operations it contains concurrently, before -- delivering the result of type 'a'. -- -- For example ----- > (page1, page2, page3) <- runConcurrently $ (,,)--- >   <$> Concurrently (getURL "url1")--- >   <*> Concurrently (getURL "url2")--- >   <*> Concurrently (getURL "url3")+-- @+--   (page1, page2, page3) <- 'runConcurrently' $ (,,)+--     '<$>' 'Concurrently' (getURL "url1")+--     '<*>' 'Concurrently' (getURL "url2")+--     '<*>' 'Concurrently' (getURL "url3")+-- @ newtype Concurrently (b :: * -> *) m a = Concurrently { runConcurrently :: m a }  -- NOTE: The phantom type variable @b :: * -> *@ in 'Concurrently' is needed to@@ -354,6 +385,10 @@   empty = Concurrently . liftBaseWith . const $ forever (threadDelay maxBound)   Concurrently as <|> Concurrently bs =     Concurrently $ either id id <$> race as bs++instance Monad m => Monad (Concurrently b m) where+  return = Concurrently . return+  Concurrently a >>= f = Concurrently $ a >>= runConcurrently . f  sequenceEither :: MonadBaseControl IO m => Either e (StM m a) -> m (Either e a) sequenceEither = either (return . Left) (liftM Right . restoreM)

@@ -0,0 +1,331 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++#if defined(__GLASGOW_HASKELL__) && __GLAGOW_HASKELL__ <= 706+{-# LANGUAGE UndecidableInstances #-}+#endif++{- |+Module      : Control.Concurrent.Async.Lifted.Safe+Copyright   : Copyright (C) 2012-2014 Mitsutoshi Aoe+License     : BSD-style (see the file LICENSE)+Maintainer  : Mitsutoshi Aoe <maoe@foldr.in>+Stability   : experimental++This is a safe variant of @Control.Concurrent.Async.Lifted@.++This module assumes your monad stack to satisfy @'StM' m a ~ a@ so you can't+mess up monadic effects. If your monad stack is stateful, use+@Control.Concurrent.Async.Lifted@ with special care.++#if MIN_VERSION_monad_control(1, 0, 0)+#else+Caveat: This module is available only if built with @monad-control >= 1.0.0@.+If you have older @monad-control@, use @Control.Concurrent.Async.Lifted@.+#endif+-}++module Control.Concurrent.Async.Lifted.Safe+  (+#if MIN_VERSION_monad_control(1, 0, 0)+    -- * Asynchronous actions+    A.Async+    -- ** Spawning+  , async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask++    -- ** Spawning with automatic 'cancel'ation+  , withAsync, withAsyncBound, withAsyncOn+  , withAsyncWithUnmask, withAsyncOnWithUnmask++    -- ** Quering 'Async's+  , wait, poll, waitCatch+  , cancel, cancelWith+  , A.asyncThreadId++    -- ** STM operations+  , A.waitSTM, A.pollSTM, A.waitCatchSTM++    -- ** Waiting for multiple 'Async's+  , waitAny, waitAnyCatch, waitAnyCancel, waitAnyCatchCancel+  , waitEither, waitEitherCatch, waitEitherCancel, waitEitherCatchCancel+  , Unsafe.waitEither_+  , waitBoth++    -- ** Linking+  , Unsafe.link, Unsafe.link2++    -- * Convenient utilities+  , race, race_, concurrently, mapConcurrently+  , Concurrently(..), Pure+#endif+  ) where++#if MIN_VERSION_monad_control(1, 0, 0)+import Control.Applicative+import Control.Concurrent (threadDelay)+import Control.Monad+import Data.Traversable++import Control.Concurrent.Async (Async)+import Control.Exception.Lifted (SomeException, Exception)+import Control.Monad.Base (MonadBase(..))+import Control.Monad.Trans.Control hiding (restoreM)+import Data.Constraint ((\\), (:-))+import Data.Constraint.Forall (Forall, inst)+import qualified Control.Concurrent.Async as A++import qualified Control.Concurrent.Async.Lifted as Unsafe++-- | Generalized version of 'A.async'.+async :: (MonadBaseControl IO m, StM m a ~ a) => m a -> m (Async a)+async = Unsafe.async++-- | Generalized version of 'A.asyncBound'.+asyncBound :: (MonadBaseControl IO m, StM m a ~ a) => m a -> m (Async a)+asyncBound = Unsafe.asyncBound++-- | Generalized version of 'A.asyncOn'.+asyncOn :: (MonadBaseControl IO m, StM m a ~ a) => Int -> m a -> m (Async a)+asyncOn = Unsafe.asyncOn++-- | Generalized version of 'A.asyncWithUnmask'.+asyncWithUnmask+  :: (MonadBaseControl IO m, StM m a ~ a)+  => ((forall b. m b -> m b) -> m a)+  -> m (Async a)+asyncWithUnmask = Unsafe.asyncWithUnmask++-- | Generalized version of 'A.asyncOnWithUnmask'.+asyncOnWithUnmask+  :: (MonadBaseControl IO m, StM m a ~ a)+  => Int+  -> ((forall b. m b -> m b) -> m a)+  -> m (Async a)+asyncOnWithUnmask = Unsafe.asyncOnWithUnmask++-- | Generalized version of 'A.withAsync'.+withAsync+  :: (MonadBaseControl IO m, StM m a ~ a)+  => m a+  -> (Async a -> m b)+  -> m b+withAsync = Unsafe.withAsync++-- | Generalized version of 'A.withAsyncBound'.+withAsyncBound+  :: (MonadBaseControl IO m, StM m a ~ a)+  => m a+  -> (Async a -> m b)+  -> m b+withAsyncBound = Unsafe.withAsyncBound++-- | Generalized version of 'A.withAsyncOn'.+withAsyncOn+  :: (MonadBaseControl IO m, StM m a ~ a)+  => Int+  -> m a+  -> (Async a -> m b)+  -> m b+withAsyncOn = Unsafe.withAsyncOn++-- | Generalized version of 'A.withAsyncWithUnmask'.+withAsyncWithUnmask+  :: (MonadBaseControl IO m, StM m a ~ a)+  => ((forall c. m c -> m c) -> m a)+  -> (Async a -> m b)+  -> m b+withAsyncWithUnmask = Unsafe.withAsyncWithUnmask++-- | Generalized version of 'A.withAsyncOnWithUnmask'.+withAsyncOnWithUnmask+  :: (MonadBaseControl IO m, StM m a ~ a)+  => Int+  -> ((forall c. m c -> m c) -> m a)+  -> (Async a -> m b)+  -> m b+withAsyncOnWithUnmask = Unsafe.withAsyncOnWithUnmask++-- | Generalized version of 'A.wait'.+wait :: (MonadBaseControl IO m, StM m a ~ a) => Async a -> m a+wait = Unsafe.wait++-- | Generalized version of 'A.poll'.+poll+  :: (MonadBaseControl IO m, StM m a ~ a)+  => Async a+  -> m (Maybe (Either SomeException a))+poll = Unsafe.poll++-- | Generalized version of 'A.waitCatch'.+waitCatch+  :: (MonadBaseControl IO m, StM m a ~ a)+  => Async a+  -> m (Either SomeException a)+waitCatch = Unsafe.waitCatch++-- | Generalized version of 'A.cancel'.+cancel :: MonadBase IO m => Async a -> m ()+cancel = Unsafe.cancel++-- | Generalized version of 'A.cancelWith'.+cancelWith :: (MonadBase IO m, Exception e) => Async a -> e -> m ()+cancelWith = Unsafe.cancelWith++-- | Generalized version of 'A.waitAny'.+waitAny+  :: (MonadBaseControl IO m, StM m a ~ a)+  => [Async a] -> m (Async a, a)+waitAny = Unsafe.waitAny++-- | Generalized version of 'A.waitAnyCatch'.+waitAnyCatch+  :: (MonadBaseControl IO m, StM m a ~ a)+  => [Async a]+  -> m (Async a, Either SomeException a)+waitAnyCatch = Unsafe.waitAnyCatch++-- | Generalized version of 'A.waitAnyCancel'.+waitAnyCancel+  :: (MonadBaseControl IO m, StM m a ~ a)+  => [Async a]+  -> m (Async a, a)+waitAnyCancel = Unsafe.waitAnyCancel++-- | Generalized version of 'A.waitAnyCatchCancel'.+waitAnyCatchCancel+  :: (MonadBaseControl IO m, StM m a ~ a)+  => [Async a]+  -> m (Async a, Either SomeException a)+waitAnyCatchCancel = Unsafe.waitAnyCatchCancel++-- | Generalized version of 'A.waitEither'.+waitEither+  :: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)+  => Async a+  -> Async b+  -> m (Either a b)+waitEither = Unsafe.waitEither++-- | Generalized version of 'A.waitEitherCatch'.+waitEitherCatch+  :: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)+  => Async a+  -> Async b+  -> m (Either (Either SomeException a) (Either SomeException b))+waitEitherCatch = Unsafe.waitEitherCatch++-- | Generalized version of 'A.waitEitherCancel'.+waitEitherCancel+  :: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)+  => Async a+  -> Async b+  -> m (Either a b)+waitEitherCancel = Unsafe.waitEitherCancel++-- | Generalized version of 'A.waitEitherCatchCancel'.+waitEitherCatchCancel+  :: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)+  => Async a+  -> Async b+  -> m (Either (Either SomeException a) (Either SomeException b))+waitEitherCatchCancel = Unsafe.waitEitherCatchCancel++-- | Generalized version of 'A.waitBoth'.+waitBoth+  :: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)+  => Async a+  -> Async b+  -> m (a, b)+waitBoth = Unsafe.waitBoth++-- | Generalized version of 'A.race'.+race+  :: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)+  => m a -> m b -> m (Either a b)+race = Unsafe.race++-- | Generalized version of 'A.race_'.+race_+  :: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)+  => m a -> m b -> m ()+race_ = Unsafe.race_++-- | Generalized version of 'A.concurrently'.+concurrently+  :: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)+  => m a -> m b -> m (a, b)+concurrently = Unsafe.concurrently++-- | Generalized version of 'A.mapConcurrently'.+mapConcurrently+  :: (Traversable t, MonadBaseControl IO m, Forall (Pure m))+  => (a -> m b)+  -> t a+  -> m (t b)+mapConcurrently f = runConcurrently . traverse (Concurrently . f)++-- | Generalized version of 'A.Concurrently'.+--+-- A value of type @'Concurrently' b m a@ is an IO-based operation that can be+-- composed with other 'Concurrently' values, using the 'Applicative' and+-- 'Alternative' instances.+--+-- Calling 'runConcurrently' on a value of type @'Concurrently' b m a@ will+-- execute the IO-based lifted operations it contains concurrently, before+-- delivering the result of type 'a'.+--+-- For example+--+-- @+--   (page1, page2, page3) <- 'runConcurrently' $ (,,)+--     '<$>' 'Concurrently' (getURL "url1")+--     '<*>' 'Concurrently' (getURL "url2")+--     '<*>' 'Concurrently' (getURL "url3")+-- @+data Concurrently (base :: * -> *) m a where+  Concurrently+    :: Forall (Pure m)+    => { runConcurrently :: m a } -> Concurrently base m a++-- NOTE: The phantom type variable @b :: * -> *@ in 'Concurrently' is needed to+-- avoid @UndecidableInstances@ in the following instance declarations.+-- See https://github.com/maoe/lifted-async/issues/4 for alternative+-- implementaions.++-- | @'Pure' m a@ only means @m@ satisfies @'StM' m a ~ a@ (i.e. the monad+-- @m@ has no monadic state). The boring 'Pure' class is necessary just to+-- convince the GHC type checker.+class StM m a ~ a => Pure m a+instance StM m a ~ a => Pure m a++instance (base ~ IO, Functor m) => Functor (Concurrently base m) where+  fmap f (Concurrently a) = Concurrently $ f <$> a++instance (base ~ IO, MonadBaseControl base m, Forall (Pure m)) =>+  Applicative (Concurrently base m) where+    pure = Concurrently . pure+    Concurrently (fs :: m (a -> b)) <*> Concurrently as =+      Concurrently (uncurry ($) <$> concurrently fs as)+        \\ (inst :: Forall (Pure m) :- Pure m a)+        \\ (inst :: Forall (Pure m) :- Pure m (a -> b))++instance (base ~ IO, MonadBaseControl base m, Forall (Pure m)) =>+  Alternative (Concurrently base m) where+    empty = Concurrently . liftBaseWith . const $ forever (threadDelay maxBound)+    Concurrently (as :: m a) <|> Concurrently bs =+      Concurrently (either id id <$> race as bs)+        \\ (inst :: Forall (Pure m) :- Pure m a)+        \\ (inst :: Forall (Pure m) :- Pure m b)++instance (Monad m, Forall (Pure m)) => Monad (Concurrently base m) where+  return = Concurrently . return+  Concurrently a >>= f = Concurrently $ a >>= runConcurrently . f+#endif

@@ -13,8 +13,6 @@ import Test.Tasty.HUnit as X import Test.Tasty.TH as X -import Control.Concurrent.Async.Lifted as X- value :: Int value = 42 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} module Test.Async.IO   ( ioTestGroup@@ -8,6 +9,11 @@ import Control.Concurrent.Lifted import Control.Exception.Lifted as E +#if MIN_VERSION_monad_control(1, 0, 0)+import Control.Concurrent.Async.Lifted.Safe+#else+import Control.Concurrent.Async.Lifted+#endif import Test.Async.Common  ioTestGroup :: TestTree

@@ -8,6 +8,7 @@ import Control.Concurrent.Lifted import Control.Exception.Lifted as E +import Control.Concurrent.Async.Lifted import Test.Async.Common  stateTestGroup :: TestTree@@ -115,12 +116,19 @@     when (isNothing r') $       liftIO $ assertFailure "The result must not be Nothing." +case_withAsync_waitEither :: Assertion+case_withAsync_waitEither = do+  (_, s) <- flip runStateT value $ do+    withAsync (modify (+1)) $ \a ->+      waitEither a a+  liftIO $ s @?= value + 1+ case_withAsync_waitEither_ :: Assertion case_withAsync_waitEither_ = do   ((), s) <- flip runStateT value $ do     withAsync (modify (+1)) $ \a ->       waitEither_ a a-  liftIO $ s @?= value + 1+  liftIO $ s @?= value  case_withAsync_waitBoth1 :: Assertion case_withAsync_waitBoth1 = do

@@ -4,9 +4,11 @@  import Test.Async.IO import Test.Async.State+import Test.Async.Reader  main :: IO () main = defaultMain $ testGroup "lifted-async test suite"   [ ioTestGroup   , stateTestGroup+  , readerTestGroup   ]