Hello community,
here is the log from the commit of package ghc-process-extras for
openSUSE:Factory checked in at 2017-03-14 10:05:49
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-process-extras (Old)
and /work/SRC/openSUSE:Factory/.ghc-process-extras.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-process-extras"
Tue Mar 14 10:05:49 2017 rev:3 rq:461675 version:0.7.1
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-process-extras/ghc-process-extras.changes
2016-11-24 21:24:18.000000000 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-process-extras.new/ghc-process-extras.changes
2017-03-14 10:05:50.250405216 +0100
@@ -1,0 +2,5 @@
+Sun Feb 12 14:16:54 UTC 2017 - [email protected]
+
+- Update to version 0.7.1 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
process-extras-0.4.1.4.tar.gz
New:
----
process-extras-0.7.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-process-extras.spec ++++++
--- /var/tmp/diff_new_pack.yL0KST/_old 2017-03-14 10:05:50.762332727 +0100
+++ /var/tmp/diff_new_pack.yL0KST/_new 2017-03-14 10:05:50.766332161 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-process-extras
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -17,8 +17,9 @@
%global pkg_name process-extras
+%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.4.1.4
+Version: 0.7.1
Release: 0
Summary: Process extras
License: MIT
@@ -28,12 +29,17 @@
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-ListLike-devel
BuildRequires: ghc-bytestring-devel
+BuildRequires: ghc-data-default-devel
BuildRequires: ghc-deepseq-devel
BuildRequires: ghc-generic-deriving-devel
+BuildRequires: ghc-mtl-devel
BuildRequires: ghc-process-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-text-devel
BuildRoot: %{_tmppath}/%{name}-%{version}-build
+%if %{with tests}
+BuildRequires: ghc-HUnit-devel
+%endif
%description
Extends <http://hackage.haskell.org/package/process>. Read process input and
@@ -61,6 +67,9 @@
%install
%ghc_lib_install
+%check
+%cabal_test
+
%post devel
%ghc_pkg_recache
++++++ process-extras-0.4.1.4.tar.gz -> process-extras-0.7.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/.ghci
new/process-extras-0.7.1/.ghci
--- old/process-extras-0.4.1.4/.ghci 2016-05-15 18:23:39.000000000 +0200
+++ new/process-extras-0.7.1/.ghci 2016-12-05 20:06:55.000000000 +0100
@@ -1,4 +1,7 @@
:set -isrc
+:set -XFlexibleContexts
:set -DMIN_VERSION_deepseq(a,b,c)=1
:set -DMIN_VERSION_bytestring(a,b,c)=1
-:load System.Process.ListLike
+:set -DMIN_VERSION_base(a,b,c)=1
+:load Tests
+
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/.travis.yml
new/process-extras-0.7.1/.travis.yml
--- old/process-extras-0.4.1.4/.travis.yml 2016-05-15 18:23:39.000000000
+0200
+++ new/process-extras-0.7.1/.travis.yml 2016-12-05 20:06:55.000000000
+0100
@@ -13,9 +13,6 @@
matrix:
include:
- - env: CABALVER=1.16 GHCVER=7.4.2
- compiler: ": #GHC 7.4.2"
- addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], sources:
[hvr-ghc]}}
- env: CABALVER=1.16 GHCVER=7.6.3
compiler: ": #GHC 7.6.3"
addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources:
[hvr-ghc]}}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/README.md
new/process-extras-0.7.1/README.md
--- old/process-extras-0.4.1.4/README.md 2016-05-15 18:23:39.000000000
+0200
+++ new/process-extras-0.7.1/README.md 2016-12-05 20:06:55.000000000 +0100
@@ -1,10 +1,14 @@
-# About
+# What is process-extras
-Extra functionality for the [Process
library](http://hackage.haskell.org/package/process).
-
- * Read process input and output as ByteStrings or Text, or write your own
ProcessOutput instance.
- * Lazy process input and output (i.e. read output from processes that run
forever.)
- * ProcessMaker class for more flexibility in the process creation API.
+You might want to use this package if
+ * You want to read and write ByteStrings or Text to a process rather
+ than just Strings
+ * You want to read output from a non-terminating process (e.g. yes(1))
+ * You want more flexibility in process creation
+ * You want various types of progress output from the process to the
+ console before capturing its output - indented and prefixed output,
+ reporting of the command that started the process, dots to reflect
+ the size of the process output, etc.
# Contributing
@@ -21,13 +25,13 @@
function:
> :m +System.Process.ListLike Data.ByteString Data.Text.Lazy
- > readCreateProcessWithExitCode (shell "echo 'λ'") mempty :: IO (ExitCode,
ByteString, ByteString)
+ > readCreateProcess (shell "echo 'λ'") mempty :: IO (ExitCode, ByteString,
ByteString)
(ExitSuccess,"\206\187\n","")
- > readCreateProcessWithExitCode (shell "echo 'λ'") mempty :: IO (ExitCode,
Text, Text)
+ > readCreateProcess (shell "echo 'λ'") mempty :: IO (ExitCode, Text, Text)
(ExitSuccess,"\955\n","")
- > readCreateProcessWithExitCode (shell "echo 'λ'") mempty :: IO (ExitCode,
String, String)
+ > readCreateProcess (shell "echo 'λ'") mempty :: IO (ExitCode, String,
String)
(ExitSuccess,"\955\n","")
- > System.Process.Text.readCreateProcessWithExitCode (shell "yes | head
-10") mempty
+ > readCreateProcess (shell "yes | head -10") mempty :: IO (ExitCode, Text,
Text)
(ExitSuccess,"y\ny\ny\ny\ny\ny\ny\ny\ny\ny\n","")
Although the output *type* can be lazy, normal process functions still
@@ -46,7 +50,7 @@
provided. [Chunk a] can be converted to any other instance of
ProcessOutput using collectOutput
- > (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk
ByteString]) >>= mapM_ (putStrLn . show)
+ > (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk
ByteString]) >>= mapM_ (Prelude.putStrLn . show)
Stdout
"\US\139\b\NUL\237\136\&7W\NUL\ETX345\183\&403\215\&31Q04267\177\&0\177\212\&33\225\STX\NUL_\169\142\178\ETB\NUL\NUL\NUL"
Stderr "gzip: stdin: file size changed while zipping\n -8.7%\n"
Result ExitSuccess
@@ -56,7 +60,7 @@
(ExitSuccess,"\US\139\b\NUL\185\137\&7W\NUL\ETX345\183\&427\212\&33W0426731\177\208\&35\225\STX\NUL\237\192\CAN\224\ETB\NUL\NUL\NUL","gzip:
stdin: file size changed while zipping\n -8.7%\n")
> collectOutput <$> (readCreateProcess (shell "gzip -v < /proc/uptime")
mempty :: IO [Chunk ByteString]) :: IO (ExitCode, ByteString, ByteString)
(ExitSuccess,"\US\139\b\NUL\185\137\&7W\NUL\ETX345\183\&427\212\&33W0426731\177\208\&35\225\STX\NUL\237\192\CAN\224\ETB\NUL\NUL\NUL","gzip:
stdin: file size changed while zipping\n -8.7%\n")
- > (collectOutput . filter (\x -> case x of Stderr _ -> False; _ -> True))
<$> (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO [Chunk
ByteString]) :: IO (ExitCode, ByteString, ByteString)
+ > (collectOutput . Prelude.filter (\x -> case x of Stderr _ -> False; _ ->
True)) <$> (readCreateProcess (shell "gzip -v < /proc/uptime") mempty :: IO
[Chunk ByteString]) :: IO (ExitCode, ByteString, ByteString)
(ExitSuccess,"\US\139\b\NUL<\138\&7W\NUL\ETX345\183\&410\210\&3\176P04267713\213\&37\224\STX\NULT\142\EOT\165\ETB\NUL\NUL\NUL","")
Some cases that need investigation:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/Tests.hs
new/process-extras-0.7.1/Tests.hs
--- old/process-extras-0.4.1.4/Tests.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/process-extras-0.7.1/Tests.hs 2016-12-05 20:06:55.000000000 +0100
@@ -0,0 +1,69 @@
+{-# LANGUAGE CPP, FlexibleInstances #-}
+
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative ((<$>))
+#endif
+import System.Exit (ExitCode(..), exitWith)
+import System.Process.Run
+import System.Process.ByteString ()
+import System.Process.ByteString.Lazy ()
+import System.Process.Text ()
+import System.Process.Text.Lazy ()
+import Test.HUnit
+
+main :: IO ()
+main = runTestTT (TestList [test0]) >>= \cts ->
+ exitWith $ if errors cts + failures cts > 0
+ then ExitFailure 1
+ else ExitSuccess
+
+instance Eq (Chunk String) where
+ (Stdout a) == (Stdout b) = a == b
+ (Stderr a) == (Stderr b) = a == b
+ (Result a) == (Result b) = a == b
+ _ == _ = False
+
+-- Every fourth run these will say:
+-- *System.Process.Run> _test4
+-- -> ls
+-- <interactive>: fd:12: hGetBuffering: illegal operation (handle is closed)
+-- <interactive>: fd:14: hGetBuffering: illegal operation (handle is closed)
+-- *** Exception: thread blocked indefinitely in an MVar operation
+
+-- Oldest file in /usr/share/doc
+file :: FilePath
+file = "/usr/share/doc/cron/THANKS"
+dir :: FilePath
+dir = "/usr/share/doc/cron"
+
+cmd :: CreateProcess
+cmd = shell "echo a; echo b 1>&2; echo -n c"
+
+omitProcessHandle :: [Chunk a] -> [Chunk a]
+omitProcessHandle [] = []
+omitProcessHandle (ProcessHandle _ : more) = omitProcessHandle more
+omitProcessHandle (x : xs) = x : omitProcessHandle xs
+
+test0 :: Test
+test0 = TestCase $ do
+ let expected = (ExitSuccess, "a\nc", "b\n") :: (ExitCode, String,
String)
+ actual <- collectOutput <$> runT (output >> run cmd "")
+ assertEqual "test1" expected actual
+
+-- | What we want to test with these is what gets written to the console,
+-- and I haven't yet invested the thought required to do that. Divert the
+-- console output somehow I guess...
+_test1 :: IO [Chunk String]
+_test1 = runT (output >> run (proc "ls" []) "")
+_test2 :: IO [Chunk String]
+_test2 = runT (vlevel 0 >> run (proc "ls" []) "")
+_test2a :: IO (ExitCode, String, String)
+_test2a = runT (silent >> run (proc "ls" []) "")
+_test3 :: IO [Chunk String]
+_test3 = runT (dots 10 >> run (proc "ls" []) "")
+_test4 :: IO [Chunk String]
+_test4 = runT (lazy >> indent (const "1> ") (const "2> ") >> run (proc "ls"
[]) "")
+_test5 :: IO [Chunk String]
+_test5 = runT (echoStart >> echoEnd >> run (proc "ls" []) "")
+_test6 :: IO [Chunk String]
+_test6 = (runT (silent >> echoStart >> echoEnd >> run (proc "yes" []) "") ::
IO [Chunk String]) >>= return . take 2
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/changelog
new/process-extras-0.7.1/changelog
--- old/process-extras-0.4.1.4/changelog 2016-05-15 18:23:39.000000000
+0200
+++ new/process-extras-0.7.1/changelog 2016-12-05 20:06:55.000000000 +0100
@@ -1,3 +1,22 @@
+haskell-process-extras (0.7.1) unstable; urgency=low
+
+ * Add System.Process.Run, utilities and a monad for process progress
+ output.
+ * Rename ProcessOutput -> ProcessResult
+ * Add a ProcessText class to characterize the type written to
+ standard input and read from standard output and error.
+ * Add an alias for readCreateProcess named readCreateProcessStrict
+ * Update README.md
+
+ -- David Fox <[email protected]> Mon, 05 Dec 2016 10:52:20 -0800
+
+haskell-process-extras (0.5) unstable; urgency=low
+
+ * Have writeOutput return the input list rather than ()
+ * Additional re-exports from the process package
+
+ -- David Fox <[email protected]> Mon, 21 Nov 2016 12:45:57 -0800
+
haskell-process-extras (0.4.1.4) unstable; urgency=low
* Add changelog and .ghci to Extra-Source-Files list.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/process-extras.cabal
new/process-extras-0.7.1/process-extras.cabal
--- old/process-extras-0.4.1.4/process-extras.cabal 2016-05-15
18:23:39.000000000 +0200
+++ new/process-extras-0.7.1/process-extras.cabal 2016-12-05
20:06:55.000000000 +0100
@@ -1,5 +1,5 @@
Name: process-extras
-Version: 0.4.1.4
+Version: 0.7.1
Synopsis: Process extras
Description: Extends <http://hackage.haskell.org/package/process>.
Read process input and output as ByteStrings or
@@ -13,7 +13,7 @@
Maintainer: David Fox <[email protected]>
Category: System
Build-type: Simple
-Cabal-version: >=1.6
+Cabal-version: >=1.10
Extra-source-files:
README.md, .travis.yml, .ghci, changelog
Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3,
GHC >= 8
@@ -23,6 +23,7 @@
Location: https://github.com/seereason/process-extras
Library
+ Default-Language: Haskell2010
ghc-options: -Wall
Hs-source-dirs: src
@@ -30,19 +31,31 @@
Exposed-modules:
System.Process.ByteString
System.Process.ByteString.Lazy
+ System.Process.Chars
System.Process.Common
System.Process.ListLike
+ System.Process.Run
System.Process.Text
System.Process.Text.Lazy
+ System.Process.Text.Builder
Other-modules:
Utils
Build-depends:
base >= 4.5 && < 5,
- ListLike >= 4,
+ data-default,
+ ListLike >= 4.4,
+ mtl,
process,
bytestring,
text,
deepseq >= 1.1,
generic-deriving >= 1.10
+
+Test-Suite process-extras-tests
+ Default-Language: Haskell2010
+ type: exitcode-stdio-1.0
+ Hs-Source-Dirs: .
+ Main-Is: Tests.hs
+ Build-Depends: base, HUnit, process-extras
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/process-extras-0.4.1.4/src/System/Process/ByteString/Lazy.hs
new/process-extras-0.7.1/src/System/Process/ByteString/Lazy.hs
--- old/process-extras-0.4.1.4/src/System/Process/ByteString/Lazy.hs
2016-05-15 18:23:39.000000000 +0200
+++ new/process-extras-0.7.1/src/System/Process/ByteString/Lazy.hs
2016-12-05 20:06:55.000000000 +0100
@@ -21,6 +21,8 @@
instance NFData ByteString
#endif
+instance ProcessText ByteString Word8
+
-- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'
instance ListLikeProcessIO ByteString Word8 where
forceOutput = C.evaluate . force
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/process-extras-0.4.1.4/src/System/Process/ByteString.hs
new/process-extras-0.7.1/src/System/Process/ByteString.hs
--- old/process-extras-0.4.1.4/src/System/Process/ByteString.hs 2016-05-15
18:23:39.000000000 +0200
+++ new/process-extras-0.7.1/src/System/Process/ByteString.hs 2016-12-05
20:06:55.000000000 +0100
@@ -20,6 +20,8 @@
instance NFData ByteString
#endif
+instance ProcessText ByteString Word8
+
-- | Like 'System.Process.readProcessWithExitCode', but using 'ByteString'
instance ListLikeProcessIO ByteString Word8 where
forceOutput = return
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/src/System/Process/Chars.hs
new/process-extras-0.7.1/src/System/Process/Chars.hs
--- old/process-extras-0.4.1.4/src/System/Process/Chars.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/process-extras-0.7.1/src/System/Process/Chars.hs 2016-12-05
20:06:55.000000000 +0100
@@ -0,0 +1,35 @@
+{-# LANGUAGE CPP, MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module System.Process.Chars where
+
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative ((<$>))
+#endif
+import Control.DeepSeq (force)
+import qualified Control.Exception as C (evaluate)
+import Data.ListLike.IO (hGetContents)
+import Data.Text.Lazy (fromStrict, toChunks)
+import Data.ListLike.Chars (Chars(..))
+import Prelude hiding (null)
+import System.Process
+import System.Process.Common
+import System.Exit (ExitCode)
+
+-- | Like 'System.Process.readProcessWithExitCode', but specialized for 'Text'
+instance ListLikeProcessIO Chars Char where
+ forceOutput = C.evaluate . force
+ readChunks h = (map (T . fromStrict) . toChunks) <$> hGetContents h
+
+-- | Specialized version for backwards compatibility.
+readProcessWithExitCode
+ :: FilePath -- ^ command to run
+ -> [String] -- ^ any arguments
+ -> Chars -- ^ standard input
+ -> IO (ExitCode, Chars, Chars) -- ^ exitcode, stdout, stderr
+readProcessWithExitCode = System.Process.Common.readProcessWithExitCode
+
+readCreateProcessWithExitCode
+ :: CreateProcess -- ^ command and arguments to run
+ -> Chars -- ^ standard input
+ -> IO (ExitCode, Chars, Chars) -- ^ exitcode, stdout, stderr
+readCreateProcessWithExitCode =
System.Process.Common.readCreateProcessWithExitCode
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/src/System/Process/Common.hs
new/process-extras-0.7.1/src/System/Process/Common.hs
--- old/process-extras-0.4.1.4/src/System/Process/Common.hs 2016-05-15
18:23:39.000000000 +0200
+++ new/process-extras-0.7.1/src/System/Process/Common.hs 2016-12-05
20:06:55.000000000 +0100
@@ -7,29 +7,32 @@
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module System.Process.Common
- ( ProcessMaker(process)
+ ( ProcessMaker(process, showProcessMakerForUser)
, ListLikeProcessIO(forceOutput, readChunks)
- , ProcessOutput(pidf, outf, errf, intf, codef)
+ , ProcessText
+ , ProcessResult(pidf, outf, errf, intf, codef)
, readProcessWithExitCode
, readCreateProcessWithExitCode
- , readCreateProcess
+ , readCreateProcessStrict
, readCreateProcessLazy
+ , showCmdSpecForUser
+ , showCreateProcessForUser
) where
import Control.Concurrent
-import Control.DeepSeq (NFData)
-import Control.Exception as E (SomeException, onException, catch, mask, throw,
try)
+import Control.Exception as E (SomeException, onException, catch, mask, throw)
import Control.Monad
-import Data.ListLike as ListLike (null)
+import Data.ListLike as ListLike (ListLike, null)
import Data.ListLike.IO (ListLikeIO, hGetContents, hPutStr)
import Data.Monoid ((<>))
+import Data.String (IsString)
import Generics.Deriving.Instances ()
import GHC.IO.Exception (IOErrorType(ResourceVanished), IOException(ioe_type))
import Prelude hiding (null)
import System.Exit (ExitCode(..))
import System.IO (Handle, hClose, hFlush, BufferMode, hSetBuffering)
import System.IO.Unsafe (unsafeInterleaveIO)
-import System.Process (CreateProcess(std_err, std_in, std_out),
StdStream(CreatePipe), ProcessHandle, createProcess, proc, waitForProcess,
terminateProcess)
+import System.Process (CmdSpec(..), CreateProcess(cmdspec, cwd, std_err,
std_in, std_out), StdStream(CreatePipe), ProcessHandle, createProcess, proc,
showCommandForUser, waitForProcess, terminateProcess)
import Utils (forkWait)
#if __GLASGOW_HASKELL__ <= 709
@@ -38,20 +41,23 @@
#endif
#if !MIN_VERSION_deepseq(1,4,2)
+import Control.DeepSeq (NFData)
-- | This instance lets us use DeepSeq's force function on a stream of Chunks.
instance NFData ExitCode
#endif
class ProcessMaker a where
process :: a -> IO (Handle, Handle, Handle, ProcessHandle)
+ showProcessMakerForUser :: a -> String
--- | This is the usual maker argument to 'readCreateProcess'.
+-- | This is the usual maker argument to 'readCreateProcessLazy'.
instance ProcessMaker CreateProcess where
process p = do
(Just inh, Just outh, Just errh, pid) <- createProcess p { std_in =
CreatePipe, std_out = CreatePipe, std_err = CreatePipe }
return (inh, outh, errh, pid)
+ showProcessMakerForUser = showCreateProcessForUser
--- | Passing this to 'readCreateProcess' as the maker argument allows
+-- | Passing this to 'readCreateProcessLazy' as the maker argument allows
-- you to set the buffer mode of the process stdout and stderr handles
-- just after the handles are created. These are set to
-- BlockBuffering by default, but for running console commands
@@ -62,15 +68,19 @@
hSetBuffering outh outmode
hSetBuffering errh errmode
return (inh, outh, errh, pid)
+ showProcessMakerForUser (p, outmode, errmode) =
+ showCreateProcessForUser p ++ " outmode=" ++ show outmode ++ ",
errmode=" ++ show errmode
+
+class (IsString text, Monoid text, ListLike text char) => ProcessText text char
-class Monoid b => ProcessOutput a b | b -> a where
- pidf :: ProcessHandle -> b
- outf :: a -> b
- errf :: a -> b
- intf :: SomeException -> b
- codef :: ExitCode -> b
+class Monoid result => ProcessResult text result | result -> text where
+ pidf :: ProcessHandle -> result
+ outf :: text -> result
+ errf :: text -> result
+ intf :: SomeException -> result
+ codef :: ExitCode -> result
-instance ListLikeProcessIO a c => ProcessOutput a (ExitCode, a, a) where
+instance ListLikeProcessIO text char => ProcessResult text (ExitCode, text,
text) where
pidf _ = mempty
codef c = (c, mempty, mempty)
outf x = (mempty, x, mempty)
@@ -84,29 +94,37 @@
mappend x (ExitFailure 0) = x
mappend _ x = x
-class ListLikeIO a c => ListLikeProcessIO a c where
- forceOutput :: a -> IO a
- readChunks :: Handle -> IO [a]
+-- | Process IO is based on the 'ListLikeIO' class from the ListLike
+-- package
+class ListLikeIO text char => ListLikeProcessIO text char where
+ forceOutput :: text -> IO text
+ readChunks :: Handle -> IO [text]
-- ^ Read from a handle, returning a lazy list of the monoid a.
--- | Like 'System.Process.readProcessWithExitCode', but with generalized input
and output type.
+-- | Like 'System.Process.readProcessWithExitCode', but with
+-- generalized input and output type. Aside from the usual text-like
+-- types, the output can be a list of Chunk a. This lets you process
+-- the chunks received from stdout and stderr lazil, in the order they
+-- are received, as well as the exit code. Utilities to handle Chunks
+-- are provided in System.Process.ListLike.
readProcessWithExitCode
- :: ListLikeProcessIO a c =>
+ :: ListLikeProcessIO text char =>
FilePath -- ^ command to run
-> [String] -- ^ any arguments
- -> a -- ^ standard input
- -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr
+ -> text -- ^ standard input
+ -> IO (ExitCode, text, text) -- ^ exitcode, stdout, stderr
readProcessWithExitCode cmd args input = readCreateProcessWithExitCode (proc
cmd args) input
readCreateProcessWithExitCode
- :: (ProcessMaker maker, ListLikeProcessIO a c) =>
- maker -- ^ command and arguments to run
- -> a -- ^ standard input
- -> IO (ExitCode, a, a) -- ^ exitcode, stdout, stderr
-readCreateProcessWithExitCode = readCreateProcess
-
-readCreateProcess :: (ProcessMaker maker, ProcessOutput a b, ListLikeProcessIO
a c) => maker -> a -> IO b
-readCreateProcess maker input = mask $ \restore -> do
+ :: (ProcessMaker maker, ListLikeProcessIO text char) =>
+ maker -- ^ command and arguments to run
+ -> text -- ^ standard input
+ -> IO (ExitCode, text, text) -- ^ exitcode, stdout, stderr
+readCreateProcessWithExitCode = readCreateProcessStrict
+
+readCreateProcessStrict :: (ProcessMaker maker, ProcessResult text result,
ListLikeProcessIO text char) =>
+ maker -> text -> IO result
+readCreateProcessStrict maker input = mask $ \restore -> do
(inh, outh, errh, pid) <- process maker
flip onException
(do terminateProcess pid; hClose inh; hClose outh; hClose errh;
@@ -133,8 +151,8 @@
return $ out <> err <> ex
--- | Like readCreateProcess, but the output is read lazily.
-readCreateProcessLazy :: (ProcessMaker maker, ProcessOutput a b,
ListLikeProcessIO a c) => maker -> a -> IO b
+-- | Like readCreateProcessStrict, but the output is read lazily.
+readCreateProcessLazy :: (ProcessMaker maker, ProcessResult a b,
ListLikeProcessIO a c) => maker -> a -> IO b
readCreateProcessLazy maker input = mask $ \restore -> do
(inh, outh, errh, pid) <- process maker
onException
@@ -150,11 +168,11 @@
waitForProcess pid)
-- | Helper function for readCreateProcessLazy.
-readInterleaved :: (ListLikeProcessIO a c, ProcessOutput a b) =>
+readInterleaved :: (ListLikeProcessIO a c, ProcessResult a b) =>
[(a -> b, Handle)] -> IO b -> IO b
readInterleaved pairs finish = newEmptyMVar >>= readInterleaved' pairs finish
-readInterleaved' :: forall a b c. (ListLikeProcessIO a c, ProcessOutput a b) =>
+readInterleaved' :: forall a b c. (ListLikeProcessIO a c, ProcessResult a b) =>
[(a -> b, Handle)] -> IO b -> MVar (Either Handle b) -> IO
b
readInterleaved' pairs finish res = do
mapM_ (forkIO . uncurry readHandle) pairs
@@ -200,3 +218,12 @@
ignoreResourceVanished :: IO () -> IO ()
ignoreResourceVanished action =
action `E.catch` (\e -> if ioe_type e == ResourceVanished then return ()
else ioError e)
+
+-- | System.Process utility functions.
+showCreateProcessForUser :: CreateProcess -> String
+showCreateProcessForUser p =
+ showCmdSpecForUser (cmdspec p) ++ maybe "" (\ d -> " (in " ++ d ++ ")")
(cwd p)
+
+showCmdSpecForUser :: CmdSpec -> String
+showCmdSpecForUser (ShellCommand s) = s
+showCmdSpecForUser (RawCommand p args) = showCommandForUser p args
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/process-extras-0.4.1.4/src/System/Process/ListLike.hs
new/process-extras-0.7.1/src/System/Process/ListLike.hs
--- old/process-extras-0.4.1.4/src/System/Process/ListLike.hs 2016-05-15
18:23:39.000000000 +0200
+++ new/process-extras-0.7.1/src/System/Process/ListLike.hs 2016-12-05
20:06:55.000000000 +0100
@@ -8,27 +8,44 @@
{-# LANGUAGE CPP, FlexibleInstances, FunctionalDependencies,
MultiParamTypeClasses, UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
module System.Process.ListLike
- ( ProcessMaker(process)
- , ListLikeProcessIO(forceOutput)
- , ProcessOutput(pidf, outf, errf, codef, intf)
+ (
+ -- * Classes for process IO monad, output type, and creation type
+ ListLikeProcessIO(forceOutput)
+ , ProcessText
+ , ProcessResult(pidf, outf, errf, codef, intf)
+ , ProcessMaker(process, showProcessMakerForUser)
+
+ -- * The generalized process runners
, readCreateProcess
+ , readCreateProcessStrict
, readCreateProcessLazy
, readCreateProcessWithExitCode
, readProcessWithExitCode
+
+ -- * Utility functions based on showCommandForUser
+ , showCreateProcessForUser
+ , showCmdSpecForUser
+
+ -- * The Chunk type
, Chunk(..)
, collectOutput
, foldOutput
, writeOutput
- , showCreateProcessForUser
- , showCmdSpecForUser
+ , writeChunk
+
+ -- * Re-exports from process
+ , CmdSpec(..)
+ , CreateProcess(..)
, proc
, shell
+ , showCommandForUser
) where
import Control.DeepSeq (force)
import Control.Exception as C (evaluate, SomeException, throw)
import Data.ListLike.IO (hGetContents, hPutStr, ListLikeIO)
#if __GLASGOW_HASKELL__ <= 709
+import Control.Applicative ((<$>), (<*>))
import Data.Monoid (mempty, mconcat)
#endif
import Data.Text (unpack)
@@ -38,19 +55,18 @@
import System.Process (CmdSpec(..), CreateProcess(..), proc, ProcessHandle,
shell, showCommandForUser)
import System.Process.ByteString ()
import System.Process.ByteString.Lazy ()
-import System.Process.Common (ProcessMaker(process),
ListLikeProcessIO(forceOutput, readChunks), ProcessOutput(pidf, outf, errf,
codef, intf),
- readCreateProcess, readCreateProcessLazy,
readCreateProcessWithExitCode, readProcessWithExitCode)
+import System.Process.Common
+ (ProcessMaker(process, showProcessMakerForUser),
ListLikeProcessIO(forceOutput, readChunks),
+ ProcessText, ProcessResult(pidf, outf, errf, codef, intf),
readCreateProcessStrict, readCreateProcessLazy,
+ readCreateProcessWithExitCode, readProcessWithExitCode,
showCmdSpecForUser, showCreateProcessForUser)
import System.Process.Text ()
+import System.Process.Text.Builder ()
import System.Process.Text.Lazy ()
--- | System.Process utility functions.
-showCreateProcessForUser :: CreateProcess -> String
-showCreateProcessForUser p =
- showCmdSpecForUser (cmdspec p) ++ maybe "" (\ d -> " (in " ++ d ++ ")")
(cwd p)
-
-showCmdSpecForUser :: CmdSpec -> String
-showCmdSpecForUser (ShellCommand s) = s
-showCmdSpecForUser (RawCommand p args) = showCommandForUser p args
+instance ProcessText String Char
+
+readCreateProcess :: (ProcessMaker maker, ProcessResult text result,
ListLikeProcessIO text char) => maker -> text -> IO result
+readCreateProcess = readCreateProcessLazy
-- | Like 'System.Process.readProcessWithExitCode' that takes a
'CreateProcess'.
instance ListLikeProcessIO String Char where
@@ -80,25 +96,25 @@
instance Show ProcessHandle where
show _ = "<process>"
-instance ListLikeProcessIO a c => ProcessOutput a [Chunk a] where
+instance ListLikeProcessIO a c => ProcessResult a [Chunk a] where
pidf p = [ProcessHandle p]
outf x = [Stdout x]
errf x = [Stderr x]
intf e = throw e
codef c = [Result c]
-instance ListLikeProcessIO a c => ProcessOutput a (ExitCode, [Chunk a]) where
+instance ListLikeProcessIO a c => ProcessResult a (ExitCode, [Chunk a]) where
pidf p = (mempty, [ProcessHandle p])
codef c = (c, mempty)
outf x = (mempty, [Stdout x])
errf x = (mempty, [Stderr x])
intf e = throw e
-foldOutput :: (ProcessHandle -> r)
- -> (a -> r)
- -> (a -> r)
- -> (SomeException -> r)
- -> (ExitCode -> r)
+foldOutput :: (ProcessHandle -> r) -- ^ called when the process handle becomes
known
+ -> (a -> r) -- ^ stdout handler
+ -> (a -> r) -- ^ stderr handler
+ -> (SomeException -> r) -- ^ exception handler
+ -> (ExitCode -> r) -- ^ exit code handler
-> Chunk a
-> r
foldOutput p _ _ _ _ (ProcessHandle x) = p x
@@ -107,16 +123,23 @@
foldOutput _ _ _ i _ (Exception x) = i x
foldOutput _ _ _ _ r (Result x) = r x
--- | Turn a @[Chunk a]@ into any other instance of 'ProcessOutput'.
-collectOutput :: ProcessOutput a b => [Chunk a] -> b
+-- | Turn a @[Chunk a]@ into any other instance of 'ProcessOutput'. I
+-- usually use this after processing the chunk list to turn it into
+-- the (ExitCode, String, String) type returned by readProcessWithExitCode.
+collectOutput :: ProcessResult a b => [Chunk a] -> b
collectOutput xs = mconcat $ map (foldOutput pidf outf errf intf codef) xs
-- | Send Stdout chunks to stdout and Stderr chunks to stderr.
-writeOutput :: ListLikeIO a c => [Chunk a] -> IO ()
-writeOutput [] = return ()
-writeOutput (x : xs) =
- foldOutput (\_ -> return ())
- (hPutStr stdout)
- (hPutStr stderr)
- (\_ -> return ())
- (\_ -> return ()) x >> writeOutput xs
+-- Returns input list unmodified.
+writeOutput :: ListLikeIO a c => [Chunk a] -> IO [Chunk a]
+writeOutput [] = return []
+writeOutput (x : xs) = (:) <$> writeChunk x <*> writeOutput xs
+
+
+writeChunk :: ListLikeIO a c => Chunk a -> IO (Chunk a)
+writeChunk x =
+ foldOutput (\_ -> return x)
+ (\s -> hPutStr stdout s >> return x)
+ (\s -> hPutStr stderr s >> return x)
+ (\_ -> return x)
+ (\_ -> return x) x
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/src/System/Process/Run.hs
new/process-extras-0.7.1/src/System/Process/Run.hs
--- old/process-extras-0.4.1.4/src/System/Process/Run.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/process-extras-0.7.1/src/System/Process/Run.hs 2016-12-05
20:06:55.000000000 +0100
@@ -0,0 +1,304 @@
+-- | Flexible control of progress reporting for readCreateProcess and friends.
+
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module System.Process.Run
+ (
+ -- * Monad transformer
+ RunT
+ , runT
+ , RunState(..)
+ , OutputStyle(..)
+ -- * Monad class
+ , RunM
+ -- * Modify moand RunM state parameters
+ , echoStart
+ , echoEnd
+ , output
+ , silent
+ , dots
+ , indent
+ , vlevel
+ , quieter
+ , noisier
+ , lazy
+ , strict
+ , message
+ -- * Monadic process runner
+ , run
+ -- * Re-exports
+ , module System.Process.ListLike
+ ) where
+
+#if __GLASGOW_HASKELL__ <= 709
+import Data.Monoid (Monoid, mempty)
+#endif
+import Control.Monad (when)
+import Control.Monad.State (evalState, evalStateT, get, modify, MonadState,
put, StateT)
+import Control.Monad.Trans (MonadIO, lift, liftIO)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import Data.Char (ord)
+import Data.Default (Default(def))
+import Data.ListLike as ListLike
+ (break, fromList, head, hPutStr, length, ListLike, null, putStr,
singleton, tail)
+import Data.Monoid ((<>))
+import Data.String (IsString, fromString)
+import Data.Text (Text)
+import Data.Word (Word8)
+import qualified Data.Text.Lazy as Lazy (Text)
+import System.IO (hPutStr, hPutStrLn, stderr)
+import System.Process.ListLike
+
+-- | This is the state record that controls the output style.
+data RunState text
+ = RunState
+ { _output :: OutputStyle -- ^ Overall style of output
+ , _outprefix :: text -- ^ Prefix for lines of stdout
+ , _errprefix :: text -- ^ Prefix for lines of stderr
+ , _echoStart :: Bool -- ^ Echo command as process starts
+ , _echoEnd :: Bool -- ^ Echo command as process finishes
+ , _verbosity :: Int -- ^ A progression of progress modes
+ , _lazy :: Bool -- ^ Use the lazy or strict runner?
+ , _message :: text -- ^ Extra text for start/end message - e.g.
the change root
+ }
+
+type RunT text m = StateT (RunState text) m
+
+class (MonadState (RunState text) m,
+ ProcessText text char,
+ ListLikeProcessIO text char,
+ MonadIO m, IsString text, Eq char, Dot char) =>
+ RunM text char m
+
+instance Dot Word8 where
+ dot = fromIntegral (ord '.')
+
+instance (MonadIO m, MonadState (RunState String) m) => RunM String Char m
+instance (MonadIO m, MonadState (RunState Text) m) => RunM Text Char m
+instance (MonadIO m, MonadState (RunState Lazy.Text) m) => RunM Lazy.Text Char
m
+instance (MonadIO m, MonadState (RunState ByteString) m) => RunM ByteString
Word8 m
+instance (MonadIO m, MonadState (RunState Lazy.ByteString) m) => RunM
Lazy.ByteString Word8 m
+
+runT :: forall m text char a. (MonadIO m, ProcessText text char) => RunT text
m a -> m a
+runT action = evalStateT action (def :: RunState text)
+
+data OutputStyle
+ = Dots Int -- ^ Output one dot per n output characters
+ | All -- ^ send process stdout to console stdout and process stderr
to console stderr
+ | Indented -- ^ Output with prefixes
+ | Silent -- ^ No output
+
+instance ProcessText text char => Default (RunState text) where
+ def = RunState { _outprefix = fromString "1> "
+ , _errprefix = fromString "2> "
+ , _output = All
+ , _echoStart = True
+ , _echoEnd = True
+ , _verbosity = 3
+ , _lazy = False
+ , _message = mempty }
+
+{-
+class (Monoid text, MonadIO m) => MonadRun m text where
+ type Text m
+ getRunState :: m (RunState text)
+ putRunState :: RunState text -> m ()
+
+instance Monoid text => MonadRun IO text where
+ getRunState = return def
+ putRunState _ = return ()
+
+instance (MonadIO m, Monoid t, MonadState (RunState t) m) => MonadRun m t where
+ getRunState = get
+ putRunState = put
+-}
+
+noEcho :: (MonadState (RunState t) m) => m ()
+noEcho = modify (\x -> x { _echoStart = False, _echoEnd = False })
+
+echoStart :: (MonadState (RunState t) m) => m ()
+echoStart = modify (\x -> x { _echoStart = True })
+
+echoEnd :: (MonadState (RunState t) m) => m ()
+echoEnd = modify (\x -> x { _echoEnd = True })
+
+output :: (MonadState (RunState t) m) => m ()
+output = modify (\x -> x { _output = All })
+
+silent :: (MonadState (RunState t) m) => m ()
+silent = modify (\x -> x { _output = Silent })
+
+dots :: (MonadState (RunState t) m) => Int -> m ()
+dots n = modify (\x -> x { _output = Dots n })
+
+-- | Modify the indentation prefixes for stdout and stderr in the
+-- progress monad.
+indent :: (MonadState (RunState t) m, ListLike t char) => (t -> t) -> (t -> t)
-> m ()
+indent so se = modify $ \x ->
+ let so' = so (_outprefix x)
+ se' = se (_errprefix x) in
+ x { _outprefix = so'
+ , _errprefix = se'
+ , _output = if ListLike.null so' &&
+ ListLike.null se' then _output x else Indented }
+
+noIndent :: (MonadState (RunState text) m, ListLike text char) => m ()
+noIndent = indent (const mempty) (const mempty)
+
+-- | Set verbosity to a specific level from 0 to 3.
+-- vlevel :: (MonadIO m, Monoid text, MonadState (RunState text) m) => Int ->
m ()
+-- vlevel :: forall m text char. (IsString text, ListLike text char, MonadIO
m) => Int -> m ()
+vlevel :: forall m text char.
+ (IsString text, ListLike text char, MonadIO m, MonadState (RunState
text) m) =>
+ Int -> m ()
+vlevel n = do
+ modify (\x -> x {_verbosity = n})
+ case n of
+ _ | n <= 0 -> noEcho >> silent >> noIndent -- No output
+ 1 -> vlevel 0 >> echoStart -- Output command at start
+ 2 -> vlevel 1 >> echoEnd >> dots 100 -- Output command at start and
end, dots to show output
+ _ -> -- echo command at start and
end, and send all output
+ -- to the console with channel
prefixes 1> and 2>
+ vlevel 2 >> output >> indent (const (fromString "1> ")) (const
(fromString ("2> ")))
+
+quieter :: RunM text char m => m ()
+quieter = get >>= \x -> vlevel (_verbosity x - 1)
+
+noisier :: RunM text char m => m ()
+noisier = get >>= \x -> vlevel (_verbosity x + 1)
+
+strict :: RunM text char m => m ()
+strict = modify (\x -> x { _lazy = False })
+
+lazy :: RunM text char m => m ()
+lazy = modify (\x -> x { _lazy = True})
+
+message :: RunM text char m => (text -> text) -> m ()
+message f = modify (\x -> x { _message = f (_message x) })
+
+class Dot c where
+ dot :: c
+
+instance Dot Char where
+ dot = '.'
+
+run' :: forall m maker text char.
+ (RunM text char m,
+ ProcessMaker maker) =>
+ maker -> text -> m [Chunk text]
+run' maker input = do
+ st0 <- get
+ when (_echoStart st0) (liftIO $ hPutStrLn stderr ("-> " ++
showProcessMakerForUser maker))
+ result <- liftIO $ (if _lazy st0 then readCreateProcessLazy else
readCreateProcess) maker input >>= doOutput st0
+ when (_echoEnd st0) (liftIO $ hPutStrLn stderr ("<- " ++
showProcessMakerForUser maker))
+ return result
+ where
+ doOutput :: RunState text -> [Chunk text] -> IO [Chunk text]
+ doOutput (RunState {_output = Dots n}) cs = putDotsLn n cs
+ doOutput (RunState {_output = Silent}) cs = return cs
+ doOutput (RunState {_output = All}) cs = writeOutput cs
+ doOutput (RunState {_output = Indented, _outprefix = outp, _errprefix =
errp}) cs = writeOutputIndented outp errp cs
+
+run :: forall m maker text char result.
+ (RunM text char m,
+ ProcessMaker maker,
+ ProcessResult text result) =>
+ maker -> text -> m result
+run maker input = run' maker input >>= return . collectOutput
+
+-- | Output the dotified text of a chunk list with a newline at EOF.
+-- Returns the original list.
+putDotsLn :: (ListLikeProcessIO text char, Dot char) =>
+ Int -> [Chunk text] -> IO [Chunk text]
+putDotsLn cpd chunks = putDots cpd chunks >>= \ r -> System.IO.hPutStr stderr
"\n" >> return r
+
+-- | Output the dotified text of a chunk list. Returns the original
+-- (undotified) list.
+putDots :: (ListLikeProcessIO text char, Dot char) => Int -> [Chunk text] ->
IO [Chunk text]
+putDots charsPerDot chunks =
+ evalStateT (mapM (\ x -> dotifyChunk charsPerDot x >>= mapM_ (lift .
putChunk) >> return x) chunks) 0
+
+-- | dotifyChunk charsPerDot dot chunk - Replaces every charsPerDot
+-- characters in the Stdout and Stderr chunks with one dot. Runs in
+-- the state monad to keep track of how many characters had been seen
+-- when the previous chunk finished. chunks.
+dotifyChunk :: forall text char m. (Monad m, ListLike text char, Dot char) =>
+ Int -> Chunk text -> StateT Int m [Chunk text]
+dotifyChunk charsPerDot chunk =
+ case chunk of
+ Stdout x -> doChars (ListLike.length x)
+ Stderr x -> doChars (ListLike.length x)
+ _ -> return [chunk]
+ where
+ doChars :: Int -> StateT Int m [Chunk text]
+ doChars count = do
+ remaining <- get
+ let (count', remaining') = divMod (remaining + count) (fromIntegral
charsPerDot)
+ put remaining'
+ if (count' > 0) then return [Stderr (ListLike.fromList (replicate
count' dot))] else return []
+
+-- | Write the Stdout chunks to stdout and the Stderr chunks to stderr.
+putChunk :: ListLikeProcessIO text char => Chunk text -> IO ()
+putChunk (Stdout x) = ListLike.putStr x
+putChunk (Stderr x) = ListLike.hPutStr stderr x
+putChunk _ = return ()
+
+writeOutputIndented :: (ListLikeProcessIO text char, Eq char, IsString text) =>
+ text -> text -> [Chunk text] -> IO [Chunk text]
+writeOutputIndented outp errp chunks =
+ mapM (\(c, cs) -> mapM_ writeChunk cs >> return c) (indentChunks outp errp
chunks)
+
+-- | Pure function to indent the text of a chunk list.
+indentChunks :: forall text char. (ListLikeProcessIO text char, Eq char,
IsString text) =>
+ text -> text -> [Chunk text] -> [(Chunk text, [Chunk text])]
+indentChunks outp errp chunks =
+ evalState (mapM (indentChunk nl outp errp) chunks) BOL
+ where
+ nl :: char
+ nl = ListLike.head (fromString "\n" :: text)
+
+-- | The monad state, are we at the beginning of a line or the middle?
+data BOL = BOL | MOL deriving (Eq)
+
+-- | Indent the text of a chunk with the prefixes given for stdout and
+-- stderr. The state monad keeps track of whether we are at the
+-- beginning of a line - when we are and more text comes we insert one
+-- of the prefixes.
+indentChunk :: forall m text char.
+ (Eq char, ListLike text char, MonadState BOL m) =>
+ char -> text -> text -> Chunk text -> m (Chunk text, [Chunk
text])
+indentChunk nl outp errp chunk =
+ case chunk of
+ Stdout x -> doText Stdout outp x >>= return . (chunk,)
+ Stderr x -> doText Stderr errp x >>= return . (chunk,)
+ _ -> return (chunk, [chunk])
+ where
+ -- doText :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]
+ doText con pre x = do
+ let (hd, tl) = ListLike.break (== nl) x
+ hd' <- doHead con pre hd
+ tl' <- doTail con pre tl
+ return $ hd' <> tl'
+ -- doHead :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]
+ doHead _ _ x | ListLike.null x = return []
+ doHead con pre x = do
+ bol <- get
+ case bol of
+ BOL -> put MOL >> return [con (pre <> x)]
+ MOL -> return [con x]
+ -- doTail :: (a -> Chunk a) -> a -> a -> StateT BOL m [Chunk a]
+ doTail _ _ x | ListLike.null x = return []
+ doTail con pre x = do
+ bol <- get
+ put BOL
+ tl <- doText con pre (ListLike.tail x)
+ return $ (if bol == BOL then [con pre] else []) <> [con (singleton
nl)] <> tl
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/process-extras-0.4.1.4/src/System/Process/Text/Builder.hs
new/process-extras-0.7.1/src/System/Process/Text/Builder.hs
--- old/process-extras-0.4.1.4/src/System/Process/Text/Builder.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/process-extras-0.7.1/src/System/Process/Text/Builder.hs 2016-12-05
20:06:55.000000000 +0100
@@ -0,0 +1,35 @@
+{-# LANGUAGE CPP, MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module System.Process.Text.Builder where
+
+#if !MIN_VERSION_base(4,8,0)
+import Control.Applicative ((<$>))
+#endif
+import Control.DeepSeq (force)
+import qualified Control.Exception as C (evaluate)
+import Data.ListLike.IO (hGetContents)
+import Data.Text.Lazy (toChunks)
+import Data.Text.Lazy.Builder (Builder, fromText)
+import Prelude hiding (null)
+import System.Process
+import System.Process.Common
+import System.Exit (ExitCode)
+
+-- | Like 'System.Process.readProcessWithExitCode', but using 'Text'
+instance ListLikeProcessIO Builder Char where
+ forceOutput = C.evaluate . force
+ readChunks h = (map fromText . toChunks) <$> hGetContents h
+
+-- | Specialized version for backwards compatibility.
+readProcessWithExitCode
+ :: FilePath -- ^ command to run
+ -> [String] -- ^ any arguments
+ -> Builder -- ^ standard input
+ -> IO (ExitCode, Builder, Builder) -- ^ exitcode, stdout, stderr
+readProcessWithExitCode = System.Process.Common.readProcessWithExitCode
+
+readCreateProcessWithExitCode
+ :: CreateProcess -- ^ command and arguments to run
+ -> Builder -- ^ standard input
+ -> IO (ExitCode, Builder, Builder) -- ^ exitcode, stdout, stderr
+readCreateProcessWithExitCode =
System.Process.Common.readCreateProcessWithExitCode
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/process-extras-0.4.1.4/src/System/Process/Text/Lazy.hs
new/process-extras-0.7.1/src/System/Process/Text/Lazy.hs
--- old/process-extras-0.4.1.4/src/System/Process/Text/Lazy.hs 2016-05-15
18:23:39.000000000 +0200
+++ new/process-extras-0.7.1/src/System/Process/Text/Lazy.hs 2016-12-05
20:06:55.000000000 +0100
@@ -1,21 +1,25 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE CPP, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module System.Process.Text.Lazy where
+#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
+#endif
import Control.DeepSeq (force)
import qualified Control.Exception as C (evaluate)
import Data.ListLike.IO (hGetContents)
-import Data.Text.Lazy (Text, fromChunks, toChunks)
+import Data.Text.Lazy (Text, fromStrict, toChunks)
import Prelude hiding (null)
import System.Process
import System.Process.Common
import System.Exit (ExitCode)
+instance ProcessText Text Char
+
-- | Like 'System.Process.readProcessWithExitCode', but using 'Text'
instance ListLikeProcessIO Text Char where
forceOutput = C.evaluate . force
- readChunks h = (map (fromChunks . (: [])) . toChunks) <$> hGetContents h
+ readChunks h = (map fromStrict . toChunks) <$> hGetContents h
-- | Specialized version for backwards compatibility.
readProcessWithExitCode
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/process-extras-0.4.1.4/src/System/Process/Text.hs
new/process-extras-0.7.1/src/System/Process/Text.hs
--- old/process-extras-0.4.1.4/src/System/Process/Text.hs 2016-05-15
18:23:39.000000000 +0200
+++ new/process-extras-0.7.1/src/System/Process/Text.hs 2016-12-05
20:06:55.000000000 +0100
@@ -1,8 +1,10 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE CPP, FlexibleContexts, MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module System.Process.Text where
+#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
+#endif
import Control.Monad
import Data.ListLike.IO (hGetContents)
import Data.Text (Text)
@@ -11,6 +13,8 @@
import System.Process.Common
import System.Exit (ExitCode)
+instance ProcessText Text Char
+
-- | Like 'System.Process.readProcessWithExitCode', but using 'Text'
instance ListLikeProcessIO Text Char where
forceOutput = return
