mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-11 23:08:30 +01:00
Switch to UseProvidedHandle after upstream bugfix
This commit is contained in:
parent
892fdb45fb
commit
31036c12f9
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -72,6 +72,7 @@ library
|
||||
, stm
|
||||
, mono-traversable
|
||||
, async
|
||||
, streaming-commons >= 0.1.7.1
|
||||
|
||||
executable stackage
|
||||
default-language: Haskell2010
|
||||
|
||||
Loading…
Reference in New Issue
Block a user