Skip to content

Commit 8b3bd5d

Browse files
committed
Capture all GHC output, including debug messages.
1 parent cee6f34 commit 8b3bd5d

File tree

3 files changed

+10
-11
lines changed

3 files changed

+10
-11
lines changed

codeworld-compiler/codeworld-compiler.cabal

-1
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,6 @@ Library
4444
Build-depends:
4545
aeson >= 1.1,
4646
array,
47-
async,
4847
base,
4948
base64-bytestring,
5049
bytestring,

codeworld-compiler/src/CodeWorld/Compile.hs

+5-1
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ import Control.Monad.IO.Class
4040
import Control.Monad.State
4141
import Data.ByteString (ByteString)
4242
import qualified Data.ByteString as B
43+
import Data.Function
4344
import Data.List
4445
import qualified Data.Map as Map
4546
import Data.Maybe
@@ -76,7 +77,7 @@ formatDiagnostics = do
7677
catMaybes $
7778
map (flip Map.lookup importLocations . takeFileName) remoteErrorFiles
7879
let revisedDiags =
79-
sort $
80+
sortDiagnostics $
8081
local
8182
++ [ ( loc,
8283
CompileError,
@@ -86,6 +87,9 @@ formatDiagnostics = do
8687
]
8788
return (T.intercalate "\n\n" (map formatDiagnostic revisedDiags))
8889

90+
sortDiagnostics :: [Diagnostic] -> [Diagnostic]
91+
sortDiagnostics = sortBy (compare `on` loc) where loc (l, _, _) = l
92+
8993
inMainModule :: Diagnostic -> Bool
9094
inMainModule (src, _, _) =
9195
src == noSrcSpan

codeworld-compiler/src/CodeWorld/Compile/Framework.hs

+5-9
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,6 @@ module CodeWorld.Compile.Framework where
3232
import qualified "ghc" Config as GHC
3333
import Control.Applicative
3434
import Control.Concurrent
35-
import Control.Concurrent.Async
3635
import Control.Exception (evaluate)
3736
import Control.Monad
3837
import Control.Monad.Catch
@@ -409,24 +408,21 @@ withTimeout micros action = do
409408
-- killed.
410409
runSync :: FilePath -> String -> [String] -> IO (ExitCode, Text)
411410
runSync dir cmd args = mask $ \restore -> do
412-
(Nothing, Just outh, Just errh, pid) <-
411+
(Nothing, Just outh, Nothing, pid) <-
413412
createProcess
414-
(proc cmd args)
413+
(shell (intercalate " " (cmd : args) ++ " 2>&1"))
415414
{ cwd = Just dir,
416415
std_in = NoStream,
417416
std_out = CreatePipe,
418-
std_err = CreatePipe,
417+
std_err = NoStream,
419418
close_fds = True
420419
}
421420
let cleanup (e :: SomeException) = terminateProcess pid >> throwM e
422421
handle cleanup $
423422
restore $ do
424-
(resultOut, resultErr) <-
425-
concurrently
426-
(decodeUtf8 <$> B.hGetContents outh)
427-
(decodeUtf8 <$> B.hGetContents errh)
423+
result <- decodeUtf8 <$> B.hGetContents outh
428424
exitCode <- waitForProcess pid
429-
return (exitCode, resultOut <> "\n" <> resultErr)
425+
return (exitCode, result)
430426

431427
formatLocation :: SrcSpanInfo -> String
432428
formatLocation spn@(SrcSpanInfo (SrcSpan fn l1 c1 l2 c2) _)

0 commit comments

Comments
 (0)