Make sure stdoutGateway is flushed before exiting.

Language/Haskell/GhcMod/Monad.hs

@@ -47,7 +47,7 @@ import Control.Monad.Reader (runReaderT)
 import Control.Monad.State.Strict (runStateT)
 import Control.Monad.Trans.Journal (runJournalT)
 
-import Exception (ExceptionMonad(..))
+import Exception
 
 import System.Directory
 import Prelude
@@ -82,9 +82,9 @@ runGmOutT opts ma = do
     runGmOutT' gmo ma
 
 runGmOutT' :: IOish m => GhcModOut -> GmOutT m a -> m a
-runGmOutT' gmo ma = do
+runGmOutT' gmo@(gmoChan -> chan) ma = do
-    gbracket_ (liftIO $ forkIO $ stdoutGateway $ gmoChan gmo)
+    gbracket_ (liftIO $ forkIO $ stdoutGateway chan)
-              (liftIO . killThread)
+              (const $ liftIO $ flushStdoutGateway chan)
               (flip runReaderT gmo $ unGmOutT ma)
 
 -- | Run a @GhcModT m@ computation.

Language/Haskell/GhcMod/Output.hs

@@ -32,6 +32,7 @@ module Language.Haskell.GhcMod.Output (
   , gmUnsafeErrStr
 
   , stdoutGateway
+  , flushStdoutGateway
   ) where
 
 import Data.List
@@ -89,14 +90,14 @@ stdioOutputFns lpfx = let
     , liftIO . hPutStr stderr . unGmLine . errPfx)
 
 chanOutputFns :: MonadIO m
-              => Chan (GmStream, GmLines String)
+              => Chan (Either (MVar ()) (GmStream, GmLines String))
               -> Maybe (String, String)
               -> (GmLines String -> m (), GmLines String -> m ())
 chanOutputFns c lpfx = let
     (outPfx, errPfx) = pfxFns lpfx
   in
-    ( liftIO . writeChan c . (,) GmOutStream . outPfx
+    ( liftIO . writeChan c . Right . (,) GmOutStream . outPfx
-    , liftIO . writeChan c . (,) GmErrStream . errPfx)
+    , liftIO . writeChan c . Right . (,) GmErrStream . errPfx)
 
 outputFns' ::
   MonadIO m => GhcModOut -> (GmLines String -> m (), GmLines String -> m ())
@@ -142,23 +143,47 @@ gmReadProcess = do
     Nothing ->
         return $ readProcess
 
-stdoutGateway :: Chan (GmStream, GmLines String) -> IO ()
+flushStdoutGateway :: Chan (Either (MVar ()) (GmStream, GmLines String)) -> IO ()
+flushStdoutGateway c = do
+  mv <- newEmptyMVar
+  writeChan c $ Left mv
+  takeMVar mv
+
+stdoutGateway :: Chan (Either (MVar ()) (GmStream, GmLines String)) -> IO ()
 stdoutGateway chan = go ("", "")
  where
-   go buf@(obuf, ebuf) = do
+   go :: (String, String) -> IO ()
-     (stream, GmLines ty l) <- readChan chan
+   go buf = do
-     case ty of
+     cmd <- readChan chan
-       GmTerminated ->
+     case cmd of
-           case stream of
+       Left mv -> do
-             GmOutStream -> putStr (obuf++l) >> hFlush stdout >> go ("", ebuf)
+           let flush (obuf, ebuf) = do
-             GmErrStream -> putStr (ebuf++l) >> hFlush stdout >> go (obuf, "")
+                 -- Add newline to unterminated stderr but not to stdout
-       GmPartial -> case reverse $ lines l of
+                 -- otherwise emacs will get confused etc
-                      [] -> go buf
+                 putStr $ ebuf ++ if null ebuf || last ebuf /= '\n'
-                      [x] -> go (appendBuf stream buf x)
+                                    then "" else "\n"
-                      x:xs -> do
+                 putStr obuf
-                        putStr $ unlines $ reverse xs
+           work (GmOutStream, GmLines GmPartial "") buf flush
-                        hFlush stdout
+           putMVar mv ()
-                        go (appendBuf stream buf x)
+       Right l ->
+           work l buf go
+
+   work (stream, GmLines ty l) buf@(obuf, ebuf) cont = case ty of
+           GmTerminated ->
+              case stream of
+                GmOutStream ->
+                    putStr (obuf++l) >> hFlush stdout >> cont ("", ebuf)
+                GmErrStream ->
+                    putStr (ebuf++l) >> hFlush stdout >> cont (obuf, "")
+
+           GmPartial ->
+              case reverse $ lines l of
+                [] -> cont buf
+                [x] -> cont (appendBuf stream buf x)
+                x:xs -> do
+                  putStr $ unlines $ reverse xs
+                  hFlush stdout
+                  cont (appendBuf stream buf x)
 
    appendBuf GmOutStream (obuf, ebuf) s = (obuf++s, ebuf)
    appendBuf GmErrStream (obuf, ebuf) s = (obuf, ebuf++s)

Language/Haskell/GhcMod/Types.hs

@@ -192,7 +192,7 @@ data GhcModEnv = GhcModEnv {
 
 data GhcModOut = GhcModOut {
       gmoOptions :: OutputOpts
-    , gmoChan    :: Chan (GmStream, GmLines String)
+    , gmoChan    :: Chan (Either (MVar ()) (GmStream, GmLines String))
     }
 
 data GhcModLog = GhcModLog {