From 607d1f2d30c35693cff51546f436931000ca9b89 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Wed, 2 Nov 2022 20:11:29 +0100
Subject: Remove some of the re-restarting logic, useless

---
 src/Ghci.hs | 26 +++++++++++++++++++-------
 1 file changed, 19 insertions(+), 7 deletions(-)

(limited to 'src')

diff --git a/src/Ghci.hs b/src/Ghci.hs
index 7567133..97943db 100644
--- a/src/Ghci.hs
+++ b/src/Ghci.hs
@@ -26,7 +26,7 @@ import Foreign (allocaBytes)
 import System.IO (hFlush, hIsClosed, hGetBufSome, hPutStrLn, stdout, stderr, Handle)
 import System.Process
 import System.Random (getStdRandom, uniformR)
-import System.Timeout (timeout)
+import System.Timeout (timeout, Timeout)
 
 import ExitEarly
 
@@ -87,7 +87,7 @@ runStmtClever ghci line =
     long `startsWith` short = take (length short) long == short
 
 runStmt :: Ghci -> String -> IO (Ghci, Result String)
-runStmt ghci line = timeouting 2_000_000 (restarting 1 (\g -> runStmt' g line)) ghci
+runStmt ghci line = timeouting 2_000_000 (restarting (\g -> runStmt' g line)) ghci
 
 timeouting :: Int -> (Ghci -> IO (Ghci, Result a)) -> Ghci -> IO (Ghci, Result a)
 timeouting microseconds f ghci =
@@ -102,8 +102,8 @@ timeouting microseconds f ghci =
                   return (ghci', Error "<timeout>")
     Just pair -> return pair
 
-restarting :: Int -> (Ghci -> IO a) -> Ghci -> IO (Ghci, Result a)
-restarting numExcRestarts f ghci = do
+restarting :: (Ghci -> IO a) -> Ghci -> IO (Ghci, Result a)
+restarting f ghci = do
   closed <- hIsClosed (ghciStdin ghci)
   ghci' <- if closed
              then do
@@ -114,14 +114,26 @@ restarting numExcRestarts f ghci = do
              else return ghci
 
   fmap (\x -> (ghci', Return x)) (f ghci')
+    `catch` (\e -> do let _ = e :: Timeout
+                      putStrLn "ghci: restarting due to timeout (caught in restarting)"
+                      hFlush stdout
+                      terminateGhci ghci
+                      -- putStrLn $ "ghci: terminated"
+                      -- hFlush stdout
+                      ghci'' <- makeGhci
+                      -- putStrLn $ "ghci: new made"
+                      -- hFlush stdout
+                      return (ghci'', Error "<timeout>"))
     `catch` (\e -> do let _ = e :: SomeException
                       putStrLn $ "ghci: restarting due to exception: " ++ show e
                       hFlush stdout
                       terminateGhci ghci'
+                      -- putStrLn $ "ghci: terminated"
+                      -- hFlush stdout
                       ghci'' <- makeGhci
-                      if numExcRestarts >= 1
-                        then restarting (numExcRestarts - 1) f ghci''
-                        else return (ghci'', Error "Oops, something went wrong"))
+                      -- putStrLn $ "ghci: new made"
+                      -- hFlush stdout
+                      return (ghci'', Error "Oops, something went wrong"))
 
 terminateGhci :: Ghci -> IO ()
 terminateGhci ghci = terminateProcess (ghciProc ghci)
-- 
cgit v1.2.3-70-g09d2