github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into heap-frames

Browse Source
This commit is contained in:
Rick Winfrey 2018-11-15 13:44:06 -08:00
commit 66d3044951
64 changed files with 1427 additions and 372 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@ -4,7 +4,7 @@
.stack-work
.stack-work-profiling
profiles
tags
/tags
cabal.project.local
dist

6
semantic.cabal
View File

@ -27,8 +27,9 @@ library
, Analysis.Abstract.Tracing
, Analysis.ConstructorName
, Analysis.CyclomaticComplexity
, Analysis.TOCSummary
, Analysis.Decorator
, Analysis.Declaration
, Analysis.HasTextElement
, Analysis.PackageDef
-- Semantic assignment
, Assigning.Assignment
@ -217,6 +218,8 @@ library
, Serializing.DOT
, Serializing.Format
, Serializing.SExpression
, Tags.Taggable
, Tags.Tagging
-- Custom Prelude
, Prologue
build-depends: base >= 4.8 && < 5
@ -360,6 +363,7 @@ test-suite test
, Semantic.CLI.Spec
, Semantic.IO.Spec
, Semantic.Stat.Spec
, Tags.Spec
, SpecHelpers
, Test.Hspec.LeanCheck
build-depends: aeson

5
src/Analysis/ConstructorName.hs
View File

@ -4,6 +4,7 @@ module Analysis.ConstructorName
) where
import Data.Sum
import Data.Term
import GHC.Generics
import Prologue
@ -22,11 +23,15 @@ instance Apply ConstructorName fs => ConstructorNameWithStrategy 'Custom (Sum fs
instance ConstructorNameWithStrategy 'Custom [] where
constructorNameWithStrategy _ _ = "Statements"
instance (ConstructorName syntax) => ConstructorNameWithStrategy 'Custom (TermF syntax ann) where
constructorNameWithStrategy _ = constructorName . termFOut
data Strategy = Default | Custom
type family ConstructorNameStrategy syntax where
ConstructorNameStrategy (Sum _) = 'Custom
ConstructorNameStrategy [] = 'Custom
ConstructorNameStrategy (TermF _ _) = 'Custom
ConstructorNameStrategy syntax = 'Default
class ConstructorNameWithStrategy (strategy :: Strategy) syntax where

39
src/Analysis/HasTextElement.hs Normal file
View File

@ -0,0 +1,39 @@
{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Analysis.HasTextElement
( HasTextElement(..)
) where
import Data.Sum
import Prologue
import qualified Data.Syntax.Literal as Literal
class HasTextElement syntax where
isTextElement :: syntax a -> Bool
instance (TextElementStrategy syntax ~ strategy, HasTextElementWithStrategy strategy syntax) => HasTextElement syntax where
isTextElement = isTextElementWithStrategy (Proxy :: Proxy strategy)
class CustomHasTextElement syntax where
customIsTextElement :: syntax a -> Bool
instance CustomHasTextElement Literal.TextElement where
customIsTextElement _ = True
instance Apply HasTextElement fs => CustomHasTextElement (Sum fs) where
customIsTextElement = apply @HasTextElement isTextElement
data Strategy = Default | Custom
class HasTextElementWithStrategy (strategy :: Strategy) syntax where
isTextElementWithStrategy :: proxy strategy -> syntax a -> Bool
type family TextElementStrategy syntax where
TextElementStrategy Literal.TextElement = 'Custom
TextElementStrategy (Sum fs) = 'Custom
TextElementStrategy a = 'Default
instance HasTextElementWithStrategy 'Default syntax where
isTextElementWithStrategy _ _ = False
instance CustomHasTextElement syntax => HasTextElementWithStrategy 'Custom syntax where
isTextElementWithStrategy _ = customIsTextElement

41
src/Analysis/Declaration.hs → src/Analysis/TOCSummary.hs
View File

@ -1,15 +1,13 @@
{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Analysis.Declaration
module Analysis.TOCSummary
( Declaration(..)
, HasDeclaration
, declarationAlgebra
) where
import Prologue hiding (first, project)
import Control.Arrow hiding (first)
import qualified Data.Text as T
import Prologue hiding (project)
import Control.Arrow
import Control.Rewriting hiding (apply)
import Data.Blob
import Data.Error (Error (..), showExpectation)
@ -20,15 +18,12 @@ import Data.Source as Source
import qualified Data.Syntax as Syntax
import qualified Data.Syntax.Declaration as Declaration
import Data.Term
import qualified Data.Text as T
import qualified Language.Markdown.Syntax as Markdown
import qualified Language.Ruby.Syntax as Ruby.Syntax
import qualified Language.TypeScript.Syntax as TypeScript.Syntax
-- | A declaration’s identifier and type.
data Declaration
= MethodDeclaration { declarationIdentifier :: Text, declarationText :: Text, declarationSpan :: Span, declarationLanguage :: Language, declarationReceiver :: Maybe Text }
| ClassDeclaration { declarationIdentifier :: Text, declarationText :: Text, declarationSpan :: Span, declarationLanguage :: Language }
| ModuleDeclaration { declarationIdentifier :: Text, declarationText :: Text, declarationSpan :: Span, declarationLanguage :: Language }
| FunctionDeclaration { declarationIdentifier :: Text, declarationText :: Text, declarationSpan :: Span, declarationLanguage :: Language }
| HeadingDeclaration { declarationIdentifier :: Text, declarationText :: Text, declarationSpan :: Span, declarationLanguage :: Language, declarationLevel :: Int }
| ErrorDeclaration { declarationIdentifier :: Text, declarationText :: Text, declarationSpan :: Span, declarationLanguage :: Language }
@ -117,27 +112,6 @@ instance CustomHasDeclaration whole Declaration.Method where
isEmpty = (== 0) . rangeLength . locationByteRange
methodSource = getIdentifier (arr Declaration.methodBody) blob (In ann decl)
-- | Produce a 'ClassDeclaration' for 'Declaration.Class' nodes.
instance CustomHasDeclaration whole Declaration.Class where
customToDeclaration blob@Blob{..} ann decl@(Declaration.Class _ (Term (In identifierAnn _), _) _ _)
= Just $ ClassDeclaration (getSource blobSource identifierAnn) classSource (locationSpan ann) blobLanguage
where classSource = getIdentifier (arr Declaration.classBody) blob (In ann decl)
instance CustomHasDeclaration whole Ruby.Syntax.Class where
customToDeclaration blob@Blob{..} ann decl@(Ruby.Syntax.Class (Term (In identifierAnn _), _) _ _)
= Just $ ClassDeclaration (getSource blobSource identifierAnn) rubyClassSource (locationSpan ann) blobLanguage
where rubyClassSource = getIdentifier (arr Ruby.Syntax.classBody) blob (In ann decl)
instance CustomHasDeclaration whole Ruby.Syntax.Module where
customToDeclaration blob@Blob{..} ann decl@(Ruby.Syntax.Module (Term (In identifierAnn _), _) _)
= Just $ ModuleDeclaration (getSource blobSource identifierAnn) rubyModuleSource (locationSpan ann) blobLanguage
where rubyModuleSource = getIdentifier (arr Ruby.Syntax.moduleStatements >>> first) blob (In ann decl)
instance CustomHasDeclaration whole TypeScript.Syntax.Module where
customToDeclaration blob@Blob{..} ann decl@(TypeScript.Syntax.Module (Term (In identifierAnn _), _) _)
= Just $ ModuleDeclaration (getSource blobSource identifierAnn) tsModuleSource (locationSpan ann) blobLanguage
where tsModuleSource = getIdentifier (arr TypeScript.Syntax.moduleStatements >>> first) blob (In ann decl)
-- When encountering a Declaration-annotated term, we need to extract a Text
-- for the resulting Declaration's 'declarationIdentifier' field. This text
-- is constructed by slicing out text from the original blob corresponding
@ -154,9 +128,6 @@ getIdentifier finder Blob{..} (In a r)
sliceFrom = T.stripEnd . toText . flip Source.slice blobSource . subtractRange declRange
in either (const mempty) sliceFrom bodyRange
first :: Rule env [a] a
first = target >>= maybeM (Prologue.fail "empty list") . listToMaybe
getSource :: Source -> Location -> Text
getSource blobSource = toText . flip Source.slice blobSource . locationByteRange
@ -181,10 +152,6 @@ class HasDeclarationWithStrategy (strategy :: Strategy) whole syntax where
--
-- If you’re seeing errors about missing a 'CustomHasDeclaration' instance for a given type, you’ve probably listed it in here but not defined a 'CustomHasDeclaration' instance for it, or else you’ve listed the wrong type in here. Conversely, if your 'customHasDeclaration' method is never being called, you may have forgotten to list the type in here.
type family DeclarationStrategy syntax where
DeclarationStrategy Declaration.Class = 'Custom
DeclarationStrategy Ruby.Syntax.Class = 'Custom
DeclarationStrategy Ruby.Syntax.Module = 'Custom
DeclarationStrategy TypeScript.Syntax.Module = 'Custom
DeclarationStrategy Declaration.Function = 'Custom
DeclarationStrategy Declaration.Method = 'Custom
DeclarationStrategy Markdown.Heading = 'Custom

4
src/Data/Duration.hs
View File

@ -5,6 +5,7 @@ module Data.Duration
, fromMicroseconds
, fromNanoseconds
, toMicroseconds
, toSeconds
) where
-- A duration suitable for timeouts stored as an int of milliseconds.
@ -32,3 +33,6 @@ fromNanoseconds n = fromMicroseconds (n `div` 1000)
toMicroseconds :: Duration -> Int
toMicroseconds (Milliseconds n) = n * 1000
toSeconds :: Duration -> Int
toSeconds (Milliseconds n) = n `div` 1000

5
src/Data/Syntax/Declaration.hs
View File

@ -195,7 +195,7 @@ instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Variable
data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: !a }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, FreeVariables1, ToJSONFields1, Named1, Message1, NFData1)
instance Declarations a => Declarations (Class a) where
declaredName (Class _ name _ _) = declaredName name
@ -235,6 +235,9 @@ instance Evaluatable Class where
-- bind name addr
-- pure (Rval addr)
instance Declarations1 Class where
liftDeclaredName declaredName = declaredName . classIdentifier
-- | A decorator in Python
data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1, NFData1)

2
src/Data/Term.hs
View File

@ -42,7 +42,7 @@ guardTerm :: forall m f syntax ann . (f :< syntax, Alternative m)
guardTerm = Sum.projectGuard . termOut
data TermF syntax ann recur = In { termFAnnotation :: ann, termFOut :: syntax recur }
deriving (Eq, Ord, Foldable, Functor, Show, Traversable)
deriving (Eq, Ord, Foldable, Functor, Show, Traversable, Generic1)
-- | A convenience typeclass to get the annotation out of a 'Term' or 'TermF'.
-- Useful in term-rewriting algebras.

3
src/Language/Go/Assignment.hs
View File

@ -488,7 +488,8 @@ parenthesizedExpression :: Assignment Term
parenthesizedExpression = symbol ParenthesizedExpression *> children expressions
selectorExpression :: Assignment Term
selectorExpression = makeTerm <$> symbol SelectorExpression <*> children (Expression.MemberAccess <$> expression <*> (identifier' <|> fieldIdentifier'))
selectorExpression = makeWithContext <$> symbol SelectorExpression <*> children ((,,) <$> expression <*> optional comment <*> (identifier' <|> fieldIdentifier'))
where makeWithContext loc (lhs, comment, rhs) = maybe (makeTerm loc (Expression.MemberAccess lhs rhs)) (\c -> makeTerm loc (Syntax.Context (c :| []) (makeTerm loc (Expression.MemberAccess lhs rhs)))) comment
sliceExpression :: Assignment Term
sliceExpression = makeTerm <$> symbol SliceExpression <*> children (Go.Syntax.Slice <$> expression <* token AnonLBracket <*> (emptyTerm <|> expression) <* token AnonColon <*> (expression <|> emptyTerm) <* optional (token AnonColon) <*> (expression <|> emptyTerm))

39
src/Language/Markdown/Syntax.hs
View File

@ -2,6 +2,7 @@
{-# OPTIONS_GHC -Wno-missing-export-lists #-}
module Language.Markdown.Syntax where
import Data.Abstract.Declarations
import Data.JSON.Fields
import qualified Data.Text as T
import Diffing.Algorithm
@ -10,7 +11,7 @@ import Proto3.Suite
import qualified Proto3.Suite as PB
newtype Document a = Document { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 Document where liftEq = genericLiftEq
instance Ord1 Document where liftCompare = genericLiftCompare
@ -20,70 +21,70 @@ instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
-- Block elements
newtype Paragraph a = Paragraph { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 Paragraph where liftEq = genericLiftEq
instance Ord1 Paragraph where liftCompare = genericLiftCompare
instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
data Heading a = Heading { headingLevel :: Int, headingContent :: [a], sectionContent :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 Heading where liftEq = genericLiftEq
instance Ord1 Heading where liftCompare = genericLiftCompare
instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
newtype UnorderedList a = UnorderedList { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 UnorderedList where liftEq = genericLiftEq
instance Ord1 UnorderedList where liftCompare = genericLiftCompare
instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
newtype OrderedList a = OrderedList { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 OrderedList where liftEq = genericLiftEq
instance Ord1 OrderedList where liftCompare = genericLiftCompare
instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
newtype BlockQuote a = BlockQuote { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 BlockQuote where liftEq = genericLiftEq
instance Ord1 BlockQuote where liftCompare = genericLiftCompare
instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
data ThematicBreak a = ThematicBreak
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 ThematicBreak where liftEq = genericLiftEq
instance Ord1 ThematicBreak where liftCompare = genericLiftCompare
instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec
newtype HTMLBlock a = HTMLBlock { value :: T.Text }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 HTMLBlock where liftEq = genericLiftEq
instance Ord1 HTMLBlock where liftCompare = genericLiftCompare
instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
newtype Table a = Table { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 Table where liftEq = genericLiftEq
instance Ord1 Table where liftCompare = genericLiftCompare
instance Show1 Table where liftShowsPrec = genericLiftShowsPrec
newtype TableRow a = TableRow { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 TableRow where liftEq = genericLiftEq
instance Ord1 TableRow where liftCompare = genericLiftCompare
instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec
newtype TableCell a = TableCell { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 TableCell where liftEq = genericLiftEq
instance Ord1 TableCell where liftCompare = genericLiftCompare
@ -93,28 +94,28 @@ instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec
-- Inline elements
newtype Strong a = Strong { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 Strong where liftEq = genericLiftEq
instance Ord1 Strong where liftCompare = genericLiftCompare
instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
newtype Emphasis a = Emphasis { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 Emphasis where liftEq = genericLiftEq
instance Ord1 Emphasis where liftCompare = genericLiftCompare
instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
newtype Text a = Text { value :: T.Text}
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 Text where liftEq = genericLiftEq
instance Ord1 Text where liftCompare = genericLiftCompare
instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
data Link a = Link { linkURL :: T.Text, linkTitle :: Maybe T.Text }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, NFData1)
instance Message1 Link where
liftEncodeMessage _ _ Link{..} = encodeMessageField 1 linkURL <> maybe mempty (encodeMessageField 2) linkTitle
@ -129,7 +130,7 @@ instance Ord1 Link where liftCompare = genericLiftCompare
instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
data Image a = Image { imageURL :: T.Text, imageTitle :: Maybe T.Text }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, NFData1)
instance Message1 Image where
liftEncodeMessage _ _ Image{..} = encodeMessageField 1 imageURL <> maybe mempty (encodeMessageField 2) imageTitle
@ -144,7 +145,7 @@ instance Ord1 Image where liftCompare = genericLiftCompare
instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
data Code a = Code { codeLanguage :: Maybe T.Text, codeContent :: T.Text }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, NFData1)
instance Message1 Code where
liftEncodeMessage _ _ Code{..} = maybe mempty (encodeMessageField 1) codeLanguage <> encodeMessageField 2 codeContent
@ -160,14 +161,14 @@ instance Ord1 Code where liftCompare = genericLiftCompare
instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
data LineBreak a = LineBreak
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 LineBreak where liftEq = genericLiftEq
instance Ord1 LineBreak where liftCompare = genericLiftCompare
instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
newtype Strikethrough a = Strikethrough { values :: [a] }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1, Named1, Message1, NFData1)
instance Eq1 Strikethrough where liftEq = genericLiftEq
instance Ord1 Strikethrough where liftCompare = genericLiftCompare

11
src/Language/Python/Assignment.hs
View File

@ -277,16 +277,19 @@ exceptClause = makeTerm <$> symbol ExceptClause <*> children
functionDefinition :: Assignment Term
functionDefinition =
makeFunctionDeclaration <$> symbol FunctionDefinition <*> children ((,,,) <$> term expression <* symbol Parameters <*> children (manyTerm expression) <*> optional (symbol Type *> children (term expression)) <*> expressions)
<|> makeFunctionDeclaration <$> (symbol Lambda' <|> symbol Lambda) <*> children ((,,,) <$ token AnonLambda <*> emptyTerm <*> (symbol LambdaParameters *> children (manyTerm expression) <|> pure []) <*> optional (symbol Type *> children (term expression)) <*> expressions)
makeFunctionDeclaration <$> symbol FunctionDefinition <*> children ((,,,) <$> term expression <* symbol Parameters <*> children (manyTerm expression) <*> optional (symbol Type *> children (term expression)) <*> expressions')
<|> makeFunctionDeclaration <$> (symbol Lambda' <|> symbol Lambda) <*> children ((,,,) <$ token AnonLambda <*> emptyTerm <*> (symbol LambdaParameters *> children (manyTerm expression) <|> pure []) <*> optional (symbol Type *> children (term expression)) <*> expressions')
where
expressions' = makeTerm <$> location <*> manyTerm expression
makeFunctionDeclaration loc (functionName', functionParameters, ty, functionBody)
= let fn = makeTerm loc (Declaration.Function [] functionName' functionParameters functionBody)
in maybe fn (makeTerm loc . Type.Annotation fn) ty
classDefinition :: Assignment Term
classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class [] <$> term expression <*> argumentList <*> expressions)
where argumentList = symbol ArgumentList *> children (manyTerm expression)
classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class [] <$> term expression <*> argumentList <*> expressions')
where
expressions' = makeTerm <$> location <*> manyTerm expression
argumentList = symbol ArgumentList *> children (manyTerm expression)
<|> pure []
type' :: Assignment Term

10
src/Language/Ruby/Syntax.hs
View File

@ -152,7 +152,7 @@ doLoad path shouldWrap = do
-- TODO: autoload
data Class a = Class { classIdentifier :: !a, classSuperClass :: !(Maybe a), classBody :: !a }
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1, NFData1)
deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, FreeVariables1, ToJSONFields1, Named1, Message1, NFData1)
instance Diffable Class where
equivalentBySubterm = Just . classIdentifier
@ -168,8 +168,11 @@ instance Evaluatable Class where
-- rvalBox =<< letrec' name (\addr ->
-- makeNamespace name addr super (void (eval classBody)))
instance Declarations1 Class where
liftDeclaredName declaredName = declaredName . classIdentifier
data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1, NFData1)
deriving (Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1, NFData1)
instance Eq1 Module where liftEq = genericLiftEq
instance Ord1 Module where liftCompare = genericLiftCompare
@ -181,6 +184,9 @@ instance Evaluatable Module where
-- rvalBox =<< letrec' name (\addr ->
-- makeNamespace name addr Nothing (traverse_ eval xs))
instance Declarations1 Module where
liftDeclaredName declaredName = declaredName . moduleIdentifier
data LowPrecedenceAnd a = LowPrecedenceAnd { lhs :: a, rhs :: a }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1, NFData1)

4
src/Language/TypeScript/Syntax/TypeScript.hs
View File

@ -537,7 +537,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Update
data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, NFData1, Named1, Ord, Show, ToJSONFields1, Traversable)
deriving (Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, NFData1, Named1, Ord, Show, ToJSONFields1, Traversable)
instance Eq1 Module where liftEq = genericLiftEq
instance Ord1 Module where liftCompare = genericLiftCompare
@ -549,6 +549,8 @@ instance Evaluatable Module where
-- rvalBox =<< letrec' name (\addr ->
-- makeNamespace name addr Nothing (traverse_ eval xs))
instance Declarations1 Module where
liftDeclaredName declaredName = declaredName . moduleIdentifier
data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] }
deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, NFData1, Named1, Ord, Show, ToJSONFields1, Traversable)

20
src/Rendering/JSON.hs
View File

@ -8,6 +8,8 @@ module Rendering.JSON
, renderJSONAST
, renderSymbolTerms
, renderJSONError
, renderJSONSymbolError
, renderJSONDiffError
, SomeJSON(..)
) where
@ -93,12 +95,26 @@ instance ToJSON a => ToJSON (JSONAST a) where
renderSymbolTerms :: ToJSON a => [a] -> JSON "files" SomeJSON
renderSymbolTerms = JSON . map SomeJSON
-- | Render an error for symbols.
renderJSONSymbolError :: Blob -> String -> JSON "files" SomeJSON
renderJSONSymbolError blob e = JSON [ renderError blob e ]
-- | Render an error for terms.
renderJSONError :: Blob -> String -> JSON "trees" SomeJSON
renderJSONError Blob{..} e = JSON [ SomeJSON (object [ "error" .= err ]) ]
where err = object [ "message" .= e
renderJSONError blob e = JSON [ renderError blob e ]
-- | Render an error for a particular blob.
renderError :: ToJSON a => Blob -> a -> SomeJSON
renderError Blob{..} e = SomeJSON $ object
[ "error" .= e
, "path" .= blobPath
, "language" .= blobLanguage ]
-- | Render an error for diffs.
renderJSONDiffError :: BlobPair -> String -> JSON "diffs" SomeJSON
renderJSONDiffError pair e = JSON [ SomeJSON (object [ "error" .= err ]) ]
where err = object ["message" .= e, "stat" .= toJSON (JSONStat pair)]
data SomeJSON where
SomeJSON :: ToJSON a => a -> SomeJSON

3
src/Rendering/Renderer.hs
View File

@ -14,6 +14,9 @@ module Rendering.Renderer
, renderToSymbols
, renderTreeGraph
, renderJSONError
, renderJSONSymbolError
, renderJSONDiffError
, renderJSONSummaryError
, Summaries(..)
, TOCSummary(..)
, SymbolFields(..)

48
src/Rendering/Symbol.hs
View File

@ -7,35 +7,35 @@ module Rendering.Symbol
) where
import Prologue hiding (when)
import Analysis.Declaration
import Data.Aeson
import Data.Blob
import Data.Language (ensureLanguage)
import Data.Location
import Data.List.Split (splitWhen)
import Data.Location
import Data.Term
import qualified Data.Text as T
import Rendering.TOC
import Tags.Taggable
import Tags.Tagging
-- | Render a 'Term' to a list of symbols (See 'Symbol').
renderToSymbols :: (Foldable f, Functor f) => SymbolFields -> Blob -> Term f (Maybe Declaration) -> [Value]
renderToSymbols fields Blob{..} term = [toJSON (termToC fields blobPath term)]
where
termToC :: (Foldable f, Functor f) => SymbolFields -> FilePath -> Term f (Maybe Declaration) -> File
termToC fields path = File (T.pack path) (T.pack (show blobLanguage)) . mapMaybe (symbolSummary fields path "unchanged") . termTableOfContentsBy declaration
renderToSymbols :: (IsTaggable f) => SymbolFields -> Blob -> Term f Location -> [File]
renderToSymbols fields blob term = either mempty (pure . tagsToFile fields blob) (runTagging blob term)
-- | Construct a 'Symbol' from a node annotation and a change type label.
symbolSummary :: SymbolFields -> FilePath -> T.Text -> Declaration -> Maybe Symbol
symbolSummary SymbolFields{..} path _ record = case record of
ErrorDeclaration{} -> Nothing
declaration -> Just Symbol
{ symbolName = when symbolFieldsName (declarationIdentifier declaration)
, symbolPath = when symbolFieldsPath (T.pack path)
, symbolLang = join (when symbolFieldsLang (T.pack . show <$> ensureLanguage (declarationLanguage declaration)))
, symbolKind = when symbolFieldsKind (toCategoryName declaration)
, symbolLine = when symbolFieldsLine (declarationText declaration)
, symbolSpan = when symbolFieldsSpan (declarationSpan declaration)
tagsToFile :: SymbolFields -> Blob -> [Tag] -> File
tagsToFile fields blob@Blob{..} tags = File (T.pack blobPath) (T.pack (show blobLanguage)) (fmap (tagToSymbol fields blob) tags)
-- | Construct a 'Symbol' from a 'Tag'
tagToSymbol :: SymbolFields -> Blob -> Tag -> Symbol
tagToSymbol SymbolFields{..} Blob{..} Tag{..}
= Symbol
{ symbolName = when symbolFieldsName name
, symbolPath = when symbolFieldsPath (T.pack blobPath)
, symbolLang = when symbolFieldsLang (T.pack (show blobLanguage))
, symbolKind = when symbolFieldsKind kind
, symbolLine = join (when symbolFieldsLine line)
, symbolSpan = when symbolFieldsSpan span
, symbolDocs = join (when symbolFieldsDocs docs)
}
data File = File
@ -56,6 +56,7 @@ data Symbol = Symbol
, symbolKind :: Maybe T.Text
, symbolLine :: Maybe T.Text
, symbolSpan :: Maybe Span
, symbolDocs :: Maybe T.Text
} deriving (Generic, Eq, Show)
instance ToJSON Symbol where
@ -65,7 +66,8 @@ instance ToJSON Symbol where
, "language" .= symbolLang
, "kind" .= symbolKind
, "line" .= symbolLine
, "span" .= symbolSpan ]
, "span" .= symbolSpan
, "docs" .= symbolDocs ]
where objectWithoutNulls = object . filter (\(_, v) -> v /= Null)
when :: Bool -> a -> Maybe a
@ -79,11 +81,12 @@ data SymbolFields = SymbolFields
, symbolFieldsKind :: Bool
, symbolFieldsLine :: Bool
, symbolFieldsSpan :: Bool
, symbolFieldsDocs :: Bool
}
deriving (Eq, Show)
defaultSymbolFields :: SymbolFields
defaultSymbolFields = SymbolFields True False False True False True
defaultSymbolFields = SymbolFields True False False True False True True
parseSymbolFields :: String -> SymbolFields
parseSymbolFields arg =
@ -95,4 +98,5 @@ parseSymbolFields arg =
, symbolFieldsKind = "kind" `elem` fields
, symbolFieldsLine = "line" `elem` fields
, symbolFieldsSpan = "span" `elem` fields
, symbolFieldsDocs = "docs" `elem` fields
}

17
src/Rendering/TOC.hs
View File

@ -3,6 +3,7 @@ module Rendering.TOC
( renderToCDiff
, renderRPCToCDiff
, renderToCTerm
, renderJSONSummaryError
, diffTOC
, Summaries(..)
, TOCSummary(..)
@ -17,7 +18,7 @@ module Rendering.TOC
) where
import Prologue
import Analysis.Declaration
import Analysis.TOCSummary
import Data.Align (bicrosswalk)
import Data.Aeson
import Data.Blob
@ -31,6 +32,10 @@ import Data.Location
import Data.Term
import qualified Data.Text as T
renderJSONSummaryError :: BlobPair -> String -> Summaries
renderJSONSummaryError pair e = Summaries mempty (Map.singleton path [object ["error" .= e]])
where path = T.pack (pathKeyForBlobPair pair)
data Summaries = Summaries { changes, errors :: !(Map.Map T.Text [Value]) }
deriving (Eq, Show)
@ -151,13 +156,7 @@ renderRPCToCDiff :: (Foldable f, Functor f) => BlobPair -> Diff f (Maybe Declara
renderRPCToCDiff _ = List.partition isValidSummary . diffTOC
diffTOC :: (Foldable f, Functor f) => Diff f (Maybe Declaration) (Maybe Declaration) -> [TOCSummary]
diffTOC = fmap entrySummary . dedupe . filter extraDeclarations . tableOfContentsBy declaration
where
extraDeclarations :: Entry Declaration -> Bool
extraDeclarations entry = case entryPayload entry of
ClassDeclaration{..} -> False
ModuleDeclaration{..} -> False
_ -> True
diffTOC = fmap entrySummary . dedupe . tableOfContentsBy declaration
renderToCTerm :: (Foldable f, Functor f) => Blob -> Term f (Maybe Declaration) -> Summaries
renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC
@ -171,8 +170,6 @@ renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition
-- The user-facing category name
toCategoryName :: Declaration -> T.Text
toCategoryName declaration = case declaration of
ClassDeclaration{} -> "Class"
ModuleDeclaration{} -> "Module"
FunctionDeclaration{} -> "Function"
MethodDeclaration{} -> "Method"
HeadingDeclaration _ _ _ _ l -> "Heading " <> T.pack (show l)

6
src/Semantic/Config.hs
View File

@ -38,6 +38,7 @@ data Config
, configStatsPort :: Stat.Port -- ^ Port of statsd/datadog (default: "28125")
, configTreeSitterParseTimeout :: Duration -- ^ Timeout in milliseconds before canceling tree-sitter parsing (default: 10000).
, configAssignmentTimeout :: Duration -- ^ Millisecond timeout for assignment (default: 10000)
, configMaxTelemetyQueueSize :: Int -- ^ Max size of telemetry queues before messages are dropped (default: 1000).
, configIsTerminal :: Bool -- ^ Whether a terminal is attached (set automaticaly at runtime).
, configLogPrintSource :: Bool -- ^ Whether to print the source reference when logging errors (set automatically at runtime).
@ -70,7 +71,9 @@ defaultConfig options@Options{..} = do
haystackURL <- lookupEnv "HAYSTACK_URL"
(statsHost, statsPort) <- lookupStatsAddr
size <- envLookupNum 1000 "MAX_TELEMETRY_QUEUE_SIZE"
parseTimeout <- envLookupNum 10000 "TREE_SITTER_PARSE_TIMEOUT" -- Default is 10 seconds
-- Defaults for these values are commensurate with the Dockerfile
parseTimeout <- envLookupNum 6000 "TREE_SITTER_PARSE_TIMEOUT"
assignTimeout <- envLookupNum 4000 "SEMANTIC_ASSIGNMENT_TIMEOUT"
pure Config
{ configAppName = "semantic"
, configHostName = hostName
@ -80,6 +83,7 @@ defaultConfig options@Options{..} = do
, configStatsPort = statsPort
, configTreeSitterParseTimeout = fromMilliseconds parseTimeout
, configAssignmentTimeout = fromMilliseconds assignTimeout
, configMaxTelemetyQueueSize = size
, configIsTerminal = isTerminal
, configLogPrintSource = isTerminal

32
src/Semantic/Diff.hs
View File

@ -5,31 +5,32 @@ module Semantic.Diff
) where
import Analysis.ConstructorName (ConstructorName)
import Analysis.Declaration (HasDeclaration, declarationAlgebra)
import Analysis.TOCSummary (HasDeclaration, declarationAlgebra)
import Control.Effect
import Control.Effect.Error
import Control.Monad.IO.Class
import Data.Blob
import Data.Diff
import Data.Graph.DiffVertex
import Data.JSON.Fields
import Data.Location
import Data.Term
import Data.Graph.DiffVertex
import Diffing.Algorithm (Diffable)
import Parsing.Parser
import Prologue
import Rendering.Graph
import Rendering.Renderer
import Semantic.Telemetry as Stat
import Semantic.Task as Task
import Serializing.Format
import Rendering.JSON (SomeJSON (..))
import qualified Rendering.JSON as JSON
import Rendering.Renderer
import Semantic.Task as Task
import Semantic.Telemetry as Stat
import Serializing.Format
-- | Using the specified renderer, diff a list of 'BlobPair's to produce a 'Builder' output.
runDiff :: (Member Distribute sig, Member (Error SomeException) sig, Member Task sig, Member Telemetry sig, MonadIO m, Carrier sig m) => DiffRenderer output -> [BlobPair] -> m Builder
runDiff ToCDiffRenderer = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderToCDiff) >=> serialize JSON
runDiff JSONDiffRenderer = withParsedBlobPairs (const pure) (render . renderJSONDiff) >=> serialize JSON
runDiff JSONGraphDiffRenderer = withParsedBlobPairs (const pure) (render . renderAdjGraph) >=> serialize JSON
runDiff ToCDiffRenderer = withParsedBlobPairs' renderJSONSummaryError (decorate . declarationAlgebra) (render . renderToCDiff) >=> serialize JSON
runDiff JSONDiffRenderer = withParsedBlobPairs' renderJSONDiffError (const pure) (render . renderJSONDiff) >=> serialize JSON
runDiff JSONGraphDiffRenderer = withParsedBlobPairs' renderJSONDiffError (const pure) (render . renderAdjGraph) >=> serialize JSON
where renderAdjGraph :: (Recursive t, ToTreeGraph DiffVertex (Base t)) => BlobPair -> t -> JSON.JSON "diffs" SomeJSON
renderAdjGraph blob diff = renderJSONAdjDiff blob (renderTreeGraph diff)
runDiff SExpressionDiffRenderer = withParsedBlobPairs (const pure) (const (serialize (SExpression ByConstructorName)))
@ -48,6 +49,19 @@ diffBlobTOCPairs = withParsedBlobPairs (decorate . declarationAlgebra) (render .
type CanDiff syntax = (ConstructorName syntax, Diffable syntax, Eq1 syntax, HasDeclaration syntax, Hashable1 syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax)
type Decorate m a b = forall syntax . CanDiff syntax => Blob -> Term syntax a -> m (Term syntax b)
withParsedBlobPairs' :: (Member Distribute sig, Member (Error SomeException) sig, Member Task sig, Member Telemetry sig, MonadIO m, Monoid output, Carrier sig m)
=> (BlobPair -> String -> output)
-> Decorate m Location ann
-> (forall syntax . CanDiff syntax => BlobPair -> Diff syntax ann ann -> m output)
-> [BlobPair]
-> m output
withParsedBlobPairs' onError decorate render = distributeFoldMap (\ blobs -> (withParsedBlobPair decorate blobs >>= withSomeTermPair (diffTerms blobs >=> render blobs)) `catchError` \(SomeException e) -> pure (onError blobs (show e)))
where diffTerms :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax, Member Task sig, Member Telemetry sig, Carrier sig m, MonadIO m) => BlobPair -> Join These (Term syntax ann) -> m (Diff syntax ann ann)
diffTerms blobs terms = time "diff" languageTag $ do
diff <- diff (runJoin terms)
diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
where languageTag = languageTagForBlobPair blobs
withParsedBlobPairs :: (Member Distribute sig, Member (Error SomeException) sig, Member Task sig, Member Telemetry sig, MonadIO m, Monoid output, Carrier sig m)
=> Decorate m Location ann
-> (forall syntax . CanDiff syntax => BlobPair -> Diff syntax ann ann -> m output)

15
src/Semantic/Parse.hs
View File

@ -2,18 +2,18 @@
module Semantic.Parse ( runParse, runParse', parseSomeBlob ) where
import Analysis.ConstructorName (ConstructorName)
import Analysis.Declaration (HasDeclaration, declarationAlgebra)
import Analysis.PackageDef (HasPackageDef)
import Control.Effect
import Control.Effect.Error
import Control.Monad.IO.Class
import Data.Abstract.Declarations
import Data.Blob
import Data.Either
import Data.ByteString.Builder (stringUtf8)
import Data.Either
import Data.Graph.TermVertex
import Data.JSON.Fields
import Data.Quieterm
import Data.Location
import Data.Quieterm
import Data.Term
import Parsing.Parser
import Prologue
@ -23,6 +23,7 @@ import qualified Rendering.JSON as JSON
import Rendering.Renderer
import Semantic.Task
import Serializing.Format
import Tags.Taggable
-- | Using the specified renderer, parse a list of 'Blob's to produce a 'Builder' output.
runParse :: (Member Distribute sig, Member (Error SomeException) sig, Member Task sig, Carrier sig m, MonadIO m) => TermRenderer output -> [Blob] -> m Builder
@ -32,7 +33,7 @@ runParse JSONGraphTermRenderer = withParsedBlobs' renderJSONError (render
renderAdjGraph blob term = renderJSONAdjTerm blob (renderTreeGraph term)
runParse SExpressionTermRenderer = withParsedBlobs (const (serialize (SExpression ByConstructorName)))
runParse ShowTermRenderer = withParsedBlobs (const (serialize Show . quieterm))
runParse (SymbolsTermRenderer fields) = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> render (renderSymbolTerms . renderToSymbols fields blob)) >=> serialize JSON
runParse (SymbolsTermRenderer fields) = withParsedBlobs' renderJSONSymbolError (\ blob -> render (renderSymbolTerms . renderToSymbols fields blob)) >=> serialize JSON
runParse DOTTermRenderer = withParsedBlobs (const (render renderTreeGraph)) >=> serialize (DOT (termStyle "terms"))
runParse QuietTermRenderer = distributeFoldMap $ \blob ->
showTiming blob <$> time' ((parseSomeBlob blob >>= withSomeTerm (fmap (const (Right ())) . serialize Show . quieterm)) `catchError` \(SomeException e) -> pure (Left (show e)))
@ -48,12 +49,14 @@ runParse' blob = parseSomeBlob blob >>= withSomeTerm (serialize Show . quieterm)
type Render m output
= forall syntax
. ( ConstructorName syntax
, HasDeclaration syntax
, HasPackageDef syntax
, Foldable syntax
, Functor syntax
, Show1 syntax
, ToJSONFields1 syntax
, Declarations1 syntax
, Taggable syntax
, HasTextElement syntax
)
=> Blob
-> Term syntax Location
@ -69,5 +72,5 @@ withParsedBlobs' onError render = distributeFoldMap $ \blob ->
(parseSomeBlob blob >>= withSomeTerm (render blob)) `catchError` \(SomeException e) ->
pure (onError blob (show e))
parseSomeBlob :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, Show1, ToJSONFields1] Location)
parseSomeBlob :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m) => Blob -> m (SomeTerm '[ConstructorName, Foldable, Functor, HasPackageDef, Show1, ToJSONFields1, Taggable, HasTextElement, Declarations1] Location)
parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (`parse` blob) (someParser blobLanguage)

17
src/Semantic/Task.hs
View File

@ -72,9 +72,7 @@ import Data.Bool
import Data.ByteString.Builder
import Data.Coerce
import Data.Diff
import Data.Duration
import qualified Data.Error as Error
import Data.Language (Language)
import Data.Location
import Data.Source (Source)
import Data.Sum
@ -273,7 +271,7 @@ logError :: (Member Telemetry sig, Carrier sig m)
-> m ()
logError Config{..} level blob err = writeLog level (Error.formatError configLogPrintSource configIsTerminal blob err)
data ParserCancelled = ParserTimedOut FilePath Language | AssignmentTimedOut FilePath Language
data ParserCancelled = ParserTimedOut | AssignmentTimedOut
deriving (Show, Typeable)
instance Exception ParserCancelled
@ -288,7 +286,7 @@ runParser blob@Blob{..} parser = case parser of
time "parse.tree_sitter_ast_parse" languageTag $ do
config <- ask
parseToAST (configTreeSitterParseTimeout config) language blob
>>= maybeM (throwError (SomeException (ParserTimedOut blobPath blobLanguage)))
>>= maybeM (throwError (SomeException ParserTimedOut))
AssignmentParser parser assignment -> runAssignment Assignment.assign parser assignment
DeterministicParser parser assignment -> runAssignment Deterministic.assign parser assignment
@ -328,21 +326,20 @@ runParser blob@Blob{..} parser = case parser of
writeLog Error "failed parsing" (("task", "parse") : blobFields)
throwError (toException err)
-- TODO: Could give assignment a dedicated config for it's timeout.
res <- timeout (fromSeconds 3) . time "parse.assign" languageTag $
res <- timeout (configAssignmentTimeout config) . time "parse.assign" languageTag $
case assign blobSource assignment ast of
Left err -> do
writeStat (increment "parse.assign_errors" languageTag)
logError config Error blob err (("task", "assign") : blobFields)
throwError (toException err)
Right term -> do
for_ (errors term) $ \ err -> case Error.errorActual err of
for_ (zip (errors term) [(0::Integer)..]) $ \ (err, i) -> case Error.errorActual err of
Just "ParseError" -> do
writeStat (increment "parse.parse_errors" languageTag)
when (i == 0) $ writeStat (increment "parse.parse_errors" languageTag)
logError config Warning blob err (("task", "parse") : blobFields)
when (optionsFailOnParseError (configOptions config)) $ throwError (toException err)
_ -> do
writeStat (increment "parse.assign_warnings" languageTag)
when (i == 0) $ writeStat (increment "parse.assign_warnings" languageTag)
logError config Warning blob err (("task", "assign") : blobFields)
when (optionsFailOnWarning (configOptions config)) $ throwError (toException err)
term <$ writeStat (count "parse.nodes" (length term) languageTag)
@ -351,4 +348,4 @@ runParser blob@Blob{..} parser = case parser of
Nothing -> do
writeStat (increment "assign.assign_timeouts" languageTag)
writeLog Error "assignment timeout" (("task", "assign") : blobFields)
throwError (SomeException (AssignmentTimedOut blobPath blobLanguage))
throwError (SomeException AssignmentTimedOut)

7
src/Semantic/Telemetry/Haystack.hs
View File

@ -10,8 +10,10 @@ import Control.Exception
import Crypto.Hash
import Data.Aeson hiding (Error)
import qualified Data.ByteString.Char8 as BC
import Data.List (intercalate)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import GHC.Exts (currentCallStack)
import Network.HTTP.Client
import Network.HTTP.Types.Status (statusCode)
import Prologue hiding (hash)
@ -51,14 +53,15 @@ haystackClient maybeURL managerSettings appName
reportError :: ErrorLogger -> HaystackClient -> ErrorReport -> IO ()
reportError logger NullHaystackClient ErrorReport{..} = let msg = takeWhile (/= '\n') (displayException errorReportException) in logger msg errorReportContext
reportError logger HaystackClient{..} ErrorReport{..} = do
bt <- fmap (intercalate "\n") currentCallStack
let fullMsg = displayException errorReportException
let summary = takeWhile (/= '\n') fullMsg
logger summary errorReportContext
let payload = object $
[ "app" .= haystackClientAppName
, "message" .= summary
, "message" .= fullMsg
, "class" .= summary
, "backtrace" .= fullMsg
, "backtrace" .= bt
, "rollup" .= rollup fullMsg
] <> foldr (\(k, v) acc -> Text.pack k .= v : acc) [] errorReportContext
let request = haystackClientRequest { requestBody = RequestBodyLBS (encode payload) }

25
src/Semantic/Util/Rewriting.hs
View File

@ -25,6 +25,11 @@ import Parsing.Parser
import Reprinting.Pipeline
import Semantic.Task
import Tags.Tagging
import Tags.Taggable
import Data.Machine
import Data.Machine.Source
testPythonFile = do
let path = "test/fixtures/python/reprinting/function.py"
src <- blobSource <$> readBlobFromFile' (File path Language.Python)
@ -47,6 +52,26 @@ testPythonPipeline''' = do
(src, tree) <- testPythonFile
pure $ runTranslating src printingPython (mark Refactored tree)
testPythonDefs path = do
blob <- readBlobFromFile' (File path Language.Python)
tree <- parseFile' pythonParser path
-- pure . Data.Machine.run $ Data.Machine.Source.source (tagging blob tree)
pure $! runTagging blob tree
testGoDefs path = do
blob <- readBlobFromFile' (File path Language.Go)
tree <- parseFile' goParser path
-- pure . Data.Machine.run $ Data.Machine.Source.source (tagging blob tree)
pure $! runTagging blob tree
testRubyDefs path = do
blob <- readBlobFromFile' (File path Language.Ruby)
tree <- parseFile' rubyParser path
pure . Data.Machine.run $ Data.Machine.Source.source (tagging blob tree)
-- pure $! runTagging blob tree
testRubyFile = do
let path = "test/fixtures/ruby/reprinting/infix.rb"
src <- blobSource <$> readBlobFromFile' (File path Language.Ruby)

661
src/Tags/Taggable.hs Normal file
View File

@ -0,0 +1,661 @@
{-# LANGUAGE AllowAmbiguousTypes, GADTs, ConstraintKinds, LambdaCase, RankNTypes, TypeFamilies, TypeOperators, ScopedTypeVariables, UndecidableInstances #-}
module Tags.Taggable
( Tagger
, Token(..)
, Taggable(..)
, IsTaggable
, HasTextElement
, tagging
)
where
import Prologue
import Analysis.ConstructorName
import Analysis.HasTextElement
import Data.Abstract.Declarations
import Data.Abstract.Name
import Data.Blob
import Data.Language
import Data.Location
import Data.Machine as Machine
import Data.Range
import Data.Term
import Data.Text hiding (empty)
import qualified Data.Syntax as Syntax
import qualified Data.Syntax.Comment as Comment
import qualified Data.Syntax.Declaration as Declaration
import qualified Data.Syntax.Directive as Directive
import qualified Data.Syntax.Expression as Expression
import qualified Data.Syntax.Literal as Literal
import qualified Data.Syntax.Statement as Statement
import qualified Data.Syntax.Type as Type
import qualified Language.Go.Syntax as Go
import qualified Language.Go.Type as Go
import qualified Language.Haskell.Syntax as Haskell
import qualified Language.Java.Syntax as Java
import qualified Language.Markdown.Syntax as Markdown
import qualified Language.PHP.Syntax as PHP
import qualified Language.Python.Syntax as Python
import qualified Language.Ruby.Syntax as Ruby
import qualified Language.TypeScript.Syntax as TypeScript
-- TODO: Move to src/Data
data Token
= Enter { tokenName :: Text, tokenSnippetRange :: Maybe Range }
| Exit { tokenName :: Text, tokenSnippetRange :: Maybe Range}
| Iden { identifierName :: Text, tokenSpan :: Span, docsLiteralRange :: Maybe Range }
deriving (Eq, Show)
data Tagger a where
Pure :: a -> Tagger a
Bind :: Tagger a -> (a -> Tagger b) -> Tagger b
Tell :: Token -> Tagger ()
compile :: Tagger a -> Machine.Plan k Token a
compile = \case
Pure a -> pure a
Bind a f -> compile a >>= compile . f
Tell t -> Machine.yield t $> ()
instance Functor Tagger where fmap = liftA
instance Applicative Tagger where
pure = Pure
(<*>) = ap
instance Monad Tagger where (>>=) = Bind
enter, exit :: String -> Maybe Range -> Tagger ()
enter c = Tell . Enter (pack c)
exit c = Tell . Exit (pack c)
emitIden :: Span -> Maybe Range -> Name -> Tagger ()
emitIden span docsLiteralRange name = Tell (Iden (formatName name) span docsLiteralRange)
class (Show1 constr, Traversable constr) => Taggable constr where
docsLiteral ::
( Functor syntax
, Foldable syntax
, HasTextElement syntax
)
=> Language -> constr (Term syntax Location) -> Maybe Range
docsLiteral _ _ = Nothing
snippet :: (Foldable syntax) => Location -> constr (Term syntax Location) -> Maybe Range
snippet _ _ = Nothing
type IsTaggable syntax =
( Functor syntax
, Foldable syntax
, Traversable syntax
, Show1 syntax
, Taggable syntax
, ConstructorName syntax
, Declarations1 syntax
, HasTextElement syntax
)
tagging :: (IsTaggable syntax)
=> Blob
-> Term syntax Location
-> Machine.Source Token
tagging Blob{..} term = pipe
where pipe = Machine.construct $ compile go
go = foldSubterms (descend blobLanguage) term
descend ::
( Taggable (TermF syntax Location)
, ConstructorName (TermF syntax Location)
, Declarations ((TermF syntax Location) (Term syntax Location))
, Functor syntax
, Foldable syntax
, HasTextElement syntax
)
=> Language -> SubtermAlgebra (TermF syntax Location) (Term syntax Location) (Tagger ())
descend lang t@(In loc _) = do
let term = fmap subterm t
let snippetRange = snippet loc term
let litRange = docsLiteral lang term
enter (constructorName term) snippetRange
maybe (pure ()) (emitIden (locationSpan loc) litRange) (declaredName term)
traverse_ subtermRef t
exit (constructorName term) snippetRange
subtractLocation :: Location -> Location -> Range
subtractLocation a b = subtractRange (locationByteRange a) (locationByteRange b)
-- Instances
instance ( Apply Show1 fs, Apply Functor fs, Apply Foldable fs, Apply Traversable fs, Apply Taggable fs) => Taggable (Sum fs) where
docsLiteral a = apply @Taggable (docsLiteral a)
snippet x = apply @Taggable (snippet x)
instance (Taggable a) => Taggable (TermF a Location) where
docsLiteral l t = docsLiteral l (termFOut t)
snippet ann t = snippet ann (termFOut t)
instance Taggable Syntax.Context where
snippet ann (Syntax.Context _ (Term (In subj _))) = Just (subtractLocation ann subj)
instance Taggable Declaration.Function where
docsLiteral Python (Declaration.Function _ _ _ (Term (In _ bodyF)))
| (Term (In exprAnn exprF):_) <- toList bodyF
, isTextElement exprF = Just (locationByteRange exprAnn)
| otherwise = Nothing
docsLiteral _ _ = Nothing
snippet ann (Declaration.Function _ _ _ (Term (In body _))) = Just $ subtractLocation ann body
instance Taggable Declaration.Method where
docsLiteral Python (Declaration.Method _ _ _ _ (Term (In _ bodyF)))
| (Term (In exprAnn exprF):_) <- toList bodyF
, isTextElement exprF = Just (locationByteRange exprAnn)
| otherwise = Nothing
docsLiteral _ _ = Nothing
snippet ann (Declaration.Method _ _ _ _ (Term (In body _))) = Just $ subtractLocation ann body
instance Taggable Declaration.Class where
docsLiteral Python (Declaration.Class _ _ _ (Term (In _ bodyF)))
| (Term (In exprAnn exprF):_) <- toList bodyF
, isTextElement exprF = Just (locationByteRange exprAnn)
| otherwise = Nothing
docsLiteral _ _ = Nothing
snippet ann (Declaration.Class _ _ _ (Term (In body _))) = Just $ subtractLocation ann body
instance Taggable Ruby.Class where
snippet ann (Ruby.Class _ _ (Term (In body _))) = Just $ subtractLocation ann body
instance Taggable Ruby.Module where
snippet ann (Ruby.Module _ (Term (In body _):_)) = Just $ subtractLocation ann body
snippet ann (Ruby.Module _ _) = Just (locationByteRange ann)
instance Taggable TypeScript.Module where
snippet ann (TypeScript.Module _ (Term (In body _):_)) = Just $ subtractLocation ann body
snippet ann (TypeScript.Module _ _) = Just (locationByteRange ann)
instance Taggable []
instance Taggable Comment.Comment
instance Taggable Comment.HashBang
instance Taggable Expression.And
instance Taggable Expression.Await
instance Taggable Expression.BAnd
instance Taggable Expression.BOr
instance Taggable Expression.BXOr
instance Taggable Expression.Call
instance Taggable Expression.Cast
instance Taggable Expression.Comparison
instance Taggable Expression.Complement
instance Taggable Expression.Delete
instance Taggable Expression.DividedBy
instance Taggable Expression.Enumeration
instance Taggable Expression.Equal
instance Taggable Expression.FloorDivision
instance Taggable Expression.GreaterThan
instance Taggable Expression.GreaterThanEqual
instance Taggable Expression.InstanceOf
instance Taggable Expression.LessThan
instance Taggable Expression.LessThanEqual
instance Taggable Expression.LShift
instance Taggable Expression.Matches
instance Taggable Expression.Member
instance Taggable Expression.MemberAccess
instance Taggable Expression.Minus
instance Taggable Expression.Modulo
instance Taggable Expression.Negate
instance Taggable Expression.New
instance Taggable Expression.NonNullExpression
instance Taggable Expression.Not
instance Taggable Expression.NotMatches
instance Taggable Expression.Or
instance Taggable Expression.Plus
instance Taggable Expression.Power
instance Taggable Expression.RShift
instance Taggable Expression.ScopeResolution
instance Taggable Expression.SequenceExpression
instance Taggable Expression.StrictEqual
instance Taggable Expression.Subscript
instance Taggable Expression.Super
instance Taggable Expression.This
instance Taggable Expression.Times
instance Taggable Expression.Typeof
instance Taggable Expression.UnsignedRShift
instance Taggable Expression.Void
instance Taggable Expression.XOr
instance Taggable Literal.Boolean
instance Taggable Literal.Integer
instance Taggable Literal.Float
instance Taggable Literal.Rational
instance Taggable Literal.Complex
instance Taggable Literal.String
instance Taggable Literal.Character
instance Taggable Literal.InterpolationElement
instance Taggable Literal.TextElement
instance Taggable Literal.EscapeSequence
instance Taggable Literal.Symbol
instance Taggable Literal.SymbolElement
instance Taggable Literal.Regex
instance Taggable Literal.Array
instance Taggable Literal.Hash
instance Taggable Literal.Tuple
instance Taggable Literal.Set
instance Taggable Literal.Pointer
instance Taggable Literal.Reference
instance Taggable Literal.Null
instance Taggable Literal.KeyValue
instance Taggable Statement.Assignment
instance Taggable Statement.Break
instance Taggable Statement.Catch
instance Taggable Statement.Continue
instance Taggable Statement.DoWhile
instance Taggable Statement.Else
instance Taggable Statement.Finally
instance Taggable Statement.For
instance Taggable Statement.ForEach
instance Taggable Statement.Goto
instance Taggable Statement.If
instance Taggable Statement.Let
instance Taggable Statement.Match
instance Taggable Statement.NoOp
instance Taggable Statement.Pattern
instance Taggable Statement.PostDecrement
instance Taggable Statement.PostIncrement
instance Taggable Statement.PreDecrement
instance Taggable Statement.PreIncrement
instance Taggable Statement.Retry
instance Taggable Statement.Return
instance Taggable Statement.ScopeEntry
instance Taggable Statement.ScopeExit
instance Taggable Statement.Statements
instance Taggable Statement.Throw
instance Taggable Statement.Try
instance Taggable Statement.While
instance Taggable Statement.Yield
instance Taggable Syntax.Empty
instance Taggable Syntax.Error
instance Taggable Syntax.Identifier
instance Taggable Syntax.AccessibilityModifier
instance Taggable Type.Annotation
instance Taggable Type.Array
instance Taggable Type.Bool
instance Taggable Type.Double
instance Taggable Type.Float
instance Taggable Type.Function
instance Taggable Type.Int
instance Taggable Type.Interface
instance Taggable Type.Map
instance Taggable Type.Parenthesized
instance Taggable Type.Pointer
instance Taggable Type.Product
instance Taggable Type.Readonly
instance Taggable Type.Slice
instance Taggable Type.TypeParameters
instance Taggable Type.Void
instance Taggable Declaration.Comprehension
instance Taggable Declaration.Constructor
instance Taggable Declaration.Datatype
instance Taggable Declaration.Decorator
instance Taggable Declaration.InterfaceDeclaration
instance Taggable Declaration.MethodSignature
instance Taggable Declaration.OptionalParameter
instance Taggable Declaration.PublicFieldDefinition
instance Taggable Declaration.RequiredParameter
instance Taggable Declaration.Type
instance Taggable Declaration.TypeAlias
instance Taggable Declaration.Variable
instance Taggable Declaration.VariableDeclaration
instance Taggable Directive.File
instance Taggable Directive.Line
instance Taggable Haskell.UnitConstructor
instance Taggable Haskell.ListConstructor
instance Taggable Haskell.FunctionConstructor
instance Taggable Haskell.RecordDataConstructor
instance Taggable Haskell.AllConstructors
instance Taggable Haskell.GADTConstructor
instance Taggable Haskell.LabeledConstruction
instance Taggable Haskell.InfixDataConstructor
instance Taggable Haskell.TupleConstructor
instance Taggable Haskell.TypeConstructorExport
instance Taggable Haskell.KindParenthesizedConstructor
instance Taggable Haskell.ConstructorSymbol
instance Taggable Haskell.Module
instance Taggable Haskell.Field
instance Taggable Haskell.GADT
instance Taggable Haskell.InfixOperatorPattern
instance Taggable Haskell.NewType
instance Taggable Haskell.ImportDeclaration
instance Taggable Haskell.QualifiedImportDeclaration
instance Taggable Haskell.ImportAlias
instance Taggable Haskell.App
instance Taggable Haskell.InfixOperatorApp
instance Taggable Haskell.ListComprehension
instance Taggable Haskell.Generator
instance Taggable Haskell.ArithmeticSequence
instance Taggable Haskell.RightOperatorSection
instance Taggable Haskell.LeftOperatorSection
instance Taggable Haskell.BindPattern
instance Taggable Haskell.Lambda
instance Taggable Haskell.FixityAlt
instance Taggable Haskell.RecordWildCards
instance Taggable Haskell.Wildcard
instance Taggable Haskell.Let
instance Taggable Haskell.FieldBind
instance Taggable Haskell.Pragma
instance Taggable Haskell.Deriving
instance Taggable Haskell.ContextAlt
instance Taggable Haskell.Class
instance Taggable Haskell.Export
instance Taggable Haskell.ModuleExport
instance Taggable Haskell.QuotedName
instance Taggable Haskell.ScopedTypeVariables
instance Taggable Haskell.DefaultDeclaration
instance Taggable Haskell.VariableOperator
instance Taggable Haskell.ConstructorOperator
instance Taggable Haskell.TypeOperator
instance Taggable Haskell.PromotedTypeOperator
instance Taggable Haskell.VariableSymbol
instance Taggable Haskell.Import
instance Taggable Haskell.HiddenImport
instance Taggable Haskell.TypeApp
instance Taggable Haskell.TupleExpression
instance Taggable Haskell.TuplePattern
instance Taggable Haskell.ConstructorPattern
instance Taggable Haskell.Do
instance Taggable Haskell.PrefixNegation
instance Taggable Haskell.CPPDirective
instance Taggable Haskell.NamedFieldPun
instance Taggable Haskell.NegativeLiteral
instance Taggable Haskell.LambdaCase
instance Taggable Haskell.LabeledUpdate
instance Taggable Haskell.QualifiedTypeClassIdentifier
instance Taggable Haskell.QualifiedTypeConstructorIdentifier
instance Taggable Haskell.QualifiedConstructorIdentifier
instance Taggable Haskell.QualifiedInfixVariableIdentifier
instance Taggable Haskell.QualifiedModuleIdentifier
instance Taggable Haskell.QualifiedVariableIdentifier
instance Taggable Haskell.TypeVariableIdentifier
instance Taggable Haskell.TypeConstructorIdentifier
instance Taggable Haskell.ModuleIdentifier
instance Taggable Haskell.ConstructorIdentifier
instance Taggable Haskell.ImplicitParameterIdentifier
instance Taggable Haskell.InfixConstructorIdentifier
instance Taggable Haskell.InfixVariableIdentifier
instance Taggable Haskell.TypeClassIdentifier
instance Taggable Haskell.VariableIdentifier
instance Taggable Haskell.PrimitiveConstructorIdentifier
instance Taggable Haskell.PrimitiveVariableIdentifier
instance Taggable Haskell.AsPattern
instance Taggable Haskell.FieldPattern
instance Taggable Haskell.ViewPattern
instance Taggable Haskell.PatternGuard
instance Taggable Haskell.StrictPattern
instance Taggable Haskell.ListPattern
instance Taggable Haskell.TypePattern
instance Taggable Haskell.IrrefutablePattern
instance Taggable Haskell.CaseGuardPattern
instance Taggable Haskell.FunctionGuardPattern
instance Taggable Haskell.LabeledPattern
instance Taggable Haskell.Guard
instance Taggable Haskell.QuasiQuotation
instance Taggable Haskell.QuasiQuotationPattern
instance Taggable Haskell.QuasiQuotationType
instance Taggable Haskell.QuasiQuotationDeclaration
instance Taggable Haskell.QuasiQuotationExpression
instance Taggable Haskell.QuasiQuotationExpressionBody
instance Taggable Haskell.QuasiQuotationQuoter
instance Taggable Haskell.Splice
instance Taggable Haskell.StrictType
instance Taggable Haskell.Type
instance Taggable Haskell.TypeSynonym
instance Taggable Haskell.AnnotatedTypeVariable
instance Taggable Haskell.StandaloneDerivingInstance
instance Taggable Haskell.FunctionType
instance Taggable Haskell.TypeSignature
instance Taggable Haskell.ExpressionTypeSignature
instance Taggable Haskell.KindFunctionType
instance Taggable Haskell.Star
instance Taggable Haskell.EqualityConstraint
instance Taggable Haskell.TypeInstance
instance Taggable Haskell.TypeClassInstance
instance Taggable Haskell.TypeClass
instance Taggable Haskell.DefaultSignature
instance Taggable Haskell.TypeFamily
instance Taggable Haskell.StrictTypeVariable
instance Taggable Haskell.KindSignature
instance Taggable Haskell.Kind
instance Taggable Haskell.KindListType
instance Taggable Haskell.Instance
instance Taggable Haskell.KindTupleType
instance Taggable Haskell.FunctionalDependency
instance Taggable Java.Import
instance Taggable Java.Package
instance Taggable Java.CatchType
instance Taggable Java.SpreadParameter
instance Taggable Java.StaticInitializer
instance Taggable Java.LambdaBody
instance Taggable Java.ClassBody
instance Taggable Java.ClassLiteral
instance Taggable Java.DefaultValue
instance Taggable Java.Module
instance Taggable Java.EnumDeclaration
instance Taggable Java.Variable
instance Taggable Java.Synchronized
instance Taggable Java.New
instance Taggable Java.Asterisk
instance Taggable Java.Constructor
instance Taggable Java.TypeParameter
instance Taggable Java.Annotation
instance Taggable Java.AnnotationField
instance Taggable Java.GenericType
instance Taggable Java.AnnotatedType
instance Taggable Java.TypeWithModifiers
instance Taggable Java.Wildcard
instance Taggable Java.WildcardBounds
instance Taggable Java.MethodReference
instance Taggable Java.NewKeyword
instance Taggable Java.Lambda
instance Taggable Java.ArrayCreationExpression
instance Taggable Java.DimsExpr
instance Taggable Java.TryWithResources
instance Taggable Java.AssertStatement
instance Taggable Java.AnnotationTypeElement
instance Taggable Python.Ellipsis
instance Taggable Python.FutureImport
instance Taggable Python.Import
instance Taggable Python.QualifiedAliasedImport
instance Taggable Python.QualifiedImport
instance Taggable Python.Redirect
instance Taggable Go.BidirectionalChannel
instance Taggable Go.ReceiveChannel
instance Taggable Go.SendChannel
instance Taggable Go.Import
instance Taggable Go.QualifiedImport
instance Taggable Go.SideEffectImport
instance Taggable Go.Composite
instance Taggable Go.Label
instance Taggable Go.Send
instance Taggable Go.Slice
instance Taggable Go.TypeSwitch
instance Taggable Go.Receive
instance Taggable Go.Field
instance Taggable Go.Package
instance Taggable Go.TypeAssertion
instance Taggable Go.TypeConversion
instance Taggable Go.Variadic
instance Taggable Go.DefaultPattern
instance Taggable Go.Defer
instance Taggable Go.Go
instance Taggable Go.Rune
instance Taggable Go.Select
instance Taggable Go.TypeSwitchGuard
instance Taggable Go.ReceiveOperator
instance Taggable Markdown.Document
instance Taggable Markdown.Paragraph
instance Taggable Markdown.UnorderedList
instance Taggable Markdown.OrderedList
instance Taggable Markdown.BlockQuote
instance Taggable Markdown.HTMLBlock
instance Taggable Markdown.Table
instance Taggable Markdown.TableRow
instance Taggable Markdown.TableCell
instance Taggable Markdown.Strong
instance Taggable Markdown.Emphasis
instance Taggable Markdown.Text
instance Taggable Markdown.Strikethrough
instance Taggable Markdown.Heading
instance Taggable Markdown.ThematicBreak
instance Taggable Markdown.Link
instance Taggable Markdown.Image
instance Taggable Markdown.Code
instance Taggable Markdown.LineBreak
instance Taggable PHP.Text
instance Taggable PHP.VariableName
instance Taggable PHP.Require
instance Taggable PHP.RequireOnce
instance Taggable PHP.Include
instance Taggable PHP.IncludeOnce
instance Taggable PHP.ArrayElement
instance Taggable PHP.GlobalDeclaration
instance Taggable PHP.SimpleVariable
instance Taggable PHP.CastType
instance Taggable PHP.ErrorControl
instance Taggable PHP.Clone
instance Taggable PHP.ShellCommand
instance Taggable PHP.Update
instance Taggable PHP.NewVariable
instance Taggable PHP.RelativeScope
instance Taggable PHP.NamespaceName
instance Taggable PHP.ConstDeclaration
instance Taggable PHP.ClassInterfaceClause
instance Taggable PHP.ClassBaseClause
instance Taggable PHP.UseClause
instance Taggable PHP.ReturnType
instance Taggable PHP.TypeDeclaration
instance Taggable PHP.BaseTypeDeclaration
instance Taggable PHP.ScalarType
instance Taggable PHP.EmptyIntrinsic
instance Taggable PHP.ExitIntrinsic
instance Taggable PHP.IssetIntrinsic
instance Taggable PHP.EvalIntrinsic
instance Taggable PHP.PrintIntrinsic
instance Taggable PHP.NamespaceAliasingClause
instance Taggable PHP.NamespaceUseDeclaration
instance Taggable PHP.NamespaceUseClause
instance Taggable PHP.NamespaceUseGroupClause
instance Taggable PHP.TraitUseSpecification
instance Taggable PHP.Static
instance Taggable PHP.ClassModifier
instance Taggable PHP.InterfaceBaseClause
instance Taggable PHP.Echo
instance Taggable PHP.Unset
instance Taggable PHP.DeclareDirective
instance Taggable PHP.LabeledStatement
instance Taggable PHP.QualifiedName
instance Taggable PHP.ClassConstDeclaration
instance Taggable PHP.Namespace
instance Taggable PHP.TraitDeclaration
instance Taggable PHP.AliasAs
instance Taggable PHP.InsteadOf
instance Taggable PHP.TraitUseClause
instance Taggable PHP.DestructorDeclaration
instance Taggable PHP.ConstructorDeclaration
instance Taggable PHP.PropertyDeclaration
instance Taggable PHP.PropertyModifier
instance Taggable PHP.InterfaceDeclaration
instance Taggable PHP.Declare
instance Taggable Ruby.Send
instance Taggable Ruby.Require
instance Taggable Ruby.Load
instance Taggable Ruby.LowPrecedenceAnd
instance Taggable Ruby.LowPrecedenceOr
instance Taggable TypeScript.JavaScriptRequire
instance Taggable TypeScript.Debugger
instance Taggable TypeScript.Super
instance Taggable TypeScript.Undefined
instance Taggable TypeScript.With
instance Taggable TypeScript.JsxElement
instance Taggable TypeScript.JsxOpeningElement
instance Taggable TypeScript.JsxSelfClosingElement
instance Taggable TypeScript.JsxAttribute
instance Taggable TypeScript.OptionalParameter
instance Taggable TypeScript.RequiredParameter
instance Taggable TypeScript.RestParameter
instance Taggable TypeScript.JsxNamespaceName
instance Taggable TypeScript.JsxText
instance Taggable TypeScript.JsxExpression
instance Taggable TypeScript.JsxClosingElement
instance Taggable TypeScript.ImplementsClause
instance Taggable TypeScript.JsxFragment
instance Taggable TypeScript.Import
instance Taggable TypeScript.QualifiedAliasedImport
instance Taggable TypeScript.QualifiedExportFrom
instance Taggable TypeScript.LookupType
instance Taggable TypeScript.Union
instance Taggable TypeScript.Intersection
instance Taggable TypeScript.FunctionType
instance Taggable TypeScript.AmbientFunction
instance Taggable TypeScript.ImportRequireClause
instance Taggable TypeScript.Constructor
instance Taggable TypeScript.TypeParameter
instance Taggable TypeScript.TypeAssertion
instance Taggable TypeScript.NestedIdentifier
instance Taggable TypeScript.NestedTypeIdentifier
instance Taggable TypeScript.GenericType
instance Taggable TypeScript.TypePredicate
instance Taggable TypeScript.EnumDeclaration
instance Taggable TypeScript.PropertySignature
instance Taggable TypeScript.CallSignature
instance Taggable TypeScript.ConstructSignature
instance Taggable TypeScript.IndexSignature
instance Taggable TypeScript.AbstractMethodSignature
instance Taggable TypeScript.ForOf
instance Taggable TypeScript.LabeledStatement
instance Taggable TypeScript.InternalModule
instance Taggable TypeScript.ImportAlias
instance Taggable TypeScript.ClassHeritage
instance Taggable TypeScript.AbstractClass
instance Taggable TypeScript.SideEffectImport
instance Taggable TypeScript.QualifiedExport
instance Taggable TypeScript.DefaultExport
instance Taggable TypeScript.ShorthandPropertyIdentifier
instance Taggable TypeScript.ImportClause
instance Taggable TypeScript.Tuple
instance Taggable TypeScript.Annotation
instance Taggable TypeScript.Decorator
instance Taggable TypeScript.ComputedPropertyName
instance Taggable TypeScript.Constraint
instance Taggable TypeScript.DefaultType
instance Taggable TypeScript.ParenthesizedType
instance Taggable TypeScript.PredefinedType
instance Taggable TypeScript.TypeIdentifier
instance Taggable TypeScript.ObjectType
instance Taggable TypeScript.AmbientDeclaration
instance Taggable TypeScript.ExtendsClause
instance Taggable TypeScript.ArrayType
instance Taggable TypeScript.FlowMaybeType
instance Taggable TypeScript.TypeQuery
instance Taggable TypeScript.IndexTypeQuery
instance Taggable TypeScript.TypeArguments
instance Taggable TypeScript.ThisType
instance Taggable TypeScript.ExistentialType
instance Taggable TypeScript.LiteralType
instance Taggable TypeScript.Update

77
src/Tags/Tagging.hs Normal file
View File

@ -0,0 +1,77 @@
{-# LANGUAGE GADTs, DeriveAnyClass, LambdaCase, RankNTypes, TypeOperators, ScopedTypeVariables, UndecidableInstances #-}
module Tags.Tagging
( runTagging
, Tag(..)
)
where
import Prelude hiding (fail, filter, log)
import Prologue hiding (Element, hash)
import Control.Effect as Eff
import Control.Effect.Error as Error
import qualified Control.Effect.State as State
import Control.Monad.Trans
import Data.Aeson
import Data.Blob
import Data.Location
import Data.Machine as Machine
import qualified Data.Source as Source
import Data.Term
import Data.Text hiding (empty)
import Tags.Taggable
symbolsToSummarize :: [Text]
symbolsToSummarize = ["Function", "Method", "Class", "Module"]
data Tag
= Tag
{ name :: Text
, kind :: Text
, span :: Span
, context :: [Text]
, line :: Maybe Text
, docs :: Maybe Text
}
deriving (Eq, Show, Generic, ToJSON)
runTagging :: (IsTaggable syntax)
=> Blob
-> Term syntax Location
-> Either TranslationError [Tag]
runTagging blob tree
= Eff.run
. Error.runError
. State.evalState mempty
. runT $ source (tagging blob tree)
~> contextualizing blob
type ContextToken = (Text, Maybe Range)
type Contextualizer
= Eff (StateC [ContextToken]
( Eff (ErrorC TranslationError
( Eff VoidC))))
contextualizing :: Blob -> Machine.ProcessT Contextualizer Token Tag
contextualizing Blob{..} = repeatedly $ await >>= \case
Enter x r -> enterScope (x, r)
Exit x r -> exitScope (x, r)
Iden iden span docsLiteralRange -> lift State.get >>= \case
((x, r):("Context", cr):xs) | x `elem` symbolsToSummarize
-> yield $ Tag iden x span (fmap fst xs) (firstLine (slice r)) (slice cr)
((x, r):xs) | x `elem` symbolsToSummarize
-> yield $ Tag iden x span (fmap fst xs) (firstLine (slice r)) (slice docsLiteralRange)
_ -> pure ()
where
slice = fmap (stripEnd . Source.toText . flip Source.slice blobSource)
firstLine = fmap (fst . breakOn "\n")
enterScope, exitScope :: ContextToken -> Machine.PlanT k Tag Contextualizer ()
enterScope c = lift (State.modify (c :))
exitScope c = lift State.get >>= \case
(x:xs) -> when (x == c) (lift (State.modify (const xs)))
cs -> lift (State.modify (const cs)) -- Just continue on if it's unbalanced
data TranslationError = UnbalancedPair ContextToken [ContextToken]
deriving (Eq, Show)

2
test/Data/Functor/Listable.hs
View File

@ -18,7 +18,7 @@ module Data.Functor.Listable
) where
import Analysis.CyclomaticComplexity
import Analysis.Declaration
import Analysis.TOCSummary
import Control.Monad.Free as Free
import Control.Monad.Trans.Free as FreeF
import Data.ByteString (ByteString)

4
test/Examples.hs
View File

@ -49,8 +49,8 @@ main = withOptions opts $ \ config logger statter -> hspec . parallel $ do
case res of
Left (SomeException e) -> case cast e of
-- We have a number of known assignment timeouts, consider these pending specs instead of failing the build.
Just (AssignmentTimedOut _ _) -> pendingWith $ show (displayException e)
Just (ParserTimedOut _ _) -> pendingWith $ show (displayException e)
Just AssignmentTimedOut -> pendingWith $ show (displayException e)
Just ParserTimedOut -> pendingWith $ show (displayException e)
-- Other exceptions are true failures
_ -> expectationFailure (show (displayException e))
_ -> if file `elem` knownFailures

2
test/Rendering/TOC/Spec.hs
View File

@ -1,7 +1,7 @@
{-# LANGUAGE DataKinds, MonoLocalBinds, TypeOperators #-}
module Rendering.TOC.Spec (spec) where
import Analysis.Declaration
import Analysis.TOCSummary
import Control.Effect
import Data.Aeson hiding (defaultOptions)
import Data.Bifunctor

2
test/Semantic/Spec.hs
View File

@ -13,7 +13,7 @@ spec = parallel $ do
describe "parseBlob" $ do
it "returns error if given an unknown language (json)" $ do
output <- fmap runBuilder . runTask $ runParse JSONTermRenderer [ methodsBlob { blobLanguage = Unknown } ]
output `shouldBe` "{\"trees\":[{\"error\":{\"path\":\"methods.rb\",\"language\":\"Unknown\",\"message\":\"NoLanguageForBlob \\\"methods.rb\\\"\"}}]}\n"
output `shouldBe` "{\"trees\":[{\"path\":\"methods.rb\",\"error\":\"NoLanguageForBlob \\\"methods.rb\\\"\",\"language\":\"Unknown\"}]}\n"
it "throws if given an unknown language for sexpression output" $ do
runTask (runParse SExpressionTermRenderer [methodsBlob { blobLanguage = Unknown }]) `shouldThrow` (== ExitFailure 1)

2
test/Spec.hs
View File

@ -29,6 +29,7 @@ import qualified Matching.Python.Spec
import qualified Numeric.Spec
import qualified Rendering.TOC.Spec
import qualified Reprinting.Spec
import qualified Tags.Spec
import qualified Semantic.Spec
import qualified Semantic.CLI.Spec
import qualified Semantic.IO.Spec
@ -73,6 +74,7 @@ main = do
describe "Numeric" Numeric.Spec.spec
describe "Rendering.TOC" Rendering.TOC.Spec.spec
describe "Reprinting.Spec" Reprinting.Spec.spec
describe "Tags.Spec" Tags.Spec.spec
describe "Semantic" Semantic.Spec.spec
describe "Semantic.CLI" Semantic.CLI.Spec.spec
describe "Semantic.IO" Semantic.IO.Spec.spec

7
test/SpecHelpers.hs
View File

@ -5,6 +5,7 @@ module SpecHelpers
, runBuilder
, diffFilePaths
, parseFilePath
, parseTestFile
, readFilePair
, testEvaluating
, verbatim
@ -98,6 +99,12 @@ readFilePair :: Both FilePath -> IO BlobPair
readFilePair paths = let paths' = fmap file paths in
runBothWith F.readFilePair paths'
parseTestFile :: Parser term -> FilePath -> IO (Blob, term)
parseTestFile parser path = runTask $ do
blob <- readBlob (file path)
term <- parse parser blob
pure (blob, term)
type TestEvaluatingC term
= ResumableC (BaseError (AddressError Precise (Val term))) (Eff
( ResumableC (BaseError (ValueError term Precise)) (Eff

80
test/Tags/Spec.hs Normal file
View File

@ -0,0 +1,80 @@
module Tags.Spec (spec) where
import Tags.Tagging
import SpecHelpers
spec :: Spec
spec = parallel $ do
describe "go" $ do
it "produces tags for functions with docs" $ do
(blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/simple_functions.go"
runTagging blob tree `shouldBe` Right
[ Tag "TestFromBits" "Function" (Span (Pos 6 1) (Pos 7 2)) ["Statements"] (Just "func TestFromBits(t *testing.T)") (Just "// TestFromBits ...")
, Tag "Hi" "Function" (Span (Pos 9 1) (Pos 10 2)) ["Statements"] (Just "func Hi()") Nothing ]
it "produces tags for methods" $ do
(blob, tree) <- parseTestFile goParser "test/fixtures/go/tags/method.go"
runTagging blob tree `shouldBe` Right
[ Tag "CheckAuth" "Method" (Span (Pos 3 1) (Pos 3 100)) ["Statements"] (Just "func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error)") Nothing]
describe "javascript and typescript" $ do
it "produces tags for functions with docs" $ do
(blob, tree) <- parseTestFile typescriptParser "test/fixtures/javascript/tags/simple_function_with_docs.js"
runTagging blob tree `shouldBe` Right
[ Tag "myFunction" "Function" (Span (Pos 2 1) (Pos 4 2)) ["Statements"] (Just "function myFunction()") (Just "// This is myFunction") ]
it "produces tags for classes" $ do
(blob, tree) <- parseTestFile typescriptParser "test/fixtures/typescript/tags/class.ts"
runTagging blob tree `shouldBe` Right
[ Tag "FooBar" "Class" (Span (Pos 1 1) (Pos 1 16)) ["Statements"] (Just "class FooBar") Nothing ]
it "produces tags for modules" $ do
(blob, tree) <- parseTestFile typescriptParser "test/fixtures/typescript/tags/module.ts"
runTagging blob tree `shouldBe` Right
[ Tag "APromise" "Module" (Span (Pos 1 1) (Pos 1 20)) ["Statements"] (Just "module APromise { }") Nothing ]
describe "python" $ do
it "produces tags for functions" $ do
(blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/simple_functions.py"
runTagging blob tree `shouldBe` Right
[ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 5 17)) ["Statements"] (Just "def Foo(x)") Nothing
, Tag "Bar" "Function" (Span (Pos 7 1) (Pos 11 13)) ["Statements"] (Just "def Bar()") Nothing
, Tag "local" "Function" (Span (Pos 8 5) (Pos 9 17)) ["Statements", "Function", "Statements"] (Just "def local()") Nothing
]
it "produces tags for functions with docs" $ do
(blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/simple_function_with_docs.py"
runTagging blob tree `shouldBe` Right
[ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 3 13)) ["Statements"] (Just "def Foo(x)") (Just "\"\"\"This is the foo function\"\"\"") ]
it "produces tags for classes" $ do
(blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/class.py"
runTagging blob tree `shouldBe` Right
[ Tag "Foo" "Class" (Span (Pos 1 1) (Pos 5 17)) ["Statements"] (Just "class Foo") (Just "\"\"\"The Foo class\"\"\"")
, Tag "f" "Function" (Span (Pos 3 5) (Pos 5 17)) ["Statements", "Class", "Statements"] (Just "def f(self)") (Just "\"\"\"The f method\"\"\"")
]
it "produces tags for multi-line functions" $ do
(blob, tree) <- parseTestFile pythonParser "test/fixtures/python/tags/multiline.py"
runTagging blob tree `shouldBe` Right
[ Tag "Foo" "Function" (Span (Pos 1 1) (Pos 3 13)) ["Statements"] (Just "def Foo(x,") Nothing ]
describe "ruby" $ do
it "produces tags for methods" $ do
(blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method.rb"
runTagging blob tree `shouldBe` Right
[ Tag "foo" "Method" (Span (Pos 1 1) (Pos 2 4)) ["Statements"] (Just "def foo") Nothing ]
it "produces tags for methods with docs" $ do
(blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/simple_method_with_docs.rb"
runTagging blob tree `shouldBe` Right
[ Tag "foo" "Method" (Span (Pos 2 1) (Pos 3 4)) ["Statements"] (Just "def foo") (Just "# Public: foo") ]
it "produces tags for methods and classes with docs" $ do
(blob, tree) <- parseTestFile rubyParser "test/fixtures/ruby/tags/class_module.rb"
runTagging blob tree `shouldBe` Right
[ Tag "Foo" "Module" (Span (Pos 2 1 ) (Pos 12 4)) ["Statements"] (Just "module Foo") (Just "# Public: Foo")
, Tag "Bar" "Class" (Span (Pos 5 3 ) (Pos 11 6)) ["Module", "Context", "Statements"] (Just "class Bar") (Just "# Public: Bar")
, Tag "baz" "Method" (Span (Pos 8 5 ) (Pos 10 8)) ["Class", "Context", "Module", "Context", "Statements"] (Just "def baz(a)") (Just "# Public: baz")
]

3
test/fixtures/go/tags/method.go vendored Normal file
View File

@ -0,0 +1,3 @@
import "net/http"
func (c *apiClient) CheckAuth(req *http.Request, user, repo string) (*authenticatedActor, error) {}

10
test/fixtures/go/tags/simple_functions.go vendored Normal file
View File

@ -0,0 +1,10 @@
package big
import "testing"
// TestFromBits ...
func TestFromBits(t *testing.T) {
}
func Hi() {
}

4
test/fixtures/javascript/tags/simple_function_with_docs.js vendored Normal file
View File

@ -0,0 +1,4 @@
// This is myFunction
function myFunction() {
return 0;
}

12
test/fixtures/python/corpus/async-function-definition.diffA-B.txt vendored
View File

@ -3,20 +3,24 @@
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+})+}
{+(Statements
{+(Identifier)+})+})+}
(Function
(Identifier)
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
(Function
{ (Identifier)
->(Identifier) }
{ (Identifier)
->(Identifier) }
{-(Identifier)-}
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
{-(Function
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-})-})
{-(Statements
{-(Identifier)-})-})-})

12
test/fixtures/python/corpus/async-function-definition.diffB-A.txt vendored
View File

@ -3,20 +3,24 @@
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-})-}
{-(Statements
{-(Identifier)-})-})-}
(Function
(Identifier)
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
(Function
{ (Identifier)
->(Identifier) }
{ (Identifier)
->(Identifier) }
{+(Identifier)+}
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
{+(Function
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+})+})
{+(Statements
{+(Identifier)+})+})+})

21
test/fixtures/python/corpus/async-function-definition.parseA.txt vendored
View File

@ -1,13 +1,16 @@
(Statements
(Function
(Identifier)
(Identifier))
(Function
(Identifier)
(Identifier)
(Identifier)
(Identifier))
(Function
(Identifier)
(Identifier)
(Statements
(Identifier)))
(Function
(Identifier)
(Identifier)
(Identifier)
(Statements
(Identifier)))
(Function
(Identifier)
(Identifier)
(Statements
(Identifier))))

17
test/fixtures/python/corpus/async-function-definition.parseB.txt vendored
View File

@ -3,11 +3,14 @@
(Identifier)
(Identifier)
(Identifier)
(Identifier))
(Function
(Identifier)
(Identifier))
(Function
(Identifier)
(Identifier)
(Statements
(Identifier)))
(Function
(Identifier)
(Statements
(Identifier)))
(Function
(Identifier)
(Identifier)
(Statements
(Identifier))))

11
test/fixtures/python/corpus/class-definition.diffA-B.txt vendored
View File

@ -3,24 +3,29 @@
{ (Identifier)
->(Identifier) }
{+(Identifier)+}
(Statements
(Function
{ (Identifier)
->(Identifier) }
(Identifier)
(Statements
(Return
{ (Identifier)
->(Empty) })))
->(Empty) })))))
{-(Class
{-(Identifier)-}
{-(Statements
{-(NoOp
{-(Empty)-})-})-}
{-(Empty)-})-})-})-}
(Class
(Identifier)
{-(Identifier)-}
(Statements
(Function
{ (Identifier)
->(Identifier) }
(Identifier)
(Statements
(Return
{ (Empty)
->(Identifier) }))))
->(Identifier) }))))))

11
test/fixtures/python/corpus/class-definition.diffB-A.txt vendored
View File

@ -3,24 +3,29 @@
{ (Identifier)
->(Identifier) }
{-(Identifier)-}
(Statements
(Function
{ (Identifier)
->(Identifier) }
(Identifier)
(Statements
(Return
{ (Empty)
->(Identifier) })))
->(Identifier) })))))
{+(Class
{+(Identifier)+}
{+(Statements
{+(NoOp
{+(Empty)+})+})+}
{+(Empty)+})+})+})+}
(Class
(Identifier)
{+(Identifier)+}
(Statements
(Function
{ (Identifier)
->(Identifier) }
(Identifier)
(Statements
(Return
{ (Identifier)
->(Empty) }))))
->(Empty) }))))))

11
test/fixtures/python/corpus/class-definition.parseA.txt vendored
View File

@ -1,20 +1,25 @@
(Statements
(Class
(Identifier)
(Statements
(Function
(Identifier)
(Identifier)
(Statements
(Return
(Identifier))))
(Identifier))))))
(Class
(Identifier)
(Statements
(NoOp
(Empty)))
(Empty))))
(Class
(Identifier)
(Identifier)
(Statements
(Function
(Identifier)
(Identifier)
(Statements
(Return
(Empty)))))
(Empty)))))))

8
test/fixtures/python/corpus/class-definition.parseB.txt vendored
View File

@ -2,15 +2,19 @@
(Class
(Identifier)
(Identifier)
(Statements
(Function
(Identifier)
(Identifier)
(Statements
(Return
(Empty))))
(Empty))))))
(Class
(Identifier)
(Statements
(Function
(Identifier)
(Identifier)
(Statements
(Return
(Identifier)))))
(Identifier)))))))

7
test/fixtures/python/corpus/decorated-definition.diffA-B.txt vendored
View File

@ -4,6 +4,7 @@
(Class
{ (Identifier)
->(Identifier) }
(Statements
(Decorator
(Identifier)
(Statements)
@ -48,7 +49,9 @@
{-(Identifier)-})-}
{-(Function
{-(Identifier)-}
{-(Identifier)-})-})-})-})
{-(Statements
{-(Identifier)-})-})-})-})-})
->(Function
{+(Identifier)+}
{+(Identifier)+}) })))))))
{+(Statements
{+(Identifier)+})+}) }))))))))

7
test/fixtures/python/corpus/decorated-definition.diffB-A.txt vendored
View File

@ -4,6 +4,7 @@
(Class
{ (Identifier)
->(Identifier) }
(Statements
(Decorator
(Identifier)
(Statements)
@ -33,7 +34,8 @@
{-(Identifier)-})-}
{ (Function
{-(Identifier)-}
{-(Identifier)-})
{-(Statements
{-(Identifier)-})-})
->(Decorator
{+(Identifier)+}
{+(Identifier)+}
@ -51,4 +53,5 @@
{+(Identifier)+})+}
{+(Function
{+(Identifier)+}
{+(Identifier)+})+})+})+}) })))))))
{+(Statements
{+(Identifier)+})+})+})+})+}) }))))))))

4
test/fixtures/python/corpus/decorated-definition.parseA.txt vendored
View File

@ -3,6 +3,7 @@
(Identifier)
(Class
(Identifier)
(Statements
(Decorator
(Identifier)
(Statements)
@ -36,4 +37,5 @@
(Identifier))
(Function
(Identifier)
(Identifier))))))))))))
(Statements
(Identifier))))))))))))))

4
test/fixtures/python/corpus/decorated-definition.parseB.txt vendored
View File

@ -3,6 +3,7 @@
(Identifier)
(Class
(Identifier)
(Statements
(Decorator
(Identifier)
(Statements)
@ -23,4 +24,5 @@
(Identifier))
(Function
(Identifier)
(Identifier)))))))))
(Statements
(Identifier)))))))))))

18
test/fixtures/python/corpus/function-definition.diffA-B.txt vendored
View File

@ -1,31 +1,36 @@
(Statements
{-(Function
{-(Identifier)-}
{-(Identifier)-})-}
{-(Statements
{-(Identifier)-})-})-}
{-(Function
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-})-}
{-(Statements
{-(Identifier)-})-})-}
(Function
(Identifier)
{ (Identifier)
->(Identifier) }
{ (Identifier)
->(Identifier) }
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
(Function
{ (Identifier)
->(Identifier) }
{-(Assignment
{-(Identifier)-}
{-(Identifier)-})-}
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
{+(Function
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+})+}
{+(Statements
{+(Identifier)+})+})+}
(Function
(Identifier)
(Annotation
@ -37,4 +42,5 @@
->(Identifier) })
{ (Identifier)
->(Identifier) }
(Identifier)))
(Statements
(Identifier))))

15
test/fixtures/python/corpus/function-definition.diffB-A.txt vendored
View File

@ -4,27 +4,31 @@
->(Identifier) }
{-(Identifier)-}
{-(Identifier)-}
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
(Function
(Identifier)
{+(Identifier)+}
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
(Function
{ (Identifier)
->(Identifier) }
{ (Identifier)
->(Identifier) }
{+(Identifier)+}
(Statements
{ (Identifier)
->(Identifier) })
->(Identifier) }))
{+(Function
{+(Identifier)+}
{+(Assignment
{+(Identifier)+}
{+(Identifier)+})+}
{+(Identifier)+})+}
{+(Statements
{+(Identifier)+})+})+}
(Function
(Identifier)
(Annotation
@ -36,4 +40,5 @@
->(Identifier) })
{ (Identifier)
->(Identifier) }
(Identifier)))
(Statements
(Identifier))))

15
test/fixtures/python/corpus/function-definition.parseA.txt vendored
View File

@ -1,22 +1,26 @@
(Statements
(Function
(Identifier)
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Identifier)
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Identifier)
(Identifier)
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Assignment
(Identifier)
(Identifier))
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Annotation
@ -25,4 +29,5 @@
(TextElement))
(Identifier))
(Identifier)
(Identifier)))
(Statements
(Identifier))))

12
test/fixtures/python/corpus/function-definition.parseB.txt vendored
View File

@ -3,14 +3,17 @@
(Identifier)
(Identifier)
(Identifier)
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Identifier)
(Identifier))
(Statements
(Identifier)))
(Function
(Identifier)
(Annotation
@ -19,4 +22,5 @@
(Integer))
(Identifier))
(Identifier)
(Identifier)))
(Statements
(Identifier))))

3
test/fixtures/python/corpus/lambda.diffA-B.txt vendored
View File

@ -2,7 +2,8 @@
(Function
(Empty)
{+(Identifier)+}
(Statements
(Plus
{ (Integer)
->(Identifier) }
(Integer))))
(Integer)))))

3
test/fixtures/python/corpus/lambda.diffB-A.txt vendored
View File

@ -2,7 +2,8 @@
(Function
(Empty)
{-(Identifier)-}
(Statements
(Plus
{ (Identifier)
->(Integer) }
(Integer))))
(Integer)))))

3
test/fixtures/python/corpus/lambda.parseA.txt vendored
View File

@ -1,6 +1,7 @@
(Statements
(Function
(Empty)
(Statements
(Plus
(Integer)
(Integer))))
(Integer)))))

3
test/fixtures/python/corpus/lambda.parseB.txt vendored
View File

@ -2,6 +2,7 @@
(Function
(Empty)
(Identifier)
(Statements
(Plus
(Identifier)
(Integer))))
(Integer)))))

5
test/fixtures/python/tags/class.py vendored Normal file
View File

@ -0,0 +1,5 @@
class Foo:
"""The Foo class"""
def f(self):
"""The f method"""
return 0

5
test/fixtures/python/tags/multiline.py vendored Normal file
View File

@ -0,0 +1,5 @@
def Foo(x,
b):
return x
Foo(1, 2)

3
test/fixtures/python/tags/simple_function_with_docs.py vendored Normal file
View File

@ -0,0 +1,3 @@
def Foo(x):
"""This is the foo function"""
return x

11
test/fixtures/python/tags/simple_functions.py vendored Normal file
View File

@ -0,0 +1,11 @@
def Foo(x):
if True:
return x
else:
return 0
def Bar():
def local():
return 1
return 0

12
test/fixtures/ruby/tags/class_module.rb vendored Normal file
View File

@ -0,0 +1,12 @@
# Public: Foo
module Foo
# Public: Bar
class Bar
# Public: baz
def baz(a)
a * 10
end
end
end

2
test/fixtures/ruby/tags/simple_method.rb vendored Normal file
View File

@ -0,0 +1,2 @@
def foo
end

3
test/fixtures/ruby/tags/simple_method_with_docs.rb vendored Normal file
View File

@ -0,0 +1,3 @@
# Public: foo
def foo
end

1
test/fixtures/typescript/tags/class.ts vendored Normal file
View File

@ -0,0 +1 @@
class FooBar {}

1
test/fixtures/typescript/tags/module.ts vendored Normal file
View File

@ -0,0 +1 @@
module APromise { }