Fix stderr streaming

Just good old-fashioned handles.
This commit is contained in:
Robert Hensing 2019-09-29 22:44:31 +02:00
parent 286d0ae084
commit a90190fc9e
3 changed files with 26 additions and 35 deletions

View file

@ -33,7 +33,6 @@ common deps
, lens , lens
, lens-aeson , lens-aeson
, process , process
, process-extras
, temporary , temporary
, text , text
, protolude , protolude

View file

@ -9,8 +9,6 @@ import qualified Data.String
import System.Process import System.Process
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified System.Process.ByteString.Lazy
as PBL
import Paths_arion_compose import Paths_arion_compose
import Control.Applicative import Control.Applicative

View file

@ -18,8 +18,6 @@ import qualified System.Directory as Directory
import System.Process import System.Process
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified System.Process.ByteString.Lazy
as PBL
import Paths_arion_compose import Paths_arion_compose
import Control.Applicative import Control.Applicative
@ -61,28 +59,30 @@ evaluateComposition ea = do
++ modeArguments (evalMode ea) ++ modeArguments (evalMode ea)
++ argArgs ea ++ argArgs ea
++ map toS (evalUserArgs ea) ++ map toS (evalUserArgs ea)
stdin = mempty procSpec = (proc "nix-instantiate" args)
procSpec = (proc "nix-instantiate" args) { cwd = evalWorkDir ea } { cwd = evalWorkDir ea
, std_out = CreatePipe
}
-- TODO: lazy IO is tricky. Let's use conduit/pipes instead? withCreateProcess procSpec $ \_in outHM _err procHandle -> do
(exitCode, out, err) <- PBL.readCreateProcessWithExitCode procSpec stdin let outHandle = fromMaybe (panic "stdout missing") outHM
-- Stream 'err' out <- BL.hGetContents outHandle
errDone <- async (BL.hPutStr stderr err)
-- Force 'out' v <- Protolude.evaluate (eitherDecode out)
v <- Protolude.evaluate (eitherDecode out)
-- Wait for process exit and 'err' printout exitCode <- waitForProcess procHandle
wait errDone
case exitCode of case exitCode of
ExitSuccess -> pass ExitSuccess -> pass
ExitFailure e -> throwIO $ FatalError "Evaluation failed" -- TODO: don't print this exception in main ExitFailure 1 -> exitFailure
e@ExitFailure {} -> do
throwIO $ FatalError $ "evaluation failed with " <> show exitCode
exitWith e
case v of case v of
Right r -> pure r Right r -> pure r
Left e -> throwIO $ FatalError "Couldn't parse nix-instantiate output" Left e -> throwIO $ FatalError "Couldn't parse nix-instantiate output"
-- | Run with docker-compose.yaml tmpfile -- | Run with docker-compose.yaml tmpfile
withEvaluatedComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r withEvaluatedComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r
@ -108,24 +108,18 @@ buildComposition outLink ea = do
++ commandArgs ++ commandArgs
++ argArgs ea ++ argArgs ea
++ map toS (evalUserArgs ea) ++ map toS (evalUserArgs ea)
stdin = mempty
procSpec = (proc "nix-build" args) { cwd = evalWorkDir ea } procSpec = (proc "nix-build" args) { cwd = evalWorkDir ea }
-- TODO: lazy IO is tricky. Let's use conduit/pipes instead? withCreateProcess procSpec $ \_in _out _err procHandle -> do
(exitCode, out, err) <- PBL.readCreateProcessWithExitCode procSpec stdin
-- Stream 'err' exitCode <- waitForProcess procHandle
errDone <- async (BL.hPutStr stderr err)
-- Force 'out' case exitCode of
_v <- Protolude.evaluate out ExitSuccess -> pass
ExitFailure 1 -> exitFailure
-- Wait for process exit and 'err' printout e@ExitFailure {} -> do
wait errDone throwIO $ FatalError $ "nix-build failed with " <> show exitCode
exitWith e
case exitCode of
ExitSuccess -> pass
ExitFailure e -> throwIO $ FatalError "Build failed" -- TODO: don't print this exception in main
-- | Do something with a docker-compose.yaml. -- | Do something with a docker-compose.yaml.
withBuiltComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r withBuiltComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r