Update testcase.

Getting a type definition can produce more than one result. E.g. the type of the
symbol "pid" in:

1: data Parameter a = Parameter a
2: f :: forall a. Parameter a -> Parameter a
3: f pid = pid

is (Parameter a), and the definition of this type is two part: the definition of
Parameter on line 1, and the definition of a on line 2.

Author: peterwicksstringfield

test/functional/Reference.hs

@@ -1,13 +1,9 @@
 module Reference (tests) where
 
-import Control.Lens
 import Control.Monad.IO.Class
-import Control.Monad (forM)
-import qualified Data.Set as Set
+import Data.Tuple.Extra (first3)
 import Language.Haskell.LSP.Test
 import Language.Haskell.LSP.Types
-import Language.Haskell.LSP.Types.Lens
-import System.Directory (canonicalizePath)
 import System.FilePath ((</>))
 import System.Time.Extra (sleep)
 import Test.Hls.Util
@@ -136,10 +132,6 @@ tests = testGroup "references"
           ]
     ]
 
--- | To locate a symbol, we provide a path to the file from the HLS root
--- directory, the line number, and the column number. (0 indexed.)
-type SymbolLocation = (FilePath, Int, Int)
-
 -- | When we ask for all references to symbol "foo", should the declaration "foo
 -- = 2" be among the references returned?
 data IncludeDeclaration =
@@ -153,19 +145,6 @@ getReferences' (file, l, c) includeDeclaration = do
     where toBool YesIncludeDeclaration = True
           toBool NoExcludeDeclaration = False
 
-expectSameLocations :: [Location] -> [SymbolLocation] -> Assertion
-actual `expectSameLocations` expected = do
-    let actual' =
-            Set.map (\location -> (location ^. uri
-                                   , location ^. range . start . line
-                                   , location ^. range . start . character))
-            $ Set.fromList actual
-    expected' <- Set.fromList <$>
-        (forM expected $ \(file, l, c) -> do
-                              fp <- canonicalizePath $ referencesPath </> file
-                              return (filePathToUri fp, l, c))
-    actual' @?= expected'
-
 referencesPath :: FilePath
 referencesPath = "test/testdata/references"
 
@@ -189,4 +168,4 @@ referenceTest :: SymbolLocation -> IncludeDeclaration -> [SymbolLocation] -> Ass
 referenceTest loc includeDeclaration expected =
     referenceTestSession $ do
         actual <- getReferences' loc includeDeclaration
-        liftIO $ actual `expectSameLocations` expected
+        liftIO $ actual `expectSameLocations` map (first3 (referencesPath </>)) expected

test/functional/TypeDefinition.hs

@@ -1,57 +1,47 @@
 module TypeDefinition (tests) where
 
-import Control.Lens ((^.))
 import Control.Monad.IO.Class
+import Data.Tuple.Extra (first3)
 import Language.Haskell.LSP.Test
 import Language.Haskell.LSP.Types
-import qualified Language.Haskell.LSP.Types.Lens as L
-import System.Directory
 import System.FilePath ((</>))
 import Test.Hls.Util
 import Test.Tasty
-import Test.Tasty.ExpectedFailure (expectFailBecause)
 import Test.Tasty.HUnit
 
 tests :: TestTree
 tests = testGroup "type definitions" [
     testCase "finds local definition of record variable"
-        $ getTypeDefinitionTest' (11, 23) 8
+        $ getTypeDefinitionTest' 10 23 7 0
     , testCase "finds local definition of newtype variable"
-        $ getTypeDefinitionTest' (16, 21) 13
+        $ getTypeDefinitionTest' 15 21 12 0
     , testCase "finds local definition of sum type variable"
-        $ getTypeDefinitionTest' (21, 13) 18
+        $ getTypeDefinitionTest' 20 13 17 0
     , knownBrokenForGhcVersions [GHC88] "Definition of sum type not found from data constructor in GHC 8.8.x" $
       testCase "finds local definition of sum type constructor"
-        $ getTypeDefinitionTest' (24, 7) 18
+        $ getTypeDefinitionTest' 23 7 17 0
     , testCase "finds non-local definition of type def"
-        $ getTypeDefinitionTest' (30, 17) 27
+        $ getTypeDefinitionTest' 29 17 26 0
     , testCase "find local definition of type def"
-        $ getTypeDefinitionTest' (35, 16) 32
+        $ getTypeDefinitionTest' 34 16 31 0
     , testCase "find type-definition of type def in component"
-        $ getTypeDefinitionTest "src/Lib2.hs" (13, 20) "src/Lib.hs" 8
-    , expectFailBecause "Why is this failing?" $
-      testCase "find definition of parameterized data type"
-        $ getTypeDefinitionTest' (40, 19) 37
+        $ getTypeDefinitionTest ("src/Lib2.hs", 12, 20) [("src/Lib.hs", 7, 0)]
+    , testCase "find definition of parameterized data type"
+        $ getTypeDefinitionTest ("src/Lib.hs", 39, 19) [ ("src/Lib.hs", 36, 0)
+                                                       , ("src/Lib.hs", 38, 0)]
     ]
 
-getTypeDefinitionTest :: String -> (Int, Int) -> String -> Int -> Assertion
-getTypeDefinitionTest symbolFile symbolPosition definitionFile definitionLine =
-    failIfSessionTimeout . runSession hlsCommand fullCaps "test/testdata/gototest" $ do
-        doc  <- openDoc symbolFile "haskell"
-        _  <- openDoc definitionFile "haskell"
-        defs <- getTypeDefinitions doc $ toPos symbolPosition
-        fp <- liftIO $ canonicalizePath $ "test/testdata/gototest" </> definitionFile
-        liftIO $ do
-            length defs == 1 @? "Expecting a list containing one location, but got: " ++ show defs
-            let [def] = defs
-            def ^. L.uri @?= filePathToUri fp
-            def ^. L.range . L.start . L.line @?= definitionLine - 1
-            def ^. L.range . L.end . L.line @?= definitionLine - 1
+definitionsPath :: FilePath
+definitionsPath = "test/testdata/gototest"
 
-getTypeDefinitionTest' :: (Int, Int) -> Int -> Assertion
-getTypeDefinitionTest' symbolPosition definitionLine =
-    getTypeDefinitionTest "src/Lib.hs" symbolPosition "src/Lib.hs" definitionLine
+getTypeDefinitionTest :: SymbolLocation -> [SymbolLocation] -> Assertion
+getTypeDefinitionTest (symbolFile, symbolLine, symbolCol) definitionLocations =
+    failIfSessionTimeout . runSession hlsCommand fullCaps definitionsPath $ do
+        doc  <- openDoc symbolFile "haskell"
+        defs <- getTypeDefinitions doc $ Position symbolLine symbolCol
+        liftIO $ defs `expectSameLocations` map (first3 (definitionsPath </>)) definitionLocations
 
---NOTE: copied from Haskell.Ide.Engine.ArtifactMap
-toPos :: (Int,Int) -> Position
-toPos (l,c) = Position (l-1) (c-1)
+getTypeDefinitionTest' :: Int -> Int -> Int -> Int -> Assertion
+getTypeDefinitionTest' symbolLine symbolCol definitionLine definitionCol =
+    getTypeDefinitionTest ("src/Lib.hs", symbolLine, symbolCol)
+                          [("src/Lib.hs", definitionLine, definitionCol)]

test/utils/Test/Hls/Util.hs

@@ -6,6 +6,7 @@ module Test.Hls.Util
     , expectCodeAction
     , expectDiagnostic
     , expectNoMoreDiagnostics
+    , expectSameLocations
     , failIfSessionTimeout
     , flushStackEnvironment
     , fromAction
@@ -22,6 +23,7 @@ module Test.Hls.Util
     , knownBrokenForGhcVersions
     , logFilePath
     , setupBuildToolFiles
+    , SymbolLocation
     , waitForDiagnosticsFrom
     , waitForDiagnosticsFromSource
     , waitForDiagnosticsFromSourceWithTimeout
@@ -38,6 +40,7 @@ import           Data.Default
 import           Data.List (intercalate)
 import           Data.List.Extra (find)
 import           Data.Maybe
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import           Language.Haskell.LSP.Core
 import           Language.Haskell.LSP.Messages (FromServerMessage(NotLogMessage))
@@ -55,7 +58,7 @@ import           Test.Hspec.Runner
 import           Test.Hspec.Core.Formatters hiding (Seconds)
 import           Test.Tasty (TestTree)
 import           Test.Tasty.ExpectedFailure (ignoreTestBecause, expectFailBecause)
-import           Test.Tasty.HUnit (assertFailure)
+import           Test.Tasty.HUnit (Assertion, assertFailure, (@?=))
 import           Text.Blaze.Renderer.String (renderMarkup)
 import           Text.Blaze.Internal hiding (null)
 
@@ -397,3 +400,20 @@ failIfSessionTimeout action = action `catch` errorHandler
     where errorHandler :: Test.SessionException -> IO a
           errorHandler e@(Test.Timeout _) = assertFailure $ show e
           errorHandler e = throwIO e
+
+-- | To locate a symbol, we provide a path to the file from the HLS root
+-- directory, the line number, and the column number. (0 indexed.)
+type SymbolLocation = (FilePath, Int, Int)
+
+expectSameLocations :: [Location] -> [SymbolLocation] -> Assertion
+actual `expectSameLocations` expected = do
+    let actual' =
+            Set.map (\location -> (location ^. L.uri
+                                   , location ^. L.range . L.start . L.line
+                                   , location ^. L.range . L.start . L.character))
+            $ Set.fromList actual
+    expected' <- Set.fromList <$>
+        (forM expected $ \(file, l, c) -> do
+                              fp <- canonicalizePath file
+                              return (filePathToUri fp, l, c))
+    actual' @?= expected'