process-streaming 0.5.0.1 → 0.5.0.2

raw patch · 3 files changed

+22/−10 lines, 3 files

Files

• CHANGELOG +5/−0
• process-streaming.cabal +1/−1
• src/System/Process/Streaming.hs +16/−9

@@ -1,3 +1,8 @@+0.5.0.2
+-------
+
+- A bug slipped by :(
+
 0.5.0.1
 -------
 

@@ -1,5 +1,5 @@ name:          process-streaming
-version:       0.5.0.1
+version:       0.5.0.2
 license:       BSD3
 license-file:  LICENSE
 data-files:    

@@ -231,26 +231,26 @@     Pipe @stdout@.
 -}
 pipeo :: (Show e,Typeable e) => Siphon ByteString e a -> PipingPolicy e a
-pipeo (halting -> siphonout) = PPOutput $ siphonout
+pipeo (runSiphon -> siphonout) = PPOutput $ siphonout
 
 {-|
     Pipe @stderr@.
 -}
 pipee :: (Show e,Typeable e) => Siphon ByteString e a -> PipingPolicy e a
-pipee (halting -> siphonout) = PPError $ siphonout
+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 (halting -> siphonout) (halting -> siphonerr) = 
+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 policy1 policy2 (halting -> siphon) = 
+pipeoec policy1 policy2 (runSiphon -> siphon) = 
     PPOutputError $ uncurry $ combined policy1 policy2 siphon  
 
 {-|
@@ -264,7 +264,7 @@ -}
 pipeio :: (Show e, Typeable e)
         => Pump ByteString e i -> Siphon ByteString e a -> PipingPolicy e (i,a)
-pipeio (Pump feeder) (halting -> siphonout) = PPInputOutput $ \(consumer,cleanup,producer) ->
+pipeio (Pump feeder) (runSiphon -> siphonout) = PPInputOutput $ \(consumer,cleanup,producer) ->
         (conceit (feeder consumer `finally` cleanup) (siphonout producer))
 
 {-|
@@ -272,7 +272,7 @@ -}
 pipeie :: (Show e, Typeable e)
         => Pump ByteString e i -> Siphon ByteString e a -> PipingPolicy e (i,a)
-pipeie (Pump feeder) (halting -> siphonerr) = PPInputError $ \(consumer,cleanup,producer) ->
+pipeie (Pump feeder) (runSiphon -> siphonerr) = PPInputError $ \(consumer,cleanup,producer) ->
         (conceit (feeder consumer `finally` cleanup) (siphonerr producer))
 
 {-|
@@ -280,7 +280,7 @@ -}
 pipeioe :: (Show e, Typeable e)
         => Pump ByteString e i -> Siphon ByteString e a -> Siphon ByteString e b -> PipingPolicy e (i,a,b)
-pipeioe (Pump feeder) (halting -> siphonout) (halting -> siphonerr) = fmap flattenTuple $ PPInputOutputError $
+pipeioe (Pump feeder) (runSiphon -> siphonout) (runSiphon -> siphonerr) = fmap flattenTuple $ PPInputOutputError $
     \(consumer,cleanup,outprod,errprod) -> 
              (conceit (feeder consumer `finally` cleanup) 
                       (separated siphonout siphonerr outprod errprod))
@@ -292,7 +292,7 @@ -}
 pipeioec :: (Show e, Typeable e)
         => Pump ByteString e i -> LinePolicy e -> LinePolicy e -> Siphon Text e a -> PipingPolicy e (i,a)
-pipeioec (Pump feeder) policy1 policy2 (halting -> siphon) = PPInputOutputError $
+pipeioec (Pump feeder) policy1 policy2 (runSiphon -> siphon) = PPInputOutputError $
     \(consumer,cleanup,outprod,errprod) -> 
              (conceit (feeder consumer `finally` cleanup) 
                       (combined policy1 policy2 siphon outprod errprod))
@@ -341,7 +341,7 @@                   . decoder
                   $ producer
         viewLines = getConst . T.lines Const
-    teardown freeLines >>= halting lopo
+    teardown freeLines >>= runSiphon lopo
 
 -- http://unix.stackexchange.com/questions/114182/can-redirecting-stdout-and-stderr-to-the-same-file-mangle-lines here
 combined :: (Show e, Typeable e) 
@@ -546,6 +546,13 @@                              `finally` atomically seal1 `finally` atomically seal2
                             ) 
 
+runSiphon :: (Show e, Typeable e) => 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 s = case s of 
     a@(Trivial _) -> halting $ Unhalting $ unhalting a