refactor: split off StackTest.Repl

Author: ulidtko

stack.cabal

@@ -629,6 +629,7 @@ executable stack-integration-test
   main-is: IntegrationSpec.hs
   other-modules:
       StackTest
+      StackTest.Repl
       Paths_stack
   autogen-modules:
       Paths_stack

tests/integration/lib/StackTest.hs

@@ -13,14 +13,6 @@ module StackTest
   , stackCleanFull
   , stackIgnoreException
   , stackErr
-  , Repl
-  , ReplConnection (..)
-  , nextPrompt
-  , replCommand
-  , replGetChar
-  , replGetLine
-  , runRepl
-  , repl
   , stackStderr
   , stackCheckStderr
   , stackErrStderr
@@ -49,17 +41,11 @@ module StackTest
   , superslow
   ) where
 
-import           Control.Monad ( forever, unless, void, when )
-import           Control.Monad.IO.Class ( liftIO )
-import           Control.Monad.Trans.Reader ( ReaderT, ask, asks, runReaderT )
-import qualified Control.Monad.Trans.State as State
-import           Control.Monad.Trans ( lift )
-import           Control.Concurrent ( forkIO )
+import           Control.Monad ( unless, void, when )
 import           Control.Exception
-                   ( Exception (..), IOException, bracket_, catch, throw
+                   ( Exception (..), IOException, bracket_, catch
                    , throwIO
                    )
-import           Data.Maybe ( fromMaybe )
 import           GHC.Stack ( HasCallStack )
 import           System.Environment ( getEnv, lookupEnv )
 import           System.Directory
@@ -68,14 +54,12 @@ import           System.Directory
                    , setCurrentDirectory
                    )
 import           System.IO
-                   ( BufferMode (..), Handle, IOMode (..), hGetChar, hGetLine
-                   , hPutChar, hPutStr, hPutStrLn, hSetBuffering, stderr
-                   , withFile
+                   ( hPutStr, hPutStrLn, stderr
                    )
 import           System.IO.Error
-                   ( isDoesNotExistError, isEOFError )
+                   ( isDoesNotExistError )
 import           System.Process
-                   ( CreateProcess (..), StdStream (..), createProcess, proc
+                   ( CreateProcess (..), createProcess, proc
                    , readCreateProcessWithExitCode, readProcessWithExitCode
                    , shell, waitForProcess
                    )
@@ -151,76 +135,6 @@ stackErr args = do
   ec <- stack' args
   when (ec == ExitSuccess) $ error "stack was supposed to fail, but didn't"
 
-type Repl = ReaderT ReplConnection IO
-
-data ReplConnection = ReplConnection
-  { replStdin  :: Handle
-  , replStdout :: Handle
-  }
-
-nextPrompt :: Repl ()
-nextPrompt = State.evalStateT poll "" where
-  poll = do
-    c <- lift (asks replStdout) >>= liftIO . hGetChar
-    State.modify (++ [c]) -- FIXME crap perf
-    when (c == '\n') $ do
-      State.get >>= liftIO . putStr . ("ghci> " <>)
-      State.put ""
-    buf <- State.get
-    unless (buf == "ghci> ")
-      poll
-
-replCommand :: String -> Repl ()
-replCommand cmd = do
-  (ReplConnection replStdinHandle _) <- ask
-  liftIO $ hPutStrLn replStdinHandle cmd
-
-replGetLine :: Repl String
-replGetLine = ask >>= liftIO . hGetLine . replStdout
-
-replGetChar :: Repl Char
-replGetChar = ask >>= liftIO . hGetChar . replStdout
-
-runRepl ::
-     HasCallStack
-  => FilePath
-  -> [String]
-  -> ReaderT ReplConnection IO ()
-  -> IO ExitCode
-runRepl cmd args actions = do
-  logInfo $ "Running: " ++ cmd ++ " " ++ unwords (map showProcessArgDebug args)
-  (Just rStdin, Just rStdout, Just rStderr, ph) <-
-    createProcess (proc cmd args)
-      { std_in = CreatePipe
-      , std_out = CreatePipe
-      , std_err = CreatePipe
-      }
-  hSetBuffering rStdin NoBuffering
-  hSetBuffering rStdout NoBuffering
-  hSetBuffering rStderr NoBuffering
-  -- Log stack repl's standard error output
-  tempDir <- if isWindows
-                then fromMaybe "" <$> lookupEnv "TEMP"
-                else pure "/tmp"
-  let tempLogFile = tempDir ++ "/stderr"
-  _ <- forkIO $ withFile tempLogFile WriteMode $ \logFileHandle -> do
-    hSetBuffering logFileHandle NoBuffering
-    forever $
-      catch
-        (hGetChar rStderr >>= hPutChar logFileHandle)
-        (\e -> unless (isEOFError e) $ throw e)
-  runReaderT actions (ReplConnection rStdin rStdout)
-  waitForProcess ph
-
-repl :: HasCallStack => [String] -> Repl () -> IO ()
-repl args action = do
-  stackExe' <- stackExe
-  ec <- runRepl stackExe' ("repl":args) action
-  unless (ec == ExitSuccess) $ pure ()
-  -- TODO: Understand why the exit code is 1 despite running GHCi tests
-  -- successfully.
-  -- else error $ "Exited with exit code: " ++ show ec
-
 stackStderr :: HasCallStack => [String] -> IO (ExitCode, String)
 stackStderr args = do
   stackExe' <- stackExe

tests/integration/lib/StackTest/Repl.hs

@@ -0,0 +1,104 @@
+{- |
+Integration-test helpers & fixtures for testing `stack repl`
+-}
+module StackTest.Repl
+    ( Repl
+    , ReplConnection (..)
+    , nextPrompt
+    , repl
+    , replCommand
+    , replGetLine
+    ) where
+
+import Control.Concurrent (forkIO)
+import Control.Exception (throw, catch)
+import Control.Monad (forever, unless, when)
+import Control.Monad.IO.Class (liftIO)
+import Data.Maybe (fromMaybe)
+import GHC.Stack (HasCallStack)
+import System.Environment (lookupEnv)
+import System.Exit (ExitCode (..))
+import System.IO
+    ( BufferMode (NoBuffering), Handle, IOMode (WriteMode)
+    , hGetChar, hGetLine, hPutChar, hPutStrLn, hSetBuffering
+    , withFile
+    )
+import System.IO.Error (isEOFError)
+
+import Control.Monad.Trans (lift)
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State qualified as State
+import System.Process
+    ( CreateProcess (std_err, std_in, std_out)
+    , StdStream (CreatePipe)
+    , createProcess, proc, waitForProcess
+    )
+
+import StackTest
+
+type Repl = ReaderT ReplConnection IO
+
+data ReplConnection = ReplConnection
+  { replStdin  :: Handle
+  , replStdout :: Handle
+  }
+
+nextPrompt :: Repl ()
+nextPrompt = State.evalStateT poll "" where
+  poll = do
+    c <- lift (asks replStdout) >>= liftIO . hGetChar
+    State.modify (++ [c]) -- FIXME crap perf
+    when (c == '\n') $ do
+      State.get >>= liftIO . putStr . ("ghci> " <>)
+      State.put ""
+    buf <- State.get
+    unless (buf == "ghci> ")
+      poll
+
+replCommand :: String -> Repl ()
+replCommand cmd = do
+  (ReplConnection replStdinHandle _) <- ask
+  liftIO $ hPutStrLn replStdinHandle cmd
+
+replGetLine :: Repl String
+replGetLine = ask >>= liftIO . hGetLine . replStdout
+
+runRepl
+  :: HasCallStack
+  => FilePath
+  -> [String]
+  -> ReaderT ReplConnection IO ()
+  -> IO ExitCode
+runRepl cmd args actions = do
+  logInfo $ "Running: " ++ cmd ++ " " ++ unwords (map showProcessArgDebug args)
+  (Just rStdin, Just rStdout, Just rStderr, ph) <-
+    createProcess (proc cmd args)
+      { std_in = CreatePipe
+      , std_out = CreatePipe
+      , std_err = CreatePipe
+      }
+  hSetBuffering rStdin NoBuffering
+  hSetBuffering rStdout NoBuffering
+  hSetBuffering rStderr NoBuffering
+  -- Log stack repl's standard error output
+  tempDir <- if isWindows
+                then fromMaybe "" <$> lookupEnv "TEMP"
+                else pure "/tmp"
+  let tempLogFile = tempDir ++ "/stderr"
+  _ <- forkIO $ withFile tempLogFile WriteMode $ \logFileHandle -> do
+    --hSetBuffering logFileHandle NoBuffering
+    forever $
+      catch
+        (hGetChar rStderr >>= hPutChar logFileHandle)
+        (\e -> unless (isEOFError e) $ throw e)
+  runReaderT actions (ReplConnection rStdin rStdout)
+  waitForProcess ph
+
+repl :: HasCallStack => [String] -> Repl () -> IO ()
+repl args action = do
+  stackExe' <- stackExe
+  ec <- runRepl stackExe' ("repl":args) action
+  unless (ec == ExitSuccess) $ pure ()
+  -- TODO: Understand why the exit code is 1 despite running GHCi tests
+  -- successfully.
+  -- else error $ "Exited with exit code: " ++ show ec

tests/integration/tests/3926-ghci-with-sublibraries/Main.hs

@@ -2,6 +2,7 @@ import Control.Monad.IO.Class
 import Control.Monad
 import Data.List
 import StackTest
+import StackTest.Repl
 
 main :: IO ()
 main

tests/integration/tests/4270-files-order/Main.hs

@@ -1,5 +1,6 @@
 import Control.Monad
 import StackTest
+import StackTest.Repl
 
 main :: IO ()
 main = do

tests/integration/tests/module-added-multiple-times/Main.hs

@@ -1,6 +1,5 @@
 import Control.Monad
-import Data.List
-import StackTest
+import StackTest.Repl
 
 main :: IO ()
 main = repl ["--ghci-options=-ignore-dot-ghci"] $ do