concurrent-output 1.0.0 → 1.0.1

raw patch · 4 files changed

+43/−187 lines, 4 filesdep +textdep −MissingHdep ~asyncdep ~bytestringdep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: text

Dependencies removed: MissingH

Dependency ranges changed: async, bytestring, containers, directory, exceptions, process, stm, transformers, unix

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• Control/Concurrent/Output.hs +25/−10
• Utility/FileSystemEncoding.hs +0/−165
• concurrent-output.cabal +11/−12

@@ -1,3 +1,10 @@+concurrent-output (1.0.1) unstable; urgency=medium++  * Generalize what can be output.+  * Dropped dependency on MissingH; added dependency on text.++ -- Joey Hess <id@joeyh.name>  Thu, 29 Oct 2015 00:47:12 -0400+ concurrent-output (1.0.0) unstable; urgency=medium    * First release.

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, TypeSynonymInstances, FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  -- | @@ -20,6 +20,7 @@ module Control.Concurrent.Output ( 	withConcurrentOutput, 	flushConcurrentOutput,+	Outputable(..), 	outputConcurrent, 	createProcessConcurrent, 	waitForProcessConcurrent,@@ -40,13 +41,14 @@ import Data.Maybe import Data.List import Data.Monoid-import qualified Data.ByteString as B import qualified System.Process as P import qualified Data.Set as S+import qualified Data.ByteString as B+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)  import Utility.Monad import Utility.Exception-import Utility.FileSystemEncoding  data OutputHandle = OutputHandle 	{ outputLock :: TMVar Lock@@ -137,27 +139,40 @@ 	-- generating output, and flush any buffered output. 	lockOutput $ return () --- | Displays a string to stdout, and flush output so it's displayed.+-- | Values that can be output.+class Outputable v where+	toOutput :: v -> B.ByteString++instance Outputable B.ByteString where+	toOutput = id++instance Outputable T.Text where+	toOutput = encodeUtf8++instance Outputable String where+	toOutput = toOutput . T.pack++-- | Displays a value to stdout, and flush output so it's displayed. ----- Uses locking to ensure that the whole string is output atomically+-- Uses locking to ensure that the whole output occurs atomically -- even when other threads are concurrently generating output. -- -- When something else is writing to the console at the same time, this does--- not block. It buffers the string, so it will be displayed once the other+-- not block. It buffers the value, so it will be displayed once the other -- writer is done.-outputConcurrent :: String -> IO ()-outputConcurrent s = bracket setup cleanup go+outputConcurrent :: Outputable v => v -> IO ()+outputConcurrent v = bracket setup cleanup go   where 	setup = tryTakeOutputLock 	cleanup False = return () 	cleanup True = dropOutputLock 	go True = do-		putStr s+		B.hPut stdout (toOutput v) 		hFlush stdout 	go False = do 		bv <- outputBuffer <$> getOutputHandle 		oldbuf <- atomically $ takeTMVar bv-		newbuf <- addBuffer (Output (B.pack (decodeW8NUL s))) oldbuf+		newbuf <- addBuffer (Output (toOutput v)) oldbuf 		atomically $ putTMVar bv newbuf  -- | This must be used to wait for processes started with 

@@ -1,165 +0,0 @@-{- GHC File system encoding handling.- -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>- -- - License: BSD-2-clause- -}--{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-tabs #-}--module Utility.FileSystemEncoding (-	fileEncoding,-	withFilePath,-	md5FilePath,-	decodeBS,-	encodeBS,-	decodeW8,-	encodeW8,-	encodeW8NUL,-	decodeW8NUL,-	truncateFilePath,-) where--import qualified GHC.Foreign as GHC-import qualified GHC.IO.Encoding as Encoding-import Foreign.C-import System.IO-import System.IO.Unsafe-import qualified Data.Hash.MD5 as MD5-import Data.Word-import Data.Bits.Utils-import Data.List.Utils-import qualified Data.ByteString.Lazy as L-#ifdef mingw32_HOST_OS-import qualified Data.ByteString.Lazy.UTF8 as L8-#endif--import Utility.Exception--{- Sets a Handle to use the filesystem encoding. This causes data- - written or read from it to be encoded/decoded the same- - as ghc 7.4 does to filenames etc. This special encoding- - allows "arbitrary undecodable bytes to be round-tripped through it".- -}-fileEncoding :: Handle -> IO ()-#ifndef mingw32_HOST_OS-fileEncoding h = hSetEncoding h =<< Encoding.getFileSystemEncoding-#else-{- The file system encoding does not work well on Windows,- - and Windows only has utf FilePaths anyway. -}-fileEncoding h = hSetEncoding h Encoding.utf8-#endif--{- Marshal a Haskell FilePath into a NUL terminated C string using temporary- - storage. The FilePath is encoded using the filesystem encoding,- - reversing the decoding that should have been done when the FilePath- - was obtained. -}-withFilePath :: FilePath -> (CString -> IO a) -> IO a-withFilePath fp f = Encoding.getFileSystemEncoding-	>>= \enc -> GHC.withCString enc fp f--{- Encodes a FilePath into a String, applying the filesystem encoding.- -- - There are very few things it makes sense to do with such an encoded- - string. It's not a legal filename; it should not be displayed.- - So this function is not exported, but instead used by the few functions- - that can usefully consume it.- -- - This use of unsafePerformIO is belived to be safe; GHC's interface- - only allows doing this conversion with CStrings, and the CString buffer- - is allocated, used, and deallocated within the call, with no side- - effects.- -- - If the FilePath contains a value that is not legal in the filesystem- - encoding, rather than thowing an exception, it will be returned as-is.- -}-{-# NOINLINE _encodeFilePath #-}-_encodeFilePath :: FilePath -> String-_encodeFilePath fp = unsafePerformIO $ do-	enc <- Encoding.getFileSystemEncoding-	GHC.withCString enc fp (GHC.peekCString Encoding.char8)-		`catchNonAsync` (\_ -> return fp)--{- Encodes a FilePath into a Md5.Str, applying the filesystem encoding. -}-md5FilePath :: FilePath -> MD5.Str-md5FilePath = MD5.Str . _encodeFilePath--{- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}-decodeBS :: L.ByteString -> FilePath-#ifndef mingw32_HOST_OS-decodeBS = encodeW8NUL . L.unpack-#else-{- On Windows, we assume that the ByteString is utf-8, since Windows- - only uses unicode for filenames. -}-decodeBS = L8.toString-#endif--{- Encodes a FilePath into a ByteString, applying the filesystem encoding. -}-encodeBS :: FilePath -> L.ByteString-#ifndef mingw32_HOST_OS-encodeBS = L.pack . decodeW8NUL-#else-encodeBS = L8.fromString-#endif--{- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.- -- - w82c produces a String, which may contain Chars that are invalid- - unicode. From there, this is really a simple matter of applying the- - file system encoding, only complicated by GHC's interface to doing so.- -- - Note that the encoding stops at any NUL in the input. FilePaths- - do not normally contain embedded NUL, but Haskell Strings may.- -}-{-# NOINLINE encodeW8 #-}-encodeW8 :: [Word8] -> FilePath-encodeW8 w8 = unsafePerformIO $ do-	enc <- Encoding.getFileSystemEncoding-	GHC.withCString Encoding.char8 (w82s w8) $ GHC.peekCString enc--{- Useful when you want the actual number of bytes that will be used to- - represent the FilePath on disk. -}-decodeW8 :: FilePath -> [Word8]-decodeW8 = s2w8 . _encodeFilePath--{- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -}-encodeW8NUL :: [Word8] -> FilePath-encodeW8NUL = join nul . map encodeW8 . split (s2w8 nul)-  where-	nul = ['\NUL']--decodeW8NUL :: FilePath -> [Word8]-decodeW8NUL = join (s2w8 nul) . map decodeW8 . split nul-  where-	nul = ['\NUL']--{- Truncates a FilePath to the given number of bytes (or less),- - as represented on disk.- -- - Avoids returning an invalid part of a unicode byte sequence, at the- - cost of efficiency when running on a large FilePath.- -}-truncateFilePath :: Int -> FilePath -> FilePath-#ifndef mingw32_HOST_OS-truncateFilePath n = go . reverse-  where-	go f =-		let bytes = decodeW8 f-		in if length bytes <= n-			then reverse f-			else go (drop 1 f)-#else-{- On Windows, count the number of bytes used by each utf8 character. -}-truncateFilePath n = reverse . go [] n . L8.fromString-  where-	go coll cnt bs-		| cnt <= 0 = coll-		| otherwise = case L8.decode bs of-			Just (c, x) | c /= L8.replacement_char ->-				let x' = fromIntegral x-				in if cnt - x' < 0-					then coll-					else go (c:coll) (cnt - x') (L8.drop 1 bs)-			_ -> coll-#endif

@@ -1,5 +1,5 @@ Name: concurrent-output-Version: 1.0.0+Version: 1.0.1 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -20,23 +20,22 @@ Library   GHC-Options: -Wall -fno-warn-tabs -O2   Build-Depends: base (>= 4.5), base < 5-    , bytestring (>= 0.10.0), bytestring (< 0.11)-    , async (>= 2.0), async (< 2.1)-    , stm (>= 2.0), stm (< 2.5)-    , process (>= 1.2.0), process (< 1.4.0)-    , unix (>= 2.7.0), unix (< 2.8.0)-    , directory (>= 1.2.0), directory (< 1.3.0)-    , containers (>= 0.5.0), containers (< 0.6.0)-    , transformers (>= 0.3.0), transformers (< 0.5.0)-    , exceptions (>= 0.8.0), exceptions (< 0.9.0)-    , MissingH (>= 1.3.0), MissingH (< 1.4.0)+    , bytestring (>= 0.10.0 && < 0.11)+    , text (>= 1.2.0 && < 1.3.0)+    , async (>= 2.0 && < 2.1)+    , stm (>= 2.0 && < 2.5)+    , process (>= 1.2.0 && < 1.4.0)+    , unix (>= 2.7.0 && < 2.8.0)+    , directory (>= 1.2.0 && < 1.3.0)+    , containers (>= 0.5.0 && < 0.6.0)+    , transformers (>= 0.3.0 && < 0.5.0)+    , exceptions (>= 0.8.0 && < 0.9.0)   Exposed-Modules:     Control.Concurrent.Output   Other-Modules:     Utility.Monad     Utility.Data     Utility.Exception-    Utility.FileSystemEncoding  source-repository head   type: git