From 7fc7eb868aed3432f26a113fcf1104b91f72a116 Mon Sep 17 00:00:00 2001 From: joshvera Date: Fri, 22 Feb 2019 17:56:42 -0500 Subject: [PATCH 01/19] Add scope graph changes back --- src/Semantic/Util.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 439a512c9..c72a3f66a 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -509,6 +509,9 @@ scopeGraphRubyProject = justEvaluatingCatchingErrors <=< evaluateProjectForScope scopeGraphPHPProject :: ProjectEvaluator Language.PHP.Assignment.Syntax scopeGraphPHPProject = justEvaluatingCatchingErrors <=< evaluateProjectForScopeGraph (Proxy @'Language.PHP) phpParser +scopeGraphPythonProject :: ProjectEvaluator Language.Python.Assignment.Syntax +scopeGraphPythonProject = justEvaluatingCatchingErrors <=< evaluateProjectForScopeGraph (Proxy @'Language.Python) pythonParser + scopeGraphGoProject :: ProjectEvaluator Language.Go.Assignment.Syntax scopeGraphGoProject = justEvaluatingCatchingErrors <=< evaluateProjectForScopeGraph (Proxy @'Language.Go) goParser From 73bbc66a2fadcba99a10ae4783357d3a10d8f368 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 4 Mar 2019 12:51:33 -0800 Subject: [PATCH 02/19] Update ScopeGraph.Kind naming to avoid confusion This helps us disambiguate between syntax terms and scope graph kinds --- src/Control/Abstract/Heap.hs | 2 +- src/Control/Abstract/Primitive.hs | 4 +-- src/Data/Abstract/Evaluatable.hs | 4 +-- src/Data/Abstract/ScopeGraph.hs | 27 ++++++++++++++++++-- src/Data/Syntax.hs | 2 +- src/Data/Syntax/Declaration.hs | 20 +++++++-------- src/Data/Syntax/Expression.hs | 4 +-- src/Data/Syntax/Statement.hs | 2 +- src/Language/Go/Syntax.hs | 2 +- src/Language/PHP/Syntax.hs | 4 +-- src/Language/Python/Syntax.hs | 8 +++--- src/Language/Ruby/Syntax.hs | 8 +++--- src/Language/TypeScript/Syntax/Import.hs | 10 ++++---- src/Language/TypeScript/Syntax/JSX.hs | 2 +- src/Language/TypeScript/Syntax/JavaScript.hs | 2 +- src/Language/TypeScript/Syntax/TypeScript.hs | 4 +-- src/Language/TypeScript/Syntax/Types.hs | 2 +- 17 files changed, 65 insertions(+), 42 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 7ec6ab8f0..f28b47590 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -181,7 +181,7 @@ define :: ( HasCallStack -> Evaluator term address value m () define declaration rel accessControl def = withCurrentCallStack callStack $ do -- TODO: This span is still wrong. - declare declaration rel accessControl emptySpan Unknown Nothing + declare declaration rel accessControl emptySpan UnknownKind Nothing slot <- lookupSlot declaration value <- def assign slot value diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 4880c787f..c47118b6e 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -43,11 +43,11 @@ defineBuiltIn declaration rel accessControl value = withCurrentCallStack callSta let lexicalEdges = Map.singleton Lexical [ currentScope' ] associatedScope <- newPreludeScope lexicalEdges -- TODO: This span is still wrong. - declare declaration rel accessControl emptySpan ScopeGraph.Unknown (Just associatedScope) + declare declaration rel accessControl emptySpan ScopeGraph.UnknownKind (Just associatedScope) param <- gensym withScope associatedScope $ do - declare (Declaration param) rel accessControl emptySpan ScopeGraph.Unknown Nothing + declare (Declaration param) rel accessControl emptySpan ScopeGraph.UnknownKind Nothing slot <- lookupSlot declaration value <- builtIn associatedScope value diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 1b885754a..34dff10d8 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -30,7 +30,7 @@ import Data.Abstract.Declarations as X import Data.Abstract.FreeVariables as X import Data.Abstract.Module import Data.Abstract.Name as X -import qualified Data.Abstract.ScopeGraph as ScopeGraph +import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Abstract.ScopeGraph (Relation(..)) import Data.Abstract.AccessControls.Class as X import Data.Language @@ -192,7 +192,7 @@ defineSelf :: ( Carrier sig m => Evaluator term address value m () defineSelf = do let self = Declaration X.__self - declare self Default Public emptySpan ScopeGraph.Unknown Nothing + declare self Default Public emptySpan ScopeGraph.UnknownKind Nothing slot <- lookupSlot self assign slot =<< object =<< currentFrame diff --git a/src/Data/Abstract/ScopeGraph.hs b/src/Data/Abstract/ScopeGraph.hs index 950a14d12..ee72a7c4a 100644 --- a/src/Data/Abstract/ScopeGraph.hs +++ b/src/Data/Abstract/ScopeGraph.hs @@ -119,11 +119,34 @@ instance HasSpan ReferenceInfo where span = lens refSpan (\r s -> r { refSpan = s }) {-# INLINE span #-} -data Kind = TypeAlias | Class | Method | QualifiedAliasedImport | QualifiedExport | DefaultExport | Module | AbstractClass | Let | QualifiedImport | UnqualifiedImport | Assignment | RequiredParameter | PublicField | VariableDeclaration | Function | Parameter | Unknown | Identifier | TypeIdentifier | This | New | MemberAccess | Call +data Kind = AbstractClassKind + | AssignmentKind + | CallKind + | ClassKind + | DefaultExportKind + | FunctionKind + | IdentifierKind + | LetKind + | MemberAccessKind + | MethodKind + | ModuleKind + | NewKind + | ParameterKind + | PublicFieldKind + | QualifiedAliasedImportKind + | QualifiedExportKind + | QualifiedImportKind + | RequiredParameterKind + | ThisKind + | TypeAliasKind + | TypeIdentifierKind + | UnknownKind + | UnqualifiedImportKind + | VariableDeclarationKind deriving (Eq, Show, Ord, Generic, NFData) instance Lower Kind where - lowerBound = Unknown + lowerBound = UnknownKind -- Offsets and frame addresses in the heap should be addresses? data Scope address = diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 3aecf713a..cb8b94306 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -126,7 +126,7 @@ instance Evaluatable Identifier where eval eval ref' term@(Identifier name) = do -- TODO: Set the span up correctly in ref so we can move the `reference` call there. span <- ask @Span - reference (Reference name) span ScopeGraph.Identifier (Declaration name) + reference (Reference name) span ScopeGraph.IdentifierKind (Declaration name) deref =<< ref eval ref' term ref _ _ (Identifier name) = lookupSlot (Declaration name) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 257a50de0..b9dce71d3 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -30,13 +30,13 @@ instance Evaluatable Function where eval _ _ Function{..} = do name <- maybeM (throwNoNameError functionName) (declaredName functionName) span <- ask @Span - associatedScope <- declareFunction name ScopeGraph.Public span ScopeGraph.Function + associatedScope <- declareFunction name ScopeGraph.Public span ScopeGraph.FunctionKind params <- withScope associatedScope . for functionParameters $ \paramNode -> do param <- maybeM (throwNoNameError paramNode) (declaredName paramNode) let paramSpan = getSpan paramNode - param <$ declare (Declaration param) Default ScopeGraph.Public paramSpan ScopeGraph.Parameter Nothing + param <$ declare (Declaration param) Default ScopeGraph.Public paramSpan ScopeGraph.ParameterKind Nothing addr <- lookupSlot (Declaration name) v <- function name params functionBody associatedScope @@ -94,14 +94,14 @@ instance Evaluatable Method where eval _ _ Method{..} = do name <- maybeM (throwNoNameError methodName) (declaredName methodName) span <- ask @Span - associatedScope <- declareFunction name methodAccessControl span ScopeGraph.Method + associatedScope <- declareFunction name methodAccessControl span ScopeGraph.MethodKind params <- withScope associatedScope $ do -- TODO: Should we give `self` a special Relation? - declare (Declaration __self) Prelude ScopeGraph.Public emptySpan ScopeGraph.Unknown Nothing + declare (Declaration __self) Prelude ScopeGraph.Public emptySpan ScopeGraph.UnknownKind Nothing for methodParameters $ \paramNode -> do param <- maybeM (throwNoNameError paramNode) (declaredName paramNode) - param <$ declare (Declaration param) Default ScopeGraph.Public span ScopeGraph.Parameter Nothing + param <$ declare (Declaration param) Default ScopeGraph.Public span ScopeGraph.ParameterKind Nothing addr <- lookupSlot (Declaration name) v <- function name params methodBody associatedScope @@ -146,7 +146,7 @@ instance Evaluatable RequiredParameter where eval _ _ RequiredParameter{..} = do name <- maybeM (throwNoNameError requiredParameter) (declaredName requiredParameter) span <- ask @Span - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.RequiredParameter Nothing + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.RequiredParameterKind Nothing unit @@ -172,7 +172,7 @@ instance Evaluatable VariableDeclaration where for_ decs $ \declaration -> do name <- maybeM (throwNoNameError declaration) (declaredName declaration) let declarationSpan = getSpan declaration - declare (Declaration name) Default ScopeGraph.Public declarationSpan ScopeGraph.VariableDeclaration Nothing + declare (Declaration name) Default ScopeGraph.Public declarationSpan ScopeGraph.VariableDeclarationKind Nothing eval declaration unit @@ -211,7 +211,7 @@ instance Evaluatable PublicFieldDefinition where span <- ask @Span propertyName <- maybeM (throwNoNameError publicFieldPropertyName) (declaredName publicFieldPropertyName) - declare (Declaration propertyName) Instance publicFieldAccessControl span ScopeGraph.PublicField Nothing + declare (Declaration propertyName) Instance publicFieldAccessControl span ScopeGraph.PublicFieldKind Nothing slot <- lookupSlot (Declaration propertyName) value <- eval publicFieldValue assign slot value @@ -253,7 +253,7 @@ instance Evaluatable Class where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.Class (Just classScope) + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.ClassKind (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) classFrame <- newFrame classScope frameEdges @@ -329,7 +329,7 @@ instance Evaluatable TypeAlias where span <- ask @Span assocScope <- associatedScope (Declaration kindName) -- TODO: Should we consider a special Relation for `TypeAlias`? - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.TypeAlias assocScope + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.TypeAliasKind assocScope slot <- lookupSlot (Declaration name) kindSlot <- lookupSlot (Declaration kindName) diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 888143b3f..18a579ea6 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -561,7 +561,7 @@ instance Evaluatable New where case maybeConstructor of Just slot -> do span <- ask @Span - reference (Reference constructorName) span ScopeGraph.New (Declaration constructorName) + reference (Reference constructorName) span ScopeGraph.NewKind (Declaration constructorName) constructor <- deref slot args <- traverse eval newArguments boundConstructor <- bindThis objectVal constructor @@ -596,7 +596,7 @@ instance Tokenize This where instance Evaluatable This where eval _ _ This = do span <- ask @Span - reference (Reference __self) span ScopeGraph.This (Declaration __self) + reference (Reference __self) span ScopeGraph.ThisKind (Declaration __self) deref =<< lookupSlot (Declaration __self) instance AccessControls1 This where diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 9477058e2..1a2768d1a 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -127,7 +127,7 @@ instance Evaluatable Let where assocScope <- associatedScope (Declaration valueName) _ <- withLexicalScopeAndFrame $ do - declare (Declaration name) Default Public letSpan ScopeGraph.Let assocScope + declare (Declaration name) Default Public letSpan ScopeGraph.LetKind assocScope letVal <- eval letValue slot <- lookupSlot (Declaration name) assign slot letVal diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 781b905b0..e489d94ea 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -78,7 +78,7 @@ instance Evaluatable QualifiedImport where alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) span <- ask @Span scopeAddress <- newScope mempty - declare (Declaration alias) Default Public span ScopeGraph.QualifiedImport (Just scopeAddress) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedImportKind (Just scopeAddress) aliasSlot <- lookupSlot (Declaration alias) withScope scopeAddress $ do diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 2054ce073..34a42ffdc 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -174,7 +174,7 @@ instance Evaluatable QualifiedName where eval _ _ (QualifiedName obj iden) = do name <- maybeM (throwNoNameError obj) (declaredName obj) let objSpan = getSpan obj - reference (Reference name) objSpan ScopeGraph.Identifier (Declaration name) + reference (Reference name) objSpan ScopeGraph.IdentifierKind (Declaration name) childScope <- associatedScope (Declaration name) propName <- maybeM (throwNoNameError iden) (declaredName iden) @@ -185,7 +185,7 @@ instance Evaluatable QualifiedName where frameAddress <- newFrame childScope (Map.singleton Lexical (Map.singleton currentScopeAddress currentFrameAddress)) withScopeAndFrame frameAddress $ do let propSpan = getSpan iden - reference (Reference propName) propSpan ScopeGraph.Identifier (Declaration propName) + reference (Reference propName) propSpan ScopeGraph.IdentifierKind (Declaration propName) slot <- lookupSlot (Declaration propName) deref slot Nothing -> diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index eaa055226..b41b3807d 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -133,7 +133,7 @@ instance Evaluatable Import where -- Add declaration of the alias name to the current scope (within our current module). aliasName <- maybeM (throwNoNameError aliasTerm) (declaredAlias aliasTerm) let aliasSpan = getSpan aliasTerm - declare (Declaration aliasName) Default Public aliasSpan ScopeGraph.UnqualifiedImport (Just importScope) + declare (Declaration aliasName) Default Public aliasSpan ScopeGraph.UnqualifiedImportKind (Just importScope) -- Retrieve the frame slot for the new declaration. aliasSlot <- lookupSlot (Declaration aliasName) assign aliasSlot =<< object aliasFrame @@ -172,7 +172,7 @@ instance Evaluatable Import where aliasValue <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) if aliasValue /= aliasName then do let aliasSpan = getSpan aliasTerm - insertImportReference (Reference aliasName) aliasSpan ScopeGraph.Identifier (Declaration aliasValue) scopeAddress + insertImportReference (Reference aliasName) aliasSpan ScopeGraph.IdentifierKind (Declaration aliasValue) scopeAddress else pure () @@ -198,7 +198,7 @@ instance Evaluatable QualifiedImport where go (((nameTerm, name), modulePath) : namesAndPaths) = do scopeAddress <- newScope mempty let nameSpan = getSpan nameTerm - declare (Declaration name) Default Public nameSpan ScopeGraph.QualifiedImport (Just scopeAddress) + declare (Declaration name) Default Public nameSpan ScopeGraph.QualifiedImportKind (Just scopeAddress) aliasSlot <- lookupSlot (Declaration name) -- a.b.c withScope scopeAddress $ @@ -231,7 +231,7 @@ instance Evaluatable QualifiedAliasedImport where span <- ask @Span scopeAddress <- newScope mempty alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) - declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImport (Just scopeAddress) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImportKind (Just scopeAddress) objFrame <- newFrame scopeAddress mempty val <- object objFrame aliasSlot <- lookupSlot (Declaration alias) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index f11fb9988..85f0768cf 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -78,7 +78,7 @@ instance Evaluatable Send where let callFunction = do span <- ask @Span - reference (Reference sel) span ScopeGraph.Call (Declaration sel) + reference (Reference sel) span ScopeGraph.CallKind (Declaration sel) func <- deref =<< lookupSlot (Declaration sel) args <- traverse eval sendArgs boundFunc <- bindThis lhsValue func @@ -210,7 +210,7 @@ instance Evaluatable Class where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.Class (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.ClassKind (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) childFrame <- newFrame classScope frameEdges @@ -260,7 +260,7 @@ instance Evaluatable Module where Nothing -> do let edges = Map.singleton Lexical [ currentScope' ] classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.Module (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.ModuleKind (Just classScope) currentFrame' <- currentFrame let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame') @@ -326,7 +326,7 @@ instance Evaluatable Assignment where lhsName <- maybeM (throwNoNameError assignmentTarget) (declaredName assignmentTarget) maybeSlot <- maybeLookupDeclaration (Declaration lhsName) assignmentSpan <- ask @Span - maybe (declare (Declaration lhsName) Default Public assignmentSpan ScopeGraph.Assignment Nothing) (const (pure ())) maybeSlot + maybe (declare (Declaration lhsName) Default Public assignmentSpan ScopeGraph.AssignmentKind Nothing) (const (pure ())) maybeSlot lhs <- ref assignmentTarget rhs <- eval assignmentValue diff --git a/src/Language/TypeScript/Syntax/Import.hs b/src/Language/TypeScript/Syntax/Import.hs index ad07c520f..46c0b9d88 100644 --- a/src/Language/TypeScript/Syntax/Import.hs +++ b/src/Language/TypeScript/Syntax/Import.hs @@ -38,7 +38,7 @@ instance Evaluatable Import where for_ symbols $ \Alias{..} -> -- TODO: Need an easier way to get the span of an Alias. It's difficult because we no longer have a term. -- Even if we had one we'd have to evaluate it at the moment. - insertImportReference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) scopeAddress + insertImportReference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) scopeAddress -- Create edges from the current scope/frame to the import scope/frame. insertImportEdge scopeAddress @@ -60,7 +60,7 @@ instance Evaluatable QualifiedAliasedImport where aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap) alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) - declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImport (Just importScope) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImportKind (Just importScope) aliasSlot <- lookupSlot (Declaration alias) assign aliasSlot =<< object aliasFrame @@ -91,7 +91,7 @@ instance Evaluatable QualifiedExport where withScope exportScope . for_ exportSymbols $ \Alias{..} -> do -- TODO: Replace Alias in QualifedExport with terms and use a real span - reference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) + reference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) -- Create an export edge from a new scope to the qualifed export's scope. unit @@ -118,7 +118,7 @@ instance Evaluatable QualifiedExportFrom where withScopeAndFrame moduleFrame . for_ exportSymbols $ \Alias{..} -> do -- TODO: Replace Alias with terms in QualifiedExportFrom and use a real span below. - insertImportReference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) exportScope + insertImportReference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) exportScope insertExportEdge exportScope insertFrameLink ScopeGraph.Export (Map.singleton exportScope exportFrame) @@ -139,7 +139,7 @@ instance Evaluatable DefaultExport where withScopeAndFrame exportFrame $ do valueRef <- eval term let declaration = Declaration $ Name.name "__default" - declare declaration Default Public exportSpan ScopeGraph.DefaultExport Nothing + declare declaration Default Public exportSpan ScopeGraph.DefaultExportKind Nothing defaultSlot <- lookupSlot declaration assign defaultSlot valueRef diff --git a/src/Language/TypeScript/Syntax/JSX.hs b/src/Language/TypeScript/Syntax/JSX.hs index dd93c33f9..299cc6da2 100644 --- a/src/Language/TypeScript/Syntax/JSX.hs +++ b/src/Language/TypeScript/Syntax/JSX.hs @@ -78,7 +78,7 @@ instance Evaluatable RequiredParameter where eval eval ref RequiredParameter{..} = do name <- maybeM (throwNoNameError requiredParameterSubject) (declaredName requiredParameterSubject) span <- ask @Span - declare (Declaration name) Default Public span ScopeGraph.RequiredParameter Nothing + declare (Declaration name) Default Public span ScopeGraph.RequiredParameterKind Nothing lhs <- ref requiredParameterSubject rhs <- eval requiredParameterValue diff --git a/src/Language/TypeScript/Syntax/JavaScript.hs b/src/Language/TypeScript/Syntax/JavaScript.hs index 95d10e2c8..29f195ddc 100644 --- a/src/Language/TypeScript/Syntax/JavaScript.hs +++ b/src/Language/TypeScript/Syntax/JavaScript.hs @@ -26,7 +26,7 @@ instance Evaluatable JavaScriptRequire where Just alias -> do span <- ask @Span importScope <- newScope (Map.singleton ScopeGraph.Import [ moduleScope ]) - declare (Declaration alias) Default Public span ScopeGraph.UnqualifiedImport (Just importScope) + declare (Declaration alias) Default Public span ScopeGraph.UnqualifiedImportKind (Just importScope) let scopeMap = Map.singleton moduleScope moduleFrame aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap) aliasSlot <- lookupSlot (Declaration alias) diff --git a/src/Language/TypeScript/Syntax/TypeScript.hs b/src/Language/TypeScript/Syntax/TypeScript.hs index 272acbf4b..64a902918 100644 --- a/src/Language/TypeScript/Syntax/TypeScript.hs +++ b/src/Language/TypeScript/Syntax/TypeScript.hs @@ -212,7 +212,7 @@ declareModule eval identifier statements = do Nothing -> do let edges = Map.singleton Lexical [ currentScope' ] childScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.Module (Just childScope) + declare (Declaration name) Default Public span ScopeGraph.ModuleKind (Just childScope) currentFrame' <- currentFrame let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame') @@ -274,7 +274,7 @@ instance Evaluatable AbstractClass where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.AbstractClass (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.AbstractClassKind (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) childFrame <- newFrame classScope frameEdges diff --git a/src/Language/TypeScript/Syntax/Types.hs b/src/Language/TypeScript/Syntax/Types.hs index 93f2440c8..44a391027 100644 --- a/src/Language/TypeScript/Syntax/Types.hs +++ b/src/Language/TypeScript/Syntax/Types.hs @@ -67,7 +67,7 @@ instance Evaluatable TypeIdentifier where eval _ _ TypeIdentifier{..} = do -- Add a reference to the type identifier in the current scope. span <- ask @Span - reference (Reference (Evaluatable.name contents)) span ScopeGraph.TypeIdentifier (Declaration (Evaluatable.name contents)) + reference (Reference (Evaluatable.name contents)) span ScopeGraph.TypeIdentifierKind (Declaration (Evaluatable.name contents)) unit data NestedTypeIdentifier a = NestedTypeIdentifier { left :: !a, right :: !a } From f777610108fc2baa20771a787acc1fafb552d4c3 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 11 Mar 2019 12:33:57 -0700 Subject: [PATCH 03/19] Update tests --- test/Control/Abstract/Evaluator/Spec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index a3094b302..054d5eec3 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -35,9 +35,9 @@ spec = parallel $ do let lexicalEdges = Map.singleton Lexical [ currentScope' ] x = SpecHelpers.name "x" associatedScope <- newScope lexicalEdges - declare (ScopeGraph.Declaration "identity") Default Public emptySpan ScopeGraph.Function (Just associatedScope) + declare (ScopeGraph.Declaration "identity") Default Public emptySpan ScopeGraph.FunctionKind (Just associatedScope) withScope associatedScope $ do - declare (Declaration x) Default Public emptySpan ScopeGraph.RequiredParameter Nothing + declare (Declaration x) Default Public emptySpan ScopeGraph.RequiredParameterKind Nothing identity <- function "identity" [ x ] (SpecEff (Heap.lookupSlot (ScopeGraph.Declaration (SpecHelpers.name "x")) >>= deref)) associatedScope val <- integer 123 From 23bad2d665ebb05a35851bbd9bbf1296e804cb27 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Mar 2019 13:10:19 -0700 Subject: [PATCH 04/19] Regen pb with latest twirp haskell, ++proto3-suite --- src/Semantic/Api/V1/CodeAnalysisPB.hs | 1039 ++++++++++++++++++++++--- 1 file changed, 940 insertions(+), 99 deletions(-) diff --git a/src/Semantic/Api/V1/CodeAnalysisPB.hs b/src/Semantic/Api/V1/CodeAnalysisPB.hs index 9ce828b72..1e364142b 100644 --- a/src/Semantic/Api/V1/CodeAnalysisPB.hs +++ b/src/Semantic/Api/V1/CodeAnalysisPB.hs @@ -3,25 +3,51 @@ {-# OPTIONS_GHC -Wno-unused-imports -Wno-missing-export-lists #-} module Semantic.Api.V1.CodeAnalysisPB where -import Control.DeepSeq -import Data.Aeson -import Data.ByteString (ByteString) -import Data.Int -import Data.Text (Text) -import Data.Vector (Vector) -import Data.Word -import GHC.Generics -import Proto3.Suite -import Proto3.Wire (at, oneof) +import Control.DeepSeq +import Control.Monad (msum) +import qualified Data.Aeson as A +import qualified Data.Aeson.Encoding as E +import Data.ByteString (ByteString) +import Data.Int +import Data.Text (Text) +import qualified Data.Text as T +import Data.Vector (Vector) +import Data.Word +import GHC.Generics +import Proto3.Suite +import Proto3.Suite.JSONPB as JSONPB +import Proto3.Wire (at, oneof) data PingRequest = PingRequest { service :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB PingRequest where + parseJSONPB = A.withObject "PingRequest" $ \obj -> PingRequest + <$> obj .: "service" + +instance ToJSONPB PingRequest where + toJSONPB PingRequest{..} = object $ + [ + "service" .= service + ] + toEncodingPB PingRequest{..} = pairs $ + [ + "service" .= service + ] + +instance FromJSON PingRequest where + parseJSON = parseJSONPB + +instance ToJSON PingRequest where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message PingRequest where encodeMessage _ PingRequest{..} = mconcat - [ encodeMessageField 1 service + [ + encodeMessageField 1 service ] decodeMessage _ = PingRequest <$> at decodeMessageField 1 @@ -33,11 +59,42 @@ data PingResponse = PingResponse , timestamp :: Text , sha :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB PingResponse where + parseJSONPB = A.withObject "PingResponse" $ \obj -> PingResponse + <$> obj .: "status" + <*> obj .: "hostname" + <*> obj .: "timestamp" + <*> obj .: "sha" + +instance ToJSONPB PingResponse where + toJSONPB PingResponse{..} = object $ + [ + "status" .= status + , "hostname" .= hostname + , "timestamp" .= timestamp + , "sha" .= sha + ] + toEncodingPB PingResponse{..} = pairs $ + [ + "status" .= status + , "hostname" .= hostname + , "timestamp" .= timestamp + , "sha" .= sha + ] + +instance FromJSON PingResponse where + parseJSON = parseJSONPB + +instance ToJSON PingResponse where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message PingResponse where encodeMessage _ PingResponse{..} = mconcat - [ encodeMessageField 1 status + [ + encodeMessageField 1 status , encodeMessageField 2 hostname , encodeMessageField 3 timestamp , encodeMessageField 4 sha @@ -52,11 +109,33 @@ instance Message PingResponse where data ParseTreeRequest = ParseTreeRequest { blobs :: Vector Blob } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB ParseTreeRequest where + parseJSONPB = A.withObject "ParseTreeRequest" $ \obj -> ParseTreeRequest + <$> obj .: "blobs" + +instance ToJSONPB ParseTreeRequest where + toJSONPB ParseTreeRequest{..} = object $ + [ + "blobs" .= blobs + ] + toEncodingPB ParseTreeRequest{..} = pairs $ + [ + "blobs" .= blobs + ] + +instance FromJSON ParseTreeRequest where + parseJSON = parseJSONPB + +instance ToJSON ParseTreeRequest where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message ParseTreeRequest where encodeMessage _ ParseTreeRequest{..} = mconcat - [ encodeMessageField 1 (NestedVec blobs) + [ + encodeMessageField 1 (NestedVec blobs) ] decodeMessage _ = ParseTreeRequest <$> (nestedvec <$> at decodeMessageField 1) @@ -65,11 +144,33 @@ instance Message ParseTreeRequest where data ParseTreeSymbolResponse = ParseTreeSymbolResponse { files :: Vector File } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB ParseTreeSymbolResponse where + parseJSONPB = A.withObject "ParseTreeSymbolResponse" $ \obj -> ParseTreeSymbolResponse + <$> obj .: "files" + +instance ToJSONPB ParseTreeSymbolResponse where + toJSONPB ParseTreeSymbolResponse{..} = object $ + [ + "files" .= files + ] + toEncodingPB ParseTreeSymbolResponse{..} = pairs $ + [ + "files" .= files + ] + +instance FromJSON ParseTreeSymbolResponse where + parseJSON = parseJSONPB + +instance ToJSON ParseTreeSymbolResponse where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message ParseTreeSymbolResponse where encodeMessage _ ParseTreeSymbolResponse{..} = mconcat - [ encodeMessageField 1 (NestedVec files) + [ + encodeMessageField 1 (NestedVec files) ] decodeMessage _ = ParseTreeSymbolResponse <$> (nestedvec <$> at decodeMessageField 1) @@ -78,11 +179,33 @@ instance Message ParseTreeSymbolResponse where data ParseTreeGraphResponse = ParseTreeGraphResponse { files :: Vector ParseTreeFileGraph } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB ParseTreeGraphResponse where + parseJSONPB = A.withObject "ParseTreeGraphResponse" $ \obj -> ParseTreeGraphResponse + <$> obj .: "files" + +instance ToJSONPB ParseTreeGraphResponse where + toJSONPB ParseTreeGraphResponse{..} = object $ + [ + "files" .= files + ] + toEncodingPB ParseTreeGraphResponse{..} = pairs $ + [ + "files" .= files + ] + +instance FromJSON ParseTreeGraphResponse where + parseJSON = parseJSONPB + +instance ToJSON ParseTreeGraphResponse where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message ParseTreeGraphResponse where encodeMessage _ ParseTreeGraphResponse{..} = mconcat - [ encodeMessageField 1 (NestedVec files) + [ + encodeMessageField 1 (NestedVec files) ] decodeMessage _ = ParseTreeGraphResponse <$> (nestedvec <$> at decodeMessageField 1) @@ -95,11 +218,45 @@ data ParseTreeFileGraph = ParseTreeFileGraph , edges :: Vector TermEdge , errors :: Vector ParseError } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB ParseTreeFileGraph where + parseJSONPB = A.withObject "ParseTreeFileGraph" $ \obj -> ParseTreeFileGraph + <$> obj .: "path" + <*> obj .: "language" + <*> obj .: "vertices" + <*> obj .: "edges" + <*> obj .: "errors" + +instance ToJSONPB ParseTreeFileGraph where + toJSONPB ParseTreeFileGraph{..} = object $ + [ + "path" .= path + , "language" .= language + , "vertices" .= vertices + , "edges" .= edges + , "errors" .= errors + ] + toEncodingPB ParseTreeFileGraph{..} = pairs $ + [ + "path" .= path + , "language" .= language + , "vertices" .= vertices + , "edges" .= edges + , "errors" .= errors + ] + +instance FromJSON ParseTreeFileGraph where + parseJSON = parseJSONPB + +instance ToJSON ParseTreeFileGraph where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message ParseTreeFileGraph where encodeMessage _ ParseTreeFileGraph{..} = mconcat - [ encodeMessageField 1 path + [ + encodeMessageField 1 path , encodeMessageField 2 language , encodeMessageField 3 (NestedVec vertices) , encodeMessageField 4 (NestedVec edges) @@ -114,14 +271,39 @@ instance Message ParseTreeFileGraph where dotProto = undefined data TermEdge = TermEdge - { source :: Int64 - , target :: Int64 + { source :: Int32 + , target :: Int32 } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB TermEdge where + parseJSONPB = A.withObject "TermEdge" $ \obj -> TermEdge + <$> obj .: "source" + <*> obj .: "target" + +instance ToJSONPB TermEdge where + toJSONPB TermEdge{..} = object $ + [ + "source" .= source + , "target" .= target + ] + toEncodingPB TermEdge{..} = pairs $ + [ + "source" .= source + , "target" .= target + ] + +instance FromJSON TermEdge where + parseJSON = parseJSONPB + +instance ToJSON TermEdge where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message TermEdge where encodeMessage _ TermEdge{..} = mconcat - [ encodeMessageField 1 source + [ + encodeMessageField 1 source , encodeMessageField 2 target ] decodeMessage _ = TermEdge @@ -130,15 +312,43 @@ instance Message TermEdge where dotProto = undefined data TermVertex = TermVertex - { vertexId :: Int64 + { vertexId :: Int32 , term :: Text - , span :: Maybe Span + , span :: (Maybe Span) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB TermVertex where + parseJSONPB = A.withObject "TermVertex" $ \obj -> TermVertex + <$> obj .: "vertexId" + <*> obj .: "term" + <*> obj .: "span" + +instance ToJSONPB TermVertex where + toJSONPB TermVertex{..} = object $ + [ + "vertexId" .= vertexId + , "term" .= term + , "span" .= span + ] + toEncodingPB TermVertex{..} = pairs $ + [ + "vertexId" .= vertexId + , "term" .= term + , "span" .= span + ] + +instance FromJSON TermVertex where + parseJSON = parseJSONPB + +instance ToJSON TermVertex where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message TermVertex where encodeMessage _ TermVertex{..} = mconcat - [ encodeMessageField 1 vertexId + [ + encodeMessageField 1 vertexId , encodeMessageField 2 term , encodeMessageField 3 (Nested span) ] @@ -151,11 +361,33 @@ instance Message TermVertex where data ParseError = ParseError { error :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB ParseError where + parseJSONPB = A.withObject "ParseError" $ \obj -> ParseError + <$> obj .: "error" + +instance ToJSONPB ParseError where + toJSONPB ParseError{..} = object $ + [ + "error" .= error + ] + toEncodingPB ParseError{..} = pairs $ + [ + "error" .= error + ] + +instance FromJSON ParseError where + parseJSON = parseJSONPB + +instance ToJSON ParseError where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message ParseError where encodeMessage _ ParseError{..} = mconcat - [ encodeMessageField 1 error + [ + encodeMessageField 1 error ] decodeMessage _ = ParseError <$> at decodeMessageField 1 @@ -164,11 +396,33 @@ instance Message ParseError where data DiffTreeRequest = DiffTreeRequest { blobs :: Vector BlobPair } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB DiffTreeRequest where + parseJSONPB = A.withObject "DiffTreeRequest" $ \obj -> DiffTreeRequest + <$> obj .: "blobs" + +instance ToJSONPB DiffTreeRequest where + toJSONPB DiffTreeRequest{..} = object $ + [ + "blobs" .= blobs + ] + toEncodingPB DiffTreeRequest{..} = pairs $ + [ + "blobs" .= blobs + ] + +instance FromJSON DiffTreeRequest where + parseJSON = parseJSONPB + +instance ToJSON DiffTreeRequest where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message DiffTreeRequest where encodeMessage _ DiffTreeRequest{..} = mconcat - [ encodeMessageField 1 (NestedVec blobs) + [ + encodeMessageField 1 (NestedVec blobs) ] decodeMessage _ = DiffTreeRequest <$> (nestedvec <$> at decodeMessageField 1) @@ -177,11 +431,33 @@ instance Message DiffTreeRequest where data DiffTreeTOCResponse = DiffTreeTOCResponse { files :: Vector TOCSummaryFile } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB DiffTreeTOCResponse where + parseJSONPB = A.withObject "DiffTreeTOCResponse" $ \obj -> DiffTreeTOCResponse + <$> obj .: "files" + +instance ToJSONPB DiffTreeTOCResponse where + toJSONPB DiffTreeTOCResponse{..} = object $ + [ + "files" .= files + ] + toEncodingPB DiffTreeTOCResponse{..} = pairs $ + [ + "files" .= files + ] + +instance FromJSON DiffTreeTOCResponse where + parseJSON = parseJSONPB + +instance ToJSON DiffTreeTOCResponse where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message DiffTreeTOCResponse where encodeMessage _ DiffTreeTOCResponse{..} = mconcat - [ encodeMessageField 1 (NestedVec files) + [ + encodeMessageField 1 (NestedVec files) ] decodeMessage _ = DiffTreeTOCResponse <$> (nestedvec <$> at decodeMessageField 1) @@ -193,11 +469,42 @@ data TOCSummaryFile = TOCSummaryFile , changes :: Vector TOCSummaryChange , errors :: Vector TOCSummaryError } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB TOCSummaryFile where + parseJSONPB = A.withObject "TOCSummaryFile" $ \obj -> TOCSummaryFile + <$> obj .: "path" + <*> obj .: "language" + <*> obj .: "changes" + <*> obj .: "errors" + +instance ToJSONPB TOCSummaryFile where + toJSONPB TOCSummaryFile{..} = object $ + [ + "path" .= path + , "language" .= language + , "changes" .= changes + , "errors" .= errors + ] + toEncodingPB TOCSummaryFile{..} = pairs $ + [ + "path" .= path + , "language" .= language + , "changes" .= changes + , "errors" .= errors + ] + +instance FromJSON TOCSummaryFile where + parseJSON = parseJSONPB + +instance ToJSON TOCSummaryFile where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message TOCSummaryFile where encodeMessage _ TOCSummaryFile{..} = mconcat - [ encodeMessageField 1 path + [ + encodeMessageField 1 path , encodeMessageField 2 language , encodeMessageField 3 (NestedVec changes) , encodeMessageField 4 (NestedVec errors) @@ -212,14 +519,45 @@ instance Message TOCSummaryFile where data TOCSummaryChange = TOCSummaryChange { category :: Text , term :: Text - , span :: Maybe Span + , span :: (Maybe Span) , changeType :: ChangeType } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB TOCSummaryChange where + parseJSONPB = A.withObject "TOCSummaryChange" $ \obj -> TOCSummaryChange + <$> obj .: "category" + <*> obj .: "term" + <*> obj .: "span" + <*> obj .: "changeType" + +instance ToJSONPB TOCSummaryChange where + toJSONPB TOCSummaryChange{..} = object $ + [ + "category" .= category + , "term" .= term + , "span" .= span + , "changeType" .= changeType + ] + toEncodingPB TOCSummaryChange{..} = pairs $ + [ + "category" .= category + , "term" .= term + , "span" .= span + , "changeType" .= changeType + ] + +instance FromJSON TOCSummaryChange where + parseJSON = parseJSONPB + +instance ToJSON TOCSummaryChange where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message TOCSummaryChange where encodeMessage _ TOCSummaryChange{..} = mconcat - [ encodeMessageField 1 category + [ + encodeMessageField 1 category , encodeMessageField 2 term , encodeMessageField 3 (Nested span) , encodeMessageField 4 changeType @@ -233,13 +571,38 @@ instance Message TOCSummaryChange where data TOCSummaryError = TOCSummaryError { error :: Text - , span :: Maybe Span + , span :: (Maybe Span) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB TOCSummaryError where + parseJSONPB = A.withObject "TOCSummaryError" $ \obj -> TOCSummaryError + <$> obj .: "error" + <*> obj .: "span" + +instance ToJSONPB TOCSummaryError where + toJSONPB TOCSummaryError{..} = object $ + [ + "error" .= error + , "span" .= span + ] + toEncodingPB TOCSummaryError{..} = pairs $ + [ + "error" .= error + , "span" .= span + ] + +instance FromJSON TOCSummaryError where + parseJSON = parseJSONPB + +instance ToJSON TOCSummaryError where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message TOCSummaryError where encodeMessage _ TOCSummaryError{..} = mconcat - [ encodeMessageField 1 error + [ + encodeMessageField 1 error , encodeMessageField 2 (Nested span) ] decodeMessage _ = TOCSummaryError @@ -250,11 +613,33 @@ instance Message TOCSummaryError where data DiffTreeGraphResponse = DiffTreeGraphResponse { files :: Vector DiffTreeFileGraph } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB DiffTreeGraphResponse where + parseJSONPB = A.withObject "DiffTreeGraphResponse" $ \obj -> DiffTreeGraphResponse + <$> obj .: "files" + +instance ToJSONPB DiffTreeGraphResponse where + toJSONPB DiffTreeGraphResponse{..} = object $ + [ + "files" .= files + ] + toEncodingPB DiffTreeGraphResponse{..} = pairs $ + [ + "files" .= files + ] + +instance FromJSON DiffTreeGraphResponse where + parseJSON = parseJSONPB + +instance ToJSON DiffTreeGraphResponse where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message DiffTreeGraphResponse where encodeMessage _ DiffTreeGraphResponse{..} = mconcat - [ encodeMessageField 1 (NestedVec files) + [ + encodeMessageField 1 (NestedVec files) ] decodeMessage _ = DiffTreeGraphResponse <$> (nestedvec <$> at decodeMessageField 1) @@ -267,11 +652,45 @@ data DiffTreeFileGraph = DiffTreeFileGraph , edges :: Vector DiffTreeEdge , errors :: Vector ParseError } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB DiffTreeFileGraph where + parseJSONPB = A.withObject "DiffTreeFileGraph" $ \obj -> DiffTreeFileGraph + <$> obj .: "path" + <*> obj .: "language" + <*> obj .: "vertices" + <*> obj .: "edges" + <*> obj .: "errors" + +instance ToJSONPB DiffTreeFileGraph where + toJSONPB DiffTreeFileGraph{..} = object $ + [ + "path" .= path + , "language" .= language + , "vertices" .= vertices + , "edges" .= edges + , "errors" .= errors + ] + toEncodingPB DiffTreeFileGraph{..} = pairs $ + [ + "path" .= path + , "language" .= language + , "vertices" .= vertices + , "edges" .= edges + , "errors" .= errors + ] + +instance FromJSON DiffTreeFileGraph where + parseJSON = parseJSONPB + +instance ToJSON DiffTreeFileGraph where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message DiffTreeFileGraph where encodeMessage _ DiffTreeFileGraph{..} = mconcat - [ encodeMessageField 1 path + [ + encodeMessageField 1 path , encodeMessageField 2 language , encodeMessageField 3 (NestedVec vertices) , encodeMessageField 4 (NestedVec edges) @@ -286,14 +705,39 @@ instance Message DiffTreeFileGraph where dotProto = undefined data DiffTreeEdge = DiffTreeEdge - { source :: Int64 - , target :: Int64 + { source :: Int32 + , target :: Int32 } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB DiffTreeEdge where + parseJSONPB = A.withObject "DiffTreeEdge" $ \obj -> DiffTreeEdge + <$> obj .: "source" + <*> obj .: "target" + +instance ToJSONPB DiffTreeEdge where + toJSONPB DiffTreeEdge{..} = object $ + [ + "source" .= source + , "target" .= target + ] + toEncodingPB DiffTreeEdge{..} = pairs $ + [ + "source" .= source + , "target" .= target + ] + +instance FromJSON DiffTreeEdge where + parseJSON = parseJSONPB + +instance ToJSON DiffTreeEdge where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message DiffTreeEdge where encodeMessage _ DiffTreeEdge{..} = mconcat - [ encodeMessageField 1 source + [ + encodeMessageField 1 source , encodeMessageField 2 target ] decodeMessage _ = DiffTreeEdge @@ -302,22 +746,73 @@ instance Message DiffTreeEdge where dotProto = undefined data DiffTreeVertexDiffTerm - = Deleted { deleted :: Maybe DeletedTerm } - | Inserted { inserted :: Maybe InsertedTerm } - | Replaced { replaced :: Maybe ReplacedTerm } - | Merged { merged :: Maybe MergedTerm } + = Deleted (Maybe DeletedTerm) + | Inserted (Maybe InsertedTerm) + | Replaced (Maybe ReplacedTerm) + | Merged (Maybe MergedTerm) deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, FromJSON, ToJSON, NFData) + deriving anyclass (Message, Named, NFData) + +instance FromJSONPB DiffTreeVertexDiffTerm where + parseJSONPB = A.withObject "DiffTreeVertexDiffTerm" $ \obj -> msum + [ + Deleted <$> parseField obj "deleted" + , Inserted <$> parseField obj "inserted" + , Replaced <$> parseField obj "replaced" + , Merged <$> parseField obj "merged" + ] + +instance ToJSONPB DiffTreeVertexDiffTerm where + toJSONPB (Deleted x) = object [ "deleted" .= x ] + toJSONPB (Inserted x) = object [ "inserted" .= x ] + toJSONPB (Replaced x) = object [ "replaced" .= x ] + toJSONPB (Merged x) = object [ "merged" .= x ] + toEncodingPB (Deleted x) = pairs [ "deleted" .= x ] + toEncodingPB (Inserted x) = pairs [ "inserted" .= x ] + toEncodingPB (Replaced x) = pairs [ "replaced" .= x ] + toEncodingPB (Merged x) = pairs [ "merged" .= x ] + +instance FromJSON DiffTreeVertexDiffTerm where + parseJSON = parseJSONPB + +instance ToJSON DiffTreeVertexDiffTerm where + toJSON = toAesonValue + toEncoding = toAesonEncoding data DiffTreeVertex = DiffTreeVertex - { diffVertexId :: Int64 + { diffVertexId :: Int32 , diffTerm :: Maybe DiffTreeVertexDiffTerm } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB DiffTreeVertex where + parseJSONPB = A.withObject "DiffTreeVertex" $ \obj -> DiffTreeVertex + <$> obj .: "diffVertexId" + <*> obj .: "diffTerm" + +instance ToJSONPB DiffTreeVertex where + toJSONPB DiffTreeVertex{..} = object $ + [ + "diffVertexId" .= diffVertexId + , "diffTerm" .= diffTerm + ] + toEncodingPB DiffTreeVertex{..} = pairs $ + [ + "diffVertexId" .= diffVertexId + , "diffTerm" .= diffTerm + ] + +instance FromJSON DiffTreeVertex where + parseJSON = parseJSONPB + +instance ToJSON DiffTreeVertex where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message DiffTreeVertex where encodeMessage _ DiffTreeVertex{..} = mconcat - [ encodeMessageField 1 diffVertexId + [ + encodeMessageField 1 diffVertexId , case diffTerm of Nothing -> mempty Just (Deleted deleted) -> encodeMessageField 2 deleted @@ -329,7 +824,8 @@ instance Message DiffTreeVertex where <$> at decodeMessageField 1 <*> oneof Nothing - [ (2, Just . Deleted <$> decodeMessageField) + [ + (2, Just . Deleted <$> decodeMessageField) , (3, Just . Inserted <$> decodeMessageField) , (4, Just . Replaced <$> decodeMessageField) , (5, Just . Merged <$> decodeMessageField) @@ -338,13 +834,38 @@ instance Message DiffTreeVertex where data DeletedTerm = DeletedTerm { term :: Text - , span :: Maybe Span + , span :: (Maybe Span) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB DeletedTerm where + parseJSONPB = A.withObject "DeletedTerm" $ \obj -> DeletedTerm + <$> obj .: "term" + <*> obj .: "span" + +instance ToJSONPB DeletedTerm where + toJSONPB DeletedTerm{..} = object $ + [ + "term" .= term + , "span" .= span + ] + toEncodingPB DeletedTerm{..} = pairs $ + [ + "term" .= term + , "span" .= span + ] + +instance FromJSON DeletedTerm where + parseJSON = parseJSONPB + +instance ToJSON DeletedTerm where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message DeletedTerm where encodeMessage _ DeletedTerm{..} = mconcat - [ encodeMessageField 1 term + [ + encodeMessageField 1 term , encodeMessageField 2 (Nested span) ] decodeMessage _ = DeletedTerm @@ -354,13 +875,38 @@ instance Message DeletedTerm where data InsertedTerm = InsertedTerm { term :: Text - , span :: Maybe Span + , span :: (Maybe Span) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB InsertedTerm where + parseJSONPB = A.withObject "InsertedTerm" $ \obj -> InsertedTerm + <$> obj .: "term" + <*> obj .: "span" + +instance ToJSONPB InsertedTerm where + toJSONPB InsertedTerm{..} = object $ + [ + "term" .= term + , "span" .= span + ] + toEncodingPB InsertedTerm{..} = pairs $ + [ + "term" .= term + , "span" .= span + ] + +instance FromJSON InsertedTerm where + parseJSON = parseJSONPB + +instance ToJSON InsertedTerm where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message InsertedTerm where encodeMessage _ InsertedTerm{..} = mconcat - [ encodeMessageField 1 term + [ + encodeMessageField 1 term , encodeMessageField 2 (Nested span) ] decodeMessage _ = InsertedTerm @@ -370,15 +916,46 @@ instance Message InsertedTerm where data ReplacedTerm = ReplacedTerm { beforeTerm :: Text - , beforeSpan :: Maybe Span + , beforeSpan :: (Maybe Span) , afterTerm :: Text - , afterSpan :: Maybe Span + , afterSpan :: (Maybe Span) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB ReplacedTerm where + parseJSONPB = A.withObject "ReplacedTerm" $ \obj -> ReplacedTerm + <$> obj .: "beforeTerm" + <*> obj .: "beforeSpan" + <*> obj .: "afterTerm" + <*> obj .: "afterSpan" + +instance ToJSONPB ReplacedTerm where + toJSONPB ReplacedTerm{..} = object $ + [ + "beforeTerm" .= beforeTerm + , "beforeSpan" .= beforeSpan + , "afterTerm" .= afterTerm + , "afterSpan" .= afterSpan + ] + toEncodingPB ReplacedTerm{..} = pairs $ + [ + "beforeTerm" .= beforeTerm + , "beforeSpan" .= beforeSpan + , "afterTerm" .= afterTerm + , "afterSpan" .= afterSpan + ] + +instance FromJSON ReplacedTerm where + parseJSON = parseJSONPB + +instance ToJSON ReplacedTerm where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message ReplacedTerm where encodeMessage _ ReplacedTerm{..} = mconcat - [ encodeMessageField 1 beforeTerm + [ + encodeMessageField 1 beforeTerm , encodeMessageField 2 (Nested beforeSpan) , encodeMessageField 3 afterTerm , encodeMessageField 4 (Nested afterSpan) @@ -392,14 +969,42 @@ instance Message ReplacedTerm where data MergedTerm = MergedTerm { term :: Text - , beforeSpan :: Maybe Span - , afterSpan :: Maybe Span + , beforeSpan :: (Maybe Span) + , afterSpan :: (Maybe Span) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB MergedTerm where + parseJSONPB = A.withObject "MergedTerm" $ \obj -> MergedTerm + <$> obj .: "term" + <*> obj .: "beforeSpan" + <*> obj .: "afterSpan" + +instance ToJSONPB MergedTerm where + toJSONPB MergedTerm{..} = object $ + [ + "term" .= term + , "beforeSpan" .= beforeSpan + , "afterSpan" .= afterSpan + ] + toEncodingPB MergedTerm{..} = pairs $ + [ + "term" .= term + , "beforeSpan" .= beforeSpan + , "afterSpan" .= afterSpan + ] + +instance FromJSON MergedTerm where + parseJSON = parseJSONPB + +instance ToJSON MergedTerm where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message MergedTerm where encodeMessage _ MergedTerm{..} = mconcat - [ encodeMessageField 1 term + [ + encodeMessageField 1 term , encodeMessageField 2 (Nested beforeSpan) , encodeMessageField 3 (Nested afterSpan) ] @@ -414,11 +1019,39 @@ data Blob = Blob , path :: Text , language :: Language } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB Blob where + parseJSONPB = A.withObject "Blob" $ \obj -> Blob + <$> obj .: "content" + <*> obj .: "path" + <*> obj .: "language" + +instance ToJSONPB Blob where + toJSONPB Blob{..} = object $ + [ + "content" .= content + , "path" .= path + , "language" .= language + ] + toEncodingPB Blob{..} = pairs $ + [ + "content" .= content + , "path" .= path + , "language" .= language + ] + +instance FromJSON Blob where + parseJSON = parseJSONPB + +instance ToJSON Blob where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message Blob where encodeMessage _ Blob{..} = mconcat - [ encodeMessageField 1 content + [ + encodeMessageField 1 content , encodeMessageField 2 path , encodeMessageField 3 language ] @@ -429,14 +1062,39 @@ instance Message Blob where dotProto = undefined data BlobPair = BlobPair - { before :: Maybe Blob - , after :: Maybe Blob + { before :: (Maybe Blob) + , after :: (Maybe Blob) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB BlobPair where + parseJSONPB = A.withObject "BlobPair" $ \obj -> BlobPair + <$> obj .: "before" + <*> obj .: "after" + +instance ToJSONPB BlobPair where + toJSONPB BlobPair{..} = object $ + [ + "before" .= before + , "after" .= after + ] + toEncodingPB BlobPair{..} = pairs $ + [ + "before" .= before + , "after" .= after + ] + +instance FromJSON BlobPair where + parseJSON = parseJSONPB + +instance ToJSON BlobPair where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message BlobPair where encodeMessage _ BlobPair{..} = mconcat - [ encodeMessageField 1 (Nested before) + [ + encodeMessageField 1 (Nested before) , encodeMessageField 2 (Nested after) ] decodeMessage _ = BlobPair @@ -450,11 +1108,42 @@ data File = File , symbols :: Vector Symbol , errors :: Vector ParseError } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB File where + parseJSONPB = A.withObject "File" $ \obj -> File + <$> obj .: "path" + <*> obj .: "language" + <*> obj .: "symbols" + <*> obj .: "errors" + +instance ToJSONPB File where + toJSONPB File{..} = object $ + [ + "path" .= path + , "language" .= language + , "symbols" .= symbols + , "errors" .= errors + ] + toEncodingPB File{..} = pairs $ + [ + "path" .= path + , "language" .= language + , "symbols" .= symbols + , "errors" .= errors + ] + +instance FromJSON File where + parseJSON = parseJSONPB + +instance ToJSON File where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message File where encodeMessage _ File{..} = mconcat - [ encodeMessageField 1 path + [ + encodeMessageField 1 path , encodeMessageField 2 language , encodeMessageField 3 (NestedVec symbols) , encodeMessageField 4 (NestedVec errors) @@ -470,14 +1159,48 @@ data Symbol = Symbol { symbol :: Text , kind :: Text , line :: Text - , span :: Maybe Span - , docs :: Maybe Docstring + , span :: (Maybe Span) + , docs :: (Maybe Docstring) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB Symbol where + parseJSONPB = A.withObject "Symbol" $ \obj -> Symbol + <$> obj .: "symbol" + <*> obj .: "kind" + <*> obj .: "line" + <*> obj .: "span" + <*> obj .: "docs" + +instance ToJSONPB Symbol where + toJSONPB Symbol{..} = object $ + [ + "symbol" .= symbol + , "kind" .= kind + , "line" .= line + , "span" .= span + , "docs" .= docs + ] + toEncodingPB Symbol{..} = pairs $ + [ + "symbol" .= symbol + , "kind" .= kind + , "line" .= line + , "span" .= span + , "docs" .= docs + ] + +instance FromJSON Symbol where + parseJSON = parseJSONPB + +instance ToJSON Symbol where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message Symbol where encodeMessage _ Symbol{..} = mconcat - [ encodeMessageField 1 symbol + [ + encodeMessageField 1 symbol , encodeMessageField 2 kind , encodeMessageField 3 line , encodeMessageField 4 (Nested span) @@ -494,25 +1217,72 @@ instance Message Symbol where data Docstring = Docstring { docstring :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB Docstring where + parseJSONPB = A.withObject "Docstring" $ \obj -> Docstring + <$> obj .: "docstring" + +instance ToJSONPB Docstring where + toJSONPB Docstring{..} = object $ + [ + "docstring" .= docstring + ] + toEncodingPB Docstring{..} = pairs $ + [ + "docstring" .= docstring + ] + +instance FromJSON Docstring where + parseJSON = parseJSONPB + +instance ToJSON Docstring where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message Docstring where encodeMessage _ Docstring{..} = mconcat - [ encodeMessageField 1 docstring + [ + encodeMessageField 1 docstring ] decodeMessage _ = Docstring <$> at decodeMessageField 1 dotProto = undefined data Position = Position - { line :: Int64 - , column :: Int64 + { line :: Int32 + , column :: Int32 } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB Position where + parseJSONPB = A.withObject "Position" $ \obj -> Position + <$> obj .: "line" + <*> obj .: "column" + +instance ToJSONPB Position where + toJSONPB Position{..} = object $ + [ + "line" .= line + , "column" .= column + ] + toEncodingPB Position{..} = pairs $ + [ + "line" .= line + , "column" .= column + ] + +instance FromJSON Position where + parseJSON = parseJSONPB + +instance ToJSON Position where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message Position where encodeMessage _ Position{..} = mconcat - [ encodeMessageField 1 line + [ + encodeMessageField 1 line , encodeMessageField 2 column ] decodeMessage _ = Position @@ -521,14 +1291,39 @@ instance Message Position where dotProto = undefined data Span = Span - { start :: Maybe Position - , end :: Maybe Position + { start :: (Maybe Position) + , end :: (Maybe Position) } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, FromJSON, ToJSON, NFData) + deriving anyclass (Named, NFData) + +instance FromJSONPB Span where + parseJSONPB = A.withObject "Span" $ \obj -> Span + <$> obj .: "start" + <*> obj .: "end" + +instance ToJSONPB Span where + toJSONPB Span{..} = object $ + [ + "start" .= start + , "end" .= end + ] + toEncodingPB Span{..} = pairs $ + [ + "start" .= start + , "end" .= end + ] + +instance FromJSON Span where + parseJSON = parseJSONPB + +instance ToJSON Span where + toJSON = toAesonValue + toEncoding = toAesonEncoding instance Message Span where encodeMessage _ Span{..} = mconcat - [ encodeMessageField 1 (Nested start) + [ + encodeMessageField 1 (Nested start) , encodeMessageField 2 (Nested end) ] decodeMessage _ = Span @@ -542,10 +1337,29 @@ data ChangeType | Removed | Modified deriving stock (Eq, Ord, Show, Enum, Bounded, Generic) - deriving anyclass (Named, MessageField, FromJSON, ToJSON, NFData) + deriving anyclass (Named, MessageField, NFData) deriving Primitive via PrimitiveEnum ChangeType + instance HasDefault ChangeType where def = None +instance FromJSONPB ChangeType where + parseJSONPB (JSONPB.String "NONE") = pure None + parseJSONPB (JSONPB.String "ADDED") = pure Added + parseJSONPB (JSONPB.String "REMOVED") = pure Removed + parseJSONPB (JSONPB.String "MODIFIED") = pure Modified + parseJSONPB x = typeMismatch "ChangeType" x + +instance ToJSONPB ChangeType where + toJSONPB x _ = A.String . T.toUpper . T.pack $ show x + toEncodingPB x _ = E.text . T.toUpper . T.pack $ show x + +instance FromJSON ChangeType where + parseJSON = parseJSONPB + +instance ToJSON ChangeType where + toJSON = toAesonValue + toEncoding = toAesonEncoding + data Language = Unknown | Go @@ -560,6 +1374,33 @@ data Language | Typescript | Php deriving stock (Eq, Ord, Show, Enum, Bounded, Generic) - deriving anyclass (Named, MessageField, FromJSON, ToJSON, NFData) + deriving anyclass (Named, MessageField, NFData) deriving Primitive via PrimitiveEnum Language + instance HasDefault Language where def = Unknown + +instance FromJSONPB Language where + parseJSONPB (JSONPB.String "UNKNOWN") = pure Unknown + parseJSONPB (JSONPB.String "GO") = pure Go + parseJSONPB (JSONPB.String "HASKELL") = pure Haskell + parseJSONPB (JSONPB.String "JAVA") = pure Java + parseJSONPB (JSONPB.String "JAVASCRIPT") = pure Javascript + parseJSONPB (JSONPB.String "JSON") = pure Json + parseJSONPB (JSONPB.String "JSX") = pure Jsx + parseJSONPB (JSONPB.String "MARKDOWN") = pure Markdown + parseJSONPB (JSONPB.String "PYTHON") = pure Python + parseJSONPB (JSONPB.String "RUBY") = pure Ruby + parseJSONPB (JSONPB.String "TYPESCRIPT") = pure Typescript + parseJSONPB (JSONPB.String "PHP") = pure Php + parseJSONPB x = typeMismatch "Language" x + +instance ToJSONPB Language where + toJSONPB x _ = A.String . T.toUpper . T.pack $ show x + toEncodingPB x _ = E.text . T.toUpper . T.pack $ show x + +instance FromJSON Language where + parseJSON = parseJSONPB + +instance ToJSON Language where + toJSON = toAesonValue + toEncoding = toAesonEncoding From 498bd79f258a2f4429b6d40b4e7291dd355ee8a9 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Mar 2019 13:10:37 -0700 Subject: [PATCH 05/19] Start vertex ids at 1 --- src/Rendering/Graph.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs index 400ac8d99..18267c691 100644 --- a/src/Rendering/Graph.hs +++ b/src/Rendering/Graph.hs @@ -11,6 +11,7 @@ import Analysis.ConstructorName import Control.Effect import Control.Effect.Fresh import Control.Effect.Reader +import Control.Effect.State import Data.Diff import Data.Graph import Data.Location @@ -30,7 +31,11 @@ renderTreeGraph = simplify . runGraph . cata toTreeGraph runGraph :: ReaderC (Graph vertex) (FreshC VoidC) (Graph vertex) -> Graph vertex -runGraph = run . runFresh . runReader mempty +runGraph = run . runFresh' . runReader mempty + where + -- NB: custom runFresh so that we count starting at 1 in order to avoid + -- default values for proto encoding. + runFresh' = evalState 1 . runFreshC -- | GraphViz styling for terms termStyle :: (IsString string, Monoid string) => String -> Style TermVertex string From c5eb774208db6423dd7d19b477dbee52f17bea1f Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Mar 2019 13:11:19 -0700 Subject: [PATCH 06/19] Use int32 so we get json numbers --- proto/semantic/api/v1/code_analysis.proto | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/proto/semantic/api/v1/code_analysis.proto b/proto/semantic/api/v1/code_analysis.proto index 55d6dc625..764a51c0c 100644 --- a/proto/semantic/api/v1/code_analysis.proto +++ b/proto/semantic/api/v1/code_analysis.proto @@ -51,12 +51,12 @@ message ParseTreeFileGraph { } message TermEdge { - int64 source = 1; - int64 target = 2; + int32 source = 1; + int32 target = 2; } message TermVertex { - int64 vertex_id = 1; + int32 vertex_id = 1; string term = 2; Span span = 3; } @@ -112,12 +112,12 @@ message DiffTreeFileGraph { } message DiffTreeEdge { - int64 source = 1; - int64 target = 2; + int32 source = 1; + int32 target = 2; } message DiffTreeVertex { - int64 diff_vertex_id = 1; + int32 diff_vertex_id = 1; oneof diff_term { DeletedTerm deleted = 2; InsertedTerm inserted = 3; @@ -195,8 +195,8 @@ message Docstring { } message Position { - int64 line = 1; - int64 column = 2; + int32 line = 1; + int32 column = 2; } message Span { From 7b28712566da4eb2d311c6704a8b8fbac081b451 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Mar 2019 13:21:27 -0700 Subject: [PATCH 07/19] Try out Language as just a string --- proto/semantic/api/v1/code_analysis.proto | 25 +++-------- src/Semantic/Api.hs | 2 +- src/Semantic/Api/Bridge.hs | 54 +++++++++++----------- src/Semantic/Api/V1/CodeAnalysisPB.hs | 55 +++-------------------- 4 files changed, 38 insertions(+), 98 deletions(-) diff --git a/proto/semantic/api/v1/code_analysis.proto b/proto/semantic/api/v1/code_analysis.proto index 764a51c0c..11ff46940 100644 --- a/proto/semantic/api/v1/code_analysis.proto +++ b/proto/semantic/api/v1/code_analysis.proto @@ -44,7 +44,7 @@ message ParseTreeGraphResponse { message ParseTreeFileGraph { string path = 1; - Language language = 2; + string language = 2; repeated TermVertex vertices = 3; repeated TermEdge edges = 4; repeated ParseError errors = 5; @@ -75,7 +75,7 @@ message DiffTreeTOCResponse { message TOCSummaryFile { string path = 1; - Language language = 2; + string language = 2; repeated TOCSummaryChange changes = 3; repeated TOCSummaryError errors = 4; } @@ -105,7 +105,7 @@ message DiffTreeGraphResponse { message DiffTreeFileGraph { string path = 1; - Language language = 2; + string language = 2; repeated DiffTreeVertex vertices = 3; repeated DiffTreeEdge edges = 4; repeated ParseError errors = 5; @@ -149,25 +149,10 @@ message MergedTerm { Span after_span = 3; } -enum Language { - UNKNOWN = 0; - GO = 1; - HASKELL = 2; - JAVA = 3; - JAVASCRIPT = 4; - JSON = 5; - JSX = 6; - MARKDOWN = 7; - PYTHON = 8; - RUBY = 9; - TYPESCRIPT = 10; - PHP = 11; -} - message Blob { string content = 1; string path = 2; - Language language = 3; + string language = 3; } message BlobPair { @@ -177,7 +162,7 @@ message BlobPair { message File { string path = 1; - Language language = 2; + string language = 2; repeated Symbol symbols = 3; repeated ParseError errors = 4; } diff --git a/src/Semantic/Api.hs b/src/Semantic/Api.hs index a284654af..54d1861ee 100644 --- a/src/Semantic/Api.hs +++ b/src/Semantic/Api.hs @@ -11,4 +11,4 @@ import Semantic.Api.Diffs as DiffsAPI import Semantic.Api.Symbols as SymbolsAPI import Semantic.Api.Terms as TermsAPI import Semantic.Api.TOCSummaries as TOCSummariesAPI -import Semantic.Api.V1.CodeAnalysisPB as Types hiding (Language(..)) +import Semantic.Api.V1.CodeAnalysisPB as Types diff --git a/src/Semantic/Api/Bridge.hs b/src/Semantic/Api/Bridge.hs index dc5876058..2197fe8b6 100644 --- a/src/Semantic/Api/Bridge.hs +++ b/src/Semantic/Api/Bridge.hs @@ -63,37 +63,37 @@ instance APIConvert Legacy.Span Data.Span where toAPI Data.Span{..} = Legacy.Span (bridging #? spanStart) (bridging #? spanEnd) fromAPI Legacy.Span {..} = Data.Span <$> (start >>= preview bridging) <*> (end >>= preview bridging) -instance APIBridge API.Language Data.Language where +instance APIBridge T.Text Data.Language where bridging = iso apiLanguageToLanguage languageToApiLanguage where - languageToApiLanguage :: Data.Language -> API.Language + languageToApiLanguage :: Data.Language -> T.Text languageToApiLanguage = \case - Data.Unknown -> API.Unknown - Data.Go -> API.Go - Data.Haskell -> API.Haskell - Data.Java -> API.Java - Data.JavaScript -> API.Javascript - Data.JSON -> API.Json - Data.JSX -> API.Jsx - Data.Markdown -> API.Markdown - Data.Python -> API.Python - Data.Ruby -> API.Ruby - Data.TypeScript -> API.Typescript - Data.PHP -> API.Php + Data.Unknown -> "Unknown" + Data.Go -> "Go" + Data.Haskell -> "Haskell" + Data.Java -> "Java" + Data.JavaScript -> "JavaScript" + Data.JSON -> "JSON" + Data.JSX -> "JSX" + Data.Markdown -> "Markdown" + Data.Python -> "Python" + Data.Ruby -> "Ruby" + Data.TypeScript -> "TypeScript" + Data.PHP -> "PHP" - apiLanguageToLanguage :: API.Language -> Data.Language + apiLanguageToLanguage :: T.Text -> Data.Language apiLanguageToLanguage = \case - API.Unknown -> Data.Unknown - API.Go -> Data.Go - API.Haskell -> Data.Haskell - API.Java -> Data.Java - API.Javascript -> Data.JavaScript - API.Json -> Data.JSON - API.Jsx -> Data.JSX - API.Markdown -> Data.Markdown - API.Python -> Data.Python - API.Ruby -> Data.Ruby - API.Typescript -> Data.TypeScript - API.Php -> Data.PHP + "Go" -> Data.Go + "Haskell" -> Data.Haskell + "Java" -> Data.Java + "JavaScript" -> Data.JavaScript + "JSON" -> Data.JSON + "JSX" -> Data.JSX + "Markdown" -> Data.Markdown + "Python" -> Data.Python + "Ruby" -> Data.Ruby + "TypeScript" -> Data.TypeScript + "PHP" -> Data.PHP + _ -> Data.Unknown instance APIBridge API.Blob Data.Blob where bridging = iso apiBlobToBlob blobToApiBlob where diff --git a/src/Semantic/Api/V1/CodeAnalysisPB.hs b/src/Semantic/Api/V1/CodeAnalysisPB.hs index 1e364142b..e2d92af7f 100644 --- a/src/Semantic/Api/V1/CodeAnalysisPB.hs +++ b/src/Semantic/Api/V1/CodeAnalysisPB.hs @@ -213,7 +213,7 @@ instance Message ParseTreeGraphResponse where data ParseTreeFileGraph = ParseTreeFileGraph { path :: Text - , language :: Language + , language :: Text , vertices :: Vector TermVertex , edges :: Vector TermEdge , errors :: Vector ParseError @@ -465,7 +465,7 @@ instance Message DiffTreeTOCResponse where data TOCSummaryFile = TOCSummaryFile { path :: Text - , language :: Language + , language :: Text , changes :: Vector TOCSummaryChange , errors :: Vector TOCSummaryError } deriving stock (Eq, Ord, Show, Generic) @@ -647,7 +647,7 @@ instance Message DiffTreeGraphResponse where data DiffTreeFileGraph = DiffTreeFileGraph { path :: Text - , language :: Language + , language :: Text , vertices :: Vector DiffTreeVertex , edges :: Vector DiffTreeEdge , errors :: Vector ParseError @@ -1017,7 +1017,7 @@ instance Message MergedTerm where data Blob = Blob { content :: Text , path :: Text - , language :: Language + , language :: Text } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -1104,7 +1104,7 @@ instance Message BlobPair where data File = File { path :: Text - , language :: Language + , language :: Text , symbols :: Vector Symbol , errors :: Vector ParseError } deriving stock (Eq, Ord, Show, Generic) @@ -1359,48 +1359,3 @@ instance FromJSON ChangeType where instance ToJSON ChangeType where toJSON = toAesonValue toEncoding = toAesonEncoding - -data Language - = Unknown - | Go - | Haskell - | Java - | Javascript - | Json - | Jsx - | Markdown - | Python - | Ruby - | Typescript - | Php - deriving stock (Eq, Ord, Show, Enum, Bounded, Generic) - deriving anyclass (Named, MessageField, NFData) - deriving Primitive via PrimitiveEnum Language - -instance HasDefault Language where def = Unknown - -instance FromJSONPB Language where - parseJSONPB (JSONPB.String "UNKNOWN") = pure Unknown - parseJSONPB (JSONPB.String "GO") = pure Go - parseJSONPB (JSONPB.String "HASKELL") = pure Haskell - parseJSONPB (JSONPB.String "JAVA") = pure Java - parseJSONPB (JSONPB.String "JAVASCRIPT") = pure Javascript - parseJSONPB (JSONPB.String "JSON") = pure Json - parseJSONPB (JSONPB.String "JSX") = pure Jsx - parseJSONPB (JSONPB.String "MARKDOWN") = pure Markdown - parseJSONPB (JSONPB.String "PYTHON") = pure Python - parseJSONPB (JSONPB.String "RUBY") = pure Ruby - parseJSONPB (JSONPB.String "TYPESCRIPT") = pure Typescript - parseJSONPB (JSONPB.String "PHP") = pure Php - parseJSONPB x = typeMismatch "Language" x - -instance ToJSONPB Language where - toJSONPB x _ = A.String . T.toUpper . T.pack $ show x - toEncodingPB x _ = E.text . T.toUpper . T.pack $ show x - -instance FromJSON Language where - parseJSON = parseJSONPB - -instance ToJSON Language where - toJSON = toAesonValue - toEncoding = toAesonEncoding From 2aa8b9fd858821ea23767559f43046fa27a63fca Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Mar 2019 13:31:47 -0700 Subject: [PATCH 08/19] Generated code cleanup --- src/Semantic/Api/V1/CodeAnalysisPB.hs | 116 +++++++++++++------------- 1 file changed, 58 insertions(+), 58 deletions(-) diff --git a/src/Semantic/Api/V1/CodeAnalysisPB.hs b/src/Semantic/Api/V1/CodeAnalysisPB.hs index e2d92af7f..a35941c77 100644 --- a/src/Semantic/Api/V1/CodeAnalysisPB.hs +++ b/src/Semantic/Api/V1/CodeAnalysisPB.hs @@ -28,11 +28,11 @@ instance FromJSONPB PingRequest where <$> obj .: "service" instance ToJSONPB PingRequest where - toJSONPB PingRequest{..} = object $ + toJSONPB PingRequest{..} = object [ "service" .= service ] - toEncodingPB PingRequest{..} = pairs $ + toEncodingPB PingRequest{..} = pairs [ "service" .= service ] @@ -69,14 +69,14 @@ instance FromJSONPB PingResponse where <*> obj .: "sha" instance ToJSONPB PingResponse where - toJSONPB PingResponse{..} = object $ + toJSONPB PingResponse{..} = object [ "status" .= status , "hostname" .= hostname , "timestamp" .= timestamp , "sha" .= sha ] - toEncodingPB PingResponse{..} = pairs $ + toEncodingPB PingResponse{..} = pairs [ "status" .= status , "hostname" .= hostname @@ -116,11 +116,11 @@ instance FromJSONPB ParseTreeRequest where <$> obj .: "blobs" instance ToJSONPB ParseTreeRequest where - toJSONPB ParseTreeRequest{..} = object $ + toJSONPB ParseTreeRequest{..} = object [ "blobs" .= blobs ] - toEncodingPB ParseTreeRequest{..} = pairs $ + toEncodingPB ParseTreeRequest{..} = pairs [ "blobs" .= blobs ] @@ -151,11 +151,11 @@ instance FromJSONPB ParseTreeSymbolResponse where <$> obj .: "files" instance ToJSONPB ParseTreeSymbolResponse where - toJSONPB ParseTreeSymbolResponse{..} = object $ + toJSONPB ParseTreeSymbolResponse{..} = object [ "files" .= files ] - toEncodingPB ParseTreeSymbolResponse{..} = pairs $ + toEncodingPB ParseTreeSymbolResponse{..} = pairs [ "files" .= files ] @@ -186,11 +186,11 @@ instance FromJSONPB ParseTreeGraphResponse where <$> obj .: "files" instance ToJSONPB ParseTreeGraphResponse where - toJSONPB ParseTreeGraphResponse{..} = object $ + toJSONPB ParseTreeGraphResponse{..} = object [ "files" .= files ] - toEncodingPB ParseTreeGraphResponse{..} = pairs $ + toEncodingPB ParseTreeGraphResponse{..} = pairs [ "files" .= files ] @@ -229,7 +229,7 @@ instance FromJSONPB ParseTreeFileGraph where <*> obj .: "errors" instance ToJSONPB ParseTreeFileGraph where - toJSONPB ParseTreeFileGraph{..} = object $ + toJSONPB ParseTreeFileGraph{..} = object [ "path" .= path , "language" .= language @@ -237,7 +237,7 @@ instance ToJSONPB ParseTreeFileGraph where , "edges" .= edges , "errors" .= errors ] - toEncodingPB ParseTreeFileGraph{..} = pairs $ + toEncodingPB ParseTreeFileGraph{..} = pairs [ "path" .= path , "language" .= language @@ -282,12 +282,12 @@ instance FromJSONPB TermEdge where <*> obj .: "target" instance ToJSONPB TermEdge where - toJSONPB TermEdge{..} = object $ + toJSONPB TermEdge{..} = object [ "source" .= source , "target" .= target ] - toEncodingPB TermEdge{..} = pairs $ + toEncodingPB TermEdge{..} = pairs [ "source" .= source , "target" .= target @@ -325,13 +325,13 @@ instance FromJSONPB TermVertex where <*> obj .: "span" instance ToJSONPB TermVertex where - toJSONPB TermVertex{..} = object $ + toJSONPB TermVertex{..} = object [ "vertexId" .= vertexId , "term" .= term , "span" .= span ] - toEncodingPB TermVertex{..} = pairs $ + toEncodingPB TermVertex{..} = pairs [ "vertexId" .= vertexId , "term" .= term @@ -368,11 +368,11 @@ instance FromJSONPB ParseError where <$> obj .: "error" instance ToJSONPB ParseError where - toJSONPB ParseError{..} = object $ + toJSONPB ParseError{..} = object [ "error" .= error ] - toEncodingPB ParseError{..} = pairs $ + toEncodingPB ParseError{..} = pairs [ "error" .= error ] @@ -403,11 +403,11 @@ instance FromJSONPB DiffTreeRequest where <$> obj .: "blobs" instance ToJSONPB DiffTreeRequest where - toJSONPB DiffTreeRequest{..} = object $ + toJSONPB DiffTreeRequest{..} = object [ "blobs" .= blobs ] - toEncodingPB DiffTreeRequest{..} = pairs $ + toEncodingPB DiffTreeRequest{..} = pairs [ "blobs" .= blobs ] @@ -438,11 +438,11 @@ instance FromJSONPB DiffTreeTOCResponse where <$> obj .: "files" instance ToJSONPB DiffTreeTOCResponse where - toJSONPB DiffTreeTOCResponse{..} = object $ + toJSONPB DiffTreeTOCResponse{..} = object [ "files" .= files ] - toEncodingPB DiffTreeTOCResponse{..} = pairs $ + toEncodingPB DiffTreeTOCResponse{..} = pairs [ "files" .= files ] @@ -479,14 +479,14 @@ instance FromJSONPB TOCSummaryFile where <*> obj .: "errors" instance ToJSONPB TOCSummaryFile where - toJSONPB TOCSummaryFile{..} = object $ + toJSONPB TOCSummaryFile{..} = object [ "path" .= path , "language" .= language , "changes" .= changes , "errors" .= errors ] - toEncodingPB TOCSummaryFile{..} = pairs $ + toEncodingPB TOCSummaryFile{..} = pairs [ "path" .= path , "language" .= language @@ -532,14 +532,14 @@ instance FromJSONPB TOCSummaryChange where <*> obj .: "changeType" instance ToJSONPB TOCSummaryChange where - toJSONPB TOCSummaryChange{..} = object $ + toJSONPB TOCSummaryChange{..} = object [ "category" .= category , "term" .= term , "span" .= span , "changeType" .= changeType ] - toEncodingPB TOCSummaryChange{..} = pairs $ + toEncodingPB TOCSummaryChange{..} = pairs [ "category" .= category , "term" .= term @@ -581,12 +581,12 @@ instance FromJSONPB TOCSummaryError where <*> obj .: "span" instance ToJSONPB TOCSummaryError where - toJSONPB TOCSummaryError{..} = object $ + toJSONPB TOCSummaryError{..} = object [ "error" .= error , "span" .= span ] - toEncodingPB TOCSummaryError{..} = pairs $ + toEncodingPB TOCSummaryError{..} = pairs [ "error" .= error , "span" .= span @@ -620,11 +620,11 @@ instance FromJSONPB DiffTreeGraphResponse where <$> obj .: "files" instance ToJSONPB DiffTreeGraphResponse where - toJSONPB DiffTreeGraphResponse{..} = object $ + toJSONPB DiffTreeGraphResponse{..} = object [ "files" .= files ] - toEncodingPB DiffTreeGraphResponse{..} = pairs $ + toEncodingPB DiffTreeGraphResponse{..} = pairs [ "files" .= files ] @@ -663,7 +663,7 @@ instance FromJSONPB DiffTreeFileGraph where <*> obj .: "errors" instance ToJSONPB DiffTreeFileGraph where - toJSONPB DiffTreeFileGraph{..} = object $ + toJSONPB DiffTreeFileGraph{..} = object [ "path" .= path , "language" .= language @@ -671,7 +671,7 @@ instance ToJSONPB DiffTreeFileGraph where , "edges" .= edges , "errors" .= errors ] - toEncodingPB DiffTreeFileGraph{..} = pairs $ + toEncodingPB DiffTreeFileGraph{..} = pairs [ "path" .= path , "language" .= language @@ -716,12 +716,12 @@ instance FromJSONPB DiffTreeEdge where <*> obj .: "target" instance ToJSONPB DiffTreeEdge where - toJSONPB DiffTreeEdge{..} = object $ + toJSONPB DiffTreeEdge{..} = object [ "source" .= source , "target" .= target ] - toEncodingPB DiffTreeEdge{..} = pairs $ + toEncodingPB DiffTreeEdge{..} = pairs [ "source" .= source , "target" .= target @@ -791,12 +791,12 @@ instance FromJSONPB DiffTreeVertex where <*> obj .: "diffTerm" instance ToJSONPB DiffTreeVertex where - toJSONPB DiffTreeVertex{..} = object $ + toJSONPB DiffTreeVertex{..} = object [ "diffVertexId" .= diffVertexId , "diffTerm" .= diffTerm ] - toEncodingPB DiffTreeVertex{..} = pairs $ + toEncodingPB DiffTreeVertex{..} = pairs [ "diffVertexId" .= diffVertexId , "diffTerm" .= diffTerm @@ -844,12 +844,12 @@ instance FromJSONPB DeletedTerm where <*> obj .: "span" instance ToJSONPB DeletedTerm where - toJSONPB DeletedTerm{..} = object $ + toJSONPB DeletedTerm{..} = object [ "term" .= term , "span" .= span ] - toEncodingPB DeletedTerm{..} = pairs $ + toEncodingPB DeletedTerm{..} = pairs [ "term" .= term , "span" .= span @@ -885,12 +885,12 @@ instance FromJSONPB InsertedTerm where <*> obj .: "span" instance ToJSONPB InsertedTerm where - toJSONPB InsertedTerm{..} = object $ + toJSONPB InsertedTerm{..} = object [ "term" .= term , "span" .= span ] - toEncodingPB InsertedTerm{..} = pairs $ + toEncodingPB InsertedTerm{..} = pairs [ "term" .= term , "span" .= span @@ -930,14 +930,14 @@ instance FromJSONPB ReplacedTerm where <*> obj .: "afterSpan" instance ToJSONPB ReplacedTerm where - toJSONPB ReplacedTerm{..} = object $ + toJSONPB ReplacedTerm{..} = object [ "beforeTerm" .= beforeTerm , "beforeSpan" .= beforeSpan , "afterTerm" .= afterTerm , "afterSpan" .= afterSpan ] - toEncodingPB ReplacedTerm{..} = pairs $ + toEncodingPB ReplacedTerm{..} = pairs [ "beforeTerm" .= beforeTerm , "beforeSpan" .= beforeSpan @@ -981,13 +981,13 @@ instance FromJSONPB MergedTerm where <*> obj .: "afterSpan" instance ToJSONPB MergedTerm where - toJSONPB MergedTerm{..} = object $ + toJSONPB MergedTerm{..} = object [ "term" .= term , "beforeSpan" .= beforeSpan , "afterSpan" .= afterSpan ] - toEncodingPB MergedTerm{..} = pairs $ + toEncodingPB MergedTerm{..} = pairs [ "term" .= term , "beforeSpan" .= beforeSpan @@ -1028,13 +1028,13 @@ instance FromJSONPB Blob where <*> obj .: "language" instance ToJSONPB Blob where - toJSONPB Blob{..} = object $ + toJSONPB Blob{..} = object [ "content" .= content , "path" .= path , "language" .= language ] - toEncodingPB Blob{..} = pairs $ + toEncodingPB Blob{..} = pairs [ "content" .= content , "path" .= path @@ -1073,12 +1073,12 @@ instance FromJSONPB BlobPair where <*> obj .: "after" instance ToJSONPB BlobPair where - toJSONPB BlobPair{..} = object $ + toJSONPB BlobPair{..} = object [ "before" .= before , "after" .= after ] - toEncodingPB BlobPair{..} = pairs $ + toEncodingPB BlobPair{..} = pairs [ "before" .= before , "after" .= after @@ -1118,14 +1118,14 @@ instance FromJSONPB File where <*> obj .: "errors" instance ToJSONPB File where - toJSONPB File{..} = object $ + toJSONPB File{..} = object [ "path" .= path , "language" .= language , "symbols" .= symbols , "errors" .= errors ] - toEncodingPB File{..} = pairs $ + toEncodingPB File{..} = pairs [ "path" .= path , "language" .= language @@ -1173,7 +1173,7 @@ instance FromJSONPB Symbol where <*> obj .: "docs" instance ToJSONPB Symbol where - toJSONPB Symbol{..} = object $ + toJSONPB Symbol{..} = object [ "symbol" .= symbol , "kind" .= kind @@ -1181,7 +1181,7 @@ instance ToJSONPB Symbol where , "span" .= span , "docs" .= docs ] - toEncodingPB Symbol{..} = pairs $ + toEncodingPB Symbol{..} = pairs [ "symbol" .= symbol , "kind" .= kind @@ -1224,11 +1224,11 @@ instance FromJSONPB Docstring where <$> obj .: "docstring" instance ToJSONPB Docstring where - toJSONPB Docstring{..} = object $ + toJSONPB Docstring{..} = object [ "docstring" .= docstring ] - toEncodingPB Docstring{..} = pairs $ + toEncodingPB Docstring{..} = pairs [ "docstring" .= docstring ] @@ -1261,12 +1261,12 @@ instance FromJSONPB Position where <*> obj .: "column" instance ToJSONPB Position where - toJSONPB Position{..} = object $ + toJSONPB Position{..} = object [ "line" .= line , "column" .= column ] - toEncodingPB Position{..} = pairs $ + toEncodingPB Position{..} = pairs [ "line" .= line , "column" .= column @@ -1302,12 +1302,12 @@ instance FromJSONPB Span where <*> obj .: "end" instance ToJSONPB Span where - toJSONPB Span{..} = object $ + toJSONPB Span{..} = object [ "start" .= start , "end" .= end ] - toEncodingPB Span{..} = pairs $ + toEncodingPB Span{..} = pairs [ "start" .= start , "end" .= end From 4094e29af0c44c985c219c1d5783cc90252db0db Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Mar 2019 13:40:58 -0700 Subject: [PATCH 09/19] More linting cleanup --- src/Semantic/Api/V1/CodeAnalysisPB.hs | 30 +++++++++++++-------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/src/Semantic/Api/V1/CodeAnalysisPB.hs b/src/Semantic/Api/V1/CodeAnalysisPB.hs index a35941c77..4055ded71 100644 --- a/src/Semantic/Api/V1/CodeAnalysisPB.hs +++ b/src/Semantic/Api/V1/CodeAnalysisPB.hs @@ -314,7 +314,7 @@ instance Message TermEdge where data TermVertex = TermVertex { vertexId :: Int32 , term :: Text - , span :: (Maybe Span) + , span :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -519,7 +519,7 @@ instance Message TOCSummaryFile where data TOCSummaryChange = TOCSummaryChange { category :: Text , term :: Text - , span :: (Maybe Span) + , span :: Maybe Span , changeType :: ChangeType } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -571,7 +571,7 @@ instance Message TOCSummaryChange where data TOCSummaryError = TOCSummaryError { error :: Text - , span :: (Maybe Span) + , span :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -834,7 +834,7 @@ instance Message DiffTreeVertex where data DeletedTerm = DeletedTerm { term :: Text - , span :: (Maybe Span) + , span :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -875,7 +875,7 @@ instance Message DeletedTerm where data InsertedTerm = InsertedTerm { term :: Text - , span :: (Maybe Span) + , span :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -916,9 +916,9 @@ instance Message InsertedTerm where data ReplacedTerm = ReplacedTerm { beforeTerm :: Text - , beforeSpan :: (Maybe Span) + , beforeSpan :: Maybe Span , afterTerm :: Text - , afterSpan :: (Maybe Span) + , afterSpan :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -969,8 +969,8 @@ instance Message ReplacedTerm where data MergedTerm = MergedTerm { term :: Text - , beforeSpan :: (Maybe Span) - , afterSpan :: (Maybe Span) + , beforeSpan :: Maybe Span + , afterSpan :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -1062,8 +1062,8 @@ instance Message Blob where dotProto = undefined data BlobPair = BlobPair - { before :: (Maybe Blob) - , after :: (Maybe Blob) + { before :: Maybe Blob + , after :: Maybe Blob } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -1159,8 +1159,8 @@ data Symbol = Symbol { symbol :: Text , kind :: Text , line :: Text - , span :: (Maybe Span) - , docs :: (Maybe Docstring) + , span :: Maybe Span + , docs :: Maybe Docstring } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) @@ -1291,8 +1291,8 @@ instance Message Position where dotProto = undefined data Span = Span - { start :: (Maybe Position) - , end :: (Maybe Position) + { start :: Maybe Position + , end :: Maybe Position } deriving stock (Eq, Ord, Show, Generic) deriving anyclass (Named, NFData) From 3001cf1c0f763128160585eec7fdeb85506e2ff4 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Mar 2019 14:35:47 -0700 Subject: [PATCH 10/19] Clean up, nothing to hide now --- src/Semantic/Api/Diffs.hs | 2 +- src/Semantic/Api/Terms.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs index 9b8d8dd29..ecec3bece 100644 --- a/src/Semantic/Api/Diffs.hs +++ b/src/Semantic/Api/Diffs.hs @@ -35,7 +35,7 @@ import Rendering.Graph import Rendering.JSON hiding (JSON) import qualified Rendering.JSON import Semantic.Api.Bridge -import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, BlobPair, Language(..)) +import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, BlobPair) import Semantic.Task as Task import Semantic.Telemetry as Stat import Serializing.Format hiding (JSON) diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs index 1f38f7add..c95cd762b 100644 --- a/src/Semantic/Api/Terms.hs +++ b/src/Semantic/Api/Terms.hs @@ -38,7 +38,7 @@ import Rendering.Graph import Rendering.JSON hiding (JSON) import qualified Rendering.JSON import Semantic.Api.Bridge -import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, Language (..)) +import Semantic.Api.V1.CodeAnalysisPB hiding (Blob) import Semantic.Task import Serializing.Format hiding (JSON) import qualified Serializing.Format as Format From 1a4d489b1da4cca174141800abe0fda10511982e Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Mon, 11 Mar 2019 15:32:15 -0700 Subject: [PATCH 11/19] Fix up tests, new CLI output --- test/Rendering/TOC/Spec.hs | 8 ++++---- test/fixtures/cli/diff-tree.toc.json | 11 +++++------ test/fixtures/cli/parse-tree.symbols.json | 14 ++++++-------- 3 files changed, 15 insertions(+), 18 deletions(-) diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 4f014f6d4..d054d24e7 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -149,22 +149,22 @@ spec = parallel $ do it "produces JSON output" $ do blobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.B.rb") output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs]) - runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.B.rb\",\"changes\":[{\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":4}},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"Added\"},{\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":6,\"column\":4}},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"Modified\"},{\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":5,\"column\":4}},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"Removed\"}],\"language\":\"Ruby\",\"errors\":[]}]}\n" :: ByteString) + runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.B.rb\",\"language\":\"Ruby\",\"changes\":[{\"category\":\"Method\",\"term\":\"self.foo\",\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":4}},\"changeType\":\"ADDED\"},{\"category\":\"Method\",\"term\":\"bar\",\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":6,\"column\":4}},\"changeType\":\"MODIFIED\"},{\"category\":\"Method\",\"term\":\"baz\",\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":5,\"column\":4}},\"changeType\":\"REMOVED\"}]}]}\n" :: ByteString) it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.X.rb") output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs]) - runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\",\"changes\":[{\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":4}},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"Removed\"},{\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":5,\"column\":4}},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"Removed\"}],\"language\":\"Ruby\",\"errors\":[{\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":3}},\"error\":\"expected end of input nodes, but got ParseError\"}]}]}\n" :: ByteString) + runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\",\"language\":\"Ruby\",\"changes\":[{\"category\":\"Method\",\"term\":\"bar\",\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":4}},\"changeType\":\"REMOVED\"},{\"category\":\"Method\",\"term\":\"baz\",\"span\":{\"start\":{\"line\":4,\"column\":1},\"end\":{\"line\":5,\"column\":4}},\"changeType\":\"REMOVED\"}],\"errors\":[{\"error\":\"expected end of input nodes, but got ParseError\",\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":2,\"column\":3}}}]}]}\n" :: ByteString) it "ignores anonymous functions" $ do blobs <- blobsForPaths (Both "ruby/toc/lambda.A.rb" "ruby/toc/lambda.B.rb") output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs]) - runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/lambda.A.rb -> test/fixtures/ruby/toc/lambda.B.rb\",\"changes\":[],\"language\":\"Ruby\",\"errors\":[]}]}\n" :: ByteString) + runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/ruby/toc/lambda.A.rb -> test/fixtures/ruby/toc/lambda.B.rb\",\"language\":\"Ruby\"}]}\n" :: ByteString) it "summarizes Markdown headings" $ do blobs <- blobsForPaths (Both "markdown/toc/headings.A.md" "markdown/toc/headings.B.md") output <- runTaskOrDie (diffSummaryBuilder Format.JSON [blobs]) - runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/markdown/toc/headings.A.md -> test/fixtures/markdown/toc/headings.B.md\",\"changes\":[{\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":3,\"column\":16}},\"category\":\"Heading 1\",\"term\":\"Introduction\",\"changeType\":\"Removed\"},{\"span\":{\"start\":{\"line\":5,\"column\":1},\"end\":{\"line\":7,\"column\":4}},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"Modified\"},{\"span\":{\"start\":{\"line\":9,\"column\":1},\"end\":{\"line\":11,\"column\":10}},\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"changeType\":\"Added\"},{\"span\":{\"start\":{\"line\":13,\"column\":1},\"end\":{\"line\":14,\"column\":4}},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"Added\"}],\"language\":\"Markdown\",\"errors\":[]}]}\n" :: ByteString) + runBuilder output `shouldBe` ("{\"files\":[{\"path\":\"test/fixtures/markdown/toc/headings.A.md -> test/fixtures/markdown/toc/headings.B.md\",\"language\":\"Markdown\",\"changes\":[{\"category\":\"Heading 1\",\"term\":\"Introduction\",\"span\":{\"start\":{\"line\":1,\"column\":1},\"end\":{\"line\":3,\"column\":16}},\"changeType\":\"REMOVED\"},{\"category\":\"Heading 2\",\"term\":\"Two\",\"span\":{\"start\":{\"line\":5,\"column\":1},\"end\":{\"line\":7,\"column\":4}},\"changeType\":\"MODIFIED\"},{\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"span\":{\"start\":{\"line\":9,\"column\":1},\"end\":{\"line\":11,\"column\":10}},\"changeType\":\"ADDED\"},{\"category\":\"Heading 1\",\"term\":\"Final\",\"span\":{\"start\":{\"line\":13,\"column\":1},\"end\":{\"line\":14,\"column\":4}},\"changeType\":\"ADDED\"}]}]}\n" :: ByteString) type Diff' = Diff ListableSyntax (Maybe Declaration) (Maybe Declaration) diff --git a/test/fixtures/cli/diff-tree.toc.json b/test/fixtures/cli/diff-tree.toc.json index 8a25277e5..d23542239 100644 --- a/test/fixtures/cli/diff-tree.toc.json +++ b/test/fixtures/cli/diff-tree.toc.json @@ -2,8 +2,11 @@ "files": [ { "path": "test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb", + "language": "Ruby", "changes": [ { + "category": "Method", + "term": "bar", "span": { "start": @@ -17,11 +20,7 @@ "column": 4 } }, - "category": "Method", - "term": "bar", - "changeType": "Modified" - }], - "language": "Ruby", - "errors": [] + "changeType": "MODIFIED" + }] }] } diff --git a/test/fixtures/cli/parse-tree.symbols.json b/test/fixtures/cli/parse-tree.symbols.json index 5f58f20f7..eb9282009 100644 --- a/test/fixtures/cli/parse-tree.symbols.json +++ b/test/fixtures/cli/parse-tree.symbols.json @@ -2,8 +2,12 @@ "files": [ { "path": "test/fixtures/ruby/corpus/method-declaration.A.rb", + "language": "Ruby", "symbols": [ { + "symbol": "foo", + "kind": "Method", + "line": "def foo", "span": { "start": @@ -16,13 +20,7 @@ "line": 2, "column": 4 } - }, - "kind": "Method", - "symbol": "foo", - "line": "def foo", - "docs": null - }], - "language": "Ruby", - "errors": [] + } + }] }] } From d16a56c6642fe786c83d293a152ffa556b727185 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 12 Mar 2019 09:56:01 -0700 Subject: [PATCH 12/19] Revert "Update ScopeGraph.Kind naming to avoid confusion" This reverts commit 6ccdc3a70c984819d457412e113b7dcfce0e17f8. --- src/Control/Abstract/Heap.hs | 2 +- src/Control/Abstract/Primitive.hs | 4 +-- src/Data/Abstract/Evaluatable.hs | 4 +-- src/Data/Abstract/ScopeGraph.hs | 27 ++------------------ src/Data/Syntax.hs | 2 +- src/Data/Syntax/Declaration.hs | 20 +++++++-------- src/Data/Syntax/Expression.hs | 4 +-- src/Data/Syntax/Statement.hs | 2 +- src/Language/Go/Syntax.hs | 2 +- src/Language/PHP/Syntax.hs | 4 +-- src/Language/Python/Syntax.hs | 8 +++--- src/Language/Ruby/Syntax.hs | 8 +++--- src/Language/TypeScript/Syntax/Import.hs | 10 ++++---- src/Language/TypeScript/Syntax/JSX.hs | 2 +- src/Language/TypeScript/Syntax/JavaScript.hs | 2 +- src/Language/TypeScript/Syntax/TypeScript.hs | 4 +-- src/Language/TypeScript/Syntax/Types.hs | 2 +- 17 files changed, 42 insertions(+), 65 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index e96f360c9..1ba00b4cb 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -181,7 +181,7 @@ define :: ( HasCallStack -> Evaluator term address value m () define declaration rel accessControl def = withCurrentCallStack callStack $ do -- TODO: This span is still wrong. - declare declaration rel accessControl emptySpan UnknownKind Nothing + declare declaration rel accessControl emptySpan Unknown Nothing slot <- lookupSlot declaration value <- def assign slot value diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index c47118b6e..4880c787f 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -43,11 +43,11 @@ defineBuiltIn declaration rel accessControl value = withCurrentCallStack callSta let lexicalEdges = Map.singleton Lexical [ currentScope' ] associatedScope <- newPreludeScope lexicalEdges -- TODO: This span is still wrong. - declare declaration rel accessControl emptySpan ScopeGraph.UnknownKind (Just associatedScope) + declare declaration rel accessControl emptySpan ScopeGraph.Unknown (Just associatedScope) param <- gensym withScope associatedScope $ do - declare (Declaration param) rel accessControl emptySpan ScopeGraph.UnknownKind Nothing + declare (Declaration param) rel accessControl emptySpan ScopeGraph.Unknown Nothing slot <- lookupSlot declaration value <- builtIn associatedScope value diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index d46629845..f0ce97e3d 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -30,7 +30,7 @@ import Data.Abstract.Declarations as X import Data.Abstract.FreeVariables as X import Data.Abstract.Module import Data.Abstract.Name as X -import qualified Data.Abstract.ScopeGraph as ScopeGraph +import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Abstract.ScopeGraph (Relation(..)) import Data.Abstract.AccessControls.Class as X import Data.Language @@ -192,7 +192,7 @@ defineSelf :: ( Carrier sig m => Evaluator term address value m () defineSelf = do let self = Declaration X.__self - declare self Default Public emptySpan ScopeGraph.UnknownKind Nothing + declare self Default Public emptySpan ScopeGraph.Unknown Nothing slot <- lookupSlot self assign slot =<< object =<< currentFrame diff --git a/src/Data/Abstract/ScopeGraph.hs b/src/Data/Abstract/ScopeGraph.hs index ee72a7c4a..950a14d12 100644 --- a/src/Data/Abstract/ScopeGraph.hs +++ b/src/Data/Abstract/ScopeGraph.hs @@ -119,34 +119,11 @@ instance HasSpan ReferenceInfo where span = lens refSpan (\r s -> r { refSpan = s }) {-# INLINE span #-} -data Kind = AbstractClassKind - | AssignmentKind - | CallKind - | ClassKind - | DefaultExportKind - | FunctionKind - | IdentifierKind - | LetKind - | MemberAccessKind - | MethodKind - | ModuleKind - | NewKind - | ParameterKind - | PublicFieldKind - | QualifiedAliasedImportKind - | QualifiedExportKind - | QualifiedImportKind - | RequiredParameterKind - | ThisKind - | TypeAliasKind - | TypeIdentifierKind - | UnknownKind - | UnqualifiedImportKind - | VariableDeclarationKind +data Kind = TypeAlias | Class | Method | QualifiedAliasedImport | QualifiedExport | DefaultExport | Module | AbstractClass | Let | QualifiedImport | UnqualifiedImport | Assignment | RequiredParameter | PublicField | VariableDeclaration | Function | Parameter | Unknown | Identifier | TypeIdentifier | This | New | MemberAccess | Call deriving (Eq, Show, Ord, Generic, NFData) instance Lower Kind where - lowerBound = UnknownKind + lowerBound = Unknown -- Offsets and frame addresses in the heap should be addresses? data Scope address = diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index cb8b94306..3aecf713a 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -126,7 +126,7 @@ instance Evaluatable Identifier where eval eval ref' term@(Identifier name) = do -- TODO: Set the span up correctly in ref so we can move the `reference` call there. span <- ask @Span - reference (Reference name) span ScopeGraph.IdentifierKind (Declaration name) + reference (Reference name) span ScopeGraph.Identifier (Declaration name) deref =<< ref eval ref' term ref _ _ (Identifier name) = lookupSlot (Declaration name) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index b9dce71d3..257a50de0 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -30,13 +30,13 @@ instance Evaluatable Function where eval _ _ Function{..} = do name <- maybeM (throwNoNameError functionName) (declaredName functionName) span <- ask @Span - associatedScope <- declareFunction name ScopeGraph.Public span ScopeGraph.FunctionKind + associatedScope <- declareFunction name ScopeGraph.Public span ScopeGraph.Function params <- withScope associatedScope . for functionParameters $ \paramNode -> do param <- maybeM (throwNoNameError paramNode) (declaredName paramNode) let paramSpan = getSpan paramNode - param <$ declare (Declaration param) Default ScopeGraph.Public paramSpan ScopeGraph.ParameterKind Nothing + param <$ declare (Declaration param) Default ScopeGraph.Public paramSpan ScopeGraph.Parameter Nothing addr <- lookupSlot (Declaration name) v <- function name params functionBody associatedScope @@ -94,14 +94,14 @@ instance Evaluatable Method where eval _ _ Method{..} = do name <- maybeM (throwNoNameError methodName) (declaredName methodName) span <- ask @Span - associatedScope <- declareFunction name methodAccessControl span ScopeGraph.MethodKind + associatedScope <- declareFunction name methodAccessControl span ScopeGraph.Method params <- withScope associatedScope $ do -- TODO: Should we give `self` a special Relation? - declare (Declaration __self) Prelude ScopeGraph.Public emptySpan ScopeGraph.UnknownKind Nothing + declare (Declaration __self) Prelude ScopeGraph.Public emptySpan ScopeGraph.Unknown Nothing for methodParameters $ \paramNode -> do param <- maybeM (throwNoNameError paramNode) (declaredName paramNode) - param <$ declare (Declaration param) Default ScopeGraph.Public span ScopeGraph.ParameterKind Nothing + param <$ declare (Declaration param) Default ScopeGraph.Public span ScopeGraph.Parameter Nothing addr <- lookupSlot (Declaration name) v <- function name params methodBody associatedScope @@ -146,7 +146,7 @@ instance Evaluatable RequiredParameter where eval _ _ RequiredParameter{..} = do name <- maybeM (throwNoNameError requiredParameter) (declaredName requiredParameter) span <- ask @Span - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.RequiredParameterKind Nothing + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.RequiredParameter Nothing unit @@ -172,7 +172,7 @@ instance Evaluatable VariableDeclaration where for_ decs $ \declaration -> do name <- maybeM (throwNoNameError declaration) (declaredName declaration) let declarationSpan = getSpan declaration - declare (Declaration name) Default ScopeGraph.Public declarationSpan ScopeGraph.VariableDeclarationKind Nothing + declare (Declaration name) Default ScopeGraph.Public declarationSpan ScopeGraph.VariableDeclaration Nothing eval declaration unit @@ -211,7 +211,7 @@ instance Evaluatable PublicFieldDefinition where span <- ask @Span propertyName <- maybeM (throwNoNameError publicFieldPropertyName) (declaredName publicFieldPropertyName) - declare (Declaration propertyName) Instance publicFieldAccessControl span ScopeGraph.PublicFieldKind Nothing + declare (Declaration propertyName) Instance publicFieldAccessControl span ScopeGraph.PublicField Nothing slot <- lookupSlot (Declaration propertyName) value <- eval publicFieldValue assign slot value @@ -253,7 +253,7 @@ instance Evaluatable Class where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.ClassKind (Just classScope) + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.Class (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) classFrame <- newFrame classScope frameEdges @@ -329,7 +329,7 @@ instance Evaluatable TypeAlias where span <- ask @Span assocScope <- associatedScope (Declaration kindName) -- TODO: Should we consider a special Relation for `TypeAlias`? - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.TypeAliasKind assocScope + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.TypeAlias assocScope slot <- lookupSlot (Declaration name) kindSlot <- lookupSlot (Declaration kindName) diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 18a579ea6..888143b3f 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -561,7 +561,7 @@ instance Evaluatable New where case maybeConstructor of Just slot -> do span <- ask @Span - reference (Reference constructorName) span ScopeGraph.NewKind (Declaration constructorName) + reference (Reference constructorName) span ScopeGraph.New (Declaration constructorName) constructor <- deref slot args <- traverse eval newArguments boundConstructor <- bindThis objectVal constructor @@ -596,7 +596,7 @@ instance Tokenize This where instance Evaluatable This where eval _ _ This = do span <- ask @Span - reference (Reference __self) span ScopeGraph.ThisKind (Declaration __self) + reference (Reference __self) span ScopeGraph.This (Declaration __self) deref =<< lookupSlot (Declaration __self) instance AccessControls1 This where diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 1a2768d1a..9477058e2 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -127,7 +127,7 @@ instance Evaluatable Let where assocScope <- associatedScope (Declaration valueName) _ <- withLexicalScopeAndFrame $ do - declare (Declaration name) Default Public letSpan ScopeGraph.LetKind assocScope + declare (Declaration name) Default Public letSpan ScopeGraph.Let assocScope letVal <- eval letValue slot <- lookupSlot (Declaration name) assign slot letVal diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index e489d94ea..781b905b0 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -78,7 +78,7 @@ instance Evaluatable QualifiedImport where alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) span <- ask @Span scopeAddress <- newScope mempty - declare (Declaration alias) Default Public span ScopeGraph.QualifiedImportKind (Just scopeAddress) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedImport (Just scopeAddress) aliasSlot <- lookupSlot (Declaration alias) withScope scopeAddress $ do diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 34a42ffdc..2054ce073 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -174,7 +174,7 @@ instance Evaluatable QualifiedName where eval _ _ (QualifiedName obj iden) = do name <- maybeM (throwNoNameError obj) (declaredName obj) let objSpan = getSpan obj - reference (Reference name) objSpan ScopeGraph.IdentifierKind (Declaration name) + reference (Reference name) objSpan ScopeGraph.Identifier (Declaration name) childScope <- associatedScope (Declaration name) propName <- maybeM (throwNoNameError iden) (declaredName iden) @@ -185,7 +185,7 @@ instance Evaluatable QualifiedName where frameAddress <- newFrame childScope (Map.singleton Lexical (Map.singleton currentScopeAddress currentFrameAddress)) withScopeAndFrame frameAddress $ do let propSpan = getSpan iden - reference (Reference propName) propSpan ScopeGraph.IdentifierKind (Declaration propName) + reference (Reference propName) propSpan ScopeGraph.Identifier (Declaration propName) slot <- lookupSlot (Declaration propName) deref slot Nothing -> diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index b41b3807d..eaa055226 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -133,7 +133,7 @@ instance Evaluatable Import where -- Add declaration of the alias name to the current scope (within our current module). aliasName <- maybeM (throwNoNameError aliasTerm) (declaredAlias aliasTerm) let aliasSpan = getSpan aliasTerm - declare (Declaration aliasName) Default Public aliasSpan ScopeGraph.UnqualifiedImportKind (Just importScope) + declare (Declaration aliasName) Default Public aliasSpan ScopeGraph.UnqualifiedImport (Just importScope) -- Retrieve the frame slot for the new declaration. aliasSlot <- lookupSlot (Declaration aliasName) assign aliasSlot =<< object aliasFrame @@ -172,7 +172,7 @@ instance Evaluatable Import where aliasValue <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) if aliasValue /= aliasName then do let aliasSpan = getSpan aliasTerm - insertImportReference (Reference aliasName) aliasSpan ScopeGraph.IdentifierKind (Declaration aliasValue) scopeAddress + insertImportReference (Reference aliasName) aliasSpan ScopeGraph.Identifier (Declaration aliasValue) scopeAddress else pure () @@ -198,7 +198,7 @@ instance Evaluatable QualifiedImport where go (((nameTerm, name), modulePath) : namesAndPaths) = do scopeAddress <- newScope mempty let nameSpan = getSpan nameTerm - declare (Declaration name) Default Public nameSpan ScopeGraph.QualifiedImportKind (Just scopeAddress) + declare (Declaration name) Default Public nameSpan ScopeGraph.QualifiedImport (Just scopeAddress) aliasSlot <- lookupSlot (Declaration name) -- a.b.c withScope scopeAddress $ @@ -231,7 +231,7 @@ instance Evaluatable QualifiedAliasedImport where span <- ask @Span scopeAddress <- newScope mempty alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) - declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImportKind (Just scopeAddress) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImport (Just scopeAddress) objFrame <- newFrame scopeAddress mempty val <- object objFrame aliasSlot <- lookupSlot (Declaration alias) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 85f0768cf..f11fb9988 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -78,7 +78,7 @@ instance Evaluatable Send where let callFunction = do span <- ask @Span - reference (Reference sel) span ScopeGraph.CallKind (Declaration sel) + reference (Reference sel) span ScopeGraph.Call (Declaration sel) func <- deref =<< lookupSlot (Declaration sel) args <- traverse eval sendArgs boundFunc <- bindThis lhsValue func @@ -210,7 +210,7 @@ instance Evaluatable Class where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.ClassKind (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.Class (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) childFrame <- newFrame classScope frameEdges @@ -260,7 +260,7 @@ instance Evaluatable Module where Nothing -> do let edges = Map.singleton Lexical [ currentScope' ] classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.ModuleKind (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.Module (Just classScope) currentFrame' <- currentFrame let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame') @@ -326,7 +326,7 @@ instance Evaluatable Assignment where lhsName <- maybeM (throwNoNameError assignmentTarget) (declaredName assignmentTarget) maybeSlot <- maybeLookupDeclaration (Declaration lhsName) assignmentSpan <- ask @Span - maybe (declare (Declaration lhsName) Default Public assignmentSpan ScopeGraph.AssignmentKind Nothing) (const (pure ())) maybeSlot + maybe (declare (Declaration lhsName) Default Public assignmentSpan ScopeGraph.Assignment Nothing) (const (pure ())) maybeSlot lhs <- ref assignmentTarget rhs <- eval assignmentValue diff --git a/src/Language/TypeScript/Syntax/Import.hs b/src/Language/TypeScript/Syntax/Import.hs index 46c0b9d88..ad07c520f 100644 --- a/src/Language/TypeScript/Syntax/Import.hs +++ b/src/Language/TypeScript/Syntax/Import.hs @@ -38,7 +38,7 @@ instance Evaluatable Import where for_ symbols $ \Alias{..} -> -- TODO: Need an easier way to get the span of an Alias. It's difficult because we no longer have a term. -- Even if we had one we'd have to evaluate it at the moment. - insertImportReference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) scopeAddress + insertImportReference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) scopeAddress -- Create edges from the current scope/frame to the import scope/frame. insertImportEdge scopeAddress @@ -60,7 +60,7 @@ instance Evaluatable QualifiedAliasedImport where aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap) alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) - declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImportKind (Just importScope) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImport (Just importScope) aliasSlot <- lookupSlot (Declaration alias) assign aliasSlot =<< object aliasFrame @@ -91,7 +91,7 @@ instance Evaluatable QualifiedExport where withScope exportScope . for_ exportSymbols $ \Alias{..} -> do -- TODO: Replace Alias in QualifedExport with terms and use a real span - reference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) + reference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) -- Create an export edge from a new scope to the qualifed export's scope. unit @@ -118,7 +118,7 @@ instance Evaluatable QualifiedExportFrom where withScopeAndFrame moduleFrame . for_ exportSymbols $ \Alias{..} -> do -- TODO: Replace Alias with terms in QualifiedExportFrom and use a real span below. - insertImportReference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) exportScope + insertImportReference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) exportScope insertExportEdge exportScope insertFrameLink ScopeGraph.Export (Map.singleton exportScope exportFrame) @@ -139,7 +139,7 @@ instance Evaluatable DefaultExport where withScopeAndFrame exportFrame $ do valueRef <- eval term let declaration = Declaration $ Name.name "__default" - declare declaration Default Public exportSpan ScopeGraph.DefaultExportKind Nothing + declare declaration Default Public exportSpan ScopeGraph.DefaultExport Nothing defaultSlot <- lookupSlot declaration assign defaultSlot valueRef diff --git a/src/Language/TypeScript/Syntax/JSX.hs b/src/Language/TypeScript/Syntax/JSX.hs index 299cc6da2..dd93c33f9 100644 --- a/src/Language/TypeScript/Syntax/JSX.hs +++ b/src/Language/TypeScript/Syntax/JSX.hs @@ -78,7 +78,7 @@ instance Evaluatable RequiredParameter where eval eval ref RequiredParameter{..} = do name <- maybeM (throwNoNameError requiredParameterSubject) (declaredName requiredParameterSubject) span <- ask @Span - declare (Declaration name) Default Public span ScopeGraph.RequiredParameterKind Nothing + declare (Declaration name) Default Public span ScopeGraph.RequiredParameter Nothing lhs <- ref requiredParameterSubject rhs <- eval requiredParameterValue diff --git a/src/Language/TypeScript/Syntax/JavaScript.hs b/src/Language/TypeScript/Syntax/JavaScript.hs index 29f195ddc..95d10e2c8 100644 --- a/src/Language/TypeScript/Syntax/JavaScript.hs +++ b/src/Language/TypeScript/Syntax/JavaScript.hs @@ -26,7 +26,7 @@ instance Evaluatable JavaScriptRequire where Just alias -> do span <- ask @Span importScope <- newScope (Map.singleton ScopeGraph.Import [ moduleScope ]) - declare (Declaration alias) Default Public span ScopeGraph.UnqualifiedImportKind (Just importScope) + declare (Declaration alias) Default Public span ScopeGraph.UnqualifiedImport (Just importScope) let scopeMap = Map.singleton moduleScope moduleFrame aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap) aliasSlot <- lookupSlot (Declaration alias) diff --git a/src/Language/TypeScript/Syntax/TypeScript.hs b/src/Language/TypeScript/Syntax/TypeScript.hs index 64a902918..272acbf4b 100644 --- a/src/Language/TypeScript/Syntax/TypeScript.hs +++ b/src/Language/TypeScript/Syntax/TypeScript.hs @@ -212,7 +212,7 @@ declareModule eval identifier statements = do Nothing -> do let edges = Map.singleton Lexical [ currentScope' ] childScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.ModuleKind (Just childScope) + declare (Declaration name) Default Public span ScopeGraph.Module (Just childScope) currentFrame' <- currentFrame let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame') @@ -274,7 +274,7 @@ instance Evaluatable AbstractClass where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.AbstractClassKind (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.AbstractClass (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) childFrame <- newFrame classScope frameEdges diff --git a/src/Language/TypeScript/Syntax/Types.hs b/src/Language/TypeScript/Syntax/Types.hs index 44a391027..93f2440c8 100644 --- a/src/Language/TypeScript/Syntax/Types.hs +++ b/src/Language/TypeScript/Syntax/Types.hs @@ -67,7 +67,7 @@ instance Evaluatable TypeIdentifier where eval _ _ TypeIdentifier{..} = do -- Add a reference to the type identifier in the current scope. span <- ask @Span - reference (Reference (Evaluatable.name contents)) span ScopeGraph.TypeIdentifierKind (Declaration (Evaluatable.name contents)) + reference (Reference (Evaluatable.name contents)) span ScopeGraph.TypeIdentifier (Declaration (Evaluatable.name contents)) unit data NestedTypeIdentifier a = NestedTypeIdentifier { left :: !a, right :: !a } From c6594f84c911d2cfefe735f7a0d27a59b652b3fd Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 12 Mar 2019 09:56:37 -0700 Subject: [PATCH 13/19] Revert "Update tests" This reverts commit 12368b2ad0ff58db794b80e0fa006841d7cacd5c. --- test/Control/Abstract/Evaluator/Spec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 054d5eec3..a3094b302 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -35,9 +35,9 @@ spec = parallel $ do let lexicalEdges = Map.singleton Lexical [ currentScope' ] x = SpecHelpers.name "x" associatedScope <- newScope lexicalEdges - declare (ScopeGraph.Declaration "identity") Default Public emptySpan ScopeGraph.FunctionKind (Just associatedScope) + declare (ScopeGraph.Declaration "identity") Default Public emptySpan ScopeGraph.Function (Just associatedScope) withScope associatedScope $ do - declare (Declaration x) Default Public emptySpan ScopeGraph.RequiredParameterKind Nothing + declare (Declaration x) Default Public emptySpan ScopeGraph.RequiredParameter Nothing identity <- function "identity" [ x ] (SpecEff (Heap.lookupSlot (ScopeGraph.Declaration (SpecHelpers.name "x")) >>= deref)) associatedScope val <- integer 123 From 29b774c22d83b98226ccb8123997efc5888add19 Mon Sep 17 00:00:00 2001 From: joshvera Date: Tue, 12 Mar 2019 18:41:20 -0400 Subject: [PATCH 14/19] WIP async effect --- src/Rendering/Graph.hs | 2 +- src/Reprinting/Translate.hs | 2 +- src/Tags/Tagging.hs | 2 +- vendor/fused-effects | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs index 400ac8d99..4fc9fe671 100644 --- a/src/Rendering/Graph.hs +++ b/src/Rendering/Graph.hs @@ -28,7 +28,7 @@ renderTreeGraph :: (Ord vertex, Recursive t, ToTreeGraph vertex (Base t)) => t - renderTreeGraph = simplify . runGraph . cata toTreeGraph runGraph :: ReaderC (Graph vertex) - (FreshC VoidC) (Graph vertex) + (FreshC PureC) (Graph vertex) -> Graph vertex runGraph = run . runFresh . runReader mempty diff --git a/src/Reprinting/Translate.hs b/src/Reprinting/Translate.hs index c5081c126..eb5208475 100644 --- a/src/Reprinting/Translate.hs +++ b/src/Reprinting/Translate.hs @@ -20,7 +20,7 @@ import qualified Data.Source as Source type Translator = StateC [Scope] - ( ErrorC TranslationError VoidC) + ( ErrorC TranslationError PureC) contextualizing :: ProcessT Translator Token Fragment contextualizing = repeatedly $ await >>= \case diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs index 0549a33a3..2cc205d4b 100644 --- a/src/Tags/Tagging.hs +++ b/src/Tags/Tagging.hs @@ -39,7 +39,7 @@ type ContextToken = (Text, Maybe Range) type Contextualizer = StateC [ContextToken] - ( ErrorC TranslationError VoidC) + ( ErrorC TranslationError PureC) contextualizing :: Blob -> Machine.ProcessT Contextualizer Token Tag contextualizing Blob{..} = repeatedly $ await >>= \case diff --git a/vendor/fused-effects b/vendor/fused-effects index 17b0a846a..25e669599 160000 --- a/vendor/fused-effects +++ b/vendor/fused-effects @@ -1 +1 @@ -Subproject commit 17b0a846aa50fd0dea157624c031a550d8edd469 +Subproject commit 25e66959978147b9ee1510ec3d90cd0045cfba54 From 98844eb3c2f0491066843d2f23babd2cd5b4d486 Mon Sep 17 00:00:00 2001 From: Ashe Connor Date: Wed, 13 Mar 2019 16:28:55 +1100 Subject: [PATCH 15/19] use cmark-gfm 0.1.7 --- .licenses/semantic/cabal/cmark-gfm.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.licenses/semantic/cabal/cmark-gfm.txt b/.licenses/semantic/cabal/cmark-gfm.txt index db015432c..adde75609 100644 --- a/.licenses/semantic/cabal/cmark-gfm.txt +++ b/.licenses/semantic/cabal/cmark-gfm.txt @@ -1,7 +1,7 @@ --- type: cabal name: cmark-gfm -version: 0.1.6 +version: 0.1.7 summary: Fast, accurate GitHub Flavored Markdown parser and renderer homepage: https://github.com/kivikakk/cmark-gfm-hs license: bsd-3-clause From 7bfe02c24c16a00d1b8d2133b649e1a577d88f50 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 13 Mar 2019 11:15:50 -0400 Subject: [PATCH 16/19] Remove Void hiding --- src/Data/Syntax/Expression.hs | 4 ++-- src/Data/Syntax/Type.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 888143b3f..bf4729752 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -5,8 +5,8 @@ module Data.Syntax.Expression where import Prelude hiding (null) import Prologue hiding (This, index, null) -import Control.Abstract hiding (Bitwise (..), Call, Member, Void) -import Data.Abstract.Evaluatable as Abstract hiding (Member, Void) +import Control.Abstract hiding (Bitwise (..), Call, Member) +import Data.Abstract.Evaluatable as Abstract hiding (Member) import Data.Abstract.Name as Name import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv) import Data.Fixed diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index 953cdd583..96d5603ea 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -Wno-missing-export-lists #-} module Data.Syntax.Type where -import Data.Abstract.Evaluatable hiding (Void) +import Data.Abstract.Evaluatable import Data.JSON.Fields import Diffing.Algorithm import Prelude hiding (Bool, Float, Int, Double) From 7c6ee7f94b28715fc359d181dee6ffc7aeb124c9 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 13 Mar 2019 11:52:45 -0400 Subject: [PATCH 17/19] Merge remote-tracking branch 'origin/master' into alephd-threading --- src/Data/Abstract/Evaluatable.hs | 2 +- src/Semantic/Util.hs | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 5f3d5ee1e..f0ce97e3d 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -30,7 +30,7 @@ import Data.Abstract.Declarations as X import Data.Abstract.FreeVariables as X import Data.Abstract.Module import Data.Abstract.Name as X -import qualified Data.Abstract.ScopeGraph as ScopeGraph +import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Abstract.ScopeGraph (Relation(..)) import Data.Abstract.AccessControls.Class as X import Data.Language diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index cd80aeb82..819d34573 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -479,6 +479,9 @@ scopeGraphRubyProject = justEvaluatingCatchingErrors <=< evaluateProjectForScope scopeGraphPHPProject :: ProjectEvaluator Language.PHP.Assignment.Syntax scopeGraphPHPProject = justEvaluatingCatchingErrors <=< evaluateProjectForScopeGraph (Proxy @'Language.PHP) phpParser +scopeGraphPythonProject :: ProjectEvaluator Language.Python.Assignment.Syntax +scopeGraphPythonProject = justEvaluatingCatchingErrors <=< evaluateProjectForScopeGraph (Proxy @'Language.Python) pythonParser + scopeGraphGoProject :: ProjectEvaluator Language.Go.Assignment.Syntax scopeGraphGoProject = justEvaluatingCatchingErrors <=< evaluateProjectForScopeGraph (Proxy @'Language.Go) goParser From 191000d1e9a9592cce448cdb98ec15c6d3ab6e6d Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 13 Mar 2019 13:02:07 -0700 Subject: [PATCH 18/19] ++generated pb code from twirp-haskell updates --- src/Semantic/Api/V1/CodeAnalysisPB.hs | 189 +++++++++++++------------- 1 file changed, 95 insertions(+), 94 deletions(-) diff --git a/src/Semantic/Api/V1/CodeAnalysisPB.hs b/src/Semantic/Api/V1/CodeAnalysisPB.hs index 4055ded71..d9675814d 100644 --- a/src/Semantic/Api/V1/CodeAnalysisPB.hs +++ b/src/Semantic/Api/V1/CodeAnalysisPB.hs @@ -14,14 +14,15 @@ import qualified Data.Text as T import Data.Vector (Vector) import Data.Word import GHC.Generics -import Proto3.Suite +import Proto3.Suite (decodeMessageField, encodeMessageField, nestedvec, packedvec) +import qualified Proto3.Suite as Proto3 import Proto3.Suite.JSONPB as JSONPB import Proto3.Wire (at, oneof) data PingRequest = PingRequest { service :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB PingRequest where parseJSONPB = A.withObject "PingRequest" $ \obj -> PingRequest @@ -44,7 +45,7 @@ instance ToJSON PingRequest where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message PingRequest where +instance Proto3.Message PingRequest where encodeMessage _ PingRequest{..} = mconcat [ encodeMessageField 1 service @@ -59,7 +60,7 @@ data PingResponse = PingResponse , timestamp :: Text , sha :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB PingResponse where parseJSONPB = A.withObject "PingResponse" $ \obj -> PingResponse @@ -91,7 +92,7 @@ instance ToJSON PingResponse where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message PingResponse where +instance Proto3.Message PingResponse where encodeMessage _ PingResponse{..} = mconcat [ encodeMessageField 1 status @@ -109,7 +110,7 @@ instance Message PingResponse where data ParseTreeRequest = ParseTreeRequest { blobs :: Vector Blob } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB ParseTreeRequest where parseJSONPB = A.withObject "ParseTreeRequest" $ \obj -> ParseTreeRequest @@ -132,10 +133,10 @@ instance ToJSON ParseTreeRequest where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message ParseTreeRequest where +instance Proto3.Message ParseTreeRequest where encodeMessage _ ParseTreeRequest{..} = mconcat [ - encodeMessageField 1 (NestedVec blobs) + encodeMessageField 1 (Proto3.NestedVec blobs) ] decodeMessage _ = ParseTreeRequest <$> (nestedvec <$> at decodeMessageField 1) @@ -144,7 +145,7 @@ instance Message ParseTreeRequest where data ParseTreeSymbolResponse = ParseTreeSymbolResponse { files :: Vector File } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB ParseTreeSymbolResponse where parseJSONPB = A.withObject "ParseTreeSymbolResponse" $ \obj -> ParseTreeSymbolResponse @@ -167,10 +168,10 @@ instance ToJSON ParseTreeSymbolResponse where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message ParseTreeSymbolResponse where +instance Proto3.Message ParseTreeSymbolResponse where encodeMessage _ ParseTreeSymbolResponse{..} = mconcat [ - encodeMessageField 1 (NestedVec files) + encodeMessageField 1 (Proto3.NestedVec files) ] decodeMessage _ = ParseTreeSymbolResponse <$> (nestedvec <$> at decodeMessageField 1) @@ -179,7 +180,7 @@ instance Message ParseTreeSymbolResponse where data ParseTreeGraphResponse = ParseTreeGraphResponse { files :: Vector ParseTreeFileGraph } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB ParseTreeGraphResponse where parseJSONPB = A.withObject "ParseTreeGraphResponse" $ \obj -> ParseTreeGraphResponse @@ -202,10 +203,10 @@ instance ToJSON ParseTreeGraphResponse where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message ParseTreeGraphResponse where +instance Proto3.Message ParseTreeGraphResponse where encodeMessage _ ParseTreeGraphResponse{..} = mconcat [ - encodeMessageField 1 (NestedVec files) + encodeMessageField 1 (Proto3.NestedVec files) ] decodeMessage _ = ParseTreeGraphResponse <$> (nestedvec <$> at decodeMessageField 1) @@ -218,7 +219,7 @@ data ParseTreeFileGraph = ParseTreeFileGraph , edges :: Vector TermEdge , errors :: Vector ParseError } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB ParseTreeFileGraph where parseJSONPB = A.withObject "ParseTreeFileGraph" $ \obj -> ParseTreeFileGraph @@ -253,14 +254,14 @@ instance ToJSON ParseTreeFileGraph where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message ParseTreeFileGraph where +instance Proto3.Message ParseTreeFileGraph where encodeMessage _ ParseTreeFileGraph{..} = mconcat [ encodeMessageField 1 path , encodeMessageField 2 language - , encodeMessageField 3 (NestedVec vertices) - , encodeMessageField 4 (NestedVec edges) - , encodeMessageField 5 (NestedVec errors) + , encodeMessageField 3 (Proto3.NestedVec vertices) + , encodeMessageField 4 (Proto3.NestedVec edges) + , encodeMessageField 5 (Proto3.NestedVec errors) ] decodeMessage _ = ParseTreeFileGraph <$> at decodeMessageField 1 @@ -274,7 +275,7 @@ data TermEdge = TermEdge { source :: Int32 , target :: Int32 } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB TermEdge where parseJSONPB = A.withObject "TermEdge" $ \obj -> TermEdge @@ -300,7 +301,7 @@ instance ToJSON TermEdge where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message TermEdge where +instance Proto3.Message TermEdge where encodeMessage _ TermEdge{..} = mconcat [ encodeMessageField 1 source @@ -316,7 +317,7 @@ data TermVertex = TermVertex , term :: Text , span :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB TermVertex where parseJSONPB = A.withObject "TermVertex" $ \obj -> TermVertex @@ -345,12 +346,12 @@ instance ToJSON TermVertex where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message TermVertex where +instance Proto3.Message TermVertex where encodeMessage _ TermVertex{..} = mconcat [ encodeMessageField 1 vertexId , encodeMessageField 2 term - , encodeMessageField 3 (Nested span) + , encodeMessageField 3 (Proto3.Nested span) ] decodeMessage _ = TermVertex <$> at decodeMessageField 1 @@ -361,7 +362,7 @@ instance Message TermVertex where data ParseError = ParseError { error :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB ParseError where parseJSONPB = A.withObject "ParseError" $ \obj -> ParseError @@ -384,7 +385,7 @@ instance ToJSON ParseError where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message ParseError where +instance Proto3.Message ParseError where encodeMessage _ ParseError{..} = mconcat [ encodeMessageField 1 error @@ -396,7 +397,7 @@ instance Message ParseError where data DiffTreeRequest = DiffTreeRequest { blobs :: Vector BlobPair } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB DiffTreeRequest where parseJSONPB = A.withObject "DiffTreeRequest" $ \obj -> DiffTreeRequest @@ -419,10 +420,10 @@ instance ToJSON DiffTreeRequest where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message DiffTreeRequest where +instance Proto3.Message DiffTreeRequest where encodeMessage _ DiffTreeRequest{..} = mconcat [ - encodeMessageField 1 (NestedVec blobs) + encodeMessageField 1 (Proto3.NestedVec blobs) ] decodeMessage _ = DiffTreeRequest <$> (nestedvec <$> at decodeMessageField 1) @@ -431,7 +432,7 @@ instance Message DiffTreeRequest where data DiffTreeTOCResponse = DiffTreeTOCResponse { files :: Vector TOCSummaryFile } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB DiffTreeTOCResponse where parseJSONPB = A.withObject "DiffTreeTOCResponse" $ \obj -> DiffTreeTOCResponse @@ -454,10 +455,10 @@ instance ToJSON DiffTreeTOCResponse where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message DiffTreeTOCResponse where +instance Proto3.Message DiffTreeTOCResponse where encodeMessage _ DiffTreeTOCResponse{..} = mconcat [ - encodeMessageField 1 (NestedVec files) + encodeMessageField 1 (Proto3.NestedVec files) ] decodeMessage _ = DiffTreeTOCResponse <$> (nestedvec <$> at decodeMessageField 1) @@ -469,7 +470,7 @@ data TOCSummaryFile = TOCSummaryFile , changes :: Vector TOCSummaryChange , errors :: Vector TOCSummaryError } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB TOCSummaryFile where parseJSONPB = A.withObject "TOCSummaryFile" $ \obj -> TOCSummaryFile @@ -501,13 +502,13 @@ instance ToJSON TOCSummaryFile where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message TOCSummaryFile where +instance Proto3.Message TOCSummaryFile where encodeMessage _ TOCSummaryFile{..} = mconcat [ encodeMessageField 1 path , encodeMessageField 2 language - , encodeMessageField 3 (NestedVec changes) - , encodeMessageField 4 (NestedVec errors) + , encodeMessageField 3 (Proto3.NestedVec changes) + , encodeMessageField 4 (Proto3.NestedVec errors) ] decodeMessage _ = TOCSummaryFile <$> at decodeMessageField 1 @@ -522,7 +523,7 @@ data TOCSummaryChange = TOCSummaryChange , span :: Maybe Span , changeType :: ChangeType } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB TOCSummaryChange where parseJSONPB = A.withObject "TOCSummaryChange" $ \obj -> TOCSummaryChange @@ -554,12 +555,12 @@ instance ToJSON TOCSummaryChange where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message TOCSummaryChange where +instance Proto3.Message TOCSummaryChange where encodeMessage _ TOCSummaryChange{..} = mconcat [ encodeMessageField 1 category , encodeMessageField 2 term - , encodeMessageField 3 (Nested span) + , encodeMessageField 3 (Proto3.Nested span) , encodeMessageField 4 changeType ] decodeMessage _ = TOCSummaryChange @@ -573,7 +574,7 @@ data TOCSummaryError = TOCSummaryError { error :: Text , span :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB TOCSummaryError where parseJSONPB = A.withObject "TOCSummaryError" $ \obj -> TOCSummaryError @@ -599,11 +600,11 @@ instance ToJSON TOCSummaryError where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message TOCSummaryError where +instance Proto3.Message TOCSummaryError where encodeMessage _ TOCSummaryError{..} = mconcat [ encodeMessageField 1 error - , encodeMessageField 2 (Nested span) + , encodeMessageField 2 (Proto3.Nested span) ] decodeMessage _ = TOCSummaryError <$> at decodeMessageField 1 @@ -613,7 +614,7 @@ instance Message TOCSummaryError where data DiffTreeGraphResponse = DiffTreeGraphResponse { files :: Vector DiffTreeFileGraph } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB DiffTreeGraphResponse where parseJSONPB = A.withObject "DiffTreeGraphResponse" $ \obj -> DiffTreeGraphResponse @@ -636,10 +637,10 @@ instance ToJSON DiffTreeGraphResponse where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message DiffTreeGraphResponse where +instance Proto3.Message DiffTreeGraphResponse where encodeMessage _ DiffTreeGraphResponse{..} = mconcat [ - encodeMessageField 1 (NestedVec files) + encodeMessageField 1 (Proto3.NestedVec files) ] decodeMessage _ = DiffTreeGraphResponse <$> (nestedvec <$> at decodeMessageField 1) @@ -652,7 +653,7 @@ data DiffTreeFileGraph = DiffTreeFileGraph , edges :: Vector DiffTreeEdge , errors :: Vector ParseError } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB DiffTreeFileGraph where parseJSONPB = A.withObject "DiffTreeFileGraph" $ \obj -> DiffTreeFileGraph @@ -687,14 +688,14 @@ instance ToJSON DiffTreeFileGraph where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message DiffTreeFileGraph where +instance Proto3.Message DiffTreeFileGraph where encodeMessage _ DiffTreeFileGraph{..} = mconcat [ encodeMessageField 1 path , encodeMessageField 2 language - , encodeMessageField 3 (NestedVec vertices) - , encodeMessageField 4 (NestedVec edges) - , encodeMessageField 5 (NestedVec errors) + , encodeMessageField 3 (Proto3.NestedVec vertices) + , encodeMessageField 4 (Proto3.NestedVec edges) + , encodeMessageField 5 (Proto3.NestedVec errors) ] decodeMessage _ = DiffTreeFileGraph <$> at decodeMessageField 1 @@ -708,7 +709,7 @@ data DiffTreeEdge = DiffTreeEdge { source :: Int32 , target :: Int32 } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB DiffTreeEdge where parseJSONPB = A.withObject "DiffTreeEdge" $ \obj -> DiffTreeEdge @@ -734,7 +735,7 @@ instance ToJSON DiffTreeEdge where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message DiffTreeEdge where +instance Proto3.Message DiffTreeEdge where encodeMessage _ DiffTreeEdge{..} = mconcat [ encodeMessageField 1 source @@ -751,7 +752,7 @@ data DiffTreeVertexDiffTerm | Replaced (Maybe ReplacedTerm) | Merged (Maybe MergedTerm) deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, NFData) + deriving anyclass (Proto3.Message, Proto3.Named, NFData) instance FromJSONPB DiffTreeVertexDiffTerm where parseJSONPB = A.withObject "DiffTreeVertexDiffTerm" $ \obj -> msum @@ -783,7 +784,7 @@ data DiffTreeVertex = DiffTreeVertex { diffVertexId :: Int32 , diffTerm :: Maybe DiffTreeVertexDiffTerm } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB DiffTreeVertex where parseJSONPB = A.withObject "DiffTreeVertex" $ \obj -> DiffTreeVertex @@ -809,7 +810,7 @@ instance ToJSON DiffTreeVertex where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message DiffTreeVertex where +instance Proto3.Message DiffTreeVertex where encodeMessage _ DiffTreeVertex{..} = mconcat [ encodeMessageField 1 diffVertexId @@ -836,7 +837,7 @@ data DeletedTerm = DeletedTerm { term :: Text , span :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB DeletedTerm where parseJSONPB = A.withObject "DeletedTerm" $ \obj -> DeletedTerm @@ -862,11 +863,11 @@ instance ToJSON DeletedTerm where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message DeletedTerm where +instance Proto3.Message DeletedTerm where encodeMessage _ DeletedTerm{..} = mconcat [ encodeMessageField 1 term - , encodeMessageField 2 (Nested span) + , encodeMessageField 2 (Proto3.Nested span) ] decodeMessage _ = DeletedTerm <$> at decodeMessageField 1 @@ -877,7 +878,7 @@ data InsertedTerm = InsertedTerm { term :: Text , span :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB InsertedTerm where parseJSONPB = A.withObject "InsertedTerm" $ \obj -> InsertedTerm @@ -903,11 +904,11 @@ instance ToJSON InsertedTerm where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message InsertedTerm where +instance Proto3.Message InsertedTerm where encodeMessage _ InsertedTerm{..} = mconcat [ encodeMessageField 1 term - , encodeMessageField 2 (Nested span) + , encodeMessageField 2 (Proto3.Nested span) ] decodeMessage _ = InsertedTerm <$> at decodeMessageField 1 @@ -920,7 +921,7 @@ data ReplacedTerm = ReplacedTerm , afterTerm :: Text , afterSpan :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB ReplacedTerm where parseJSONPB = A.withObject "ReplacedTerm" $ \obj -> ReplacedTerm @@ -952,13 +953,13 @@ instance ToJSON ReplacedTerm where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message ReplacedTerm where +instance Proto3.Message ReplacedTerm where encodeMessage _ ReplacedTerm{..} = mconcat [ encodeMessageField 1 beforeTerm - , encodeMessageField 2 (Nested beforeSpan) + , encodeMessageField 2 (Proto3.Nested beforeSpan) , encodeMessageField 3 afterTerm - , encodeMessageField 4 (Nested afterSpan) + , encodeMessageField 4 (Proto3.Nested afterSpan) ] decodeMessage _ = ReplacedTerm <$> at decodeMessageField 1 @@ -972,7 +973,7 @@ data MergedTerm = MergedTerm , beforeSpan :: Maybe Span , afterSpan :: Maybe Span } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB MergedTerm where parseJSONPB = A.withObject "MergedTerm" $ \obj -> MergedTerm @@ -1001,12 +1002,12 @@ instance ToJSON MergedTerm where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message MergedTerm where +instance Proto3.Message MergedTerm where encodeMessage _ MergedTerm{..} = mconcat [ encodeMessageField 1 term - , encodeMessageField 2 (Nested beforeSpan) - , encodeMessageField 3 (Nested afterSpan) + , encodeMessageField 2 (Proto3.Nested beforeSpan) + , encodeMessageField 3 (Proto3.Nested afterSpan) ] decodeMessage _ = MergedTerm <$> at decodeMessageField 1 @@ -1019,7 +1020,7 @@ data Blob = Blob , path :: Text , language :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB Blob where parseJSONPB = A.withObject "Blob" $ \obj -> Blob @@ -1048,7 +1049,7 @@ instance ToJSON Blob where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message Blob where +instance Proto3.Message Blob where encodeMessage _ Blob{..} = mconcat [ encodeMessageField 1 content @@ -1065,7 +1066,7 @@ data BlobPair = BlobPair { before :: Maybe Blob , after :: Maybe Blob } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB BlobPair where parseJSONPB = A.withObject "BlobPair" $ \obj -> BlobPair @@ -1091,11 +1092,11 @@ instance ToJSON BlobPair where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message BlobPair where +instance Proto3.Message BlobPair where encodeMessage _ BlobPair{..} = mconcat [ - encodeMessageField 1 (Nested before) - , encodeMessageField 2 (Nested after) + encodeMessageField 1 (Proto3.Nested before) + , encodeMessageField 2 (Proto3.Nested after) ] decodeMessage _ = BlobPair <$> at decodeMessageField 1 @@ -1108,7 +1109,7 @@ data File = File , symbols :: Vector Symbol , errors :: Vector ParseError } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB File where parseJSONPB = A.withObject "File" $ \obj -> File @@ -1140,13 +1141,13 @@ instance ToJSON File where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message File where +instance Proto3.Message File where encodeMessage _ File{..} = mconcat [ encodeMessageField 1 path , encodeMessageField 2 language - , encodeMessageField 3 (NestedVec symbols) - , encodeMessageField 4 (NestedVec errors) + , encodeMessageField 3 (Proto3.NestedVec symbols) + , encodeMessageField 4 (Proto3.NestedVec errors) ] decodeMessage _ = File <$> at decodeMessageField 1 @@ -1162,7 +1163,7 @@ data Symbol = Symbol , span :: Maybe Span , docs :: Maybe Docstring } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB Symbol where parseJSONPB = A.withObject "Symbol" $ \obj -> Symbol @@ -1197,14 +1198,14 @@ instance ToJSON Symbol where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message Symbol where +instance Proto3.Message Symbol where encodeMessage _ Symbol{..} = mconcat [ encodeMessageField 1 symbol , encodeMessageField 2 kind , encodeMessageField 3 line - , encodeMessageField 4 (Nested span) - , encodeMessageField 5 (Nested docs) + , encodeMessageField 4 (Proto3.Nested span) + , encodeMessageField 5 (Proto3.Nested docs) ] decodeMessage _ = Symbol <$> at decodeMessageField 1 @@ -1217,7 +1218,7 @@ instance Message Symbol where data Docstring = Docstring { docstring :: Text } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB Docstring where parseJSONPB = A.withObject "Docstring" $ \obj -> Docstring @@ -1240,7 +1241,7 @@ instance ToJSON Docstring where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message Docstring where +instance Proto3.Message Docstring where encodeMessage _ Docstring{..} = mconcat [ encodeMessageField 1 docstring @@ -1253,7 +1254,7 @@ data Position = Position { line :: Int32 , column :: Int32 } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB Position where parseJSONPB = A.withObject "Position" $ \obj -> Position @@ -1279,7 +1280,7 @@ instance ToJSON Position where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message Position where +instance Proto3.Message Position where encodeMessage _ Position{..} = mconcat [ encodeMessageField 1 line @@ -1294,7 +1295,7 @@ data Span = Span { start :: Maybe Position , end :: Maybe Position } deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Named, NFData) + deriving anyclass (Proto3.Named, NFData) instance FromJSONPB Span where parseJSONPB = A.withObject "Span" $ \obj -> Span @@ -1320,11 +1321,11 @@ instance ToJSON Span where toJSON = toAesonValue toEncoding = toAesonEncoding -instance Message Span where +instance Proto3.Message Span where encodeMessage _ Span{..} = mconcat [ - encodeMessageField 1 (Nested start) - , encodeMessageField 2 (Nested end) + encodeMessageField 1 (Proto3.Nested start) + , encodeMessageField 2 (Proto3.Nested end) ] decodeMessage _ = Span <$> at decodeMessageField 1 @@ -1337,10 +1338,10 @@ data ChangeType | Removed | Modified deriving stock (Eq, Ord, Show, Enum, Bounded, Generic) - deriving anyclass (Named, MessageField, NFData) - deriving Primitive via PrimitiveEnum ChangeType + deriving anyclass (Proto3.Named, Proto3.MessageField, NFData) + deriving Proto3.Primitive via Proto3.PrimitiveEnum ChangeType -instance HasDefault ChangeType where def = None +instance Proto3.HasDefault ChangeType where def = None instance FromJSONPB ChangeType where parseJSONPB (JSONPB.String "NONE") = pure None From 212510036c43007c9f6377e9e68fb5141f8b4a4b Mon Sep 17 00:00:00 2001 From: Ashe Connor Date: Thu, 14 Mar 2019 13:41:40 +1100 Subject: [PATCH 19/19] use cmark-gfm 0.1.8 --- .licenses/semantic/cabal/cmark-gfm.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.licenses/semantic/cabal/cmark-gfm.txt b/.licenses/semantic/cabal/cmark-gfm.txt index adde75609..75ba799c3 100644 --- a/.licenses/semantic/cabal/cmark-gfm.txt +++ b/.licenses/semantic/cabal/cmark-gfm.txt @@ -1,7 +1,7 @@ --- type: cabal name: cmark-gfm -version: 0.1.7 +version: 0.1.8 summary: Fast, accurate GitHub Flavored Markdown parser and renderer homepage: https://github.com/kivikakk/cmark-gfm-hs license: bsd-3-clause