Switch to UseProvidedHandle after upstream bugfix

This commit is contained in:
Michael Snoyman 2014-12-11 14:44:29 +02:00
parent 892fdb45fb
commit 31036c12f9
3 changed files with 2 additions and 45 deletions

View File

@ -214,17 +214,13 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} =
]
runIn wdir outH errH cmd args =
withCheckedProcess cp $ \ClosedStream out err -> do
void $ async $ out $$ sinkHandle outH
void $ async $ err $$ sinkHandle errH
withCheckedProcess cp $ \ClosedStream UseProvidedHandle UseProvidedHandle ->
(return () :: IO ())
where
cp = (proc (unpack $ asText cmd) (map (unpack . asText) args))
{ cwd = Just $ fpToString wdir
{- FIXME UseProvidedHandle is broken
, std_out = UseHandle outH
, std_err = UseHandle errH
-}
, env = Just sbModifiedEnv
}
runParent = runIn sbBuildDir

View File

@ -1,4 +1,3 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoImplicitPrelude #-}
@ -59,45 +58,6 @@ data ParseFailedException = ParseFailedException TypeRep Text
deriving (Show, Typeable)
instance Exception ParseFailedException
#ifndef MIN_VERSION_streaming_commons
#define MIN_VERSION_streaming_commons(x, y, z) 1
#endif
#if !MIN_VERSION_streaming_commons(0,1,7)
data ProcessExitedUnsuccessfully = ProcessExitedUnsuccessfully CreateProcess ExitCode
deriving Typeable
instance Show ProcessExitedUnsuccessfully where
show (ProcessExitedUnsuccessfully cp ec) = concat
[ "Process exited with "
, show ec
, ": "
, showCmdSpec (cmdspec cp)
]
where
showCmdSpec (ShellCommand str) = str
showCmdSpec (RawCommand x xs) = unwords (x:xs)
instance Exception ProcessExitedUnsuccessfully
checkExitCode :: MonadThrow m => CreateProcess -> ExitCode -> m ()
checkExitCode _ ExitSuccess = return ()
checkExitCode cp ec = throwM $ ProcessExitedUnsuccessfully cp ec
-- FIXME move into streaming-commons?
withCheckedProcess :: ( InputSource stdin
, OutputSink stderr
, OutputSink stdout
, MonadIO m
)
=> CreateProcess
-> (stdin -> stdout -> stderr -> m b)
-> m b
withCheckedProcess cp f = do
(x, y, z, sph) <- streamingProcess cp
res <- f x y z
ec <- waitForStreamingProcess sph
liftIO $ checkExitCode cp ec
return res
#endif
newtype Maintainer = Maintainer { unMaintainer :: Text }
deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString)

View File

@ -72,6 +72,7 @@ library
, stm
, mono-traversable
, async
, streaming-commons >= 0.1.7.1
executable stackage
default-language: Haskell2010