Flush stdout more

1 files changed, 7 insertions, 2 deletions

diff --git a/src/Ghci.hs b/src/Ghci.hs
index f931a7b..7567133 100644
--- a/src/Ghci.hs
+++ b/src/Ghci.hs
@@ -23,7 +23,7 @@ import qualified Data.ByteString.Short as BSS
 import Data.Char (isSpace, toLower)
 import Data.List (nub)
 import Foreign (allocaBytes)
-import System.IO (hFlush, hIsClosed, hGetBufSome, hPutStrLn, stderr, Handle)
+import System.IO (hFlush, hIsClosed, hGetBufSome, hPutStrLn, stdout, stderr, Handle)
 import System.Process
 import System.Random (getStdRandom, uniformR)
 import System.Timeout (timeout)
@@ -77,6 +77,7 @@ runStmtClever ghci line =
         | "quit" `startsWith` cmd -> do
             terminateGhci ghci
             putStrLn "ghci: restarting due to :quit"
+            hFlush stdout
             ghci' <- makeGhci
             return (ghci', Return "")
       _ -> runStmt ghci line
@@ -95,6 +96,7 @@ timeouting microseconds f ghci =
   -- 'restarting'.
   timeout microseconds (f ghci) >>= \case
     Nothing -> do putStrLn "ghci: restarting due to timeout"
+                  hFlush stdout
                   terminateGhci ghci
                   ghci' <- makeGhci
                   return (ghci', Error "<timeout>")
@@ -106,12 +108,15 @@ restarting numExcRestarts f ghci = do
   ghci' <- if closed
              then do
                putStrLn "ghci: restarting due to closed stdin"
+               hFlush stdout
                terminateGhci ghci
                makeGhci
              else return ghci
-  (f ghci' >>= \x -> return (ghci', Return x))
+
+  fmap (\x -> (ghci', Return x)) (f ghci')
     `catch` (\e -> do let _ = e :: SomeException
                       putStrLn $ "ghci: restarting due to exception: " ++ show e
+                      hFlush stdout
                       terminateGhci ghci'
                       ghci'' <- makeGhci
                       if numExcRestarts >= 1