Add check for indexing message

Author: nlander

haskell-language-server.cabal

@@ -568,6 +568,7 @@ test-suite func-test
     , containers
     , unordered-containers
     , row-types
+    , process
 
   hs-source-dirs:     test/functional test/utils
 

test/functional/Definition.hs

@@ -1,10 +1,24 @@
+{-# LANGUAGE DataKinds                #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE GADTs                    #-}
+{-# LANGUAGE LambdaCase               #-}
+{-# LANGUAGE NamedFieldPuns           #-}
+{-# LANGUAGE TypeApplications         #-}
+{-# LANGUAGE ViewPatterns             #-}
+
 module Definition (tests) where
 
 import           Control.Lens
+import           Data.Aeson                 (Result (Success), fromJSON)
+import           Data.Bool                  (bool)
 import           Data.List                  (isSuffixOf)
-import           Language.LSP.Protocol.Lens
+import           Data.Proxy                 (Proxy (Proxy))
+import qualified Data.Text                  as T
+import           Language.LSP.Protocol.Lens (uri)
 import           System.Directory
+import           System.Exit                (ExitCode(ExitSuccess))
 import           System.FilePath            (splitDirectories)
+import           System.Process             (readCreateProcessWithExitCode, shell)
 import           Test.Hls
 import           Test.Hls.Command
 
@@ -43,26 +57,57 @@ symbolTests = testGroup "gotoDefinition on symbols"
         -- gotoDefinition where the definition is in an external
         -- dependency.
   ,    testCase "gotoDefinition in dependency" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do
+        liftIO $ do
+            (exitCode, _out, _err) <- readCreateProcessWithExitCode (shell "cabal build") ""
+            exitCode @?= ExitSuccess
         doc <- openDoc "Bar.hs" "haskell"
-        defs <- getDefinitions doc (Position 13 12)
-        let expRange = Range (Position 513 0) (Position 513 4)
+        _mHieFile <- fileDoneIndexing ["Data", "Aeson", "Types", "Internal.hie"]
+        defs <- getDefinitions doc (Position 13 13)
+        let expRange = Range (Position 370 13) (Position 370 16)
         case defs of
             InL (Definition (InR [Location fp actualRange])) ->
                 liftIO $ do
                     let locationDirectories :: [String]
                         locationDirectories =
                             maybe [] splitDirectories $
                                 uriToFilePath fp
-                    assertBool "empty not found in Data.Set.Internal"
-                        $ ["Data", "Set", "Internal.hs"]
+                    assertBool "empty not found in Data.Aeson.Types.Internal"
+                        $ ["Data", "Aeson", "Types", "Internal.hs"]
                             `isSuffixOf` locationDirectories
                     actualRange @?= expRange
             wrongLocation ->
                 liftIO $
-                    assertFailure $ "Wrong location for Set.empty: "
+                    assertFailure $ "Wrong location for Null: "
                         ++ show wrongLocation
   ]
 
+fileDoneIndexing :: [String] -> Session (Maybe FilePath)
+fileDoneIndexing fpSuffix =
+    skipManyTill anyMessage (indexedFile <|> doneIndexing)
+    where
+        indexedFile :: Session (Maybe FilePath)
+        indexedFile = do
+            NotMess TNotificationMessage{_params} <-
+                customNotification (Proxy @"ghcide/reference/ready")
+            case fromJSON _params of
+                Success fp -> do
+                    let fpDirs :: [String]
+                        fpDirs = splitDirectories fp
+                    bool empty (pure (Just fp)) $
+                        fpSuffix `isSuffixOf` fpDirs
+                other -> error $ "Failed to parse ghcide/reference/ready file: " <> show other
+        doneIndexing :: Session (Maybe FilePath)
+        doneIndexing = satisfyMaybe $ \case
+            FromServerMess SMethod_Progress (TNotificationMessage _ _ (ProgressParams t (preview _workDoneProgressEnd -> Just params))) ->
+                case params of
+                    (WorkDoneProgressEnd _ m) ->
+                        case m of
+                            Just message -> bool Nothing (Just Nothing) $
+                                "Finished indexing" `T.isPrefixOf` message
+                            _ -> Nothing
+                    _ -> Nothing
+            _ -> Nothing
+
   -- -----------------------------------
 
 moduleTests :: TestTree

test/testdata/definition/Bar.hs

@@ -1,6 +1,6 @@
 module Bar where
 
-import Data.Set (Set, empty)
+import Data.Aeson (Value(Null))
 
 a = 42
 
@@ -10,5 +10,5 @@ a = 42
 -- the number of lines in Foo.hs.
 b = 43
 
-emptySet :: Set Integer
-emptySet = empty
+nullValue :: Value
+nullValue = Null

test/testdata/definition/cabal.project

@@ -1,5 +1,5 @@
 packages: .
 source-repository-package
   type:git
-  location: https://github.com/haskell/containers.git
-  tag: cde5e58b12e744ca4742db71443bee6584dfd1e9
+  location: https://github.com/haskell/aeson.git
+  tag: fc5f5bb067613a273de358f09760b635d6f78c82

test/testdata/definition/definitions.cabal

@@ -8,5 +8,5 @@ library
   other-modules:    Bar
   default-language: Haskell2010
   build-depends:    base
-                  , containers
+                  , aeson
   ghc-options: -fwrite-ide-info