New Haskell Indexer (#511)

Summary:
Redesigned the schema and rewrote the indexer. Compared with the previous indexer:

* this captures a lot more xrefs (e.g. local variables)
* it has more information (distinguishes functions/classes/constructors etc.)
* it is much simpler and probably faster, because it doesn't go via hiedb, it reads .hie files directly.
* it is probably more correct, I fixed a lot of things.

The schema is carefully designed so that a Name uniquely identifies an entity and corresponds fairly closely to GHC's Name, including OccName. The main difference is we don't store Uniques, instead we distinguish local Names by including their ByteSpan.

There are a couple of snapshot tests, one for the plain indexer and one for the codemarkup layer, and a Glass regression test.

Not done yet:

* we can extract types from the .hie file too, and provide type hovers in Glass. That wouldn't be too hard.

* extracting more structure so that we can reconstruct data/class decls should be possible but it's not straightforward using .hie. I'm still thinking about how best to do that.

Pull Request resolved: #511

Reviewed By: rubmary

Differential Revision: D74400980

Pulled By: jjuliamolin

fbshipit-source-id: 6cb183b96ef1c7030c8b7278434f84a4d72ceb28

Author: simonmar

.github/workflows/ci.yml

@@ -171,9 +171,9 @@ jobs:
       - name: Build glean-clang
         run: make glean-clang
 
-      - if: matrix.ghc != '8.6.5' && matrix.ghc != '9.4.7'
-        name: Build hiedb-indexer
-        run: make glean-hiedb
+      - if: matrix.ghc != '8.6.5' && matrix.ghc != '8.8.4' && matrix.ghc != '8.10.7'
+        name: Build hie-indexer
+        run: make glean-hie
 
       - name: Run tests
         run: make test

Makefile

@@ -315,9 +315,9 @@ glass::
 glean-clang:: gen-schema glean glean.cabal cxx-libraries glean/schema/cpp/schema.h
 	$(CABAL) build glean-clang
 
-.PHONY: glean-hiedb
-glean-hiedb:: glean.cabal cxx-libraries
-	$(CABAL) build hiedb-indexer
+.PHONY: glean-hie
+glean-hie:: glean.cabal cxx-libraries
+	$(CABAL) build hie-indexer
 
 define bash_macros
 call_cabal() {

glean.cabal.in

@@ -65,6 +65,12 @@ common fb-cpp
 common exe
   ghc-options: -threaded -rtsopts
 
+common haskell-indexer
+  if impl(ghc >= 9.2)
+    buildable: True
+  else
+    buildable: False
+
 flag clang
      default: False
 
@@ -1098,40 +1104,26 @@ executable hack-derive
         glean:stubs,
         glean:util,
 
--- Haskell indexer via hiedb
-executable hiedb-indexer
-    import: deps, fb-haskell, exe
-    if impl(ghc >= 8.8 && < 9.4)
-      buildable: True
-    else
-      buildable: False
+-- Haskell indexer via hie
+executable hie-indexer
+    import: deps, fb-haskell, exe, haskell-indexer
     hs-source-dirs: glean/lang/haskell
-    main-is: HieDBIndexer/Main.hs
+    main-is: HieIndexer/Main.hs
     other-modules:
-        HieDBIndexer.Builder
-        HieDBIndexer.DefaultMain
-        HieDBIndexer.Glean
-        HieDBIndexer.HieDB
-        HieDBIndexer.Options
-        HieDBIndexer.Trace
-        HieDBIndexer.Types
-    ghc-options: -main-is HieDBIndexer.Main
+        HieIndexer.Index
+        HieIndexer.Options
+    ghc-options: -main-is HieIndexer.Main
     build-depends:
         ghc,
         glean:client-hs,
         glean:client-hs-local,
         glean:core,
-        glean:db,
-        glean:if-glean-hs,
         glean:lib,
-        glean:lib-derive,
         glean:schema,
         glean:stubs,
         glean:util,
         hie-compat < 0.3.1.2,
-        hiedb < 0.4.3,
-        split,
-        sqlite-simple,
+        hiedb < 0.4.3
 
 -- -----------------------------------------------------------------------------
 -- LSIF support
@@ -2153,8 +2145,34 @@ test-suite glean-snapshot-hack
     if !flag(hack-tests)
         buildable: False
 
+test-suite glean-snapshot-haskell
+    import: fb-haskell, fb-cpp, deps, exe, haskell-indexer
+    hs-source-dirs: glean/lang/haskell/tests
+    type: exitcode-stdio-1.0
+    main-is: Main.hs
+    ghc-options: -main-is Main
+    build-depends:
+       glean:regression-test-lib,
+       glean:indexers
+    build-tool-depends:
+       glean:hie-indexer,
+       glean:glean
+
+test-suite glean-snapshot-codemarkup-haskell
+    import: fb-haskell, fb-cpp, deps, exe, haskell-indexer
+    hs-source-dirs: glean/lang/codemarkup/tests/haskell
+    type: exitcode-stdio-1.0
+    main-is: Main.hs
+    ghc-options: -main-is Main
+    build-depends:
+       glean:regression-test-lib,
+       glean:indexers
+    build-tool-depends:
+       glean:hie-indexer,
+       glean:glean
+
 test-suite glean-snapshot-rust-lsif
-    import: fb-haskell, deps
+    import: fb-haskell, deps, exe
     hs-source-dirs: glean/lang/rust-lsif/tests
     type: exitcode-stdio-1.0
     main-is: Glean/Regression/RustLsif/Main.hs
@@ -2342,6 +2360,19 @@ test-suite glass-regression-hack
     if !flag(hack-tests)
         buildable: False
 
+test-suite glass-regression-haskell
+    import: glass-regression-deps, fb-haskell, deps, exe, haskell-indexer
+    type: exitcode-stdio-1.0
+    main-is: Glean/Glass/Regression/Haskell/Main.hs
+    ghc-options: -main-is Glean.Glass.Regression.Haskell.Main
+    other-modules: Glean.Glass.Regression.Haskell
+    build-depends:
+        glean:client-hs,
+        glean:indexers,
+        glean:util
+    build-tool-depends:
+        glean:hie-indexer
+
 test-suite glass-regression-typescript
     import: glass-regression-deps, fb-haskell, deps, exe
     type: exitcode-stdio-1.0

glean/glass/Glean/Glass/RepoMapping.hs

@@ -45,6 +45,7 @@ gleanIndices_ = Map.fromList
   , (RepoName "test",
       [("test", Language_JavaScript)
       ,("test", Language_Hack)
+      ,("test", Language_Haskell)
       ,("test", Language_Cpp)
       ,("test", Language_PreProcessor)
       ,("test", Language_Python)

glean/glass/Glean/Glass/Search/Haskell.hs

@@ -15,32 +15,73 @@ module Glean.Glass.Search.Haskell
 
 import Data.Text ( Text )
 import qualified Data.Text as Text ( intercalate )
+import Util.Text
 
 import Glean.Angle as Angle
 
 import Glean.Glass.Search.Class
-import Glean.Glass.Query ( entityLocation )
 
 import qualified Glean.Schema.CodeHs.Types as Haskell
-import qualified Glean.Schema.CodemarkupTypes.Types as Code
-import qualified Glean.Schema.SearchHs.Types as Haskell
-import qualified Glean.Schema.Src.Types as Src
+import qualified Glean.Schema.Hs.Types as Hs
 
 instance Search (ResultLocation Haskell.Entity) where
   symbolSearch [] = return $ None "Haskell.symbolSearch: empty"
-  symbolSearch toks = do
-    searchSymbolId toks $ searchByName $ Text.intercalate "." toks
-
--- code.hs:searchByName
-searchByName :: Text -> Angle (ResultLocation Haskell.Entity)
-searchByName sym =
-  vars $ \(ent :: Angle Haskell.Entity) (file :: Angle Src.File)
-    (rangespan :: Angle Code.RangeSpan) (lname :: Angle Text) ->
-  tuple (ent, file, rangespan, lname) `where_` [
-    wild .= predicate @Haskell.SearchByName (
-      rec $
-        field @"name" (string sym) $
-        field @"entity" ent
-      end),
-    entityLocation (alt @"hs" ent) file rangespan lname
-  ]
+  symbolSearch toks@(pkg : rest) = do
+    case reverse rest of
+      end : start : ident : namespace : mod
+        | Right e <- textToInt end,
+          Right s <- textToInt start,
+          Just ns <- fromNamespace namespace ->
+          searchSymbolId toks $
+            symbolIdQuery pkg (Text.intercalate "." (reverse mod)) ident ns
+              (Just (s,e))
+      ident : namespace : mod
+        | Just ns <- fromNamespace namespace ->
+          searchSymbolId toks $
+            symbolIdQuery pkg (Text.intercalate "." (reverse mod)) ident ns
+              Nothing
+      _ -> return $ None "Haskell.symbolSearch: empty"
+    where
+    fromNamespace "var" = Just Hs.Namespace_var_
+    fromNamespace "ty" = Just Hs.Namespace_tycon
+    fromNamespace "con" = Just Hs.Namespace_datacon
+    fromNamespace "tyvar" = Just Hs.Namespace_tyvar
+    fromNamespace _ = Nothing
+
+
+symbolIdQuery
+  :: Text  -- ^ package (ignored (TODO))
+  -> Text  -- ^ module name
+  -> Text  -- ^ identifier
+  -> Hs.Namespace -- ^ namespace (var, datacon, tycon, tyvar)
+  -> Maybe (Int, Int)  -- ^ span, for local names
+  -> Angle (ResultLocation Haskell.Entity)
+symbolIdQuery _pkg mod ident ns sort =
+  vars $ \name file span ->
+    tuple (
+      alt @"name" (asPredicate name),
+      file,
+      alt @"span" span,
+      string ident
+    ) `where_` [
+        name .= predicate @Hs.Name (
+          rec $
+            field @"occ" (rec $
+              field @"name" (string ident) $
+              field @"namespace_" (enum ns) end) $
+            field @"mod" (rec $
+              field @"name" (string mod) end) $
+            field @"sort" (
+              case sort of
+                Nothing -> alt @"external" wild
+                Just (s,l) -> alt @"internal" (rec $
+                  field @"start" (nat (fromIntegral s)) $
+                  field @"length" (nat (fromIntegral l)) end)
+            ) end),
+        stmt $ predicate @Hs.DeclarationLocation (
+          rec $
+            field @"name" (asPredicate name) $
+            field @"file" (asPredicate file) $
+            field @"span" span end
+        )
+    ]

glean/glass/Glean/Glass/SymbolId/Hs.hs

@@ -10,70 +10,74 @@
 
 module Glean.Glass.SymbolId.Hs ({- instances -}) where
 
-import Data.Text (Text)
+import Data.Char
 import qualified Data.Text as Text
+import TextShow
 
 import Glean.Glass.SymbolId.Class
 import Glean.Glass.Types (Name(..))
-import Glean.Schema.CodeHs.Types as Hs (Entity (..))
+import Glean.Schema.CodeHs.Types as Hs (Entity(..))
 import qualified Glean
 import qualified Glean.Schema.Hs.Types as Hs
 import qualified Glean.Schema.Src.Types as Src
 
+-- REPO/hs/containers/Data/Map/{var|datacon|tyvar|tycon}/toList[/START/END]
+
 instance Symbol Hs.Entity where
-  toSymbol (Hs.Entity_definition d) = toSymbolPredicate d
-  toSymbol (Hs.Entity_function_ d) = toSymbolPredicate d
-  toSymbol (Hs.Entity_class_ d) = toSymbolPredicate d
-  toSymbol Hs.Entity_EMPTY = return []
+  toSymbol (Hs.Entity_name x) = toSymbolPredicate x
+  toSymbol (Hs.Entity_mod x) = toSymbolPredicate x
+  toSymbol _ = error "toSymbol: unknown Hs.Entity"
 
-instance Symbol Hs.Definition_key where
-  toSymbol (Hs.Definition_key name _) = do
-    n <- Glean.keyOf name
-    return (Text.splitOn "." n)
+instance Symbol Hs.Name_key where
+  toSymbol (Hs.Name_key occ mod sort) = do
+    m <- toSymbol mod
+    o <- toSymbol occ
+    s <- toSymbol sort
+    return $ m <> o <> s
 
-instance Symbol Hs.FunctionDefinition_key where
-  toSymbol (Hs.FunctionDefinition_key fnName Src.Range{..}) = do
-    name <- Glean.keyOf fnName
-    fname <- Glean.keyOf range_file
-    return (fname : Text.splitOn "." name)
+instance Symbol Hs.Module where
+  toSymbol = toSymbolPredicate
 
-instance Symbol Hs.Class_key where
-  toSymbol (Hs.Class_key clsName Src.Range{..}) = do
-    name <- Glean.keyOf clsName
-    fname <- Glean.keyOf range_file
-    return (fname : Text.splitOn "." name)
+instance Symbol Hs.OccName where
+  toSymbol = toSymbolPredicate
 
-instance ToQName Hs.Entity where
-  toQName (Hs.Entity_definition d) = Glean.keyOf d >>= toQName
-  toQName (Hs.Entity_function_ d) = Glean.keyOf d >>= toQName
-  toQName (Hs.Entity_class_ d) = Glean.keyOf d >>= toQName
-  toQName Hs.Entity_EMPTY =
-    return $ Left "toQName: Haskell: empty qname"
-
-instance ToQName Hs.Definition_key where
-  toQName (Hs.Definition_key name _) = do
+instance Symbol Hs.Module_key where
+  toSymbol (Hs.Module_key name unit) = do
+    u <- Glean.keyOf unit
     n <- Glean.keyOf name
-    return $ case reverse (Text.splitOn "." n) of
-      [] -> Left "toQName: Haskell: empty function qname"
-      [x] -> Right (Name x, Name "")
-      (x:xs) -> Right (Name x, joinDotted xs)
+    -- unit names are things like glean-0.1.0.0-inplace-core
+    -- let's strip the version and everything after it
+    let pkg = Text.intercalate "-" (fst (break isVer (Text.splitOn "-" u)))
+    return (pkg : Text.splitOn "." n)
+    where
+    isVer t
+      | Just (d, _) <- Text.uncons t = isDigit d
+      | otherwise = False
 
-instance ToQName Hs.FunctionDefinition_key where
-  toQName (Hs.FunctionDefinition_key fnName _) = do
-    name <- Glean.keyOf fnName
-    return $ case reverse (Text.splitOn "." name) of
-      [] -> Left "toQName: Haskell: empty function qname"
-      [x] -> Right (Name x, Name "")
-      (x:xs) -> Right (Name x, joinDotted xs)
+instance Symbol Hs.OccName_key where
+  toSymbol (Hs.OccName_key name namespace) = do
+    let sp = case namespace of
+          Hs.Namespace_var_ -> "var"
+          Hs.Namespace_datacon -> "con"
+          Hs.Namespace_tyvar -> "tyvar"
+          Hs.Namespace_tycon -> "ty"
+          _ -> error "namespace"
+    return [sp,name]
 
+instance Symbol Hs.NameSort where
+  toSymbol Hs.NameSort_external{} = return []
+  toSymbol (Hs.NameSort_internal (Src.ByteSpan start end)) =
+    return [showt (Glean.fromNat start), showt (Glean.fromNat end)]
+  toSymbol _ = error "toSymbol: unknown Hs.NameSort"
 
-instance ToQName Hs.Class_key where
-  toQName (Hs.Class_key clsName _) = do
-    name <- Glean.keyOf clsName
-    return $ case reverse (Text.splitOn "." name) of
-      [] -> Left "toQName: Haskell: empty class qname"
-      [x] -> Right (Name x, Name "")
-      (x:xs) -> Right (Name x, joinDotted xs)
+instance ToQName Hs.Entity where
+  toQName (Hs.Entity_name n) = Glean.keyOf n >>= toQName
+  toQName (Hs.Entity_mod _) = error "TODO: ToQName Hs.Entity_mod"
+  toQName _ = error "ToQName: unknown Hs.Entity"
 
-joinDotted :: [Text] -> Name
-joinDotted = Name . Text.intercalate "." . reverse
+instance ToQName Hs.Name_key where
+  toQName (Hs.Name_key occ mod _) = do
+    Hs.Module_key m _ <- Glean.keyOf mod
+    modname <- Glean.keyOf m
+    Hs.OccName_key n _ <- Glean.keyOf occ
+    return $ Right (Name modname, Name n)

glean/glass/test/regression/Glean/Glass/Regression/Haskell.hs

@@ -0,0 +1,19 @@
+{-
+  Copyright (c) Meta Platforms, Inc. and affiliates.
+  All rights reserved.
+
+  This source code is licensed under the BSD-style license found in the
+  LICENSE file in the root directory of this source tree.
+-}
+
+module Glean.Glass.Regression.Haskell (main) where
+
+import Glean.Indexer.Haskell as Haskell ( indexer )
+import Glean.Glass.Regression.Snapshot ( mainGlassSnapshot )
+
+main :: IO ()
+main = mainGlassSnapshot testName testPath testIndexer (const [])
+  where
+    testName = "glass-regression-haskell"
+    testPath = "glean/glass/test/regression/tests/haskell"
+    testIndexer = Haskell.indexer