From a90190fc9ea425b661a210fd48e1c205d3501297 Mon Sep 17 00:00:00 2001
From: Robert Hensing <robert@roberthensing.nl>
Date: Sun, 29 Sep 2019 22:44:31 +0200
Subject: [PATCH] Fix stderr streaming

Just good old-fashioned handles.
---
 arion-compose.cabal                    |  1 -
 src/haskell/lib/Arion/DockerCompose.hs |  2 -
 src/haskell/lib/Arion/Nix.hs           | 58 ++++++++++++--------------
 3 files changed, 26 insertions(+), 35 deletions(-)

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