conceit 0.3.2.0 → 0.4.0.0

raw patch · 4 files changed

+40/−68 lines, 4 filesdep +semigroupsdep −exceptionsdep −mtldep −transformersdep ~bifunctorsdep ~semigroupoidsdep ~voidPVP ok

version bump matches the API change (PVP)

Dependencies added: semigroups

Dependencies removed: exceptions, mtl, transformers

Dependency ranges changed: bifunctors, semigroupoids, void

API changes (from Hackage documentation)

Files

• CHANGELOG +6/−0
• README.md +6/−3
• conceit.cabal +7/−9
• src/Control/Concurrent/Conceit.hs +21/−56

@@ -1,3 +1,9 @@+0.4.0.0+=======+    - Removed Monad, MonadThrow, MonadCatch instances.+    - Added Semigroup instance.+    - Removed exception and mtl dependencies.+ 0.3.1.0 =======     - Made internal function "conceit'" public.

@@ -1,9 +1,12 @@ conceit ======= -A version of the Concurrently applicative from Simon Marlow's async package,-with the difference that the concurrent computation stops if any of the actions-returns a Left value, not only in the case of exceptions.+A version of the+[Concurrently](http://hackage.haskell.org/package/async-2.0.2/docs/Control-Concurrent-Async.html#t:Concurrently)+Applicative from Simon Marlow's+[async](http://hackage.haskell.org/package/async) package, with the difference+that the concurrent computation stops if any of the actions returns a Left+value, not only in the case of exceptions.  The internals have been copied wholesale from Concurrently, with modifications to support the new behaviour.

@@ -1,5 +1,5 @@ name:          conceit-version:       0.3.2.0+version:       0.4.0.0 license:       BSD3 license-file:  LICENSE data-files:    @@ -8,8 +8,8 @@ category:      Concurrency build-type:    Simple cabal-version: >= 1.10-Synopsis:      Concurrent actions that may fail-Description:   A version of the async package's 'Control.Concurrent.Async.Concurrently' for which the actions may fail+Synopsis:      Concurrent actions that may fail with a value.+Description:   A version of the async package's 'Control.Concurrent.Async.Concurrently' for which the actions may fail with a value.  Extra-Source-Files:     README.md@@ -23,12 +23,10 @@     other-modules:      build-depends:                  base >= 4.4 && < 5,-        semigroupoids >=4 && < 6,-        bifunctors >= 4.1 && < 6,-        void >= 0.6 && < 1.0,-        exceptions >= 0.6 && < 1.0,-        mtl >=2.0 && <2.3,-        transformers >=0.2 && < 0.5+        void >= 0.6,+        semigroupoids >=4,+        semigroups,+        bifunctors >= 4.1  Source-repository head     type:     git

@@ -1,8 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE CPP #-}  module Control.Concurrent.Conceit (            Conceit (..)@@ -15,24 +11,18 @@         , conceit'     ) where +import Data.Void+import Data.Functor.Bind+import Data.Functor.Plus import Data.Bifunctor-import Data.Monoid-import Data.Typeable+import Data.Semigroup+import Data.Monoid (Monoid,mempty,mappend) import Data.Traversable-import Data.Void import Control.Applicative -import Control.Monad-import Control.Monad.IO.Class-import qualified Control.Monad.Catch as Ex+import Control.Monad (forever) import Control.Exception  import Control.Concurrent-import Data.Functor.Bind-import Data.Functor.Plus -#if MIN_VERSION_mtl(2, 2, 1)-import Control.Monad.Except-#endif- {-|      'Conceit' is very similar to 'Control.Concurrent.Async.Concurrently' from the @async@ package, but it has an explicit error type @e@.@@ -43,13 +33,13 @@    However, if any of the actions fails with @e@ the other action is    immediately cancelled and the whole computation fails with @e@.  -    To put it another way: 'Conceit' behaves like 'Concurrently' for-    successes and like 'race' for errors.  +   To put it another way: 'Conceit' behaves like 'Concurrently' for+   successes and like 'race' for errors.   -} newtype Conceit e a = Conceit { runConceit :: IO (Either e a) } deriving Functor  instance Bifunctor Conceit where-  bimap f g (Conceit x) = Conceit $ liftM (bimap f g) x+  bimap f g (Conceit x) = Conceit $ liftA (bimap f g) x  instance Applicative (Conceit e) where   pure = Conceit . pure . pure@@ -61,25 +51,12 @@   Conceit as <|> Conceit bs =     Conceit $ fmap (fmap (either id id)) $ race as bs +instance (Semigroup a) => Semigroup (Conceit e a) where+  c1 <> c2 = (<>) <$> c1 <*> c2+ instance (Monoid a) => Monoid (Conceit e a) where    mempty = Conceit . pure . pure $ mempty-   mappend c1 c2 = (<>) <$> c1 <*> c2---- | `>>` sequences its arguments.-instance Monad (Conceit e) where-   return = pure-   f >>= k = Conceit $ do-      x <- runConceit f-      case x of -         Left e -> return $ Left e                      -         Right r -> runConceit $ k r--instance MonadPlus (Conceit e) where-   mzero = empty-   mplus = (<|>)--instance MonadIO (Conceit e) where-   liftIO = _Conceit+   mappend c1 c2 = mappend <$> c1 <*> c2  -- | `<!>` makes its two arguments race against each other. instance Data.Functor.Plus.Alt (Conceit e) where@@ -89,35 +66,21 @@ instance Plus (Conceit e) where     zero = empty --- | `>>-` is sequential.-instance Bind (Conceit s) where-    (>>-) = (>>=)- -- | `<.>` is concurrent. instance Apply (Conceit s) where     (<.>) = (<*>)      (<.) = (<*)      (.>) = (*>)  --#if MIN_VERSION_mtl(2, 2, 1)-instance MonadError e (Conceit e) where-     throwError = Conceit . pure . Left-     Conceit c `catchError`  h = -        Conceit $ runExceptT $ ExceptT c `catchError` (ExceptT . runConceit . h)-#endif---- | Throws exceptions into IO.-instance Ex.MonadThrow (Conceit e) where-    throwM = Conceit . Ex.throwM---- | Catches exceptions from IO.-instance Ex.MonadCatch (Conceit e) where-      catch (Conceit m) f = Conceit $ Ex.catch m (runConceit . f)-+{-| +    Construct a 'Conceit' as if it were a 'Control.Concurrent.Async.Concurrently'.+-} _Conceit :: IO a -> Conceit e a _Conceit = Conceit . fmap pure   +{-| +    Run a 'Conceit' as if it were a 'Control.Concurrent.Async.Concurrently'.+-} _runConceit :: Conceit Void a -> IO a _runConceit c = either absurd id <$> runConceit c  @@ -132,6 +95,7 @@ catchAll :: IO a -> (SomeException -> IO a) -> IO a catchAll = catch + -- Adapted from the race function from async race :: IO (Either e a) -> IO (Either e b) -> IO (Either e (Either a b))  race left right = conceit' left right collect@@ -144,6 +108,7 @@             Right (Right (Left e1)) -> return $ Left e1              Right (Left (Right r2)) -> return $ Right $ Left r2              Right (Left (Left e2)) -> return $ Left e2+  -- Adapted from the concurrently function from async conceit :: IO (Either e a) -> IO (Either e b) -> IO (Either e (a, b))