ghci-quickfix-0.1.0.0: test/Main.hs

module Main (main) where

import           Control.Concurrent (threadDelay)
import           Control.Concurrent.Async (race)
import           Control.Monad
import           Data.List (isInfixOf)
import qualified System.Directory as Dir
import           System.IO
import qualified System.Process as Proc
import           Test.Tasty
import           Test.Tasty.HUnit

main :: IO ()
main = defaultMain $ testGroup "Tests"
  [ testCase "ParseError1" $ runTest "ParseError1"
  , testCase "ParseError2" $ runTest "ParseError2"
  , testCase "TypeErr1" $ runTest "TypeErr1"
  , testCase "UnusedVar" $ runTest "UnusedVar"
  , testCase "IncompletePat" $ runTest "IncompletePat"
  , testCase "MultiMod" $ runTest "MultiMod"
  , testCase "WarningFix" runTestWarningFix
  ]

testModulePath :: String -> FilePath
testModulePath name = "test-modules/" <> name

-- Wait for GHCi prompt by reading output until we see "ghci>"
waitForPrompt :: Handle -> IO ()
waitForPrompt hOut = void $ race (go "") (threadDelay 6_000_000)
  where
    go acc = do
      ready <- hReady hOut
      if ready
        then do
          c <- hGetChar hOut
          let acc' = take 10 (c : acc)  -- Keep last 10 chars
          if "ghci>" `isInfixOf` reverse acc'
            then threadDelay 300_000  -- Brief delay for background thread
            else go acc'
        else do
          threadDelay 10_000  -- 10ms before checking again
          go acc

runTest :: String -> Assertion
runTest name = do
  let qfFile = testModulePath (name ++ ".qf")
  -- Remove any existing quickfix file
  qfExists <- Dir.doesFileExist qfFile
  when qfExists $ Dir.removeFile qfFile

  hDevNull <- openFile "/dev/null" WriteMode

  -- Use cabal repl to keep GHC alive long enough for background thread
  (Just ghciIn, Just ghciOut, _, h) <- Proc.createProcess
    (Proc.proc "cabal" ["repl", "test-modules:" ++ name])
      { Proc.std_in = Proc.CreatePipe
      , Proc.std_out = Proc.CreatePipe
      , Proc.std_err = Proc.UseHandle hDevNull
      }
  hSetBuffering ghciIn NoBuffering

  -- Wait for GHCi prompt
  waitForPrompt ghciOut

  -- Quit gracefully, ignoring errors if pipe is already closed
  void $ hPutStrLn ghciIn ":quit"
  void $ hClose ghciIn
  void $ Proc.waitForProcess h
  hClose hDevNull

  -- Check that quickfix file was created and has expected contents
  actualContents <- readFile qfFile
  expectedContents <- readFile $ qfFile ++ ".expected"
  assertEqual "Expected quickfix output" expectedContents actualContents

  -- Clean up
  Dir.removeFile qfFile

runTestWarningFix :: Assertion
runTestWarningFix = do
  let qfFile = testModulePath "WarningFix.qf"
      mod2File = testModulePath "WarningFix2.hs"
      mod2Broken = testModulePath "WarningFix2.hs.broken"
      mod2Fixed = testModulePath "WarningFix2.hs.fixed"

  -- Remove any existing quickfix file
  qfExists <- Dir.doesFileExist qfFile
  when qfExists $ Dir.removeFile qfFile

  -- Start with broken version (no type signature, has warning)
  Dir.copyFile mod2Broken mod2File

  hDevNull <- openFile "/dev/null" WriteMode

  -- Use cabal repl
  (Just ghciIn, Just ghciOut, _, h) <- Proc.createProcess
    (Proc.proc "cabal" ["repl", "test-modules:WarningFix"])
      { Proc.std_in = Proc.CreatePipe
      , Proc.std_out = Proc.CreatePipe
      , Proc.std_err = Proc.UseHandle hDevNull
      }
  hSetBuffering ghciIn NoBuffering

  -- Wait for GHCi prompt after initial compilation
  waitForPrompt ghciOut

  -- Check that quickfix file was created
  qfExists1 <- Dir.doesFileExist qfFile
  assertBool "Quickfix file should exist after initial compilation" qfExists1

  -- Check that quickfix file has error and warning
  actualContents1 <- readFile qfFile
  assertBool "Should have error and warning initially"
    (("error:" `isInfixOf` actualContents1) && ("warning:" `isInfixOf` actualContents1))

  -- Now fix the warning by copying fixed version
  Dir.copyFile mod2Fixed mod2File

  -- Reload in the repl
  void $ hPutStrLn ghciIn ":reload"

  -- Wait for GHCi prompt after reload
  waitForPrompt ghciOut

  -- Check that quickfix file now only has error, no warning
  actualContents2 <- readFile qfFile
  expectedContents <- readFile $ qfFile ++ ".expected"
  assertEqual "Expected only error after fix" expectedContents actualContents2

  -- Quit gracefully
  void $ hPutStrLn ghciIn ":quit"
  void $ hClose ghciIn
  void $ Proc.waitForProcess h
  hClose hDevNull

  -- Clean up
  Dir.removeFile qfFile
  Dir.removeFile mod2File