process-streaming 0.6.1.0 → 0.6.2.0
raw patch · 4 files changed
+31/−40 lines, 4 filesdep ~conceit
Dependency ranges changed: conceit
Files
- CHANGELOG +6/−0
- process-streaming.cabal +2/−3
- src/System/Process/Streaming.hs +23/−36
- tests/test.hs +0/−1
CHANGELOG view
@@ -1,3 +1,9 @@+0.6.2.0+-------++- Removed ugly (Show e,Typeable) constraints on the error type from many+ functions. + 0.6.1.0 -------
process-streaming.cabal view
@@ -1,5 +1,5 @@ name: process-streaming-version: 0.6.1.0+version: 0.6.2.0 license: BSD3 license-file: LICENSE data-files: @@ -41,7 +41,7 @@ void >= 0.6 && < 0.7, containers >= 0.4, semigroups >= 0.15 && < 0.16,- conceit >= 0.1.0.0 && < 0.2.0.0+ conceit >= 0.2.1.0 && < 0.3.0.0 Test-suite test default-language:@@ -58,7 +58,6 @@ , transformers-compat == 0.3.* , free >= 4.2 && < 5 , bifunctors >= 4.1 && < 5- , async >= 2.0.1 && < 2.1 , process >= 1.2.0 && < 1.3 , pipes >= 4.1.2 && < 4.2 , pipes-bytestring >= 2.1.0 && < 2.2
src/System/Process/Streaming.hs view
@@ -14,7 +14,6 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-}@@ -81,7 +80,6 @@ import Data.Monoid import Data.Foldable import Data.Traversable-import Data.Typeable import Data.Tree import Data.Text import Data.Text.Encoding @@ -97,7 +95,6 @@ import qualified Control.Monad.Catch as C import Control.Exception import Control.Concurrent-import Control.Concurrent.Async import Control.Concurrent.Conceit import Pipes import qualified Pipes as P@@ -232,56 +229,53 @@ {-| Pipe @stdout@. -}-pipeo :: (Show e,Typeable e) => Siphon ByteString e a -> PipingPolicy e a+pipeo :: Siphon ByteString e a -> PipingPolicy e a pipeo (runSiphon -> siphonout) = PPOutput $ siphonout {-| Pipe @stderr@. -}-pipee :: (Show e,Typeable e) => Siphon ByteString e a -> PipingPolicy e a+pipee :: Siphon ByteString e a -> PipingPolicy e a pipee (runSiphon -> siphonout) = PPError $ siphonout {-| Pipe @stdout@ and @stderr@. -}-pipeoe :: (Show e,Typeable e) => Siphon ByteString e a -> Siphon ByteString e b -> PipingPolicy e (a,b)+pipeoe :: Siphon ByteString e a -> Siphon ByteString e b -> PipingPolicy e (a,b) pipeoe (runSiphon -> siphonout) (runSiphon -> siphonerr) = PPOutputError $ uncurry $ separated siphonout siphonerr {-| Pipe @stdout@ and @stderr@ and consume them combined as 'Text'. -}-pipeoec :: (Show e,Typeable e) => LinePolicy e -> LinePolicy e -> Siphon Text e a -> PipingPolicy e a+pipeoec :: LinePolicy e -> LinePolicy e -> Siphon Text e a -> PipingPolicy e a pipeoec policy1 policy2 (runSiphon -> siphon) = PPOutputError $ uncurry $ combined policy1 policy2 siphon {-| Pipe @stdin@. -}-pipei :: (Show e, Typeable e) => Pump ByteString e i -> PipingPolicy e i+pipei :: Pump ByteString e i -> PipingPolicy e i pipei (Pump feeder) = PPInput $ \(consumer,cleanup) -> feeder consumer `finally` cleanup {-| Pipe @stdin@ and @stdout@. -}-pipeio :: (Show e, Typeable e)- => Pump ByteString e i -> Siphon ByteString e a -> PipingPolicy e (i,a)+pipeio :: Pump ByteString e i -> Siphon ByteString e a -> PipingPolicy e (i,a) pipeio (Pump feeder) (runSiphon -> siphonout) = PPInputOutput $ \(consumer,cleanup,producer) -> (conceit (feeder consumer `finally` cleanup) (siphonout producer)) {-| Pipe @stdin@ and @stderr@. -}-pipeie :: (Show e, Typeable e)- => Pump ByteString e i -> Siphon ByteString e a -> PipingPolicy e (i,a)+pipeie :: Pump ByteString e i -> Siphon ByteString e a -> PipingPolicy e (i,a) pipeie (Pump feeder) (runSiphon -> siphonerr) = PPInputError $ \(consumer,cleanup,producer) -> (conceit (feeder consumer `finally` cleanup) (siphonerr producer)) {-| Pipe @stdin@, @stdout@ and @stderr@. -}-pipeioe :: (Show e, Typeable e)- => Pump ByteString e i -> Siphon ByteString e a -> Siphon ByteString e b -> PipingPolicy e (i,a,b)+pipeioe :: Pump ByteString e i -> Siphon ByteString e a -> Siphon ByteString e b -> PipingPolicy e (i,a,b) pipeioe (Pump feeder) (runSiphon -> siphonout) (runSiphon -> siphonerr) = fmap flattenTuple $ PPInputOutputError $ \(consumer,cleanup,outprod,errprod) -> (conceit (feeder consumer `finally` cleanup) @@ -292,15 +286,13 @@ {-| Pipe @stdin@, @stdout@ and @stderr@, consuming the last two combined as 'Text'. -}-pipeioec :: (Show e, Typeable e)- => Pump ByteString e i -> LinePolicy e -> LinePolicy e -> Siphon Text e a -> PipingPolicy e (i,a)+pipeioec :: Pump ByteString e i -> LinePolicy e -> LinePolicy e -> Siphon Text e a -> PipingPolicy e (i,a) pipeioec (Pump feeder) policy1 policy2 (runSiphon -> siphon) = PPInputOutputError $ \(consumer,cleanup,outprod,errprod) -> (conceit (feeder consumer `finally` cleanup) (combined policy1 policy2 siphon outprod errprod)) -separated :: (Show e, Typeable e)- => (Producer ByteString IO () -> IO (Either e a))+separated :: (Producer ByteString IO () -> IO (Either e a)) -> (Producer ByteString IO () -> IO (Either e b)) -> Producer ByteString IO () -> Producer ByteString IO () -> IO (Either e (a,b)) separated outfunc errfunc outprod errprod = @@ -340,8 +332,7 @@ the 'Siphon' will ignore any leftovers. Passing @unwanted ()@ will abort the computation if leftovers remain. -}-linePolicy :: (Show e, Typeable e)- => DecodingFunction ByteString Text +linePolicy :: DecodingFunction ByteString Text -> Siphon ByteString e () -> LinePolicy e linePolicy decoder lopo = LinePolicy@@ -355,16 +346,14 @@ id -- http://unix.stackexchange.com/questions/114182/can-redirecting-stdout-and-stderr-to-the-same-file-mangle-lines here-combined :: (Show e, Typeable e) - => LinePolicy e +combined :: LinePolicy e -> LinePolicy e -> (Producer T.Text IO () -> IO (Either e a)) -> Producer ByteString IO () -> Producer ByteString IO () -> IO (Either e a) combined (LinePolicy fun1 twk1) (LinePolicy fun2 twk2) combinedConsumer prod1 prod2 = manyCombined [fmap ($prod1) (fun1 twk1), fmap ($prod2) (fun2 twk2)] combinedConsumer where - manyCombined :: (Show e, Typeable e) - => [(FreeT (Producer T.Text IO) IO (Producer ByteString IO ()) -> IO (Producer ByteString IO ())) -> IO (Either e ())]+ manyCombined :: [(FreeT (Producer T.Text IO) IO (Producer ByteString IO ()) -> IO (Producer ByteString IO ())) -> IO (Either e ())] -> (Producer T.Text IO () -> IO (Either e a)) -> IO (Either e a) manyCombined actions consumer = do@@ -412,8 +401,7 @@ determines how to handle leftovers. Pass @pure id@ to ignore leftovers. Pass @unwanted id@ to abort the computation if leftovers remain. -}-encoded :: (Show e, Typeable e) - => DecodingFunction bytes text+encoded :: DecodingFunction bytes text -> Siphon bytes e (a -> b) -> Siphon text e a -> Siphon bytes e b@@ -429,7 +417,7 @@ instance Bifunctor (Pump b) where bimap f g (Pump x) = Pump $ fmap (liftM (bimap f g)) x -instance (Show e, Typeable e) => Applicative (Pump b e) where+instance Applicative (Pump b e) where pure = Pump . pure . pure . pure Pump fs <*> Pump as = Pump $ \consumer -> do@@ -452,7 +440,7 @@ runExceptT $ pure () ) -instance (Show e, Typeable e, Monoid a) => Monoid (Pump b e a) where+instance (Monoid a) => Monoid (Pump b e a) where mempty = Pump . pure . pure . pure $ mempty mappend s1 s2 = (<>) <$> s1 <*> s2 @@ -478,7 +466,7 @@ Unhalting u -> Unhalting $ fmap (liftM (bimap f (bimap g id))) u Halting h -> Halting $ fmap (liftM (bimap f g)) h -instance (Show e, Typeable e) => Applicative (Siphon b e) where+instance Applicative (Siphon b e) where pure = Trivial s1 <*> s2 = case (s1,s2) of@@ -505,20 +493,20 @@ `finally` atomically seal1 `finally` atomically seal2 ) -runSiphon :: (Show e, Typeable e) => Siphon b e a -> Producer b IO () -> IO (Either e a)+runSiphon :: Siphon b e a -> Producer b IO () -> IO (Either e a) runSiphon s = case s of h@(Halting _) -> halting $ Unhalting $ unhalting h _ -> halting s -- This might return a computation that *doesn't* completely drain the -- Producer.-halting :: (Show e, Typeable e) => Siphon b e a -> Producer b IO () -> IO (Either e a)+halting :: Siphon b e a -> Producer b IO () -> IO (Either e a) halting s = case s of a@(Trivial _) -> halting $ Unhalting $ unhalting a Unhalting u -> \producer -> liftM (fmap fst) $ u producer Halting h -> h -unhalting :: (Show e, Typeable e) => Siphon b e a -> Producer b IO r -> IO (Either e (a,r))+unhalting :: Siphon b e a -> Producer b IO r -> IO (Either e (a,r)) unhalting s = case s of Trivial a -> \producer -> do r <- (runEffect $ producer >-> P.drain)@@ -536,7 +524,7 @@ `finally` atomically seal ) -instance (Show e, Typeable e, Monoid a) => Monoid (Siphon b e a) where+instance (Monoid a) => Monoid (Siphon b e a) where mempty = pure mempty mappend s1 s2 = (<>) <$> s1 <*> s2 @@ -623,7 +611,7 @@ processes are not notified and keep going. There is no SIGPIPE-like functionality, in other words. -}-executePipelineFallibly :: (Show e,Typeable e) => PipingPolicy e a -> Tree (Stage e) -> IO (Either e a)+executePipelineFallibly :: PipingPolicy e a -> Tree (Stage e) -> IO (Either e a) executePipelineFallibly policy (Node (Stage cp lpol ecpol _) []) = case policy of PPNone a -> blende ecpol <$> executeFallibly policy cp PPOutput action -> blende ecpol <$> executeFallibly policy cp @@ -831,8 +819,7 @@ data CreatePipeline e = CreatePipeline (Stage e) (NonEmpty (Tree (Stage e))) deriving (Functor) -executePipelineInternal :: (Show e,Typeable e) - => (Siphon ByteString e () -> LinePolicy e -> PipingPolicy e ())+executePipelineInternal :: (Siphon ByteString e () -> LinePolicy e -> PipingPolicy e ()) -> (Pump ByteString e () -> Siphon ByteString e () -> LinePolicy e -> PipingPolicy e ()) -> (Pump ByteString e () -> LinePolicy e -> PipingPolicy e ()) -> (Pump ByteString e () -> LinePolicy e -> PipingPolicy e ())
tests/test.hs view
@@ -20,7 +20,6 @@ import Control.Monad import Control.Monad.Trans.Except import Control.Lens (view)-import Control.Concurrent.Async import Pipes import qualified Pipes.ByteString as B import qualified Pipes.Prelude as P