Merge pull request #690 from peterwicksstringfield/enable_get_type_definition_tests

Enable get type definition tests

Author: jneira

test/functional/TypeDefinition.hs

@@ -1,102 +1,54 @@
 module TypeDefinition (tests) where
 
+import Control.Lens ((^.))
 import Control.Monad.IO.Class
 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 (ignoreTestBecause)
 import Test.Tasty.HUnit
 
 tests :: TestTree
 tests = testGroup "type definitions" [
-    ignoreTestBecause "Broken" $ testCase "finds local definition of record variable"
-        $ runSession hlsCommand fullCaps "test/testdata/gototest"
-        $ do
-            doc  <- openDoc "src/Lib.hs" "haskell"
-            defs <- getTypeDefinitions doc (toPos (11, 23))
-            liftIO $ do
-                fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
-                defs @?= [ Location (filePathToUri fp)
-                                    (Range (toPos (8, 1)) (toPos (8, 29)))
-                         ]
-    , ignoreTestBecause "Broken" $ testCase "finds local definition of newtype variable"
-        $ runSession hlsCommand fullCaps "test/testdata/gototest"
-        $ do
-            doc  <- openDoc "src/Lib.hs" "haskell"
-            defs <- getTypeDefinitions doc (toPos (16, 21))
-            liftIO $ do
-                fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
-                defs @?= [ Location (filePathToUri fp)
-                                    (Range (toPos (13, 1)) (toPos (13, 30)))
-                         ]
-    , ignoreTestBecause "Broken" $ testCase "finds local definition of sum type variable"
-        $ runSession hlsCommand fullCaps "test/testdata/gototest"
-        $ do
-            doc  <- openDoc "src/Lib.hs" "haskell"
-            defs <- getTypeDefinitions doc (toPos (21, 13))
-            liftIO $ do
-                fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
-                defs @?= [ Location (filePathToUri fp)
-                                    (Range (toPos (18, 1)) (toPos (18, 26)))
-                         ]
-    , ignoreTestBecause "Broken" $ testCase "finds local definition of sum type contructor"
-            $ runSession hlsCommand fullCaps "test/testdata/gototest"
-            $ do
-                doc  <- openDoc "src/Lib.hs" "haskell"
-                defs <- getTypeDefinitions doc (toPos (24, 7))
-                liftIO $ do
-                    fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
-                    defs
-                        @?= [ Location (filePathToUri fp)
-                                       (Range (toPos (18, 1)) (toPos (18, 26)))
-                            ]
-    , ignoreTestBecause "Broken" $ testCase "can not find non-local definition of type def"
-        $ runSession hlsCommand fullCaps "test/testdata/gototest"
-        $ do
-            doc  <- openDoc "src/Lib.hs" "haskell"
-            defs <- getTypeDefinitions doc (toPos (30, 17))
-            liftIO $ defs @?= []
+    testCase "finds local definition of record variable"
+        $ getTypeDefinitionTest' (11, 23) 8
+    , testCase "finds local definition of newtype variable"
+        $ getTypeDefinitionTest' (16, 21) 13
+    , testCase "finds local definition of sum type variable"
+        $ getTypeDefinitionTest' (21, 13) 18
+    , 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
+    , testCase "finds non-local definition of type def"
+        $ getTypeDefinitionTest' (30, 17) 27
+    , testCase "find local definition of type def"
+        $ getTypeDefinitionTest' (35, 16) 32
+    , testCase "find type-definition of type def in component"
+        $ getTypeDefinitionTest "src/Lib2.hs" (13, 20) "src/Lib.hs" 8
+    , testCase "find definition of parameterized data type"
+        $ getTypeDefinitionTest' (40, 19) 37
+    ]
 
-    , ignoreTestBecause "Broken" $ testCase "find local definition of type def"
-        $ runSession hlsCommand fullCaps "test/testdata/gototest"
-        $ do
-            doc      <- openDoc "src/Lib.hs" "haskell"
-            defs <- getTypeDefinitions doc (toPos (35, 16))
-            liftIO $ do
-                fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
-                defs @?= [ Location (filePathToUri fp)
-                                    (Range (toPos (18, 1)) (toPos (18, 26)))
-                         ]
+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
 
-    {--  TODO Implement
-     , ignoreTestBecause "Broken" $ testCase "find type-definition of type def in component"
-         $ pendingWith "Finding symbols cross module is currently not supported"
-         $ runSession hlsCommand fullCaps "test/testdata/gototest"
-         $ do
-             doc      <- openDoc "src/Lib2.hs" "haskell"
-             otherDoc <- openDoc "src/Lib.hs" "haskell"
-             closeDoc otherDoc
-             defs <- getTypeDefinitions doc (toPos (13, 20))
-             liftIO $ do
-               fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
-               defs
-                 @?= [ Location (filePathToUri fp)
-                                       (Range (toPos (8, 1)) (toPos (8, 29)))
-                            ]
-    --}
-    , ignoreTestBecause "Broken" $ testCase "find definition of parameterized data type"
-        $ runSession hlsCommand fullCaps "test/testdata/gototest"
-        $ do
-            doc  <- openDoc "src/Lib.hs" "haskell"
-            defs <- getTypeDefinitions doc (toPos (40, 19))
-            liftIO $ do
-                fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs"
-                defs @?= [ Location (filePathToUri fp)
-                                    (Range (toPos (37, 1)) (toPos (37, 31)))
-                         ]
-    ]
+getTypeDefinitionTest' :: (Int, Int) -> Int -> Assertion
+getTypeDefinitionTest' symbolPosition definitionLine =
+    getTypeDefinitionTest "src/Lib.hs" symbolPosition "src/Lib.hs" definitionLine
 
 --NOTE: copied from Haskell.Ide.Engine.ArtifactMap
 toPos :: (Int,Int) -> Position

test/testdata/gototest/Setup.hs

@@ -0,0 +1,6 @@
+cradle:
+  direct:
+    arguments:
+      - "-i src/"
+      - "Lib"
+      - "Lib2"

test/testdata/gototest/app/Main.hs

@@ -37,4 +37,4 @@ typEnuId enu = enu
 data Parameter a = Parameter a
 
 parameterId :: Parameter a -> Parameter a
-parameterId pid = pid
+parameterId pid = pid