summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2020-06-17 18:01:46 -0400
committerJoey Hess2020-06-17 18:01:46 -0400
commit1585784507441f97a829c2d7d77dcf2072e4bbec (patch)
tree870c9845a679a3e7bfbd1a98c747053cb085a0bb
parent132e548403db3c9c446e0447499c844f9bff125f (diff)
parent745784f61bdd678e20b1b18743f18d458836a802 (diff)
Merge branch 'joeyconfig'
-rw-r--r--.gitignore3
-rw-r--r--Makefile35
l---------config.hs2
-rw-r--r--debian/changelog2
-rw-r--r--doc/forum/Bootstrapping_with_Cabal_on_Archlinux_fails/comment_4_294fcbae675879cb81aeb8d37cf3b635._comment13
-rw-r--r--doc/todo/depend_on_concurrent-output.mdwn23
-rw-r--r--privdata/relocate1
-rw-r--r--src/Propellor/Bootstrap.hs7
-rw-r--r--src/System/Console/Concurrent.hs10
-rw-r--r--src/System/Console/Concurrent/Internal.hs187
-rw-r--r--src/System/Process/Concurrent.hs16
11 files changed, 148 insertions, 151 deletions
diff --git a/.gitignore b/.gitignore
index d9285db3..4e1b918c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,6 +1,8 @@
/propellor
dist/*
+dist-newstyle/*
tags
+configured
privdata/local
privdata/keyring.gpg~
Setup
@@ -15,4 +17,5 @@ propellor.1
.cabal-sandbox/
.dir-locals.el
cabal.sandbox.config
+cabal.project.local
*~
diff --git a/Makefile b/Makefile
index 0e4b2ca3..b5d5708b 100644
--- a/Makefile
+++ b/Makefile
@@ -1,35 +1,43 @@
CABAL?=cabal
DATE := $(shell dpkg-parsechangelog 2>/dev/null | grep Date | cut -d " " -f2-)
-build: tags propellor.1 dist/setup-config
+build: tags propellor.1 configured
$(CABAL) build
- ln -sf dist/build/propellor-config/propellor-config propellor
+ @if [ -d dist-newstyle ]; then \
+ ln -sf $$(find dist-newstyle/ -executable -type f | grep 'build/propellor-config/propellor-config$$') propellor; \
+ else \
+ ln -sf dist/build/propellor-config/propellor-config propellor; \
+ fi
install:
install -d $(DESTDIR)/usr/bin $(DESTDIR)/usr/src/propellor
- install -s dist/build/propellor/propellor $(DESTDIR)/usr/bin/propellor
- mkdir -p dist/gittmp
- $(CABAL) sdist
- cat dist/propellor-*.tar.gz | (cd dist/gittmp && tar zx --strip-components=1)
+ if [ -d dist-newstyle ]; then \
+ install -s $$(find dist-newstyle/ -executable -type f | grep 'build/propellor/propellor$$') $(DESTDIR)/usr/bin/propellor; \
+ else \
+ install -s dist/build/propellor/propellor $(DESTDIR)/usr/bin/propellor; \
+ fi
+ mkdir -p gittmp
+ $(CABAL) sdist -o - | (cd gittmp && tar zx --strip-components=1)
# cabal sdist does not preserve symlinks, so copy over file
- cd dist/gittmp && for f in $$(find -type f); do rm -f $$f; cp -a ../../$$f $$f; done
+ cd gittmp && for f in $$(find -type f); do rm -f $$f; cp -a ../$$f $$f; done
# reset mtime on files in git bundle so bundle is reproducible
- find dist/gittmp -print0 | xargs -0r touch --no-dereference --date="$(DATE)"
+ find gittmp -print0 | xargs -0r touch --no-dereference --date="$(DATE)"
export GIT_AUTHOR_NAME=build \
&& export GIT_AUTHOR_EMAIL=build@buildhost \
&& export GIT_AUTHOR_DATE="$(DATE)" \
&& export GIT_COMMITTER_NAME=build \
&& export GIT_COMMITTER_EMAIL=build@buildhost \
&& export GIT_COMMITTER_DATE="$(DATE)" \
- && cd dist/gittmp && git init \
+ && cd gittmp && git init \
&& git add . \
&& git commit -q -m "distributed version of propellor" \
&& git bundle create $(DESTDIR)/usr/src/propellor/propellor.git master HEAD \
&& git show-ref master --hash > $(DESTDIR)/usr/src/propellor/head
- rm -rf dist/gittmp
+ rm -rf gittmp
clean:
- rm -rf dist Setup tags propellor propellor.1 privdata/local
+ rm -rf dist dist-newstyle configured Setup \
+ tags propellor propellor.1 privdata/local
find . -name \*.o -exec rm {} \;
find . -name \*.hi -exec rm {} \;
@@ -37,11 +45,12 @@ clean:
# duplicate tags with Propellor.Property. removed from the start, as we
# often import qualified by just the module base name.
tags:
- find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags 2>/dev/null | perl -ne 'print; s/Propellor\.Property\.//; print' | sort > tags || true
+ @find . | grep -v /.git/ | grep -v /tmp/ | grep -v dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags 2>/dev/null | perl -ne 'print; s/Propellor\.Property\.//; print' | sort > tags || true
-dist/setup-config: propellor.cabal
+configured: propellor.cabal
@if [ "$(CABAL)" = ./Setup ]; then ghc --make Setup; fi
@$(CABAL) configure
+ touch configured
propellor.1: doc/usage.mdwn doc/mdwn2man
doc/mdwn2man propellor 1 < doc/usage.mdwn > propellor.1
diff --git a/config.hs b/config.hs
index ec313725..97d90636 120000
--- a/config.hs
+++ b/config.hs
@@ -1 +1 @@
-config-simple.hs \ No newline at end of file
+joeyconfig.hs \ No newline at end of file
diff --git a/debian/changelog b/debian/changelog
index b46c4b4e..24bbf641 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,8 @@ propellor (5.10.3) UNRELEASED; urgency=medium
* Fix display of concurrent output from processes when using
Propellor.Property.Conductor.
(Reversion introduced in version 5.5.0.)
+ * Support bootstrapping to hosts using cabal 3.x, with new-dist directory.
+ * Makefile: Fix build with cabal 3.x.
-- Joey Hess <id@joeyh.name> Fri, 05 Jun 2020 11:26:21 -0400
diff --git a/doc/forum/Bootstrapping_with_Cabal_on_Archlinux_fails/comment_4_294fcbae675879cb81aeb8d37cf3b635._comment b/doc/forum/Bootstrapping_with_Cabal_on_Archlinux_fails/comment_4_294fcbae675879cb81aeb8d37cf3b635._comment
new file mode 100644
index 00000000..726067da
--- /dev/null
+++ b/doc/forum/Bootstrapping_with_Cabal_on_Archlinux_fails/comment_4_294fcbae675879cb81aeb8d37cf3b635._comment
@@ -0,0 +1,13 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2020-06-17T21:33:14Z"
+ content="""
+ cabal install --install-method=symlink --installdir=. exe:propellor --overwrite-policy=always
+
+But, this seems to do a lot of extra work, including generating a tarball
+of all the source code, and possibly building the package again
+unncessarily. And only works with a new enough cabal version.
+
+Ok, I've implemented it using `find`.
+"""]]
diff --git a/doc/todo/depend_on_concurrent-output.mdwn b/doc/todo/depend_on_concurrent-output.mdwn
index c3641385..48dd829e 100644
--- a/doc/todo/depend_on_concurrent-output.mdwn
+++ b/doc/todo/depend_on_concurrent-output.mdwn
@@ -27,3 +27,26 @@ Waiting on concurrent-output reaching Debian stable.
> from debian. That is a somewhat old version and perhaps it was buggy?
> However, I have not had any luck reproducing the problem there running
> readProcess in ghci. --[[Joey]]
+>
+> > Tried again in 2020, same bugs still happened. On a system running
+> > debian unstable with concurrent-output 1.10.9, and a system running stable that
+> > had cabal installed concurrent-output 1.10.11.
+> >
+> > The former system (kite) had the strange output problem.
+> >
+> > The latter system (keysafe) seemed ok but crashed at the end with
+> > a STM transaction deadlock. Seemed to only happen when spinning the
+> > host remotely, or not always; I tried to reproduce it running propellor
+> > manually to bisect concurrent-output but without success.
+> >
+> > This is really looking like a reversion, or several, in newer
+> > versions of concurrent-output. The code bundled with propellor is
+> > the same as concurrent-output 1.7.4.
+
+> > > I think I've fixed it, concurrent-output (>= 1.10.12 || <= 1.7.4)
+> > > will be needed to avoid the bug. Will be several years until that's
+> > > in debian stable..
+> > >
+> > > I've updated the embedded concurrent-output copy, and it should
+> > > be kept up-to-date as concurrent-output changes, to avoid more
+> > > such reversions. --[[Joey]]
diff --git a/privdata/relocate b/privdata/relocate
new file mode 100644
index 00000000..271692d8
--- /dev/null
+++ b/privdata/relocate
@@ -0,0 +1 @@
+.joeyconfig
diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs
index d772d7c7..0fef92f1 100644
--- a/src/Propellor/Bootstrap.hs
+++ b/src/Propellor/Bootstrap.hs
@@ -81,7 +81,12 @@ buildCommand bs = intercalate " && " (go (getBuilder bs))
go Cabal =
[ "cabal configure"
, "cabal build -j1 propellor-config"
- , "ln -sf dist/build/propellor-config/propellor-config propellor"
+ , intercalate "; "
+ [ "if [ -d dist-newstyle ]"
+ , "then ln -sf $(find dist-newstyle/ -executable -type f | grep 'build/propellor-config/propellor-config$') propellor"
+ , "else ln -sf dist/build/propellor-config/propellor-config propellor"
+ , "fi"
+ ]
]
go Stack =
[ "stack build :propellor-config"
diff --git a/src/System/Console/Concurrent.hs b/src/System/Console/Concurrent.hs
index 12447637..8ab73c3d 100644
--- a/src/System/Console/Concurrent.hs
+++ b/src/System/Console/Concurrent.hs
@@ -7,29 +7,25 @@
-- > import Control.Concurrent.Async
-- > import System.Console.Concurrent
-- >
--- > main = withConcurrentOutput $
+-- > main = withConcurrentOutput $ do
-- > outputConcurrent "washed the car\n"
-- > `concurrently`
-- > outputConcurrent "walked the dog\n"
-- > `concurrently`
-- > createProcessConcurrent (proc "ls" [])
-{-# LANGUAGE CPP #-}
-
module System.Console.Concurrent (
-- * Concurrent output
withConcurrentOutput,
Outputable(..),
outputConcurrent,
errorConcurrent,
- ConcurrentProcessHandle,
-#ifndef mingw32_HOST_OS
createProcessConcurrent,
-#endif
- waitForProcessConcurrent,
createProcessForeground,
flushConcurrentOutput,
lockOutput,
+ ConcurrentProcessHandle,
+ waitForProcessConcurrent,
-- * Low level access to the output buffer
OutputBuffer,
StdHandle(..),
diff --git a/src/System/Console/Concurrent/Internal.hs b/src/System/Console/Concurrent/Internal.hs
index ffe6a9e8..de4cffaf 100644
--- a/src/System/Console/Concurrent/Internal.hs
+++ b/src/System/Console/Concurrent/Internal.hs
@@ -1,5 +1,4 @@
{-# 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. -}
@@ -15,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
@@ -32,6 +28,7 @@ import Data.Monoid
import qualified System.Process as P
import qualified Data.Text as T
import qualified Data.Text.IO as T
+import qualified Data.Text.Lazy as L
import Control.Applicative
import Prelude
@@ -43,8 +40,6 @@ data OutputHandle = OutputHandle
, outputBuffer :: TMVar OutputBuffer
, errorBuffer :: TMVar OutputBuffer
, outputThreads :: TMVar Integer
- , processWaiters :: TMVar [Async ()]
- , waitForProcessLock :: TMVar ()
}
data Lock = Locked
@@ -57,8 +52,6 @@ globalOutputHandle = unsafePerformIO $ OutputHandle
<*> newTMVarIO (OutputBuffer [])
<*> newTMVarIO (OutputBuffer [])
<*> newTMVarIO 0
- <*> newTMVarIO []
- <*> newEmptyTMVarIO
-- | Holds a lock while performing an action. This allows the action to
-- perform its own output to the console, without using functions from this
@@ -109,7 +102,8 @@ dropOutputLock :: IO ()
dropOutputLock = withLock $ void . takeTMVar
-- | Use this around any actions that use `outputConcurrent`
--- or `createProcessConcurrent`
+-- or `createProcessConcurrent`, unless
+-- `System.Console.Regions.displayConsoleRegions` is being used.
--
-- This is necessary to ensure that buffered concurrent output actually
-- gets displayed before the program exits.
@@ -140,20 +134,30 @@ class Outputable v where
instance Outputable T.Text where
toOutput = id
+-- | Note that using a lazy Text as an Outputable value
+-- will buffer it all in memory.
+instance Outputable L.Text where
+ toOutput = toOutput . L.toStrict
+
instance Outputable String where
toOutput = toOutput . T.pack
-- | Displays a value to stdout.
--
--- No newline is appended to the value, so if you want a newline, be sure
--- to include it yourself.
---
-- Uses locking to ensure that the whole output occurs atomically
-- even when other threads are concurrently generating output.
--
+-- No newline is appended to the value, so if you want a newline, be sure
+-- to include it yourself.
+--
-- When something else is writing to the console at the same time, this does
-- not block. It buffers the value, so it will be displayed once the other
-- writer is done.
+--
+-- When outputConcurrent is used within a call to
+-- `System.Console.Regions.displayConsoleRegions`, the output is displayed
+-- above the currently open console regions. Only lines ending in a newline
+-- are displayed in this case (it uses `waitCompleteLines`).
outputConcurrent :: Outputable v => v -> IO ()
outputConcurrent = outputConcurrent' StdOut
@@ -179,69 +183,13 @@ outputConcurrent' stdh v = bracket setup cleanup go
h = toHandle stdh
bv = bufferFor stdh
-newtype ConcurrentProcessHandle = ConcurrentProcessHandle P.ProcessHandle
-
-toConcurrentProcessHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle) -> (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
-toConcurrentProcessHandle (i, o, e, h) = (i, o, e, ConcurrentProcessHandle h)
+-- | This alias is provided to avoid breaking backwards compatibility.
+type ConcurrentProcessHandle = P.ProcessHandle
--- | Use this to wait for processes started with
--- `createProcessConcurrent` and `createProcessForeground`, and get their
--- exit status.
---
--- Note that such processes are actually automatically waited for
--- internally, so not calling this explicitly will not result
--- in zombie processes. This behavior differs from `P.waitForProcess`
+-- | Same as `P.waitForProcess`; provided to avoid breaking backwards
+-- compatibility.
waitForProcessConcurrent :: ConcurrentProcessHandle -> IO ExitCode
-waitForProcessConcurrent (ConcurrentProcessHandle h) =
- bracket lock unlock checkexit
- where
- lck = waitForProcessLock globalOutputHandle
- lock = atomically $ tryPutTMVar lck ()
- unlock True = atomically $ takeTMVar lck
- unlock False = return ()
- checkexit locked = maybe (waitsome locked) return
- =<< P.getProcessExitCode h
- waitsome True = do
- let v = processWaiters globalOutputHandle
- l <- atomically $ readTMVar v
- if null l
- -- Avoid waitAny [] which blocks forever
- then P.waitForProcess h
- else do
- -- Wait for any of the running
- -- processes to exit. It may or may not
- -- be the one corresponding to the
- -- ProcessHandle. If it is,
- -- getProcessExitCode will succeed.
- void $ tryIO $ waitAny l
- checkexit True
- waitsome False = do
- -- Another thread took the lck first. Wait for that thread to
- -- wait for one of the running processes to exit.
- atomically $ do
- putTMVar lck ()
- takeTMVar lck
- checkexit False
-
--- Registers an action that waits for a process to exit,
--- adding it to the processWaiters list, and removing it once the action
--- completes.
-asyncProcessWaiter :: IO () -> IO ()
-asyncProcessWaiter waitaction = do
- regdone <- newEmptyTMVarIO
- waiter <- async $ do
- self <- atomically (takeTMVar regdone)
- waitaction `finally` unregister self
- register waiter regdone
- where
- v = processWaiters globalOutputHandle
- register waiter regdone = atomically $ do
- l <- takeTMVar v
- putTMVar v (waiter:l)
- putTMVar regdone waiter
- unregister waiter = atomically $ do
- l <- takeTMVar v
- putTMVar v (filter (/= waiter) l)
+waitForProcessConcurrent = P.waitForProcess
-- | Wrapper around `System.Process.createProcess` that prevents
-- multiple processes that are running concurrently from writing
@@ -260,9 +208,10 @@ asyncProcessWaiter waitaction = do
-- redirected to a buffer. The buffered output will be displayed as soon
-- 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)
+-- Note that the the process is waited for by a background thread,
+-- so unlike createProcess, neglecting to call waitForProcess will not
+-- result in zombie processess.
+createProcessConcurrent :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle)
createProcessConcurrent p
| willOutput (P.std_out p) || willOutput (P.std_err p) =
ifM tryTakeOutputLock
@@ -271,56 +220,65 @@ createProcessConcurrent p
)
| otherwise = do
r@(_, _, _, h) <- P.createProcess p
- asyncProcessWaiter $
- void $ tryIO $ P.waitForProcess h
- return (toConcurrentProcessHandle r)
-#endif
+ _ <- async $ void $ tryIO $ P.waitForProcess h
+ return r
-- | Wrapper around `System.Process.createProcess` that makes sure a process
-- is run in the foreground, with direct access to stdout and stderr.
-- Useful when eg, running an interactive process.
-createProcessForeground :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
+--
+-- Note that the the process is waited for by a background thread,
+-- so unlike createProcess, neglecting to call waitForProcess will not
+-- result in zombie processess.
+createProcessForeground :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle)
createProcessForeground p = do
takeOutputLock
fgProcess p
-fgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
+fgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle)
fgProcess p = do
r@(_, _, _, h) <- P.createProcess p
`onException` dropOutputLock
registerOutputThread
-- Wait for the process to exit and drop the lock.
- asyncProcessWaiter $ do
+ _ <- async $ do
void $ tryIO $ P.waitForProcess h
unregisterOutputThread
dropOutputLock
- return (toConcurrentProcessHandle r)
+ return r
-#ifndef mingw32_HOST_OS
-bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ConcurrentProcessHandle)
+bgProcess :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle)
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
- asyncProcessWaiter $ void $ tryIO $ P.waitForProcess h
- outbuf <- setupOutputBuffer StdOut toouth (P.std_out p) fromouth
- errbuf <- setupOutputBuffer StdErr toerrh (P.std_err p) fromerrh
+ let r =
+ ( stdin_h
+ , mungeret (P.std_out p) stdout_h
+ , mungeret (P.std_err p) stderr_h
+ , h
+ )
+ -- Wait for the process for symmetry with fgProcess,
+ -- which does the same.
+ _ <- async $ void $ tryIO $ P.waitForProcess h
+ outbuf <- setupOutputBuffer StdOut (mungebuf (P.std_out p) stdout_h)
+ errbuf <- setupOutputBuffer StdErr (mungebuf (P.std_err p) stderr_h)
void $ async $ bufferWriter [outbuf, errbuf]
- return (toConcurrentProcessHandle r)
+ return 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
+ mungebuf ss mh
+ | willOutput ss = mh
+ | otherwise = Nothing
+ mungeret ss mh
+ | willOutput ss = Nothing
+ | otherwise = mh
willOutput :: P.StdStream -> Bool
willOutput P.Inherit = True
@@ -353,32 +311,31 @@ data AtEnd = AtEnd
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
diff --git a/src/System/Process/Concurrent.hs b/src/System/Process/Concurrent.hs
index 0e00e4fd..346ce2e0 100644
--- a/src/System/Process/Concurrent.hs
+++ b/src/System/Process/Concurrent.hs
@@ -9,26 +9,14 @@
module System.Process.Concurrent where
import System.Console.Concurrent
-import System.Console.Concurrent.Internal (ConcurrentProcessHandle(..))
import System.Process hiding (createProcess, waitForProcess)
import System.IO
import System.Exit
-- | Calls `createProcessConcurrent`
---
--- You should use the waitForProcess in this module on the resulting
--- ProcessHandle. Using System.Process.waitForProcess instead can have
--- mildly unexpected results.
createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-createProcess p = do
- (i, o, e, ConcurrentProcessHandle h) <- createProcessConcurrent p
- return (i, o, e, h)
+createProcess = createProcessConcurrent
-- | Calls `waitForProcessConcurrent`
---
--- You should only use this on a ProcessHandle obtained by calling
--- createProcess from this module. Using this with a ProcessHandle
--- obtained from System.Process.createProcess etc will have extremely
--- unexpected results; it can wait a very long time before returning.
waitForProcess :: ProcessHandle -> IO ExitCode
-waitForProcess = waitForProcessConcurrent . ConcurrentProcessHandle
+waitForProcess = waitForProcessConcurrent