BootTests.hs

module BootTests (tests) where

import           Config                          (checkDefs, mkR, runInDir,
                                                  runWithExtraFiles)
import           Control.Applicative.Combinators
import           Control.Monad
import           Control.Monad.IO.Class          (liftIO)
import           Development.IDE.GHC.Util
import           Development.IDE.Test            (expectNoMoreDiagnostics,
                                                  isReferenceReady)
import           Development.IDE.Types.Location
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types     hiding
                                                 (SemanticTokenAbsolute (..),
                                                  SemanticTokenRelative (..),
                                                  SemanticTokensEdit (..),
                                                  mkRange)
import           Language.LSP.Test
import           System.FilePath                 ((</>))
import           Test.Tasty
import           Test.Tasty.HUnit


tests :: TestTree
tests = testGroup "boot"
  [ testCase "boot-def-test" $ runWithExtraFiles "boot" $ \dir -> do
        let cPath = dir </> "C.hs"
        cSource <- liftIO $ readFileUtf8 cPath
        -- Dirty the cache
        liftIO $ runInDir dir $ do
            cDoc <- createDoc cPath "haskell" cSource
            -- We send a hover request then wait for either the hover response or
            -- `ghcide/reference/ready` notification.
            -- Once we receive one of the above, we wait for the other that we
            -- haven't received yet.
            -- If we don't wait for the `ready` notification it is possible
            -- that the `getDefinitions` request/response in the outer ghcide
            -- session will find no definitions.
            let hoverParams = HoverParams cDoc (Position 4 3) Nothing
            hoverRequestId <- sendRequest SMethod_TextDocumentHover hoverParams
            let parseReadyMessage = isReferenceReady cPath
            let parseHoverResponse = responseForId SMethod_TextDocumentHover hoverRequestId
            hoverResponseOrReadyMessage <- skipManyTill anyMessage ((Left <$> parseHoverResponse) <|> (Right <$> parseReadyMessage))
            _ <- skipManyTill anyMessage $
              case hoverResponseOrReadyMessage of
                Left _  -> void parseReadyMessage
                Right _ -> void parseHoverResponse
            closeDoc cDoc
        cdoc <- createDoc cPath "haskell" cSource
        locs <- getDefinitions cdoc (Position 7 4)
        let floc = mkR 9 0 9 1
        checkDefs locs (pure [floc])
  , testCase "graph with boot modules" $ runWithExtraFiles "boot2" $ \dir -> do
      _ <- openDoc (dir </> "A.hs") "haskell"
      expectNoMoreDiagnostics 2
  ]