Update Haskell SymbolId handling

Author: simonmar

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

@@ -15,32 +15,70 @@ 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 (name, file, sig (alt @"span" span :: Angle Code.RangeSpan), 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,69 @@
 
 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 = toSymbolPredicate
 
-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)]
 
-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 n = Glean.keyOf n >>= toQName
 
-joinDotted :: [Text] -> Name
-joinDotted = Name . Text.intercalate "." . reverse
+instance ToQName Hs.Name_key where
+  toQName (Hs.Name_key occ mod sort) = 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)