Move codeql over to proto driven datatypes

semantic-codeql/semantic-codeql.cabal

@@ -26,6 +26,7 @@ common haskell
                      , parsers ^>= 0.12.10
                      , semantic-ast
                      , semantic-core ^>= 0.0
+                     , semantic-proto ^>= 0
                      , semantic-source ^>= 0.1.0
                      , semantic-tags ^>= 0.0
                      , template-haskell ^>= 2.15

semantic-codeql/src/Language/CodeQL/Tags.hs

@@ -20,6 +20,7 @@ import Data.Text (Text)
 import qualified Language.CodeQL.AST as CodeQL
 import Source.Loc
 import Source.Source as Source
+import Proto.Semantic as P
 import Tags.Tag
 import qualified Tags.Tagging.Precise as Tags
 
@@ -54,7 +55,7 @@ gtags ::
   m ()
 gtags = traverse1_ @ToTags (const (pure ())) tags
 
-yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()
+yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> P.SyntaxType -> Loc -> Range -> m ()
 yieldTag name kind loc srcLineRange = do
   src <- ask @Source
   Tags.yield (Tag name kind loc (Tags.firstLine src srcLineRange) Nothing)
@@ -64,49 +65,49 @@ instance ToTags CodeQL.Module where
     t@CodeQL.Module
       { ann = Loc {byteRange},
         name = CodeQL.ModuleName {extraChildren = CodeQL.SimpleId {text, ann}}
-      } = yieldTag text Module ann byteRange >> gtags t
+      } = yieldTag text P.MODULE ann byteRange >> gtags t
 
 instance ToTags CodeQL.ClasslessPredicate where
   tags
     t@CodeQL.ClasslessPredicate
       { ann = Loc {byteRange},
         name = CodeQL.PredicateName {text, ann}
-      } = yieldTag text Function ann byteRange >> gtags t
+      } = yieldTag text P.FUNCTION ann byteRange >> gtags t
 
 instance ToTags CodeQL.AritylessPredicateExpr where
   tags
     t@CodeQL.AritylessPredicateExpr
       { ann = Loc {byteRange},
         name = CodeQL.LiteralId {text, ann}
-      } = yieldTag text Call ann byteRange >> gtags t
+      } = yieldTag text P.CALL ann byteRange >> gtags t
 
 instance ToTags CodeQL.Dataclass where
   tags
     t@CodeQL.Dataclass
       { ann = Loc {byteRange},
         name = CodeQL.ClassName {text, ann}
-      } = yieldTag text Class ann byteRange >> gtags t
+      } = yieldTag text P.CLASS ann byteRange >> gtags t
 
 instance ToTags CodeQL.MemberPredicate where
   tags
     t@CodeQL.MemberPredicate
       { ann = Loc {byteRange},
         name = CodeQL.PredicateName {text, ann}
-      } = yieldTag text Method ann byteRange >> gtags t
+      } = yieldTag text P.METHOD ann byteRange >> gtags t
 
 instance ToTags CodeQL.Datatype where
   tags
     t@CodeQL.Datatype
       { ann = Loc {byteRange},
         name = CodeQL.ClassName {text, ann}
-      } = yieldTag text Class ann byteRange >> gtags t
+      } = yieldTag text P.CLASS ann byteRange >> gtags t
 
 instance ToTags CodeQL.DatatypeBranch where
   tags
     t@CodeQL.DatatypeBranch
       { ann = Loc {byteRange},
         name = CodeQL.ClassName {text, ann}
-      } = yieldTag text Class ann byteRange >> gtags t
+      } = yieldTag text P.CLASS ann byteRange >> gtags t
 
 instance ToTags CodeQL.ClasslessPredicateCall where
   tags
@@ -122,7 +123,7 @@ instance ToTags CodeQL.QualifiedRhs where
       { ann = Loc {byteRange},
         name = expr
       } = case expr of
-      Just (Prj CodeQL.PredicateName {text, ann}) -> yieldTag text Call ann byteRange >> gtags t
+      Just (Prj CodeQL.PredicateName {text, ann}) -> yieldTag text P.CALL ann byteRange >> gtags t
       _ -> gtags t
 
 instance ToTags CodeQL.TypeExpr where
@@ -131,7 +132,7 @@ instance ToTags CodeQL.TypeExpr where
       { ann = Loc {byteRange},
         name = expr
       } = case expr of
-      Just (Prj CodeQL.ClassName {text, ann}) -> yieldTag text Type ann byteRange >> gtags t
+      Just (Prj CodeQL.ClassName {text, ann}) -> yieldTag text P.TYPE ann byteRange >> gtags t
       _ -> gtags t
 
 instance ToTags CodeQL.AddExpr

semantic-proto/src/Proto/Semantic_Fields.hs

@@ -1,6 +1,7 @@
 {- This file was auto-generated from semantic.proto by the proto-lens-protoc program. -}
 {-# LANGUAGE ScopedTypeVariables, DataKinds, TypeFamilies, UndecidableInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternSynonyms, MagicHash, NoImplicitPrelude, DataKinds, BangPatterns, TypeApplications#-}
 {-# OPTIONS_GHC -Wno-unused-imports#-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-} -- Manually added for semantic's project settings
 {-# OPTIONS_GHC -Wno-duplicate-exports#-}
 {-# OPTIONS_GHC -Wno-dodgy-exports#-}
 module Proto.Semantic_Fields where
@@ -432,4 +433,4 @@ vertices ::
   (Prelude.Functor f,
    Data.ProtoLens.Field.HasField s "vertices" a) =>
   Lens.Family2.LensLike' f s a
-vertices = Data.ProtoLens.Field.field @"vertices"
+vertices = Data.ProtoLens.Field.field @"vertices"

semantic-tags/semantic-tags.cabal

@@ -26,6 +26,7 @@ library
       base                >= 4.13 && < 5
     , fused-effects      ^>= 1.0
     , semantic-source    ^>= 0.1.0
+    , semantic-proto     ^>= 0
     , text               ^>= 1.2.3.1
   hs-source-dirs:      src
   default-language:    Haskell2010

semantic-tags/src/Tags/Tag.hs

@@ -1,33 +1,15 @@
-module Tags.Tag
-( Tag(..)
-, Kind(..)
-) where
+module Tags.Tag (Tag (..)) where
 
 import Data.Text (Text)
+import Proto.Semantic as P
 import Source.Loc
 
-data Tag = Tag
-  { name :: Text
-  , kind :: Kind
-  , loc  :: Loc
-  , line :: Text
-  , docs :: Maybe Text
-  }
+data Tag
+  = Tag
+      { name :: Text,
+        kind :: P.SyntaxType,
+        loc :: Loc,
+        line :: Text,
+        docs :: Maybe Text
+      }
   deriving (Eq, Show)
-
-data Kind
-  -- Definitions
-  = Function
-  | Method
-  | Class
-  | Module
-  -- References
-  | Call
-  | Type
-  -- Just as Call is to Class and Function, Implementation is to Interface.
-  -- This suggests that perhaps we should have an Instantiation kind that
-  -- we use for Class.
-  | Interface
-  | Implementation
-  -- Constant -- TODO: New kind for constant references
-  deriving (Bounded, Enum, Eq, Show)