diff --git a/semantic-codeql/src/Language/CodeQL/Tags.hs b/semantic-codeql/src/Language/CodeQL/Tags.hs index 490ed49a2..b37e8fe00 100644 --- a/semantic-codeql/src/Language/CodeQL/Tags.hs +++ b/semantic-codeql/src/Language/CodeQL/Tags.hs @@ -17,12 +17,10 @@ import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer import Data.Foldable (for_) -import Data.Text (Text) import qualified Language.CodeQL.AST as CodeQL import Proto.Semantic as P import Source.Loc import Source.Source as Source -import Tags.Tag import qualified Tags.Tagging.Precise as Tags class ToTags t where @@ -56,17 +54,12 @@ gtags :: m () gtags = traverse1_ @ToTags (const (pure ())) tags -yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> P.SyntaxType -> P.NodeType -> Loc -> Range -> m () -yieldTag name kind ty loc srcLineRange = do - src <- ask @Source - Tags.yield (Tag name kind ty loc (Tags.firstLine src srcLineRange) Nothing) - instance ToTags CodeQL.Module where tags t@CodeQL.Module { ann = Loc {byteRange}, name = Parse.Success (CodeQL.ModuleName {extraChildren = Parse.Success (CodeQL.SimpleId {text, ann})}) - } = yieldTag text P.MODULE P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.MODULE P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags CodeQL.ClasslessPredicate where @@ -74,7 +67,7 @@ instance ToTags CodeQL.ClasslessPredicate where t@CodeQL.ClasslessPredicate { ann = Loc {byteRange}, name = Parse.Success (CodeQL.PredicateName {text, ann}) - } = yieldTag text P.FUNCTION P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.FUNCTION P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags CodeQL.AritylessPredicateExpr where @@ -82,7 +75,7 @@ instance ToTags CodeQL.AritylessPredicateExpr where t@CodeQL.AritylessPredicateExpr { ann = Loc {byteRange}, name = Parse.Success (CodeQL.LiteralId {text, ann}) - } = yieldTag text P.CALL P.REFERENCE ann byteRange >> gtags t + } = Tags.yield text P.CALL P.REFERENCE ann byteRange >> gtags t tags _ = pure () instance ToTags CodeQL.Dataclass where @@ -90,7 +83,7 @@ instance ToTags CodeQL.Dataclass where t@CodeQL.Dataclass { ann = Loc {byteRange}, name = Parse.Success (CodeQL.ClassName {text, ann}) - } = yieldTag text P.CLASS P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.CLASS P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags CodeQL.MemberPredicate where @@ -98,7 +91,7 @@ instance ToTags CodeQL.MemberPredicate where t@CodeQL.MemberPredicate { ann = Loc {byteRange}, name = Parse.Success (CodeQL.PredicateName {text, ann}) - } = yieldTag text P.METHOD P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.METHOD P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags CodeQL.Datatype where @@ -106,7 +99,7 @@ instance ToTags CodeQL.Datatype where t@CodeQL.Datatype { ann = Loc {byteRange}, name = Parse.Success (CodeQL.ClassName {text, ann}) - } = yieldTag text P.CLASS P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.CLASS P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags CodeQL.DatatypeBranch where @@ -114,7 +107,7 @@ instance ToTags CodeQL.DatatypeBranch where t@CodeQL.DatatypeBranch { ann = Loc {byteRange}, name = Parse.Success (CodeQL.ClassName {text, ann}) - } = yieldTag text P.CLASS P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.CLASS P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags CodeQL.ClasslessPredicateCall where @@ -131,7 +124,7 @@ instance ToTags CodeQL.QualifiedRhs where { ann = Loc {byteRange}, name = expr } = case expr of - Just (EPrj CodeQL.PredicateName {text, ann}) -> yieldTag text P.CALL P.REFERENCE ann byteRange >> gtags t + Just (EPrj CodeQL.PredicateName {text, ann}) -> Tags.yield text P.CALL P.REFERENCE ann byteRange >> gtags t _ -> gtags t instance ToTags CodeQL.TypeExpr where @@ -140,7 +133,7 @@ instance ToTags CodeQL.TypeExpr where { ann = Loc {byteRange}, name = expr } = case expr of - Just (EPrj CodeQL.ClassName {text, ann}) -> yieldTag text P.TYPE P.REFERENCE ann byteRange >> gtags t + Just (EPrj CodeQL.ClassName {text, ann}) -> Tags.yield text P.TYPE P.REFERENCE ann byteRange >> gtags t _ -> gtags t instance ToTags CodeQL.AddExpr diff --git a/semantic-go/src/Language/Go/Tags.hs b/semantic-go/src/Language/Go/Tags.hs index f3d2a12a4..f70ab7f93 100644 --- a/semantic-go/src/Language/Go/Tags.hs +++ b/semantic-go/src/Language/Go/Tags.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DefaultSignatures #-}{-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeApplications #-} @@ -15,12 +16,10 @@ import AST.Token import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer -import Data.Text as Text import qualified Language.Go.AST as Go import Proto.Semantic as P import Source.Loc import Source.Source as Source -import Tags.Tag import qualified Tags.Tagging.Precise as Tags class ToTags t where @@ -44,7 +43,7 @@ instance ToTags Go.FunctionDeclaration where t@Go.FunctionDeclaration { ann = Loc {byteRange}, name = Parse.Success (Go.Identifier {text, ann}) - } = yieldTag text P.FUNCTION P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.FUNCTION P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags Go.MethodDeclaration where @@ -52,7 +51,7 @@ instance ToTags Go.MethodDeclaration where t@Go.MethodDeclaration { ann = Loc {byteRange}, name = Parse.Success (Go.FieldIdentifier {text, ann}) - } = yieldTag text P.METHOD P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.METHOD P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags Go.CallExpression where @@ -68,7 +67,7 @@ instance ToTags Go.CallExpression where Prj Go.CallExpression {function = Parse.Success (Go.Expression e)} -> match e Prj Go.ParenthesizedExpression {extraChildren = Parse.Success (Go.Expression e)} -> match e _ -> gtags t - yield name loc = yieldTag name P.CALL P.REFERENCE loc byteRange >> gtags t + yield name loc = Tags.yield name P.CALL P.REFERENCE loc byteRange >> gtags t tags _ = pure () instance (ToTags l, ToTags r) => ToTags (l :+: r) where @@ -86,11 +85,6 @@ gtags :: m () gtags = traverse1_ @ToTags (const (pure ())) tags -yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> P.SyntaxType -> P.NodeType -> Loc -> Range -> m () -yieldTag name kind ty loc srcLineRange = do - src <- ask @Source - Tags.yield (Tag name kind ty loc (Tags.firstLine src srcLineRange) Nothing) - instance ToTags Go.ArgumentList instance ToTags Go.ArrayType diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs index 31ca5a8ad..775e68119 100644 --- a/semantic-java/src/Language/Java/Tags.hs +++ b/semantic-java/src/Language/Java/Tags.hs @@ -22,7 +22,6 @@ import Proto.Semantic as P import Source.Loc import Source.Range import Source.Source as Source -import Tags.Tag import qualified Tags.Tagging.Precise as Tags class ToTags t where @@ -54,17 +53,14 @@ instance ToTags Java.MethodDeclaration where name = Parse.Success (Java.Identifier {text, ann}), body } = do - src <- ask @Source - let line = - Tags.firstLine - src + let srcRange = range { end = case body of Just (Parse.Success (Java.Block {ann = Loc Range {end} _})) -> end Nothing -> end range Just (Parse.Fail _) -> end range } - Tags.yield (Tag text P.METHOD P.DEFINITION ann line Nothing) + Tags.yield text P.METHOD P.DEFINITION ann srcRange gtags t tags _ = pure () @@ -78,8 +74,7 @@ instance ToTags Java.ClassDeclaration where name = Parse.Success (Java.Identifier {text, ann}), body = Parse.Success (Java.ClassBody {ann = Loc Range {start = end} _}) } = do - src <- ask @Source - Tags.yield (Tag text P.CLASS P.DEFINITION ann (Tags.firstLine src (Range start end)) Nothing) + Tags.yield text P.CLASS P.DEFINITION ann (Range start end) gtags t tags _ = pure () @@ -89,8 +84,7 @@ instance ToTags Java.MethodInvocation where { ann = Loc {byteRange = range}, name = Parse.Success (Java.Identifier {text, ann}) } = do - src <- ask @Source - Tags.yield (Tag text P.CALL P.REFERENCE ann (Tags.firstLine src range) Nothing) + Tags.yield text P.CALL P.REFERENCE ann range gtags t tags _ = pure () @@ -100,17 +94,15 @@ instance ToTags Java.InterfaceDeclaration where { ann = Loc {byteRange}, name = Parse.Success (Java.Identifier {text, ann}) } = do - src <- ask @Source - Tags.yield (Tag text P.INTERFACE P.DEFINITION ann (Tags.firstLine src byteRange) Nothing) + Tags.yield text P.INTERFACE P.DEFINITION ann byteRange gtags t tags _ = pure () instance ToTags Java.InterfaceTypeList where tags t@Java.InterfaceTypeList {extraChildren = interfaces} = do - src <- ask @Source for_ interfaces $ \x -> case x of Parse.Success (Java.Type (Prj (Java.UnannotatedType (Prj (Java.SimpleType (Prj Java.TypeIdentifier {ann = loc@Loc {byteRange = range}, text = name})))))) -> - Tags.yield (Tag name P.IMPLEMENTATION P.REFERENCE loc (Tags.firstLine src range) Nothing) + Tags.yield name P.IMPLEMENTATION P.REFERENCE loc range _ -> pure () gtags t diff --git a/semantic-php/src/Language/PHP/Tags.hs b/semantic-php/src/Language/PHP/Tags.hs index 24fc356ee..cada0a55c 100644 --- a/semantic-php/src/Language/PHP/Tags.hs +++ b/semantic-php/src/Language/PHP/Tags.hs @@ -17,12 +17,10 @@ import AST.Token import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer -import Data.Text (Text) import qualified Language.PHP.AST as PHP import Proto.Semantic as P import Source.Loc import Source.Source as Source -import Tags.Tag import qualified Tags.Tagging.Precise as Tags class ToTags t where @@ -56,17 +54,12 @@ gtags :: m () gtags = traverse1_ @ToTags (const (pure ())) tags -yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> P.SyntaxType -> P.NodeType -> Loc -> Range -> m () -yieldTag name kind ty loc srcLineRange = do - src <- ask @Source - Tags.yield (Tag name kind ty loc (Tags.firstLine src srcLineRange) Nothing) - instance ToTags PHP.FunctionDefinition where tags t@PHP.FunctionDefinition { PHP.ann = Loc {byteRange}, PHP.name = Parse.Success (PHP.Name {text, ann}) - } = yieldTag text P.METHOD P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.METHOD P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags PHP.MethodDeclaration where @@ -74,7 +67,7 @@ instance ToTags PHP.MethodDeclaration where t@PHP.MethodDeclaration { PHP.ann = Loc {byteRange}, PHP.name = Parse.Success (PHP.Name {text, ann}) - } = yieldTag text P.FUNCTION P.DEFINITION ann byteRange >> gtags t + } = Tags.yield text P.FUNCTION P.DEFINITION ann byteRange >> gtags t tags _ = pure () instance ToTags PHP.FunctionCallExpression where @@ -84,7 +77,7 @@ instance ToTags PHP.FunctionCallExpression where PHP.function = func } = match func where - yield name loc = yieldTag name P.CALL P.REFERENCE loc byteRange >> gtags t + yield name loc = Tags.yield name P.CALL P.REFERENCE loc byteRange >> gtags t match expr = case expr of EPrj PHP.VariableName {extraChildren = Parse.Success (PHP.Name {text, ann})} -> yield text ann *> gtags t EPrj PHP.QualifiedName {extraChildren = [EPrj PHP.Name {text, ann}]} -> yield text ann *> gtags t @@ -96,7 +89,7 @@ instance ToTags PHP.MemberCallExpression where t@PHP.MemberCallExpression { PHP.ann = Loc {byteRange}, PHP.name = Parse.Success (Prj PHP.Name {text, ann}) - } = yieldTag text P.CALL P.REFERENCE ann byteRange >> gtags t + } = Tags.yield text P.CALL P.REFERENCE ann byteRange >> gtags t tags t = gtags t diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs index c6ed74e8e..20d17343d 100644 --- a/semantic-python/src/Language/Python/Tags.hs +++ b/semantic-python/src/Language/Python/Tags.hs @@ -18,15 +18,12 @@ import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer import Data.Foldable -import Data.List.NonEmpty (NonEmpty (..)) -import Data.Maybe (listToMaybe) import Data.Text as Text import qualified Language.Python.AST as Py import Proto.Semantic as P import Source.Loc import Source.Range import Source.Source as Source -import Tags.Tag import qualified Tags.Tagging.Precise as Tags class ToTags t where @@ -61,7 +58,7 @@ keywordFunctionCall :: Range -> Text -> m () -keywordFunctionCall t loc range name = yieldTag name P.FUNCTION P.DEFINITION loc range Nothing >> gtags t +keywordFunctionCall t loc range name = Tags.yield name P.FUNCTION P.DEFINITION loc range >> gtags t instance ToTags Py.String where tags Py.String {extraChildren} = for_ extraChildren $ \x -> case x of @@ -99,11 +96,9 @@ instance ToTags Py.FunctionDefinition where t@Py.FunctionDefinition { ann = Loc {byteRange = Range {start}}, name = Parse.Success (Py.Identifier {text, ann}), - body = Parse.Success (Py.Block {ann = Loc Range {start = end} _, extraChildren}) + body = Parse.Success (Py.Block {ann = Loc Range {start = end} _}) } = do - src <- ask @Source - let docs = listToMaybe extraChildren >>= docComment src - yieldTag text P.FUNCTION P.DEFINITION ann (Range start end) docs >> gtags t + Tags.yield text P.FUNCTION P.DEFINITION ann (Range start end) >> gtags t tags _ = pure () instance ToTags Py.ClassDefinition where @@ -111,11 +106,9 @@ instance ToTags Py.ClassDefinition where t@Py.ClassDefinition { ann = Loc {byteRange = Range {start}}, name = Parse.Success (Py.Identifier {text, ann}), - body = Parse.Success (Py.Block {ann = Loc Range {start = end} _, extraChildren}) + body = Parse.Success (Py.Block {ann = Loc Range {start = end} _}) } = do - src <- ask @Source - let docs = listToMaybe extraChildren >>= docComment src - yieldTag text P.CLASS P.DEFINITION ann (Range start end) docs >> gtags t + Tags.yield text P.CLASS P.DEFINITION ann (Range start end) >> gtags t tags _ = pure () instance ToTags Py.Call where @@ -131,35 +124,9 @@ instance ToTags Py.Call where Prj Py.Call {function = Parse.Success (Py.PrimaryExpression expr')} -> match expr' -- Nested call expression like this in Python represent creating an instance of a class and calling it: e.g. AClass()() Prj (Py.ParenthesizedExpression _ (Parse.Success (Prj (Py.Expression (Prj (Py.PrimaryExpression expr')))))) -> match expr' -- Parenthesized expressions _ -> gtags t - yield name loc = yieldTag name P.CALL P.REFERENCE loc byteRange Nothing >> gtags t + yield name loc = Tags.yield name P.CALL P.REFERENCE loc byteRange >> gtags t tags _ = pure () -yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> P.SyntaxType -> P.NodeType -> Loc -> Range -> Maybe Text -> m () -yieldTag name kind ty loc srcLineRange docs = do - src <- ask @Source - Tags.yield (Tag name kind ty loc (Tags.firstLine src srcLineRange) docs) - -docComment :: Source -> Parse.Err ((Py.CompoundStatement :+: Py.SimpleStatement) Loc) -> Maybe Text -docComment - src - ( Parse.Success - ( R1 - ( Py.SimpleStatement - ( Prj - Py.ExpressionStatement - { extraChildren = - Parse.Success - ( L1 - (Prj (Py.Expression (Prj (Py.PrimaryExpression (Prj Py.String {ann}))))) - ) - :| _ - } - ) - ) - ) - ) = Just (toText (slice src (byteRange ann))) -docComment _ _ = Nothing - gtags :: ( Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m, diff --git a/semantic-ruby/src/Language/Ruby/Tags.hs b/semantic-ruby/src/Language/Ruby/Tags.hs index 3993ee9e2..b77650927 100644 --- a/semantic-ruby/src/Language/Ruby/Tags.hs +++ b/semantic-ruby/src/Language/Ruby/Tags.hs @@ -29,7 +29,6 @@ import Proto.Semantic as P import Source.Loc import Source.Range as Range import Source.Source as Source -import Tags.Tag import qualified Tags.Tagging.Precise as Tags class ToTags t where @@ -75,9 +74,7 @@ nameBlacklist = yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> P.SyntaxType -> P.NodeType -> Loc -> Range -> m () yieldTag name P.CALL _ _ _ | name `elem` nameBlacklist = pure () -yieldTag name kind ty loc srcLineRange = do - src <- ask @Source - Tags.yield (Tag name kind ty loc (Tags.firstLine src srcLineRange) Nothing) +yieldTag name kind ty loc srcLineRange = Tags.yield name kind ty loc srcLineRange instance ToTags Rb.Class where tags @@ -213,7 +210,7 @@ instance ToTags Rb.Lambda where instance ToTags Rb.If where tags Rb.If {condition = Parse.Success cond, consequence, alternative} = do tags cond - case consequence of + case consequence of Just (Parse.Success cons) -> tags cons _ -> pure () case alternative of @@ -224,7 +221,7 @@ instance ToTags Rb.If where instance ToTags Rb.Elsif where tags Rb.Elsif {condition = Parse.Success cond, consequence, alternative} = do tags cond - case consequence of + case consequence of Just (Parse.Success cons) -> tags cons _ -> pure () case alternative of @@ -235,7 +232,7 @@ instance ToTags Rb.Elsif where instance ToTags Rb.Unless where tags Rb.Unless {condition = Parse.Success cond, consequence, alternative} = do tags cond - case consequence of + case consequence of Just (Parse.Success cons) -> tags cons _ -> pure () case alternative of diff --git a/semantic-tags/src/Tags/Tag.hs b/semantic-tags/src/Tags/Tag.hs index 2cbb033e9..9b5cc1fbe 100644 --- a/semantic-tags/src/Tags/Tag.hs +++ b/semantic-tags/src/Tags/Tag.hs @@ -1,17 +1,23 @@ -module Tags.Tag (Tag (..)) where +module Tags.Tag (Tag (..), UTF16CodeUnitSpan, OneIndexedSpan) where import Data.Text (Text) import qualified Proto.Semantic as P import Source.Loc +-- | A 0-indxed Span where the column offset units are utf-16 code units (2 +-- bytes), suitable for the LSP (Language Server Protocol) specification. +type UTF16CodeUnitSpan = Span + +-- A 1-indexed Span where the units are bytes. +type OneIndexedSpan = Span + data Tag = Tag { tagName :: Text, tagSyntaxType :: P.SyntaxType, tagNodeType :: P.NodeType, - tagLoc :: Loc, + tagSpan :: OneIndexedSpan, tagLine :: Text, - tagDocs :: Maybe Text, - tagLspSpan :: Span + tagLspSpan :: UTF16CodeUnitSpan } deriving (Eq, Show) diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs index 2835f61d2..0491f0502 100644 --- a/semantic-tags/src/Tags/Tagging/Precise.hs +++ b/semantic-tags/src/Tags/Tagging/Precise.hs @@ -1,12 +1,12 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeApplications #-} module Tags.Tagging.Precise ( Tags , Tag(..) , ToTags(..) , yield , runTagging -, firstLine -, firstLineAndSpans +, calculateLineAndSpans , surroundingLine , surroundingLineRange ) where @@ -16,12 +16,14 @@ import Control.Carrier.Reader import Control.Carrier.Writer.Strict import Data.Functor.Identity import Data.Monoid (Endo (..)) -import Data.Text as Text (Text, take, takeWhile, stripEnd, foldr, take) +import Data.Text as Text (Text, take, strip, foldr, take) import Prelude hiding (span) import Source.Loc import Source.Span (Pos(..), start, end) import Source.Source as Source +import qualified Source.Range as Range (start) import Tags.Tag +import qualified Proto.Semantic as P import qualified Data.ByteString as B import Data.Bits ((.&.)) @@ -33,10 +35,24 @@ class ToTags t where tags :: Source -> t Loc -> [Tag] -yield :: Has (Writer Tags) sig m => Tag -> m () -yield = tell . Endo . (:) . modSpan toOneIndexed where - modSpan f t@Tag{ tagLoc = l } = t { tagLoc = l { span = f (span l) } } - toOneIndexed (Span (Pos l1 c1) (Pos l2 c2)) = Span (Pos (l1 + 1) (c1 + 1)) (Pos (l2 + 1) (c2 + 1)) +-- yield :: Has (Writer Tags) sig m => Tag -> m () +-- yield = tell . Endo . (:) . modSpan toOneIndexed where +-- modSpan f t@Tag{ tagLoc = l } = t { tagLoc = l { span = f (span l) } } +-- toOneIndexed (Span (Pos l1 c1) (Pos l2 c2)) = Span (Pos (l1 + 1) (c1 + 1)) (Pos (l2 + 1) (c2 + 1)) + +yield :: + (Has (Reader Source) sig m, Has (Writer Tags) sig m) => + Text -> -- |^ Text of the identifier + P.SyntaxType -> -- |^ Type of syntax + P.NodeType -> -- |^ Node type: definition or reference + Loc -> -- |^ Location of the identifier + Range -> -- |^ Range of the entire expression (not used, but reserved for future used) + m () +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 runTagging :: Source -> ReaderC Source (WriterC Tags Identity) () -> [Tag] runTagging source @@ -46,27 +62,19 @@ runTagging source . execWriter . runReader source --- | Slices a range out of 'Source' and gives back the first line of source up to 180 characters. -firstLine :: Source -> Range -> Text -firstLine src = Text.stripEnd . Text.take 180 . Text.takeWhile (/= '\n') . Source.toText . slice src - --- A 1-indexed Span where the units are bytes. -type OneIndexedSpan = Span - --- | A 0-indxed Span where the units are utf-16 code units (2 bytes), suitable for the LSP (Language Server Protocol) specification -type UTF16CodeUnitSpan = Span - -- | Takes a Loc (where the span's column offset is measured in bytes) and --- returns two Spans: A 1-indexed span LSP friendly span (where column offset is measure in utf16 code --- units). -firstLineAndSpans :: Source -> Loc -> (Text, OneIndexedSpan, UTF16CodeUnitSpan) -firstLineAndSpans src Loc {byteRange, span = span@Span {start = start@Pos {column = startCol}, end = end@Pos {column = endCol}}} = +-- returns two Spans: A 1-indexed span LSP friendly span (where column offset is +-- measure in utf16 code units). +calculateLineAndSpans :: + Source -> -- |^ Source + Loc -> -- |^ Location of identifier + (Text, OneIndexedSpan, UTF16CodeUnitSpan) +calculateLineAndSpans src Loc {byteRange = srcRange, span = span@Span {start = start@Pos {column = startCol}, end = end@Pos {column = endCol}}} = (line, toOneIndexed span, Span start {column = utf16cpStartOffset} end {column = utf16cpEndOffset}) where - -- NB: Important to limit to 180 characters after converting to text so as - -- not to take in the middle of a multi-byte character. - line = Text.stripEnd . Text.take 180 . Source.toText $ srcLine - srcLine = surroundingLine src byteRange + -- NB: Important to limit to 180 characters after converting to text so as not to take in the middle of a multi-byte character. + line = Text.strip . Text.take 180 . Source.toText $ srcLine + srcLine = surroundingLine src srcRange toOneIndexed (Span (Pos l1 c1) (Pos l2 c2)) = Span (Pos (l1 + 1) (c1 + 1)) (Pos (l2 + 1) (c2 + 1)) utf16cpStartOffset = countUtf16CodeUnits startSlice @@ -87,16 +95,16 @@ countUtf16CodeUnits = Text.foldr len 0 . Source.toText -- | The Source of the entire surrounding line. surroundingLine :: Source -> Range -> Source -surroundingLine src = Source.slice src . surroundingLineRange src +surroundingLine src = Source.slice src . surroundingLineRange src . Range.start --- | Find the Range of the line surrounding the given Range where a line is defined by `\n`, `\r\n`, or `\r`. -surroundingLineRange :: Source -> Range -> Range -surroundingLineRange src (Range start end) = Range lineStart lineEnd +-- | Find the Range of the line surrounding the given Position where a line is defined by `\n`, `\r\n`, or `\r`. +surroundingLineRange :: Source -> Int -> Range +surroundingLineRange src start = Range lineStart lineEnd where - lineStart = maybe start (start -) $ B.elemIndex lfChar precedingSource <|> B.elemIndex crChar precedingSource + lineStart = maybe 0 (start -) $ B.elemIndex lfChar precedingSource <|> B.elemIndex crChar precedingSource precedingSource = B.reverse $ bytes (Source.slice src (Range 0 start)) - lineEnd = maybe end (start +) $ B.elemIndex crChar remainingSource <|> B.elemIndex lfChar remainingSource + lineEnd = maybe eof (start +) $ B.elemIndex crChar remainingSource <|> B.elemIndex lfChar remainingSource remainingSource = bytes $ Source.slice src (Range start eof) lfChar = toEnum (ord '\n') diff --git a/semantic-tags/test/Test.hs b/semantic-tags/test/Test.hs index 692acb2c5..408fcb332 100644 --- a/semantic-tags/test/Test.hs +++ b/semantic-tags/test/Test.hs @@ -19,50 +19,49 @@ main = defaultMain $ testGroup "semantic-tags" [ testTree ] testTree :: Tasty.TestTree testTree = Tasty.testGroup "Tags.Tagging.Precise" [ Tasty.testGroup "firstLineAndSpans" - [ testCase "ascii" $ - ( " 'a'.hi" - , Span (Pos 2 7) (Pos 2 9) -- one indexed, counting bytes - , Span (Pos 1 6) (Pos 1 8)) -- zero-indexed, counting utf16 code units (lsp-style column offset) - @=? - firstLineAndSpans (Source.fromText "def foo\n 'a'.hi\nend\n") (Loc (Range 14 16) (Span (Pos 1 6) (Pos 1 8))) - -- 0123456 789 - -- 10 ~~~^ - -- 11 ~~~~^ - -- 12 ~~~~~^ - , testCase "unicode" $ - ( " 'à'.hi" - , Span (Pos 2 8) (Pos 2 10) -- one indexed, counting bytes - , Span (Pos 1 6) (Pos 1 8)) -- zero-indexed, counting utf16 code units (lsp-style column offset) - @=? - firstLineAndSpans (Source.fromText "def foo\n 'à'.hi\nend\n") (Loc (Range 15 17) (Span (Pos 1 7) (Pos 1 9))) - -- 0123456 789 - -- 10 ~~~^ - -- 11, 12 ~~~~^ - -- 13 ~~~~~^ - , testCase "multi code point unicode" $ - ( " '💀'.hi" - , Span (Pos 2 10) (Pos 2 12) -- one indexed, counting bytes - , Span (Pos 1 7) (Pos 1 9)) -- zero-indexed, counting utf16 code units (lsp-style column offset) - @=? - firstLineAndSpans (Source.fromText "def foo\n '💀'.hi\nend\n") (Loc (Range 17 19) (Span (Pos 1 9) (Pos 1 11))) - -- 0123456 789 - -- 10 ~~~^ - -- 11, 12, 13, 14 ~~~~^ - -- 15 ~~~~~^ + [ testCase "one line" $ + let src = Source.fromText "def foo;end" + loc = Loc (Range 4 7) (Span (Pos 0 4) (Pos 0 7)) + in ( "def foo;end" + , Span (Pos 1 5) (Pos 1 8) -- one indexed, counting bytes + , Span (Pos 0 4) (Pos 0 7) -- zero-indexed, counting utf16 code units (lsp-style column offset) + ) @=? calculateLineAndSpans src loc - -- NB: This emoji cannot be entered into a string literal in haskell for some reason, you'll get: + , testCase "ascii" $ + let src = Source.fromText "def foo\n 'a'.hi\nend\n" + loc = Loc (Range 14 16) (Span (Pos 1 6) (Pos 1 8)) + in ( "'a'.hi" + , Span (Pos 2 7) (Pos 2 9) -- one indexed, counting bytes + , Span (Pos 1 6) (Pos 1 8) -- zero-indexed, counting utf16 code units (lsp-style column offset) + ) @=? calculateLineAndSpans src loc + + , testCase "unicode" $ + let src = Source.fromText "def foo\n 'à'.hi\nend\n" + loc = Loc (Range 15 17) (Span (Pos 1 7) (Pos 1 9)) + in ( "'à'.hi" + , Span (Pos 2 8) (Pos 2 10) -- one indexed, counting bytes + , Span (Pos 1 6) (Pos 1 8) -- zero-indexed, counting utf16 code units (lsp-style column offset) + ) @=? calculateLineAndSpans src loc + + , testCase "multi code point unicode" $ + let src = Source.fromText "def foo\n '💀'.hi\nend\n" + loc = Loc (Range 17 19) (Span (Pos 1 9) (Pos 1 11)) + in ( "'💀'.hi" + , Span (Pos 2 10) (Pos 2 12) -- one indexed, counting bytes + , Span (Pos 1 7) (Pos 1 9) -- zero-indexed, counting utf16 code units (lsp-style column offset) + ) @=? calculateLineAndSpans src loc + + -- NB: This emoji (:man-woman-girl-girl:) cannot be entered into a string literal in haskell for some reason, you'll get: -- > lexical error in string/character literal at character '\8205' - -- The work around is to enter the unicode directly. + -- The work around is to enter the unicode directly (7 code points). -- utf-8: 25 bytes to represent - -- utf-16: 24 bytes to represent + -- utf-16: 23 bytes to represent , testCase "multi code point unicode :man-woman-girl-girl:" $ - ( " '\128104\8205\128105\8205\128103\8205\128103'.hi" - , Span (Pos 2 31) (Pos 2 33) -- one indexed, counting bytes - , Span (Pos 1 16) (Pos 1 18)) -- zero-indexed, counting utf16 code units (lsp-style column offset) - @=? - firstLineAndSpans (Source.fromText "def foo\n '\128104\8205\128105\8205\128103\8205\128103'.hi\nend\n") (Loc (Range 38 40) (Span (Pos 1 30) (Pos 1 32))) - -- 0123456 789 - -- 10 ~~~^ - -- 11-35 ~~~~^ + let src = Source.fromText "def foo\n '\128104\8205\128105\8205\128103\8205\128103'.hi\nend\n" + loc = Loc (Range 38 40) (Span (Pos 1 30) (Pos 1 32)) + in ( "'\128104\8205\128105\8205\128103\8205\128103'.hi" + , Span (Pos 2 31) (Pos 2 33) -- one indexed, counting bytes + , Span (Pos 1 16) (Pos 1 18) -- zero-indexed, counting utf16 code units (lsp-style column offset) + ) @=? calculateLineAndSpans src loc ] ] diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs index 844ddaff3..222065c0e 100644 --- a/semantic-tsx/src/Language/TSX/Tags.hs +++ b/semantic-tsx/src/Language/TSX/Tags.hs @@ -23,7 +23,6 @@ import qualified Language.TSX.AST as Tsx import Proto.Semantic as P import Source.Loc import Source.Source as Source -import Tags.Tag import qualified Tags.Tagging.Precise as Tags class ToTags t where @@ -148,9 +147,7 @@ nameBlacklist = ["require"] yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> P.SyntaxType -> P.NodeType -> Loc -> Range -> m () yieldTag name P.CALL _ _ _ | name `elem` nameBlacklist = pure () -yieldTag name kind ty loc srcLineRange = do - src <- ask @Source - Tags.yield (Tag name kind ty loc (Tags.firstLine src srcLineRange) Nothing) +yieldTag name kind ty loc srcLineRange = Tags.yield name kind ty loc srcLineRange {- ORMOLU_DISABLE -} instance ToTags Tsx.AbstractClassDeclaration diff --git a/semantic-typescript/src/Language/TypeScript/Tags.hs b/semantic-typescript/src/Language/TypeScript/Tags.hs index 092ddb286..3b17d70ec 100644 --- a/semantic-typescript/src/Language/TypeScript/Tags.hs +++ b/semantic-typescript/src/Language/TypeScript/Tags.hs @@ -26,7 +26,6 @@ import qualified Language.TypeScript.AST as Ts import Proto.Semantic as P import Source.Loc import Source.Source as Source -import Tags.Tag import qualified Tags.Tagging.Precise as Tags class ToTags (t :: * -> *) where @@ -152,9 +151,7 @@ nameBlacklist = ["require"] yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> P.SyntaxType -> P.NodeType -> Loc -> Range -> m () yieldTag name P.CALL _ _ _ | name `elem` nameBlacklist = pure () -yieldTag name kind ty loc srcLineRange = do - src <- ask @Source - Tags.yield (Tag name kind ty loc (Tags.firstLine src srcLineRange) Nothing) +yieldTag name kind ty loc srcLineRange = Tags.yield name kind ty loc srcLineRange {- ORMOLU_DISABLE -} instance ToTags Ts.AbstractClassDeclaration diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs index 6e60f8d68..9c764419d 100644 --- a/src/Semantic/Api/Symbols.hs +++ b/src/Semantic/Api/Symbols.hs @@ -76,8 +76,8 @@ parseSymbols blobs = do & P.nodeType .~ tagNodeType tag & P.syntaxType .~ tagSyntaxType tag & P.line .~ tagLine tag - & P.maybe'span ?~ converting # Loc.span (tagLoc tag) - & P.maybe'docs .~ fmap (flip (set P.docstring) defMessage) (tagDocs tag) + & P.maybe'span ?~ converting # tagSpan tag + & P.maybe'lspSpan ?~ converting # tagLspSpan tag where toKind = toTitle . pack . show . tagSyntaxType diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs index 9393844b1..be0616ad9 100644 --- a/test/Tags/Spec.hs +++ b/test/Tags/Spec.hs @@ -14,80 +14,91 @@ spec = do describe "go" $ do it "produces tags for functions with docs (TODO)" $ parseTestFile [P.FUNCTION] (Path.relFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn` - [ Tag "TestFromBits" P.FUNCTION P.DEFINITION (Loc (Range 56 68) (Span (Pos 6 6) (Pos 6 18))) "func TestFromBits(t *testing.T) {" Nothing - , Tag "Hi" P.FUNCTION P.DEFINITION (Loc (Range 99 101) (Span (Pos 10 6) (Pos 10 8))) "func Hi() {" Nothing ] + [ Tag "TestFromBits" P.FUNCTION P.DEFINITION (Span (Pos 6 6) (Pos 6 18)) "func TestFromBits(t *testing.T) {" (Span (Pos 5 5) (Pos 5 17)) + , Tag "Hi" P.FUNCTION P.DEFINITION (Span (Pos 10 6) (Pos 10 8)) "func Hi() {" (Span (Pos 9 5) (Pos 9 7)) + ] it "produces tags for methods" $ parseTestFile [] (Path.relFile "test/fixtures/go/tags/method.go") `shouldReturn` - [ Tag "CheckAuth" P.METHOD P.DEFINITION (Loc (Range 39 48) (Span (Pos 3 21) (Pos 3 30))) "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error) {}" Nothing] + [ Tag "CheckAuth" P.METHOD P.DEFINITION (Span (Pos 3 21) (Pos 3 30)) "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error) {}" (Span (Pos 2 20) (Pos 2 29)) + ] it "produces tags for calls" $ parseTestFile [P.CALL] (Path.relFile "test/fixtures/go/tags/simple_functions.go") `shouldReturn` - [ Tag "Hi" P.CALL P.REFERENCE (Loc (Range 86 88) (Span (Pos 7 2) (Pos 7 4))) "Hi()" Nothing] + [ Tag "Hi" P.CALL P.REFERENCE (Span (Pos 7 2) (Pos 7 4)) "Hi()" (Span (Pos 6 1) (Pos 6 3)) + ] describe "javascript and typescript" $ do it "produces tags for functions with docs (TODO)" $ parseTestFile [] (Path.relFile "test/fixtures/javascript/tags/simple_function_with_docs.js") `shouldReturn` - [ Tag "myFunction" P.FUNCTION P.DEFINITION (Loc (Range 31 41) (Span (Pos 2 10) (Pos 2 20))) "function myFunction() {" Nothing ] + [ Tag "myFunction" P.FUNCTION P.DEFINITION (Span (Pos 2 10) (Pos 2 20)) "function myFunction() {" (Span (Pos 1 9) (Pos 1 19)) + ] it "produces tags for classes" $ parseTestFile [] (Path.relFile "test/fixtures/typescript/tags/class.ts") `shouldReturn` - [ Tag "FooBar" P.CLASS P.DEFINITION (Loc (Range 6 12) (Span (Pos 1 7) (Pos 1 13))) "class FooBar {}" Nothing ] + [ Tag "FooBar" P.CLASS P.DEFINITION (Span (Pos 1 7) (Pos 1 13)) "class FooBar {}" (Span (Pos 0 6) (Pos 0 12)) + ] it "produces tags for modules" $ parseTestFile [] (Path.relFile "test/fixtures/typescript/tags/module.ts") `shouldReturn` - [ Tag "APromise" P.MODULE P.DEFINITION (Loc (Range 7 15) (Span (Pos 1 8) (Pos 1 16))) "module APromise { }" Nothing ] + [ Tag "APromise" P.MODULE P.DEFINITION (Span (Pos 1 8) (Pos 1 16)) "module APromise { }" (Span (Pos 0 7) (Pos 0 15)) + ] describe "python" $ do it "produces tags for functions" $ parseTestFile [] (Path.relFile "test/fixtures/python/tags/simple_functions.py") `shouldReturn` - [ Tag "Foo" P.FUNCTION P.DEFINITION (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x):" Nothing - , Tag "Bar" P.FUNCTION P.DEFINITION (Loc (Range 74 77) (Span (Pos 7 5) (Pos 7 8))) "def Bar():" Nothing - , Tag "local" P.FUNCTION P.DEFINITION (Loc (Range 89 94) (Span (Pos 8 9) (Pos 8 14))) "def local():" Nothing + [ Tag "Foo" P.FUNCTION P.DEFINITION (Span (Pos 1 5) (Pos 1 8)) "def Foo(x):" (Span (Pos 0 4) (Pos 0 7)) + , Tag "Bar" P.FUNCTION P.DEFINITION (Span (Pos 7 5) (Pos 7 8)) "def Bar():" (Span (Pos 6 4) (Pos 6 7)) + , Tag "local" P.FUNCTION P.DEFINITION (Span (Pos 8 9) (Pos 8 14)) "def local():" (Span (Pos 7 8) (Pos 7 13)) ] it "produces tags for functions with docs" $ parseTestFile [] (Path.relFile "test/fixtures/python/tags/simple_function_with_docs.py") `shouldReturn` - [ Tag "Foo" P.FUNCTION P.DEFINITION (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x):" (Just "\"\"\"This is the foo function\"\"\"") ] + [ Tag "Foo" P.FUNCTION P.DEFINITION (Span (Pos 1 5) (Pos 1 8)) "def Foo(x):" (Span (Pos 0 4) (Pos 0 7)) + ] it "produces tags for classes" $ parseTestFile [] (Path.relFile "test/fixtures/python/tags/class.py") `shouldReturn` - [ Tag "Foo" P.CLASS P.DEFINITION (Loc (Range 6 9) (Span (Pos 1 7) (Pos 1 10))) "class Foo:" (Just "\"\"\"The Foo class\"\"\"") - , Tag "f" P.FUNCTION P.DEFINITION (Loc (Range 43 44) (Span (Pos 3 9) (Pos 3 10))) "def f(self):" (Just "\"\"\"The f method\"\"\"") + [ Tag "Foo" P.CLASS P.DEFINITION (Span (Pos 1 7) (Pos 1 10)) "class Foo:" (Span (Pos 0 6) (Pos 0 9)) + , Tag "f" P.FUNCTION P.DEFINITION (Span (Pos 3 9) (Pos 3 10)) "def f(self):" (Span (Pos 2 8) (Pos 2 9)) ] it "produces tags for multi-line functions" $ parseTestFile [P.FUNCTION] (Path.relFile "test/fixtures/python/tags/multiline.py") `shouldReturn` - [ Tag "Foo" P.FUNCTION P.DEFINITION (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def Foo(x," Nothing ] + [ Tag "Foo" P.FUNCTION P.DEFINITION (Span (Pos 1 5) (Pos 1 8)) "def Foo(x," (Span (Pos 0 4) (Pos 0 7)) + ] describe "ruby" $ do it "produces tags for methods" $ parseTestFile [P.METHOD] (Path.relFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn` - [ Tag "foo" P.METHOD P.DEFINITION (Loc (Range 4 7) (Span (Pos 1 5) (Pos 1 8))) "def foo" Nothing ] + [ Tag "foo" P.METHOD P.DEFINITION (Span (Pos 1 5) (Pos 1 8)) "def foo" (Span (Pos 0 4) (Pos 0 7)) + ] it "produces tags for sends" $ parseTestFile [P.CALL] (Path.relFile "test/fixtures/ruby/tags/simple_method.rb") `shouldReturn` - [ Tag "puts" P.CALL P.REFERENCE (Loc (Range 10 14) (Span (Pos 2 3) (Pos 2 7))) "puts \"hi\"" Nothing - , Tag "bar" P.CALL P.REFERENCE (Loc (Range 24 27) (Span (Pos 3 5) (Pos 3 8))) "a.bar" Nothing - , Tag "a" P.CALL P.REFERENCE (Loc (Range 22 23) (Span (Pos 3 3) (Pos 3 4))) "a" Nothing + [ Tag "puts" P.CALL P.REFERENCE (Span (Pos 2 3) (Pos 2 7)) "puts \"hi\"" (Span (Pos 1 2) (Pos 1 6)) + , Tag "bar" P.CALL P.REFERENCE (Span (Pos 3 5) (Pos 3 8)) "a.bar" (Span (Pos 2 4) (Pos 2 7)) + , Tag "a" P.CALL P.REFERENCE (Span (Pos 3 3) (Pos 3 4)) "a.bar" (Span (Pos 2 2) (Pos 2 3)) ] it "produces tags for methods with docs (TODO)" $ parseTestFile [] (Path.relFile "test/fixtures/ruby/tags/simple_method_with_docs.rb") `shouldReturn` - [ Tag "foo" P.METHOD P.DEFINITION (Loc (Range 18 21) (Span (Pos 2 5) (Pos 2 8))) "def foo" Nothing ] + [ Tag "foo" P.METHOD P.DEFINITION (Span (Pos 2 5) (Pos 2 8)) "def foo" (Span (Pos 1 4) (Pos 1 7)) + ] it "correctly tags files containing multibyte UTF-8 characters (TODO)" $ parseTestFile [] (Path.relFile "test/fixtures/ruby/tags/unicode_identifiers.rb") `shouldReturn` - [ Tag "日本語" P.METHOD P.DEFINITION (Loc (Range 20 29) (Span (Pos 2 5) (Pos 2 14))) "def 日本語" Nothing] + [ Tag "日本語" P.METHOD P.DEFINITION (Span (Pos 2 5) (Pos 2 14)) "def 日本語" (Span (Pos 1 4) (Pos 1 7)) + ] it "produces tags for methods and classes with docs (TODO)" $ parseTestFile [P.MODULE, P.CLASS, P.METHOD] (Path.relFile "test/fixtures/ruby/tags/class_module.rb") `shouldReturn` - [ Tag "Foo" P.MODULE P.DEFINITION (Loc (Range 21 24) (Span (Pos 2 8) (Pos 2 11))) "module Foo" Nothing - , Tag "Bar" P.CLASS P.DEFINITION (Loc (Range 50 53) (Span (Pos 5 9) (Pos 5 12))) "class Bar" Nothing - , Tag "baz" P.METHOD P.DEFINITION (Loc (Range 81 84) (Span (Pos 8 9) (Pos 8 12))) "def baz(a)" Nothing - , Tag "C" P.CLASS P.DEFINITION (Loc (Range 132 133) (Span (Pos 14 13) (Pos 14 14))) "class A::B::C" Nothing - , Tag "foo" P.METHOD P.DEFINITION (Loc (Range 140 143) (Span (Pos 15 7) (Pos 15 10))) "def foo" Nothing - , Tag "foo" P.METHOD P.DEFINITION (Loc (Range 175 178) (Span (Pos 18 12) (Pos 18 15))) "def self.foo" Nothing + [ Tag "Foo" P.MODULE P.DEFINITION (Span (Pos 2 8) (Pos 2 11)) "module Foo" (Span (Pos 1 7) (Pos 1 10)) + , Tag "Bar" P.CLASS P.DEFINITION (Span (Pos 5 9) (Pos 5 12)) "class Bar" (Span (Pos 4 8) (Pos 4 11)) + , Tag "baz" P.METHOD P.DEFINITION (Span (Pos 8 9) (Pos 8 12)) "def baz(a)" (Span (Pos 7 8) (Pos 7 11)) + , Tag "C" P.CLASS P.DEFINITION (Span (Pos 14 13) (Pos 14 14)) "class A::B::C" (Span (Pos 13 12) (Pos 13 13)) + , Tag "foo" P.METHOD P.DEFINITION (Span (Pos 15 7) (Pos 15 10)) "def foo" (Span (Pos 14 6) (Pos 14 9)) + , Tag "foo" P.METHOD P.DEFINITION (Span (Pos 18 12) (Pos 18 15)) "def self.foo" (Span (Pos 17 11) (Pos 17 14)) ] parseTestFile :: Foldable t => t P.SyntaxType -> Path.RelFile -> IO [Tag]