Fix stderr streaming

Just good old-fashioned handles.

arion-compose.cabal

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

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
 

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)
-      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
 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?
+  withCreateProcess procSpec $ \_in _out _err procHandle -> do
-  (exitCode, out, err) <- PBL.readCreateProcessWithExitCode procSpec stdin
-    
-  -- Stream 'err'
-  errDone <- async (BL.hPutStr stderr err)
 
-  -- Force 'out'
+    exitCode <- waitForProcess procHandle
-  _v <- Protolude.evaluate out
 
-  -- Wait for process exit and 'err' printout
+    case exitCode of
-  wait errDone
+      ExitSuccess -> pass
-
+      ExitFailure 1 -> exitFailure
-  case exitCode of
+      e@ExitFailure {} -> do
-    ExitSuccess -> pass
+        throwIO $ FatalError $ "nix-build failed with " <> show exitCode
-    ExitFailure e -> throwIO $ FatalError "Build failed" -- TODO: don't print this exception in main
+        exitWith e
 
 -- | Do something with a docker-compose.yaml.
 withBuiltComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r