concurrent-output 1.7.4 → 1.7.5

raw patch · 5 files changed

+44/−38 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• System/Console/Concurrent/Internal.hs +32/−34
• System/Console/Regions.hs +3/−0
• System/Process/Concurrent.hs +0/−2
• concurrent-output.cabal +2/−2

@@ -1,3 +1,10 @@+concurrent-output (1.7.5) unstable; urgency=medium++  * createProcessConcurrent and System.Process.Concurrent are+    now available on Windows.++ -- Joey Hess <id@joeyh.name>  Sun, 01 May 2016 19:40:38 -0400+ concurrent-output (1.7.4) unstable; urgency=medium    * Update process dep to allow 1.4.

@@ -1,5 +1,7 @@ {-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances, TupleSections #-}-{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -O2 #-}+{- Building this module with -O0 causes streams not to fuse and too much+ - memory to be used. -}  -- |  -- Copyright: 2015 Joey Hess <id@joeyh.name>@@ -12,9 +14,6 @@ module System.Console.Concurrent.Internal where  import System.IO-#ifndef mingw32_HOST_OS-import System.Posix.IO-#endif import System.Directory import System.Exit import Control.Monad@@ -258,7 +257,6 @@ -- as the output lock becomes free. -- -- Currently only available on Unix systems, not Windows.-#ifndef mingw32_HOST_OS createProcessConcurrent :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)  createProcessConcurrent p 	| willOutput (P.std_out p) || willOutput (P.std_err p) =@@ -271,7 +269,6 @@ 		asyncProcessWaiter $ 			void $ tryIO $ P.waitForProcess h 		return (toConcurrentProcessHandle r)-#endif  -- | Wrapper around `System.Process.createProcess` that makes sure a process -- is run in the foreground, with direct access to stdout and stderr.@@ -293,31 +290,33 @@ 		dropOutputLock 	return (toConcurrentProcessHandle r) -#ifndef mingw32_HOST_OS bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle) bgProcess p = do-	(toouth, fromouth) <- pipe-	(toerrh, fromerrh) <- pipe 	let p' = p-		{ P.std_out = rediroutput (P.std_out p) toouth-		, P.std_err = rediroutput (P.std_err p) toerrh+		{ P.std_out = rediroutput (P.std_out p)+		, P.std_err = rediroutput (P.std_err p) 		} 	registerOutputThread-	r@(_, _, _, h) <- P.createProcess p'+	(stdin_h, stdout_h, stderr_h, h) <- P.createProcess p' 		`onException` unregisterOutputThread+	let r =+		( stdin_h+		, mungeret (P.std_out p) stdout_h+		, mungeret (P.std_err p) stderr_h+		, h+		) 	asyncProcessWaiter $ void $ tryIO $ P.waitForProcess h-	outbuf <- setupOutputBuffer StdOut toouth (P.std_out p) fromouth-	errbuf <- setupOutputBuffer StdErr toerrh (P.std_err p) fromerrh+	outbuf <- setupOutputBuffer StdOut stdout_h+	errbuf <- setupOutputBuffer StdErr stderr_h 	void $ async $ bufferWriter [outbuf, errbuf] 	return (toConcurrentProcessHandle r)   where-	pipe = do-		(from, to) <- createPipe-		(,) <$> fdToHandle to <*> fdToHandle from-	rediroutput ss h-		| willOutput ss = P.UseHandle h+	rediroutput ss+		| willOutput ss = P.CreatePipe 		| otherwise = ss-#endif+	mungeret ss mh+		| willOutput ss = Nothing+		| otherwise = mh  willOutput :: P.StdStream -> Bool willOutput P.Inherit = True@@ -350,32 +349,31 @@  data BufSig = BufSig -setupOutputBuffer :: StdHandle -> Handle -> P.StdStream -> Handle -> IO (StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)-setupOutputBuffer h toh ss fromh = do-	hClose toh+setupOutputBuffer :: StdHandle -> Maybe Handle -> IO (StdHandle, MVar OutputBuffer, TMVar BufSig, TMVar AtEnd)+setupOutputBuffer h fromh = do 	buf <- newMVar (OutputBuffer []) 	bufsig <- atomically newEmptyTMVar 	bufend <- atomically newEmptyTMVar-	void $ async $ outputDrainer ss fromh buf bufsig bufend+	void $ async $ outputDrainer fromh buf bufsig bufend 	return (h, buf, bufsig, bufend)  -- Drain output from the handle, and buffer it.-outputDrainer :: P.StdStream -> Handle -> MVar OutputBuffer -> TMVar BufSig -> TMVar AtEnd -> IO ()-outputDrainer ss fromh buf bufsig bufend-	| willOutput ss = go-	| otherwise = atend+outputDrainer :: Maybe Handle -> MVar OutputBuffer -> TMVar BufSig -> TMVar AtEnd -> IO ()+outputDrainer mfromh buf bufsig bufend = case mfromh of+	Nothing -> atend+	Just fromh -> go fromh   where-	go = do+	go fromh = do 		t <- T.hGetChunk fromh 		if T.null t-			then atend+			then do+				atend+				hClose fromh 			else do 				modifyMVar_ buf $ addOutputBuffer (Output t) 				changed-				go-	atend = do-		atomically $ putTMVar bufend AtEnd-		hClose fromh+				go fromh+	atend = atomically $ putTMVar bufend AtEnd 	changed = atomically $ do 		void $ tryTakeTMVar bufsig 		putTMVar bufsig BufSig

@@ -1,5 +1,8 @@ {-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -O2 #-}+{- This module does a lot of calculation that can be expensive, so optimise+ - it well -}  -- |  -- Copyright: 2015 Joey Hess <id@joeyh.name>

@@ -5,8 +5,6 @@ -- The functions exported by this module are intended to be drop-in -- replacements for those from System.Process, when converting a whole -- program to use System.Console.Concurrent.------ Not currently available on Windows.  module System.Process.Concurrent where 

@@ -1,5 +1,5 @@ Name: concurrent-output-Version: 1.7.4+Version: 1.7.5 Cabal-Version: >= 1.8 License: BSD2 Maintainer: Joey Hess <id@joeyh.name>@@ -44,6 +44,7 @@     System.Console.Concurrent     System.Console.Concurrent.Internal     System.Console.Regions+    System.Process.Concurrent   Other-Modules:     Utility.Monad     Utility.Data@@ -51,7 +52,6 @@    if (! os(Windows))     Build-Depends: unix (>= 2.7.0 && < 2.8.0)-    Exposed-Modules: System.Process.Concurrent  source-repository head   type: git