Support xrefs for type/data constructors and data fields.

Fixes google#6.
jinwoo · Sep 26, 2019 · 88e25da · 88e25da
1 parent 435d467
commit 88e25da
Show file tree

Hide file tree

Showing 7 changed files with 90 additions and 19 deletions.
diff --git a/haskell-indexer-backend-ghc/src/Language/Haskell/Indexer/Backend/Compat.hs b/haskell-indexer-backend-ghc/src/Language/Haskell/Indexer/Backend/Compat.hs
@@ -420,6 +420,27 @@ pattern IEVarCompat lwn <-
   IEVar _ lwn
 #endif
 
+pattern IEThingAbsCompat lwn <-
+#if __GLASGOW_HASKELL__ < 806
+  IEThingAbs lwn
+#else
+  IEThingAbs _ lwn
+#endif
+
+pattern IEThingAllCompat lwn <-
+#if __GLASGOW_HASKELL__ < 806
+  IEThingAll lwn
+#else
+  IEThingAll _ lwn
+#endif
+
+pattern IEThingWithCompat lwn ctors fields <-
+#if __GLASGOW_HASKELL__ < 806
+  IEThingWith lwn _ ctors fields
+#else
+  IEThingWith _ lwn _ ctors fields
+#endif
+
 -- 8.0.x doesn't have ieWrappedName.
 #if __GLASGOW_HASKELL__ < 802
 ieWrappedName = id

diff --git a/haskell-indexer-backend-ghc/src/Language/Haskell/Indexer/Backend/Ghc.hs b/haskell-indexer-backend-ghc/src/Language/Haskell/Indexer/Backend/Ghc.hs
@@ -44,6 +44,7 @@ import qualified ConLike
 import qualified DataCon as GHC
 import qualified Name as GHC
 import FastString (unpackFS)
+import FieldLabel (FieldLbl (..))
 import GHC
 import qualified Id as GHC
 import Name (nameModule_maybe, nameOccName)
@@ -470,19 +471,40 @@ refsFromRenamed ctx declAlts (hsGroup, importDecls, _, _) =
         case ideclHiding of
           Nothing -> []
           Just (False, (L _ imports)) ->
-              mapMaybe (refsFromImport Import) imports
+            concatMap (refsFromImport Import) imports
           Just (True, (L _ imports))
-              | generateRefEdgeForHiddenImports ->
-                  mapMaybe (refsFromImport Ref) imports
-              | otherwise -> []
+            | generateRefEdgeForHiddenImports ->
+              concatMap (refsFromImport Ref) imports
+            | otherwise -> []
       _ -> []
 
-    -- TODO(jinwoo): Support non-var imports (e.g., data constructors, dotted
-    -- imports, etc.)
-    refsFromImport :: ReferenceKind -> LIE GhcRn -> Maybe Reference
+    refsFromImport :: ReferenceKind -> LIE GhcRn -> [Reference]
     refsFromImport refKind (L _ (IEVarCompat (L l n))) =
-        give ctx (nameLocToRef (ieWrappedName n) refKind l)
-    refsFromImport _ _ = Nothing
+      maybeToList $ give ctx (nameLocToRef (ieWrappedName n) refKind l)
+    refsFromImport refKind (L _ (IEThingAbsCompat (L l n))) =
+      maybeToList $ give ctx (nameLocToRef (ieWrappedName n) refKind l)
+    refsFromImport refKind (L _ (IEThingAllCompat (L l n))) =
+      maybeToList $ give ctx (nameLocToRef (ieWrappedName n) refKind l)
+    refsFromImport refKind (L _ (IEThingWithCompat (L tl tn) ctors fields)) =
+      typeRef ++ ctorRefs ++ fieldRefs
+      where
+        typeRef =
+          maybeToList $ give ctx (nameLocToRef (ieWrappedName tn) refKind tl)
+        ctorRefs =
+          catMaybes
+            $ map
+                ( \(L cl cn) ->
+                    give ctx (nameLocToRef (ieWrappedName cn) refKind cl)
+                )
+                ctors
+        fieldRefs =
+          catMaybes
+            $ map
+                ( \(L fl label) ->
+                    give ctx (nameLocToRef (flSelector label) refKind fl)
+                )
+                fields
+    refsFromImport _ _ = []
 
 -- | Exports subclasses/overrides relationships from typeclasses.
 relationsFromRenamed :: ExtractCtx -> DeclAltMap -> RenamedSource

diff --git a/haskell-indexer-backend-ghc/testdata/basic/ImportDefs.hs b/haskell-indexer-backend-ghc/testdata/basic/ImportDefs.hs
@@ -12,7 +12,7 @@ bar :: Double
 bar = 42.0
 
 data FooBar
-  = FooBar
+  = MkFooBar
       { fbFoo :: Int,
         fbBar :: Double
       }
diff --git a/haskell-indexer-backend-ghc/testdata/basic/ImportRefs.hs b/haskell-indexer-backend-ghc/testdata/basic/ImportRefs.hs
@@ -1,3 +1,6 @@
 module ImportRefs where
 
-import ImportDefs (FooBar (..), bar, foo)
+import ImportDefs (bar, foo)                        -- IEVar
+import ImportDefs (FooBar)                          -- IEThingAbs
+import ImportDefs (FooBar (..))                     -- IEThingAll
+import ImportDefs (FooBar (MkFooBar, fbFoo, fbBar)) -- IEThingWith
diff --git a/haskell-indexer-backend-ghc/tests/Language/Haskell/Indexer/Backend/Ghc/Test/BasicTestBase.hs b/haskell-indexer-backend-ghc/tests/Language/Haskell/Indexer/Backend/Ghc/Test/BasicTestBase.hs
@@ -344,17 +344,30 @@ testImportRefs = assertXRefsFrom ["basic/ImportDefs.hs", "basic/ImportRefs.hs"]
     -- foo
     declAt (9, 1) >>= usages >>= \case
       [u1, u2] -> do
-        includesPos (3, 38) u1 -- import statement in ImportRefs.hs
+        includesPos (3, 25) u1 -- import statement in ImportRefs.hs
         assertRefKind Import u1
         includesPos (8, 1) u2 -- type signature in ImportDefs.hs
       us -> checking $ assertFailure "Usage count differs for foo"
     -- bar
     declAt (12, 1) >>= usages >>= \case
       [u1, u2] -> do
-        includesPos (3, 33) u1 -- import statement in ImportRefs.hs
+        includesPos (3, 20) u1 -- import statement in ImportRefs.hs
         assertRefKind Import u1
         includesPos (11, 1) u2 -- type signature in ImportDefs.hs
       us -> checking $ assertFailure "Usage count differs for bar"
+    -- FooBar
+    declAt (14, 6) >>= usages >>= \case
+      [u1, u2, u3] -> do
+        includesPos (4, 20) u1
+        includesPos (5, 20) u2
+        includesPos (6, 20) u3
+      us -> checking $ assertFailure "Usage count differs for FooBar"
+    -- MkFooBar
+    declAt (15, 5) >>= singleUsage >>= includesPos (6, 28)
+    -- fbFoo
+    declAt (16, 9) >>= singleUsage >>= includesPos (6, 38)
+    -- fbBar
+    declAt (17, 9) >>= singleUsage >>= includesPos (6, 45)
 
 testImportRefsHiding :: AssertionInEnv
 testImportRefsHiding =

diff --git a/kythe-verification/testdata/basic/ImportDefs.hs b/kythe-verification/testdata/basic/ImportDefs.hs
@@ -13,8 +13,7 @@ bar :: Double
 -- - @bar defines/binding BarVar
 bar = 42.0
 
-data FooBar
-  = FooBar
-      { fbFoo :: Int,
-        fbBar :: Double
-      }
+-- - @FooBar defines/binding TypeD
+-- - @MkFB defines/binding CtorD
+-- - @fbFoo defines/binding FieldFbFoo
+data FooBar = MkFB {fbFoo :: Int}
diff --git a/kythe-verification/testdata/basic/ImportRefs.hs b/kythe-verification/testdata/basic/ImportRefs.hs
@@ -1,6 +1,19 @@
 module ImportRefs where
 
 -- - @foo ref/imports FooVar
-import ImportDefs (foo)
+-- - @bar ref/imports BarVar
+import ImportDefs (bar, foo)              -- IEVar
+
+-- - @FooBar ref/imports TypeD
+import ImportDefs (FooBar)                -- IEThingAbs
+
+-- - @FooBar ref/imports TypeD
+import ImportDefs (FooBar (..))           -- IEThingAll
+
+-- - @FooBar ref/imports TypeD
+-- - @MkFB ref/imports CtorD
+-- - @fbFoo ref/imports FieldFbFoo
+import ImportDefs (FooBar (MkFB, fbFoo))  -- IEThingWith
+
 -- - @bar ref BarVar
 import ImportDefs hiding (bar)