SetupHooksTests.hs

-- | Tests for @build-type: Hooks@ support in HLS.
module SetupHooksTests (tests) where

import           Config                      (runWithExtraFiles)
import           Control.Exception           (bracket_)
import           Control.Monad.IO.Class      (liftIO)
import           System.Environment.Blank    (setEnv, unsetEnv)
import           Development.IDE.GHC.Util    (readFileUtf8)
import           Development.IDE.Plugin.Test (WaitForIdeRuleResult (..))
import           Development.IDE.Test        (expectCurrentDiagnostics,
                                              waitForAction,
                                              waitForTypecheck)
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types hiding
                                             (SemanticTokenAbsolute (..),
                                              SemanticTokenRelative (..),
                                              SemanticTokensEdit (..),
                                              mkRange)
import           Language.LSP.Test
import           System.FilePath
import           Test.Hls                    (waitForProgressDone,
                                              waitForAllProgressDone)
import           Test.Hls.FileSystem         (atomicFileWriteString)
import           Test.Tasty
import           Test.Tasty.HUnit

tests :: TestTree
tests = testGroup "build-type: Hooks"
  [ testCase "loads generated modules" hooksInitialLoad
  , testCase "re-runs rules when rule input changes" hooksRuleInputChange
  ]

-- | Increased timeout for setup-hooks tests, which need to compile
-- @Cabal-syntax@, @Cabal@ and @Cabal-hooks@ in order to compile @SetupHooks.hs@.
withHooksTimeout :: IO a -> IO a
withHooksTimeout = bracket_ (setEnv "LSP_TIMEOUT" "600" True) (unsetEnv "LSP_TIMEOUT")
  -- LSP_TIMEOUT = 600 seconds = 10 minutes
  -- (I know this is really long but in CI I have seen it take over 4 minutes)

-- | Open a module that imports module generated by a pre-build rule,
-- ensuring that it successfully compiles.
hooksInitialLoad :: IO ()
hooksInitialLoad = withHooksTimeout $ runWithExtraFiles "setup-hooks" $ \dir -> do
  let libPath = dir </> "Lib.hs"
  libSrc <- liftIO $ readFileUtf8 libPath
  libDoc <- createDoc libPath "haskell" libSrc
  waitForProgressDone
  expectCurrentDiagnostics libDoc []

-- | Modify a .myPP pre-build rule input, notify HLS, and verify the regenerated
-- module causes an expected type error.
--
-- This checks that HLS re-runs pre-build rules when necessary.
hooksRuleInputChange :: IO ()
hooksRuleInputChange = withHooksTimeout $ runWithExtraFiles "setup-hooks" $ \dir -> do
  let libPath = dir </> "Lib.hs"
      genMyPP = dir </> "Gen.myPP"
  libSrc <- liftIO $ readFileUtf8 libPath
  libDoc <- createDoc libPath "haskell" libSrc

  -- Check the package builds. This ensures SetupHooks.hs compiled successfully,
  -- and that the pre-build rules were run (generating Gen.hs).
  waitForAllProgressDone
  expectCurrentDiagnostics libDoc []

  -- Modify Gen.myPP, changing the type of 'genVal'.
  liftIO $ atomicFileWriteString genMyPP "genVal :: Bool\ngenVal = True\n"

  -- Notify HLS that Gen.myPP has changed. HLS should trigger a re-run of
  -- pre-build rules.
  sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams
    [FileEvent (filePathToUri genMyPP) FileChangeType_Changed]

  -- Wait for the session to reload, which should re-run pre-build rules.
  WaitForIdeRuleResult { ideResultSuccess = sessionOk } <- waitForAction "GhcSession" libDoc
  liftIO $ assertBool "GhcSession should succeed after reload" sessionOk

  -- We now expect a type error from the change in type of 'genVal'.
  _ <- waitForTypecheck libDoc
  expectCurrentDiagnostics libDoc
    [(DiagnosticSeverity_Error, (3, 9), "Couldn't match", Just "GHC-83865")]