
Hello café, I have a program that is crashing, and I have no idea why: module Main where import System.Process (readProcessWithExitCode) main :: IO () main = do _ <- readProcessWithExitCode "ghc-pkg" ["describe", "hoopl"] "" putStrLn "Should never get here" this is using the process package from hackage. The program crashes with minimal-test: fd:5: hGetContents: invalid argument (invalid byte sequence) minimal-test: thread blocked indefinitely in an MVar operation inspecting the source of readProcessWithExitCode yields an obvious explanation to the MVar problem, but I don't understand why hGetContents is so offended. For the lazy it is defined as follows: readProcessWithExitCode :: FilePath -- ^ command to run -> [String] -- ^ any arguments -> String -- ^ standard input -> IO (ExitCode,String,String) -- ^ exitcode, stdout, stderr readProcessWithExitCode cmd args input = do (Just inh, Just outh, Just errh, pid) <- createProcess (proc cmd args){ std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe } outMVar <- newEmptyMVar -- fork off a thread to start consuming stdout out <- hGetContents outh _ <- forkIO $ C.evaluate (length out) >> putMVar outMVar () -- fork off a thread to start consuming stderr err <- hGetContents errh _ <- forkIO $ C.evaluate (length err) >> putMVar outMVar () -- now write and flush any input when (not (null input)) $ do hPutStr inh input; hFlush inh hClose inh -- done with stdin -- wait on the output takeMVar outMVar takeMVar outMVar hClose outh hClose errh -- wait on the process ex <- waitForProcess pid return (ex, out, err) Now having looked at the source of ghc-pkg it is dumping it's output using putStr and friends, so that should be using my local encoding on the system, right? and so should hGetContents in my program..? Now, for the curious: the reason I care is that this problem has effectively prevented me from using virthualenv. Sadness and woe.