Include byteRange in the output

proto/semantic.proto

@@ -58,6 +58,7 @@ message Symbol {
   NodeType node_type = 6;
   SyntaxType syntax_type = 7;
   Span utf16_code_unit_span = 8;
+  ByteRange byte_range = 9;
 }
 
 message Docstring {
@@ -74,6 +75,11 @@ message Span {
   Position end = 2;
 }
 
+message ByteRange {
+  int32 start = 1;
+  int32 end = 2;
+}
+
 message StackGraphFile {
   string path = 1;
   string language = 2;

semantic-proto/src/Proto/Semantic.hs

@@ -4,7 +4,7 @@
 {-# OPTIONS_GHC -Wno-duplicate-exports#-}
 {-# OPTIONS_GHC -Wno-dodgy-exports#-}
 module Proto.Semantic (
-        Blob(), Docstring(), File(), NodeType(..), NodeType(),
+        Blob(), ByteRange(), Docstring(), File(), NodeType(..), NodeType(),
         NodeType'UnrecognizedValue, ParseError(), ParseTreeRequest(),
         ParseTreeSymbolResponse(), PingRequest(), PingResponse(),
         Position(), Span(), StackGraphFile(), StackGraphNode(),
@@ -249,6 +249,142 @@ instance Control.DeepSeq.NFData Blob where
                    (Control.DeepSeq.deepseq (_Blob'language x__) ())))
 {- | Fields :
      
+         * 'Proto.Semantic_Fields.start' @:: Lens' ByteRange Data.Int.Int32@
+         * 'Proto.Semantic_Fields.end' @:: Lens' ByteRange Data.Int.Int32@ -}
+data ByteRange
+  = ByteRange'_constructor {_ByteRange'start :: !Data.Int.Int32,
+                            _ByteRange'end :: !Data.Int.Int32,
+                            _ByteRange'_unknownFields :: !Data.ProtoLens.FieldSet}
+  deriving (Prelude.Eq, Prelude.Ord)
+instance Prelude.Show ByteRange where
+  showsPrec _ __x __s
+    = Prelude.showChar
+        '{'
+        (Prelude.showString
+           (Data.ProtoLens.showMessageShort __x) (Prelude.showChar '}' __s))
+instance Data.ProtoLens.Field.HasField ByteRange "start" Data.Int.Int32 where
+  fieldOf _
+    = (Prelude..)
+        (Lens.Family2.Unchecked.lens
+           _ByteRange'start (\ x__ y__ -> x__ {_ByteRange'start = y__}))
+        Prelude.id
+instance Data.ProtoLens.Field.HasField ByteRange "end" Data.Int.Int32 where
+  fieldOf _
+    = (Prelude..)
+        (Lens.Family2.Unchecked.lens
+           _ByteRange'end (\ x__ y__ -> x__ {_ByteRange'end = y__}))
+        Prelude.id
+instance Data.ProtoLens.Message ByteRange where
+  messageName _ = Data.Text.pack "github.semantic.ByteRange"
+  fieldsByTag
+    = let
+        start__field_descriptor
+          = Data.ProtoLens.FieldDescriptor
+              "start"
+              (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field ::
+                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32)
+              (Data.ProtoLens.PlainField
+                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"start")) ::
+              Data.ProtoLens.FieldDescriptor ByteRange
+        end__field_descriptor
+          = Data.ProtoLens.FieldDescriptor
+              "end"
+              (Data.ProtoLens.ScalarField Data.ProtoLens.Int32Field ::
+                 Data.ProtoLens.FieldTypeDescriptor Data.Int.Int32)
+              (Data.ProtoLens.PlainField
+                 Data.ProtoLens.Optional (Data.ProtoLens.Field.field @"end")) ::
+              Data.ProtoLens.FieldDescriptor ByteRange
+      in
+        Data.Map.fromList
+          [(Data.ProtoLens.Tag 1, start__field_descriptor),
+           (Data.ProtoLens.Tag 2, end__field_descriptor)]
+  unknownFields
+    = Lens.Family2.Unchecked.lens
+        _ByteRange'_unknownFields
+        (\ x__ y__ -> x__ {_ByteRange'_unknownFields = y__})
+  defMessage
+    = ByteRange'_constructor
+        {_ByteRange'start = Data.ProtoLens.fieldDefault,
+         _ByteRange'end = Data.ProtoLens.fieldDefault,
+         _ByteRange'_unknownFields = []}
+  parseMessage
+    = let
+        loop :: ByteRange -> Data.ProtoLens.Encoding.Bytes.Parser ByteRange
+        loop x
+          = do end <- Data.ProtoLens.Encoding.Bytes.atEnd
+               if end then
+                   do (let missing = []
+                       in
+                         if Prelude.null missing then
+                             Prelude.return ()
+                         else
+                             Prelude.fail
+                               ((Prelude.++)
+                                  "Missing required fields: "
+                                  (Prelude.show (missing :: [Prelude.String]))))
+                      Prelude.return
+                        (Lens.Family2.over
+                           Data.ProtoLens.unknownFields (\ !t -> Prelude.reverse t) x)
+               else
+                   do tag <- Data.ProtoLens.Encoding.Bytes.getVarInt
+                      case tag of
+                        8 -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)
+                                       (Prelude.fmap
+                                          Prelude.fromIntegral
+                                          Data.ProtoLens.Encoding.Bytes.getVarInt)
+                                       "start"
+                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"start") y x)
+                        16
+                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)
+                                       (Prelude.fmap
+                                          Prelude.fromIntegral
+                                          Data.ProtoLens.Encoding.Bytes.getVarInt)
+                                       "end"
+                                loop (Lens.Family2.set (Data.ProtoLens.Field.field @"end") y x)
+                        wire
+                          -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
+                                        wire
+                                loop
+                                  (Lens.Family2.over
+                                     Data.ProtoLens.unknownFields (\ !t -> (:) y t) x)
+      in
+        (Data.ProtoLens.Encoding.Bytes.<?>)
+          (do loop Data.ProtoLens.defMessage) "ByteRange"
+  buildMessage
+    = \ _x
+        -> (Data.Monoid.<>)
+             (let
+                _v = Lens.Family2.view (Data.ProtoLens.Field.field @"start") _x
+              in
+                if (Prelude.==) _v Data.ProtoLens.fieldDefault then
+                    Data.Monoid.mempty
+                else
+                    (Data.Monoid.<>)
+                      (Data.ProtoLens.Encoding.Bytes.putVarInt 8)
+                      ((Prelude..)
+                         Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v))
+             ((Data.Monoid.<>)
+                (let _v = Lens.Family2.view (Data.ProtoLens.Field.field @"end") _x
+                 in
+                   if (Prelude.==) _v Data.ProtoLens.fieldDefault then
+                       Data.Monoid.mempty
+                   else
+                       (Data.Monoid.<>)
+                         (Data.ProtoLens.Encoding.Bytes.putVarInt 16)
+                         ((Prelude..)
+                            Data.ProtoLens.Encoding.Bytes.putVarInt Prelude.fromIntegral _v))
+                (Data.ProtoLens.Encoding.Wire.buildFieldSet
+                   (Lens.Family2.view Data.ProtoLens.unknownFields _x)))
+instance Control.DeepSeq.NFData ByteRange where
+  rnf
+    = \ x__
+        -> Control.DeepSeq.deepseq
+             (_ByteRange'_unknownFields x__)
+             (Control.DeepSeq.deepseq
+                (_ByteRange'start x__)
+                (Control.DeepSeq.deepseq (_ByteRange'end x__) ()))
+{- | Fields :
+     
          * 'Proto.Semantic_Fields.docstring' @:: Lens' Docstring Data.Text.Text@ -}
 data Docstring
   = Docstring'_constructor {_Docstring'docstring :: !Data.Text.Text,
@@ -3316,7 +3452,9 @@ instance Control.DeepSeq.NFData StackGraphResponse where
          * 'Proto.Semantic_Fields.nodeType' @:: Lens' Symbol NodeType@
          * 'Proto.Semantic_Fields.syntaxType' @:: Lens' Symbol SyntaxType@
          * 'Proto.Semantic_Fields.utf16CodeUnitSpan' @:: Lens' Symbol Span@
-         * 'Proto.Semantic_Fields.maybe'utf16CodeUnitSpan' @:: Lens' Symbol (Prelude.Maybe Span)@ -}
+         * 'Proto.Semantic_Fields.maybe'utf16CodeUnitSpan' @:: Lens' Symbol (Prelude.Maybe Span)@
+         * 'Proto.Semantic_Fields.byteRange' @:: Lens' Symbol ByteRange@
+         * 'Proto.Semantic_Fields.maybe'byteRange' @:: Lens' Symbol (Prelude.Maybe ByteRange)@ -}
 data Symbol
   = Symbol'_constructor {_Symbol'symbol :: !Data.Text.Text,
                          _Symbol'kind :: !Data.Text.Text,
@@ -3326,6 +3464,7 @@ data Symbol
                          _Symbol'nodeType :: !NodeType,
                          _Symbol'syntaxType :: !SyntaxType,
                          _Symbol'utf16CodeUnitSpan :: !(Prelude.Maybe Span),
+                         _Symbol'byteRange :: !(Prelude.Maybe ByteRange),
                          _Symbol'_unknownFields :: !Data.ProtoLens.FieldSet}
   deriving (Prelude.Eq, Prelude.Ord)
 instance Prelude.Show Symbol where
@@ -3402,6 +3541,18 @@ instance Data.ProtoLens.Field.HasField Symbol "maybe'utf16CodeUnitSpan" (Prelude
            _Symbol'utf16CodeUnitSpan
            (\ x__ y__ -> x__ {_Symbol'utf16CodeUnitSpan = y__}))
         Prelude.id
+instance Data.ProtoLens.Field.HasField Symbol "byteRange" ByteRange where
+  fieldOf _
+    = (Prelude..)
+        (Lens.Family2.Unchecked.lens
+           _Symbol'byteRange (\ x__ y__ -> x__ {_Symbol'byteRange = y__}))
+        (Data.ProtoLens.maybeLens Data.ProtoLens.defMessage)
+instance Data.ProtoLens.Field.HasField Symbol "maybe'byteRange" (Prelude.Maybe ByteRange) where
+  fieldOf _
+    = (Prelude..)
+        (Lens.Family2.Unchecked.lens
+           _Symbol'byteRange (\ x__ y__ -> x__ {_Symbol'byteRange = y__}))
+        Prelude.id
 instance Data.ProtoLens.Message Symbol where
   messageName _ = Data.Text.pack "github.semantic.Symbol"
   fieldsByTag
@@ -3472,6 +3623,14 @@ instance Data.ProtoLens.Message Symbol where
               (Data.ProtoLens.OptionalField
                  (Data.ProtoLens.Field.field @"maybe'utf16CodeUnitSpan")) ::
               Data.ProtoLens.FieldDescriptor Symbol
+        byteRange__field_descriptor
+          = Data.ProtoLens.FieldDescriptor
+              "byte_range"
+              (Data.ProtoLens.MessageField Data.ProtoLens.MessageType ::
+                 Data.ProtoLens.FieldTypeDescriptor ByteRange)
+              (Data.ProtoLens.OptionalField
+                 (Data.ProtoLens.Field.field @"maybe'byteRange")) ::
+              Data.ProtoLens.FieldDescriptor Symbol
       in
         Data.Map.fromList
           [(Data.ProtoLens.Tag 1, symbol__field_descriptor),
@@ -3481,7 +3640,8 @@ instance Data.ProtoLens.Message Symbol where
            (Data.ProtoLens.Tag 5, docs__field_descriptor),
            (Data.ProtoLens.Tag 6, nodeType__field_descriptor),
            (Data.ProtoLens.Tag 7, syntaxType__field_descriptor),
-           (Data.ProtoLens.Tag 8, utf16CodeUnitSpan__field_descriptor)]
+           (Data.ProtoLens.Tag 8, utf16CodeUnitSpan__field_descriptor),
+           (Data.ProtoLens.Tag 9, byteRange__field_descriptor)]
   unknownFields
     = Lens.Family2.Unchecked.lens
         _Symbol'_unknownFields
@@ -3495,7 +3655,7 @@ instance Data.ProtoLens.Message Symbol where
          _Symbol'nodeType = Data.ProtoLens.fieldDefault,
          _Symbol'syntaxType = Data.ProtoLens.fieldDefault,
          _Symbol'utf16CodeUnitSpan = Prelude.Nothing,
-         _Symbol'_unknownFields = []}
+         _Symbol'byteRange = Prelude.Nothing, _Symbol'_unknownFields = []}
   parseMessage
     = let
         loop :: Symbol -> Data.ProtoLens.Encoding.Bytes.Parser Symbol
@@ -3596,6 +3756,14 @@ instance Data.ProtoLens.Message Symbol where
                                 loop
                                   (Lens.Family2.set
                                      (Data.ProtoLens.Field.field @"utf16CodeUnitSpan") y x)
+                        74
+                          -> do y <- (Data.ProtoLens.Encoding.Bytes.<?>)
+                                       (do len <- Data.ProtoLens.Encoding.Bytes.getVarInt
+                                           Data.ProtoLens.Encoding.Bytes.isolate
+                                             (Prelude.fromIntegral len) Data.ProtoLens.parseMessage)
+                                       "byte_range"
+                                loop
+                                  (Lens.Family2.set (Data.ProtoLens.Field.field @"byteRange") y x)
                         wire
                           -> do !y <- Data.ProtoLens.Encoding.Wire.parseTaggedValueFromWire
                                         wire
@@ -3738,8 +3906,27 @@ instance Data.ProtoLens.Message Symbol where
                                                        (Data.ProtoLens.Encoding.Bytes.putBytes bs))
                                                Data.ProtoLens.encodeMessage
                                                _v))
-                                  (Data.ProtoLens.Encoding.Wire.buildFieldSet
-                                     (Lens.Family2.view Data.ProtoLens.unknownFields _x)))))))))
+                                  ((Data.Monoid.<>)
+                                     (case
+                                          Lens.Family2.view
+                                            (Data.ProtoLens.Field.field @"maybe'byteRange") _x
+                                      of
+                                        Prelude.Nothing -> Data.Monoid.mempty
+                                        (Prelude.Just _v)
+                                          -> (Data.Monoid.<>)
+                                               (Data.ProtoLens.Encoding.Bytes.putVarInt 74)
+                                               ((Prelude..)
+                                                  (\ bs
+                                                     -> (Data.Monoid.<>)
+                                                          (Data.ProtoLens.Encoding.Bytes.putVarInt
+                                                             (Prelude.fromIntegral
+                                                                (Data.ByteString.length bs)))
+                                                          (Data.ProtoLens.Encoding.Bytes.putBytes
+                                                             bs))
+                                                  Data.ProtoLens.encodeMessage
+                                                  _v))
+                                     (Data.ProtoLens.Encoding.Wire.buildFieldSet
+                                        (Lens.Family2.view Data.ProtoLens.unknownFields _x))))))))))
 instance Control.DeepSeq.NFData Symbol where
   rnf
     = \ x__
@@ -3760,7 +3947,8 @@ instance Control.DeepSeq.NFData Symbol where
                                (Control.DeepSeq.deepseq
                                   (_Symbol'syntaxType x__)
                                   (Control.DeepSeq.deepseq
-                                     (_Symbol'utf16CodeUnitSpan x__) ()))))))))
+                                     (_Symbol'utf16CodeUnitSpan x__)
+                                     (Control.DeepSeq.deepseq (_Symbol'byteRange x__) ())))))))))
 newtype SyntaxType'UnrecognizedValue
   = SyntaxType'UnrecognizedValue Data.Int.Int32
   deriving (Prelude.Eq, Prelude.Ord, Prelude.Show)

semantic-proto/src/Proto/Semantic_Fields.hs

@@ -38,6 +38,12 @@ blobs ::
   (Prelude.Functor f, Data.ProtoLens.Field.HasField s "blobs" a) =>
   Lens.Family2.LensLike' f s a
 blobs = Data.ProtoLens.Field.field @"blobs"
+byteRange ::
+  forall f s a.
+  (Prelude.Functor f,
+   Data.ProtoLens.Field.HasField s "byteRange" a) =>
+  Lens.Family2.LensLike' f s a
+byteRange = Data.ProtoLens.Field.field @"byteRange"
 column ::
   forall f s a.
   (Prelude.Functor f, Data.ProtoLens.Field.HasField s "column" a) =>
@@ -128,6 +134,12 @@ line ::
   (Prelude.Functor f, Data.ProtoLens.Field.HasField s "line" a) =>
   Lens.Family2.LensLike' f s a
 line = Data.ProtoLens.Field.field @"line"
+maybe'byteRange ::
+  forall f s a.
+  (Prelude.Functor f,
+   Data.ProtoLens.Field.HasField s "maybe'byteRange" a) =>
+  Lens.Family2.LensLike' f s a
+maybe'byteRange = Data.ProtoLens.Field.field @"maybe'byteRange"
 maybe'docs ::
   forall f s a.
   (Prelude.Functor f,

semantic-proto/src/Proto/Semantic_JSON.hs

@@ -252,6 +252,7 @@ instance FromJSONPB Symbol where
     nodeType' <- obj .: "nodeType"
     syntaxType' <- obj .: "syntaxType"
     utf16CodeUnitSpan' <- obj A..:? "utf16CodeUnitSpan"
+    byteRange' <- obj A..:? "byteRange"
     pure $ defMessage
       & P.symbol .~ symbol'
       & P.kind .~ kind'
@@ -261,6 +262,7 @@ instance FromJSONPB Symbol where
       & P.nodeType .~ nodeType'
       & P.syntaxType .~ syntaxType'
       & P.maybe'utf16CodeUnitSpan .~ utf16CodeUnitSpan'
+      & P.maybe'byteRange .~ byteRange'
 
 instance ToJSONPB Symbol where
   toJSONPB x = object
@@ -272,6 +274,7 @@ instance ToJSONPB Symbol where
     , "nodeType" .= (x^.nodeType)
     , "syntaxType" .= (x^.syntaxType)
     , "utf16CodeUnitSpan" .= (x^.maybe'utf16CodeUnitSpan)
+    , "byteRange" .= (x^.maybe'byteRange)
     ]
   toEncodingPB x = pairs
     [ "symbol" .= (x^.symbol)
@@ -282,6 +285,7 @@ instance ToJSONPB Symbol where
     , "nodeType" .= (x^.nodeType)
     , "syntaxType" .= (x^.syntaxType)
     , "utf16CodeUnitSpan" .= (x^.maybe'utf16CodeUnitSpan)
+    , "byteRange" .= (x^.maybe'byteRange)
     ]
 
 instance FromJSON Symbol where
@@ -362,6 +366,31 @@ instance ToJSON Span where
   toJSON = toAesonValue
   toEncoding = toAesonEncoding
 
+instance FromJSONPB ByteRange where
+  parseJSONPB = withObject "ByteRange" $ \obj -> do
+    start' <- obj .: "start"
+    end' <- obj .: "end"
+    pure $ defMessage
+      & P.start .~ start'
+      & P.end .~ end'
+
+instance ToJSONPB ByteRange where
+  toJSONPB x = object
+    [ "start" .= (x^.start)
+    , "end" .= (x^.end)
+    ]
+  toEncodingPB x = pairs
+    [ "start" .= (x^.start)
+    , "end" .= (x^.end)
+    ]
+
+instance FromJSON ByteRange where
+  parseJSON = parseJSONPB
+
+instance ToJSON ByteRange where
+  toJSON = toAesonValue
+  toEncoding = toAesonEncoding
+
 instance FromJSONPB StackGraphFile where
   parseJSONPB = withObject "StackGraphFile" $ \obj -> do
     path' <- obj .: "path"

semantic-tags/semantic-tags.cabal

@@ -20,6 +20,7 @@ tested-with:         GHC == 8.6.5
 
 common haskell
   default-language: Haskell2010
+  default-extensions: StrictData
   ghc-options:
     -Weverything
     -Wno-missing-local-signatures

semantic-tags/src/Tags/Tag.hs

@@ -18,6 +18,7 @@ data Tag
       { tagName :: Text,
         tagSyntaxType :: P.SyntaxType,
         tagNodeType :: P.NodeType,
+        tagByteRange :: Range,
         tagOneIndexedSpan :: OneIndexedSpan,
         tagLine :: Text,
         tagUTF16CodeUnitSpan :: UTF16CodeUnitSpan

semantic-tags/src/Tags/Tagging/Precise.hs

@@ -51,7 +51,7 @@ yield name syntaxType nodeType loc _ = do
   src <- ask @Source
   let (line, span, lspSpan) = calculateLineAndSpans src loc
   tell . Endo . (:) $
-    Tag name syntaxType nodeType span line lspSpan
+    Tag name syntaxType nodeType (byteRange loc) span line lspSpan
 
 runTagging :: Source -> ReaderC Source (WriterC Tags Identity) () -> [Tag]
 runTagging source

semantic/src/Semantic/Api/Bridge.hs

@@ -20,6 +20,7 @@ import qualified Proto.Semantic as API
 import           Proto.Semantic_Fields as P hiding (to)
 import qualified Source.Source as Source (fromText, toText, totalSpan)
 import qualified Source.Span as Source
+import qualified Source.Range as Source
 import qualified System.Path as Path
 
 -- | An @APIBridge x y@ instance describes an isomorphism between @x@ and @y@.
@@ -61,6 +62,11 @@ instance APIConvert API.Span Source.Span where
     toAPI Source.Span{..} = defMessage & P.maybe'start .~ (bridging #? start) & P.maybe'end .~ (bridging #? end)
     fromAPI span = Source.Span <$> (span^.maybe'start >>= preview bridging) <*> (span^.maybe'end >>= preview bridging)
 
+instance APIBridge API.ByteRange Source.Range where
+  bridging = iso fromAPI toAPI where
+    toAPI Source.Range{..} = defMessage & P.start .~ fromIntegral start & P.end .~ fromIntegral end
+    fromAPI range = Source.Range (fromIntegral (range^.start)) (fromIntegral (range^.end))
+
 instance APIBridge T.Text Data.Language where
   bridging = iso Data.textToLanguage Data.languageToText
 

semantic/src/Semantic/Api/Symbols.hs

@@ -78,6 +78,7 @@ parseSymbols blobs = do
             & P.line .~ tagLine tag
             & P.maybe'span ?~ converting # unOneIndexedSpan (tagOneIndexedSpan tag)
             & P.maybe'utf16CodeUnitSpan ?~ converting # unUTF16CodeUnitSpan (tagUTF16CodeUnitSpan tag)
+            & P.byteRange .~ bridging # tagByteRange tag
           where
             toKind = toTitle . pack . show . tagSyntaxType