process-streaming 0.6.0.0 → 0.6.1.0

raw patch · 3 files changed

+10/−50 lines, 3 filesdep +conceit

Dependencies added: conceit

Files

• CHANGELOG +6/−0
• process-streaming.cabal +3/−2
• src/System/Process/Streaming.hs +1/−48

@@ -1,3 +1,9 @@+0.6.1.0+-------++- No changes to the external API, but some internal code has moved to a+  separate package, "conceit".+ 0.6.0.0 ------- 

@@ -1,5 +1,5 @@ name:          process-streaming-version:       0.6.0.0+version:       0.6.1.0 license:       BSD3 license-file:  LICENSE data-files:    @@ -40,7 +40,8 @@         exceptions >= 0.6.0 && < 0.7,         void >= 0.6 && < 0.7,         containers >= 0.4,-        semigroups >= 0.15 && < 0.16+        semigroups >= 0.15 && < 0.16,+        conceit >= 0.1.0.0 && < 0.2.0.0  Test-suite test     default-language:

@@ -64,13 +64,11 @@         -- * Pipelines         , executePipeline         , executePipelineFallibly---        , CreatePipeline (..)         --, simplePipeline         , Stage         , stage         , pipefail         , inbound-       -- , SubsequentStage (..)         -- * Re-exports         -- $reexports         , module System.Process@@ -100,6 +98,7 @@ import Control.Exception import Control.Concurrent import Control.Concurrent.Async+import Control.Concurrent.Conceit import Pipes import qualified Pipes as P import qualified Pipes.Prelude as P@@ -424,52 +423,6 @@             (a,leftovers) <- ExceptT $ unhalting activity $ decoder producer              (f,r) <- ExceptT $ unhalting policy leftovers              pure (f a,r)--data WrappedError e = WrappedError e-    deriving (Show, Typeable)--instance (Show e, Typeable e) => Exception (WrappedError e)--elideError :: (Show e, Typeable e) => IO (Either e a) -> IO a-elideError action = action >>= either (throwIO . WrappedError) return--revealError :: (Show e, Typeable e) => IO a -> IO (Either e a)  -revealError action = catch (action >>= return . Right)-                           (\(WrappedError e) -> return . Left $ e)   --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--instance (Show e, Typeable e) => Applicative (Conceit e) where-  pure = Conceit . pure . pure-  Conceit fs <*> Conceit as =-    Conceit . revealError $ -        uncurry ($) <$> concurrently (elideError fs) (elideError as)--instance (Show e, Typeable e) => Alternative (Conceit e) where-  empty = Conceit $ forever (threadDelay maxBound)-  Conceit as <|> Conceit bs =-    Conceit $ either id id <$> race as bs--instance (Show e, Typeable e, Monoid a) => Monoid (Conceit e a) where-   mempty = Conceit . pure . pure $ mempty-   mappend c1 c2 = (<>) <$> c1 <*> c2--conceit :: (Show e, Typeable e) -        => IO (Either e a)-        -> IO (Either e b)-        -> IO (Either e (a,b))-conceit c1 c2 = runConceit $ (,) <$> Conceit c1 <*> Conceit c2--{-| -      Works similarly to 'Control.Concurrent.Async.mapConcurrently' from the-@async@ package, but if any of the computations fails with @e@, the others are-immediately cancelled and the whole computation fails with @e@. - -}-mapConceit :: (Show e, Typeable e, Traversable t) => (a -> IO (Either e b)) -> t a -> IO (Either e (t b))-mapConceit f = revealError .  mapConcurrently (elideError . f)  newtype Pump b e a = Pump { runPump :: Consumer b IO () -> IO (Either e a) } deriving Functor