From be4250707d524db3f985615d2df464cf28773a9a Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 20 Feb 2019 14:23:18 -0500 Subject: [PATCH] Merge remote-tracking branch 'origin/indexer-prototype' into deploy-to-moda --- .hlint.yaml | 1 + .stylish-haskell.yaml | 1 + .../api/v1/code_analysis.proto} | 47 +- semantic.cabal | 16 +- src/Control/Abstract/Heap.hs | 6 +- src/Control/Abstract/Primitive.hs | 9 +- src/Control/Abstract/ScopeGraph.hs | 40 +- src/Data/Abstract/AccessControls/Instances.hs | 1 - src/Data/Abstract/Declarations.hs | 8 - src/Data/Abstract/Evaluatable.hs | 5 +- src/Data/Abstract/Module.hs | 3 - src/Data/Abstract/ScopeGraph.hs | 109 +--- src/Data/Graph.hs | 4 + src/Data/Graph/ControlFlowVertex.hs | 9 +- src/Data/Language.hs | 6 - src/Data/Source.hs | 2 + src/Data/Span.hs | 3 +- src/Data/Syntax.hs | 9 +- src/Data/Syntax/Declaration.hs | 25 +- src/Data/Syntax/Expression.hs | 47 +- src/Data/Syntax/Statement.hs | 2 +- src/Language/Go/Assignment.hs | 10 +- src/Language/Go/Syntax.hs | 2 +- src/Language/Java/Assignment.hs | 10 +- src/Language/PHP/Assignment.hs | 10 +- src/Language/Python/Assignment.hs | 18 +- src/Language/Python/Syntax.hs | 7 +- src/Language/Ruby/Syntax.hs | 9 +- src/Language/TypeScript/Assignment.hs | 2 +- src/Language/TypeScript/Syntax/Import.hs | 15 +- src/Language/TypeScript/Syntax/JSX.hs | 2 +- src/Language/TypeScript/Syntax/JavaScript.hs | 3 +- src/Language/TypeScript/Syntax/TypeScript.hs | 7 +- src/Language/TypeScript/Syntax/Types.hs | 5 +- src/Proto3/Google/Timestamp.hs | 3 +- src/Proto3/Google/Wrapped.hs | 2 +- src/Rendering/Graph.hs | 30 +- src/Semantic/API.hs | 12 +- src/Semantic/API/Diffs.hs | 17 +- src/Semantic/API/Helpers.hs | 43 +- src/Semantic/API/LegacyTypes.hs | 2 +- src/Semantic/API/Symbols.hs | 21 +- src/Semantic/API/TOCSummaries.hs | 23 +- src/Semantic/API/Terms.hs | 21 +- src/Semantic/API/Types.hs | 343 ----------- src/Semantic/API/V1/CodeAnalysisPB.hs | 564 ++++++++++++++++++ src/Semantic/Analysis.hs | 2 +- src/Semantic/CLI.hs | 14 +- src/Semantic/REPL.hs | 80 +-- src/Semantic/Task.hs | 53 +- src/Semantic/Util.hs | 5 +- src/Tags/Taggable.hs | 1 - test/Control/Abstract/Evaluator/Spec.hs | 4 +- test/Examples.hs | 4 +- test/Rendering/TOC/Spec.hs | 2 +- test/Semantic/CLI/Spec.hs | 2 +- test/Semantic/Spec.hs | 2 +- test/Spec.hs | 2 +- test/SpecHelpers.hs | 6 +- 59 files changed, 940 insertions(+), 771 deletions(-) rename proto/{semantic.proto => semantic/api/v1/code_analysis.proto} (82%) delete mode 100644 src/Semantic/API/Types.hs create mode 100644 src/Semantic/API/V1/CodeAnalysisPB.hs diff --git a/.hlint.yaml b/.hlint.yaml index 389760351..f0d665711 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -48,6 +48,7 @@ - ignore: {name: Use ., within: [Analysis.Abstract.Graph.graphingModules]} - ignore: {name: Reduce duplication, within: [Semantic.Util]} +- ignore: {name: Use newtype instead of data, within: [Semantic.Api.V1.CodeAnalysisPB]} # Our customized warnings diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml index 98702f987..19825baca 100644 --- a/.stylish-haskell.yaml +++ b/.stylish-haskell.yaml @@ -223,6 +223,7 @@ language_extensions: - DeriveFunctor - DeriveGeneric - DeriveTraversable + - DerivingVia - ExplicitNamespaces - FlexibleContexts - FlexibleInstances diff --git a/proto/semantic.proto b/proto/semantic/api/v1/code_analysis.proto similarity index 82% rename from proto/semantic.proto rename to proto/semantic/api/v1/code_analysis.proto index 35954303d..55d6dc625 100644 --- a/proto/semantic.proto +++ b/proto/semantic/api/v1/code_analysis.proto @@ -1,13 +1,11 @@ -// This file was generated by proto-gen. Do not edit by hand. syntax = "proto3"; -package github.semantic; +package semantic.api.v1; -option java_package = "com.github.semantic.analysis"; -option go_package = "github.com/semantic/analysis/;analysis"; - -// Semantic's CodeAnalysis service provides endpoints for parsing, analyzing, and comparing source code. +option java_package = "com.github.semantic.api.v1"; +// Semantic's CodeAnalysis service provides endpoints for parsing, analyzing, +// and comparing source code. service CodeAnalysis { // Check health & status of the service. rpc Ping (PingRequest) returns (PingResponse); @@ -58,7 +56,7 @@ message TermEdge { } message TermVertex { - int64 vertexId = 1; + int64 vertex_id = 1; string term = 2; Span span = 3; } @@ -86,7 +84,7 @@ message TOCSummaryChange { string category = 1; string term = 2; Span span = 3; - ChangeType changeType = 4; + ChangeType change_type = 4; } message TOCSummaryError { @@ -119,16 +117,12 @@ message DiffTreeEdge { } message DiffTreeVertex { - int64 diffVertexId = 1; - DiffTreeTerm diffTerm = 2; -} - -message DiffTreeTerm { - oneof sum { - DeletedTerm deleted = 1; - InsertedTerm inserted = 2; - ReplacedTerm replaced = 3; - MergedTerm merged = 4; + int64 diff_vertex_id = 1; + oneof diff_term { + DeletedTerm deleted = 2; + InsertedTerm inserted = 3; + ReplacedTerm replaced = 4; + MergedTerm merged = 5; } } @@ -143,16 +137,16 @@ message InsertedTerm { } message ReplacedTerm { - string beforeTerm = 1; - Span beforeSpan = 2; - string afterTerm = 3; - Span afterSpan = 4; + string before_term = 1; + Span before_span = 2; + string after_term = 3; + Span after_span = 4; } message MergedTerm { string term = 1; - Span beforeSpan = 2; - Span afterSpan = 3; + Span before_span = 2; + Span after_span = 3; } enum Language { @@ -193,6 +187,11 @@ message Symbol { string kind = 2; string line = 3; Span span = 4; + Docstring docs = 5; +} + +message Docstring { + string docstring = 1; } message Position { diff --git a/semantic.cabal b/semantic.cabal index 04079a03b..77f21f6ea 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -188,14 +188,14 @@ library -- High-level flow & operational functionality (logging, stats, etc.) , Semantic.Analysis -- API - , Semantic.API - , Semantic.API.Diffs - , Semantic.API.Helpers - , Semantic.API.LegacyTypes - , Semantic.API.Symbols - , Semantic.API.Terms - , Semantic.API.TOCSummaries - , Semantic.API.Types + , Semantic.Api + , Semantic.Api.Diffs + , Semantic.Api.Helpers + , Semantic.Api.LegacyTypes + , Semantic.Api.Symbols + , Semantic.Api.Terms + , Semantic.Api.TOCSummaries + , Semantic.Api.V1.CodeAnalysisPB , Semantic.AST , Semantic.CLI , Semantic.Config diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 7ec6ab8f0..c93b5944a 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -56,7 +56,7 @@ import qualified Data.Abstract.Heap as Heap import Data.Abstract.Live import Data.Abstract.Module (ModuleInfo) import Data.Abstract.Name -import Data.Abstract.ScopeGraph (Kind(..), Path (..), Relation(..), putDeclarationScopeAtPosition) +import Data.Abstract.ScopeGraph (Path (..), Relation(..), putDeclarationScopeAtPosition) import qualified Data.Map.Strict as Map import Data.Span (Span, emptySpan) import Prologue @@ -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 Nothing slot <- lookupSlot declaration value <- def assign slot value @@ -203,7 +203,7 @@ withChildFrame :: ( Member (Allocator address) sig -> (address -> Evaluator term address value m a) -> Evaluator term address value m a withChildFrame declaration body = do - scope <- newPreludeScope mempty + scope <- newScope mempty putDeclarationScope declaration scope frame <- newFrame scope mempty withScopeAndFrame frame (body frame) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 4880c787f..2ef0f6a5f 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -11,7 +11,6 @@ import Control.Abstract.Heap import Control.Abstract.ScopeGraph import Control.Abstract.Value import Data.Abstract.BaseError -import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Abstract.Name import Data.Map.Strict as Map import Data.Span @@ -41,13 +40,13 @@ defineBuiltIn :: ( HasCallStack defineBuiltIn declaration rel accessControl value = withCurrentCallStack callStack $ do currentScope' <- currentScope let lexicalEdges = Map.singleton Lexical [ currentScope' ] - associatedScope <- newPreludeScope lexicalEdges + associatedScope <- newScope lexicalEdges -- TODO: This span is still wrong. - declare declaration rel accessControl emptySpan ScopeGraph.Unknown (Just associatedScope) + declare declaration rel accessControl emptySpan (Just associatedScope) param <- gensym withScope associatedScope $ do - declare (Declaration param) rel accessControl emptySpan ScopeGraph.Unknown Nothing + declare (Declaration param) rel accessControl emptySpan Nothing slot <- lookupSlot declaration value <- builtIn associatedScope value @@ -81,7 +80,7 @@ defineClass declaration superclasses body = void . define declaration Default Pu let superclassEdges = (Superclass, ) <$> (fmap pure . catMaybes $ superScopes) current = fmap (Lexical, ) . pure . pure $ currentScope' edges = Map.fromList (superclassEdges <> current) - childScope <- newPreludeScope edges + childScope <- newScope edges putDeclarationScope declaration childScope withScope childScope $ do diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index d6f69cd8a..6db7e731a 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -5,7 +5,6 @@ module Control.Abstract.ScopeGraph , declare , reference , newScope - , newPreludeScope , Declaration(..) , ScopeGraph , ScopeError(..) @@ -48,7 +47,7 @@ import Control.Effect.Carrier import Data.Abstract.BaseError import Data.Abstract.Module import Data.Abstract.Name hiding (name) -import Data.Abstract.ScopeGraph (Kind, Declaration(..), EdgeLabel, Reference, Relation(..), Scope (..), ScopeGraph, Slot(..), Info(..), AccessControl(..)) +import Data.Abstract.ScopeGraph (Declaration(..), EdgeLabel, Reference, Relation(..), Scope (..), ScopeGraph, Slot(..), Info(..), AccessControl(..)) import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Span import Prelude hiding (lookup) @@ -64,20 +63,17 @@ lookup ref = ScopeGraph.scopeOfRef ref <$> get declare :: ( Carrier sig m , Member (State (ScopeGraph address)) sig , Member (Reader (CurrentScope address)) sig - , Member (Reader ModuleInfo) sig , Ord address ) => Declaration -> Relation -> AccessControl -> Span - -> Kind -> Maybe address -> Evaluator term address value m () -declare decl rel accessControl span kind scope = do +declare decl rel accessControl span scope = do currentAddress <- currentScope - moduleInfo <- ask @ModuleInfo - modify (fst . ScopeGraph.declare decl moduleInfo rel accessControl span kind scope currentAddress) + modify (fst . ScopeGraph.declare decl rel accessControl span scope currentAddress) putDeclarationScope :: ( Ord address , Member (Reader (CurrentScope address)) sig @@ -105,18 +101,14 @@ reference :: forall address sig m term value . ( Ord address , Member (State (ScopeGraph address)) sig , Member (Reader (CurrentScope address)) sig - , Member (Reader ModuleInfo) sig , Carrier sig m ) => Reference - -> Span - -> Kind -> Declaration -> Evaluator term address value m () -reference ref span kind decl = do +reference ref decl = do currentAddress <- currentScope - moduleInfo <- ask @ModuleInfo - modify @(ScopeGraph address) (ScopeGraph.reference ref moduleInfo span kind decl currentAddress) + modify @(ScopeGraph address) (ScopeGraph.reference ref decl currentAddress) -- | Combinator to insert an export edge from the current scope to the provided scope address. insertExportEdge :: (Member (Reader (CurrentScope scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress) @@ -162,21 +154,6 @@ newScope edges = do address <- alloc name address <$ modify (ScopeGraph.newScope address edges) --- | Inserts a new scope into the scope graph with the given edges. -newPreludeScope :: ( Member (Allocator address) sig - , Member (State (ScopeGraph address)) sig - , Member Fresh sig - , Carrier sig m - , Ord address - ) - => Map EdgeLabel [address] - -> Evaluator term address value m address -newPreludeScope edges = do - -- Take the edges and construct a new scope - name <- gensym - address <- alloc name - address <$ modify (ScopeGraph.newPreludeScope address edges) - newtype CurrentScope address = CurrentScope { unCurrentScope :: address } currentScope :: ( Carrier sig m @@ -237,17 +214,14 @@ insertImportReference :: ( Member (Resumable (BaseError (ScopeError address))) s , Ord address ) => Reference - -> Span - -> Kind -> Declaration -> address -> Evaluator term address value m () -insertImportReference ref span kind decl scopeAddress = do +insertImportReference ref decl scopeAddress = do scopeGraph <- get scope <- lookupScope scopeAddress currentAddress <- currentScope - moduleInfo <- ask @ModuleInfo - newScope <- maybeM (throwScopeError ImportReferenceError) (ScopeGraph.insertImportReference ref moduleInfo span kind decl currentAddress scopeGraph scope) + newScope <- maybeM (throwScopeError ImportReferenceError) (ScopeGraph.insertImportReference ref decl currentAddress scopeGraph scope) insertScope scopeAddress newScope insertScope :: ( Member (State (ScopeGraph address)) sig diff --git a/src/Data/Abstract/AccessControls/Instances.hs b/src/Data/Abstract/AccessControls/Instances.hs index abe3111bd..aeb7e1c8d 100644 --- a/src/Data/Abstract/AccessControls/Instances.hs +++ b/src/Data/Abstract/AccessControls/Instances.hs @@ -335,7 +335,6 @@ instance AccessControls1 Java.TryWithResources instance AccessControls1 Java.AssertStatement instance AccessControls1 Java.AnnotationTypeElement -instance AccessControls1 Python.Alias instance AccessControls1 Python.Ellipsis instance AccessControls1 Python.FutureImport instance AccessControls1 Python.Import diff --git a/src/Data/Abstract/Declarations.hs b/src/Data/Abstract/Declarations.hs index 9c23e0eda..77b00102d 100644 --- a/src/Data/Abstract/Declarations.hs +++ b/src/Data/Abstract/Declarations.hs @@ -12,9 +12,6 @@ class Declarations syntax where declaredName :: syntax -> Maybe Name declaredName = const Nothing - declaredAlias :: syntax -> Maybe Name - declaredAlias = const Nothing - class Declarations1 syntax where -- | Lift a function mapping each element to its declared name (if any) through a containing structure. This can be used to define the declared name for a composite piece of syntax in terms of the declared name of one of its components. -- @@ -22,17 +19,12 @@ class Declarations1 syntax where liftDeclaredName :: (a -> Maybe Name) -> syntax a -> Maybe Name liftDeclaredName _ _ = Nothing - liftDeclaredAlias :: (a -> Maybe Name) -> syntax a -> Maybe Name - liftDeclaredAlias _ _ = Nothing - deriving instance Declarations1 syntax => Declarations (Term syntax ann) instance (Declarations recur, Declarations1 syntax) => Declarations (TermF syntax ann recur) where declaredName = liftDeclaredName declaredName . termFOut - declaredAlias = liftDeclaredAlias declaredAlias . termFOut instance Apply Declarations1 fs => Declarations1 (Sum fs) where liftDeclaredName f = apply @Declarations1 (liftDeclaredName f) - liftDeclaredAlias f = apply @Declarations1 (liftDeclaredAlias f) instance Declarations1 [] diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 1b885754a..46b9540b0 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -30,7 +30,6 @@ 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 Data.Abstract.ScopeGraph (Relation(..)) import Data.Abstract.AccessControls.Class as X import Data.Language @@ -192,7 +191,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 Nothing slot <- lookupSlot self assign slot =<< object =<< currentFrame @@ -211,7 +210,7 @@ data EvalError term address value return where IntegerFormatError :: Text -> EvalError term address value Integer NoNameError :: term -> EvalError term address value Name RationalFormatError :: Text -> EvalError term address value Rational - ReferenceError :: value -> term -> EvalError term address value (Slot address) + ReferenceError :: value -> Name -> EvalError term address value (Slot address) ScopedEnvError :: value -> EvalError term address value address throwNoNameError :: ( Carrier sig m diff --git a/src/Data/Abstract/Module.hs b/src/Data/Abstract/Module.hs index 8d8b04c38..c1f6f37fb 100644 --- a/src/Data/Abstract/Module.hs +++ b/src/Data/Abstract/Module.hs @@ -38,9 +38,6 @@ newtype ModuleInfo = ModuleInfo { modulePath :: ModulePath } deriving stock (Eq, Ord, Generic) deriving anyclass (NFData) -instance Lower ModuleInfo where - lowerBound = ModuleInfo mempty - instance Show ModuleInfo where showsPrec d = showsUnaryWith showsPrec "ModuleInfo" d . modulePath diff --git a/src/Data/Abstract/ScopeGraph.hs b/src/Data/Abstract/ScopeGraph.hs index 6372446cc..725b5cbf0 100644 --- a/src/Data/Abstract/ScopeGraph.hs +++ b/src/Data/Abstract/ScopeGraph.hs @@ -1,21 +1,18 @@ -{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, LambdaCase, TupleSections #-} +{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, TupleSections #-} module Data.Abstract.ScopeGraph ( Slot(..) , Info(..) , associatedScope - , lookupDeclaration , declarationByName , declarationsByAccessControl , declarationsByRelation , Declaration(..) -- TODO don't export these constructors , declare - , formatDeclaration , EdgeLabel(..) , insertDeclarationScope , insertDeclarationSpan , insertImportReference , newScope - , newPreludeScope , insertScope , insertEdge , Path(..) @@ -25,10 +22,8 @@ module Data.Abstract.ScopeGraph , Position(..) , reference , Reference(..) -- TODO don't export these constructors - , ReferenceInfo(..) , Relation(..) , ScopeGraph(..) - , Kind(..) , lookupScope , lookupScopePath , Scope(..) @@ -39,26 +34,21 @@ module Data.Abstract.ScopeGraph , AccessControl(..) ) where -import Prelude hiding (lookup) -import Prologue - -import Control.Lens.Lens +import Control.Abstract.Hole +import Data.Abstract.Name import Data.Aeson +import Data.JSON.Fields (ToJSONFields(..)) import qualified Data.Map.Strict as Map import qualified Data.Sequence as Seq import qualified Data.Set as Set - -import Data.JSON.Fields (ToJSONFields (..)) -import Control.Abstract.Hole -import Data.Abstract.Module -import Data.Abstract.Name import Data.Span +import Prologue + -- A slot is a location in the heap where a value is stored. data Slot address = Slot { frameAddress :: address, position :: Position } deriving (Eq, Show, Ord, Generic, NFData) - data AccessControl = Public | Protected | Private @@ -88,58 +78,28 @@ instance Ord AccessControl where (<=) Public _ = False -data Relation = Default | Instance | Prelude - deriving (Eq, Show, Ord, Generic, NFData) +data Relation = Default | Instance deriving (Eq, Show, Ord, Generic, NFData) instance Lower Relation where lowerBound = Default data Info scopeAddress = Info - { infoDeclaration :: Declaration - , infoModule :: ModuleInfo - , infoRelation :: Relation - , infoAccessControl :: AccessControl - , infoSpan :: Span - , infoKind :: Kind + { infoDeclaration :: Declaration + , infoRelation :: Relation + , infoAccessControl :: AccessControl + , infoSpan :: Span , infoAssociatedScope :: Maybe scopeAddress } deriving (Eq, Show, Ord, Generic, NFData) -instance HasSpan (Info scopeAddress) where - span = lens infoSpan (\i s -> i { infoSpan = s }) - {-# INLINE span #-} - instance Lower (Info scopeAddress) where - lowerBound = Info lowerBound lowerBound lowerBound Public lowerBound lowerBound Nothing - -data ReferenceInfo = ReferenceInfo - { refSpan :: Span - , refKind :: Kind - , refModule :: ModuleInfo - } deriving (Eq, Show, Ord, Generic, NFData) - -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 - deriving (Eq, Show, Ord, Generic, NFData) - -instance Lower Kind where - lowerBound = Unknown + lowerBound = Info lowerBound lowerBound Public lowerBound Nothing -- Offsets and frame addresses in the heap should be addresses? -data Scope address = - Scope { - edges :: Map EdgeLabel [address] - , references :: Map Reference ([ReferenceInfo], Path address) - , declarations :: Seq (Info address) - } - | PreludeScope { - edges :: Map EdgeLabel [address] - , references :: Map Reference ([ReferenceInfo], Path address) - , declarations :: Seq (Info address) - } - deriving (Eq, Show, Ord, Generic, NFData) +data Scope address = Scope + { edges :: Map EdgeLabel [address] + , references :: Map Reference (Path address) + , declarations :: Seq (Info address) + } deriving (Eq, Show, Ord, Generic, NFData) instance Lower (Scope scopeAddress) where lowerBound = Scope mempty mempty mempty @@ -193,7 +153,7 @@ pathPosition (DPath _ p) = p pathPosition (EPath _ _ p) = pathPosition p -- Returns the reference paths of a scope in a scope graph. -pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference ([ReferenceInfo], Path scope)) +pathsOfScope :: Ord scope => scope -> ScopeGraph scope -> Maybe (Map Reference (Path scope)) pathsOfScope scope = fmap references . Map.lookup scope . unScopeGraph -- Returns the declaration data of a scope in a scope graph. @@ -227,37 +187,35 @@ lookupScope scope = Map.lookup scope . unScopeGraph -- TODO: Return the whole value in Maybe or Either. declare :: Ord scope => Declaration - -> ModuleInfo -> Relation -> AccessControl -> Span - -> Kind -> Maybe scope -> scope -> ScopeGraph scope -> (ScopeGraph scope, Maybe Position) -declare decl moduleInfo rel accessControl declSpan kind assocScope currentScope g = fromMaybe (g, Nothing) $ do +declare decl rel accessControl declSpan assocScope currentScope g = fromMaybe (g, Nothing) $ do scope <- lookupScope currentScope g dataSeq <- ddataOfScope currentScope g case Seq.findIndexR (\Info{..} -> decl == infoDeclaration && declSpan == infoSpan && rel == infoRelation) dataSeq of Just index -> pure (g, Just (Position index)) Nothing -> do - let newScope = scope { declarations = declarations scope Seq.|> Info decl moduleInfo rel accessControl declSpan kind assocScope } + let newScope = scope { declarations = declarations scope Seq.|> Info decl rel accessControl declSpan assocScope } pure (insertScope currentScope newScope g, Just (Position (length (declarations newScope)))) -- | Add a reference to a declaration in the scope graph. -- Returns the original scope graph if the declaration could not be found. -reference :: Ord scope => Reference -> ModuleInfo -> Span -> Kind -> Declaration -> scope -> ScopeGraph scope -> ScopeGraph scope -reference ref moduleInfo span kind decl currentAddress g = fromMaybe g $ do +reference :: Ord scope => Reference -> Declaration -> scope -> ScopeGraph scope -> ScopeGraph scope +reference ref decl currentAddress g = fromMaybe g $ do -- Start from the current address currentScope' <- lookupScope currentAddress g -- Build a path up to the declaration - flip (insertScope currentAddress) g . flip (insertReference ref moduleInfo span kind) currentScope' <$> findPath (const Nothing) decl currentAddress g + flip (insertScope currentAddress) g . flip (insertReference ref) currentScope' <$> findPath (const Nothing) decl currentAddress g -- | Insert a reference into the given scope by constructing a resolution path to the declaration within the given scope graph. -insertImportReference :: Ord address => Reference -> ModuleInfo -> Span -> Kind -> Declaration -> address -> ScopeGraph address -> Scope address -> Maybe (Scope address) -insertImportReference ref moduleInfo span kind decl currentAddress g scope = flip (insertReference ref moduleInfo span kind) scope . EPath Import currentAddress <$> findPath (const Nothing) decl currentAddress g +insertImportReference :: Ord address => Reference -> Declaration -> address -> ScopeGraph address -> Scope address -> Maybe (Scope address) +insertImportReference ref decl currentAddress g scope = flip (insertReference ref) scope . EPath Import currentAddress <$> findPath (const Nothing) decl currentAddress g lookupScopePath :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress) lookupScopePath declaration currentAddress g = findPath (flip (lookupReference declaration) g) (Declaration declaration) currentAddress g @@ -284,10 +242,8 @@ foldGraph combine address graph = go lowerBound address pathToDeclaration :: Ord scopeAddress => Declaration -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress) pathToDeclaration decl address g = DPath decl . snd <$> lookupDeclaration (unDeclaration decl) address g -insertReference :: Reference -> ModuleInfo -> Span -> Kind -> Path scopeAddress -> Scope scopeAddress -> Scope scopeAddress -insertReference ref moduleInfo span kind path scope = scope { references = Map.alter (\case - Nothing -> pure ([ ReferenceInfo span kind moduleInfo ], path) - Just (refInfos, path) -> pure (ReferenceInfo span kind moduleInfo : refInfos, path)) ref (references scope) } +insertReference :: Reference -> Path scopeAddress -> Scope scopeAddress -> Scope scopeAddress +insertReference ref path scope = scope { references = Map.insert ref path (references scope) } lookupDeclaration :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Info scopeAddress, Position) lookupDeclaration name scope g = do @@ -309,7 +265,7 @@ putDeclarationScopeAtPosition scope position assocScope g@(ScopeGraph graph) = f pure $ ScopeGraph (Map.adjust (\s -> s { declarations = seq }) scope graph) lookupReference :: Ord scopeAddress => Name -> scopeAddress -> ScopeGraph scopeAddress -> Maybe (Path scopeAddress) -lookupReference name scope g = fmap snd . Map.lookup (Reference name) =<< pathsOfScope scope g +lookupReference name scope g = Map.lookup (Reference name) =<< pathsOfScope scope g insertEdge :: Ord scopeAddress => EdgeLabel -> scopeAddress -> scopeAddress -> ScopeGraph scopeAddress -> ScopeGraph scopeAddress insertEdge label target currentAddress g@(ScopeGraph graph) = fromMaybe g $ do @@ -340,10 +296,6 @@ insertDeclarationSpan decl@Declaration{..} span g = fromMaybe g $ do newScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address newScope address edges = insertScope address (Scope edges mempty mempty) --- | Insert a new scope with the given address and edges into the scope graph. -newPreludeScope :: Ord address => address -> Map EdgeLabel [address] -> ScopeGraph address -> ScopeGraph address -newPreludeScope address edges = insertScope address (PreludeScope edges mempty mempty) - insertScope :: Ord address => address -> Scope address -> ScopeGraph address -> ScopeGraph address insertScope address scope = ScopeGraph . Map.insert address scope . unScopeGraph @@ -362,7 +314,7 @@ pathOfRef :: (Ord scope) => Reference -> ScopeGraph scope -> Maybe (Path scope) pathOfRef ref graph = do scope <- scopeOfRef ref graph pathsMap <- pathsOfScope scope graph - snd <$> Map.lookup ref pathsMap + Map.lookup ref pathsMap -- Returns the scope the declaration was declared in. scopeOfDeclaration :: Ord scope => Declaration -> ScopeGraph scope -> Maybe scope @@ -389,9 +341,6 @@ newtype Declaration = Declaration { unDeclaration :: Name } instance Lower Declaration where lowerBound = Declaration $ name "" -formatDeclaration :: Declaration -> Text -formatDeclaration = formatName . unDeclaration - -- | The type of edge from a scope to its parent scopes. -- Either a lexical edge or an import edge in the case of non-lexical edges. data EdgeLabel = Lexical | Import | Export | Superclass diff --git a/src/Data/Graph.hs b/src/Data/Graph.hs index e036a2955..52820b4ea 100644 --- a/src/Data/Graph.hs +++ b/src/Data/Graph.hs @@ -24,6 +24,7 @@ import Control.Effect import Control.Effect.State import Data.Aeson import qualified Data.Set as Set +import Semantic.Api.V1.CodeAnalysisPB -- | An algebraic graph with 'Ord', 'Semigroup', and 'Monoid' instances. newtype Graph vertex = Graph { unGraph :: G.Graph vertex } @@ -100,6 +101,9 @@ instance Ord vertex => Ord (Graph vertex) where class VertexTag vertex where uniqueTag :: vertex -> Int +instance VertexTag DiffTreeVertex where uniqueTag = fromIntegral . diffVertexId +instance VertexTag TermVertex where uniqueTag = fromIntegral . vertexId + instance (Ord vertex, ToJSON vertex, VertexTag vertex) => ToJSON (Graph vertex) where toJSON (Graph graph) = object ["vertices" .= G.vertexList graph, "edges" .= (Edge <$> G.edgeList graph)] toEncoding (Graph graph) = pairs ("vertices" .= G.vertexList graph <> "edges" .= (Edge <$> G.edgeList graph)) diff --git a/src/Data/Graph/ControlFlowVertex.hs b/src/Data/Graph/ControlFlowVertex.hs index 7f2c85221..ee07ec043 100644 --- a/src/Data/Graph/ControlFlowVertex.hs +++ b/src/Data/Graph/ControlFlowVertex.hs @@ -147,8 +147,7 @@ instance VertexDeclarationWithStrategy 'Custom whole Declaration.Method where toVertexWithStrategy _ ann info term@Declaration.Method{} = (\n -> (methodVertex (formatName n) info (locationSpan ann), n)) <$> liftDeclaredName declaredName term instance VertexDeclarationWithStrategy 'Custom whole whole => VertexDeclarationWithStrategy 'Custom whole Expression.MemberAccess where - toVertexWithStrategy proxy ann info (Expression.MemberAccess (Term (In lhsAnn lhs)) (Term (In rhsAnn rhs))) = - case (toVertexWithStrategy proxy lhsAnn info lhs, toVertexWithStrategy proxy rhsAnn info rhs) of - (Just (Variable n _ _, _), Just (_, name)) -> Just (variableVertex (n <> "." <> formatName name) info (locationSpan ann), name) - (_, Just (_, name)) -> Just (variableVertex (formatName name) info (locationSpan ann), name) - _ -> Nothing + toVertexWithStrategy proxy ann info (Expression.MemberAccess (Term (In lhsAnn lhs)) name) = + case toVertexWithStrategy proxy lhsAnn info lhs of + Just (Variable n _ _, _) -> Just (variableVertex (n <> "." <> formatName name) info (locationSpan ann), name) + _ -> Just (variableVertex (formatName name) info (locationSpan ann), name) diff --git a/src/Data/Language.hs b/src/Data/Language.hs index 7441eef48..9a0a101c2 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -2,7 +2,6 @@ module Data.Language ( Language (..) , SLanguage (..) - , ensureLanguage , extensionsForLanguage , knownLanguage , languageForFilePath @@ -100,11 +99,6 @@ instance FromJSON Language where knownLanguage :: Language -> Bool knownLanguage = (/= Unknown) --- | Returns 'Nothing' when passed 'Unknown'. -ensureLanguage :: Language -> Maybe Language -ensureLanguage Unknown = Nothing -ensureLanguage x = Just x - -- | Defaults to 'Unknown'. instance HasDefault Language where def = Unknown diff --git a/src/Data/Source.hs b/src/Data/Source.hs index fe4e4f9f3..067fc779a 100644 --- a/src/Data/Source.hs +++ b/src/Data/Source.hs @@ -33,6 +33,8 @@ import Data.Array import qualified Data.ByteString as B import Data.Char (ord) import Data.List (span) +import Data.Range +import Data.Span hiding (HasSpan (..)) import Data.String (IsString (..)) import qualified Data.Text as T import qualified Data.Text.Encoding as T diff --git a/src/Data/Span.hs b/src/Data/Span.hs index c467f98de..2494db90d 100644 --- a/src/Data/Span.hs +++ b/src/Data/Span.hs @@ -19,6 +19,7 @@ import Prologue import Control.Lens.Lens import Data.Aeson ((.:), (.=)) import qualified Data.Aeson as A +import Proto3.Suite import Data.JSON.Fields @@ -36,7 +37,7 @@ column = lens posColumn (\p l -> p { posColumn = l }) data Span = Span { spanStart :: Pos , spanEnd :: Pos - } deriving (Eq, Ord, Generic, Hashable, NFData) + } deriving (Eq, Ord, Generic, Hashable, Named, NFData) -- | "Classy-fields" interface for data types that have spans. class HasSpan a where diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index e41e70a4a..4245da51b 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -20,7 +20,6 @@ import Reprinting.Tokenize hiding (Element) import qualified Assigning.Assignment as Assignment import qualified Data.Error as Error import Control.Abstract.ScopeGraph (reference, Reference(..), Declaration(..)) -import qualified Data.Abstract.ScopeGraph as ScopeGraph import Control.Abstract.Heap (deref, lookupSlot) -- Combinators @@ -123,13 +122,10 @@ newtype Identifier a = Identifier { name :: Name } instance Evaluatable Identifier where - eval eval ref' term@(Identifier name) = do - -- FIXME: 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) - deref =<< ref eval ref' term + eval eval ref' = ref eval ref' >=> deref ref _ _ (Identifier name) = do + reference (Reference name) (Declaration name) lookupSlot (Declaration name) @@ -141,7 +137,6 @@ instance FreeVariables1 Identifier where instance Declarations1 Identifier where liftDeclaredName _ (Identifier x) = pure x - liftDeclaredAlias _ (Identifier x) = pure x -- | An accessibility modifier, e.g. private, public, protected, etc. newtype AccessibilityModifier a = AccessibilityModifier { contents :: Text } diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 1f54da0b2..6c1548321 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -30,14 +30,12 @@ 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 Default ScopeGraph.Public span params <- withScope associatedScope . for functionParameters $ \paramNode -> do param <- maybeM (throwNoNameError paramNode) (declaredName paramNode) let paramSpan = getSpan paramNode - -- TODO: This might be a motivation for a typeclass for `declarationKind` since we - -- sometimes create declarations for our children. param <$ declare (Declaration param) Default ScopeGraph.Public paramSpan ScopeGraph.Parameter Nothing addr <- lookupSlot (Declaration name) @@ -61,7 +59,7 @@ declareFunction name accessControl span kind = do currentScope' <- currentScope let lexicalEdges = Map.singleton Lexical [ currentScope' ] associatedScope <- newScope lexicalEdges - declare (Declaration name) Default accessControl span kind (Just associatedScope) + declare (Declaration name) relation accessControl span (Just associatedScope) pure associatedScope instance Tokenize Function where @@ -96,14 +94,13 @@ 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 Default methodAccessControl span 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) Default ScopeGraph.Public emptySpan 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 Nothing addr <- lookupSlot (Declaration name) v <- function name params methodBody associatedScope @@ -170,12 +167,12 @@ newtype VariableDeclaration a = VariableDeclaration { variableDeclarations :: [a instance Evaluatable VariableDeclaration where eval _ _ (VariableDeclaration []) = unit - eval eval' _ (VariableDeclaration decs) = do + eval eval _ (VariableDeclaration decs) = do for_ decs $ \declaration -> do name <- maybeM (throwNoNameError declaration) (declaredName declaration) let declarationSpan = getSpan declaration declare (Declaration name) Default ScopeGraph.Public declarationSpan ScopeGraph.VariableDeclaration Nothing - eval' declaration + eval declaration unit instance Declarations a => Declarations (VariableDeclaration a) where @@ -213,7 +210,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 Nothing slot <- lookupSlot (Declaration propertyName) value <- eval publicFieldValue assign slot value @@ -249,13 +246,13 @@ instance Evaluatable Class where superclassFrame <- scopedEnvironment =<< deref slot pure $ case (scope, superclassFrame) of (Just scope, Just frame) -> Just (scope, frame) - _ -> Nothing + _ -> Nothing let superclassEdges = (Superclass, ) . pure . fst <$> catMaybes superScopes 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 (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) classFrame <- newFrame classScope frameEdges @@ -331,7 +328,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 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..34cb0282b 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -18,7 +18,6 @@ import qualified Data.Reprinting.Scope as Scope import qualified Data.Reprinting.Token as Token import Diffing.Algorithm hiding (Delete) import Reprinting.Tokenize hiding (Superclass) -import qualified Data.Abstract.ScopeGraph as ScopeGraph -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell. data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a } @@ -406,18 +405,18 @@ data MemberAccess a = MemberAccess { lhs :: a, rhs :: a } deriving (Eq1, Show1, Ord1) via Generically MemberAccess instance Declarations1 MemberAccess where - liftDeclaredName declaredName MemberAccess{..} = declaredName rhs + liftDeclaredName _ MemberAccess{..} = Just rhs instance Evaluatable MemberAccess where - eval eval ref MemberAccess{..} = do + eval eval _ MemberAccess{..} = do lhsValue <- eval lhs lhsFrame <- Abstract.scopedEnvironment lhsValue rhsSlot <- case lhsFrame of Just lhsFrame -> - -- FIXME: The span is not set up correctly when calling `ref` so we have to eval - -- it first - withScopeAndFrame lhsFrame (eval rhs >> ref rhs) + withScopeAndFrame lhsFrame $ do + reference (Reference rhs) (Declaration rhs) + lookupSlot (Declaration rhs) -- Throw a ReferenceError since we're attempting to reference a name within a value that is not an Object. Nothing -> throwEvalError (ReferenceError lhsValue rhs) @@ -427,28 +426,30 @@ instance Evaluatable MemberAccess where let lhsAccessControl = fromMaybe Public (termToAccessControl lhs) infos <- declarationsByAccessControl rhsScope lhsAccessControl - rhsName <- maybeM (throwNoNameError rhs) (declaredName rhs) - rhsValue' <- case find (\Info{..} -> Declaration rhsName == infoDeclaration) infos of + rhsValue' <- case find (\Info{..} -> Declaration rhs == infoDeclaration) infos of Just _ -> pure rhsValue Nothing -> do let lhsName = fromMaybe (name "") (declaredName lhs) - info <- declarationByName rhsScope (Declaration rhsName) - throwEvalError $ AccessControlError (lhsName, lhsAccessControl) (rhsName, infoAccessControl info) rhsValue + info <- declarationByName rhsScope (Declaration rhs) + throwEvalError $ AccessControlError (lhsName, lhsAccessControl) (rhs, infoAccessControl info) rhsValue bindThis lhsValue rhsValue' - ref eval ref' MemberAccess{..} = do + ref eval _ MemberAccess{..} = do lhsValue <- eval lhs lhsFrame <- Abstract.scopedEnvironment lhsValue case lhsFrame of - Just lhsFrame -> withScopeAndFrame lhsFrame (ref' rhs) + Just lhsFrame -> + withScopeAndFrame lhsFrame $ do + reference (Reference rhs) (Declaration rhs) + lookupSlot (Declaration rhs) -- Throw a ReferenceError since we're attempting to reference a name within a value that is not an Object. Nothing -> throwEvalError (ReferenceError lhsValue rhs) instance Tokenize MemberAccess where - tokenize MemberAccess{..} = lhs *> yield Access <* rhs + tokenize MemberAccess{..} = lhs *> yield Access *> yield (Run (formatName rhs)) -- | Subscript (e.g a[1]) data Subscript a = Subscript { lhs :: a, rhs :: [a] } @@ -553,20 +554,15 @@ instance Evaluatable New where void . withScopeAndFrame objectFrame $ do for_ instanceMembers $ \Info{..} -> do - declare infoDeclaration Default infoAccessControl infoSpan infoKind infoAssociatedScope + declare infoDeclaration Default infoAccessControl infoSpan infoAssociatedScope -- TODO: This is a typescript specific name and we should allow languages to customize it. let constructorName = Name.name "constructor" - maybeConstructor <- maybeLookupDeclaration (Declaration constructorName) - case maybeConstructor of - Just slot -> do - span <- ask @Span - reference (Reference constructorName) span ScopeGraph.New (Declaration constructorName) - constructor <- deref slot - args <- traverse eval newArguments - boundConstructor <- bindThis objectVal constructor - call boundConstructor args - Nothing -> pure objectVal + reference (Reference constructorName) (Declaration constructorName) + constructor <- deref =<< lookupSlot (Declaration constructorName) + args <- traverse eval newArguments + boundConstructor <- bindThis objectVal constructor + call boundConstructor args pure objectVal @@ -595,8 +591,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) (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..d20702c19 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 assocScope letVal <- eval letValue slot <- lookupSlot (Declaration name) assign slot letVal diff --git a/src/Language/Go/Assignment.hs b/src/Language/Go/Assignment.hs index e979cf08c..4ee99fc9f 100644 --- a/src/Language/Go/Assignment.hs +++ b/src/Language/Go/Assignment.hs @@ -258,6 +258,9 @@ element = symbol Element *> children expression fieldIdentifier :: Assignment Term fieldIdentifier = makeTerm <$> symbol FieldIdentifier <*> (Syntax.Identifier . name <$> source) +fieldIdentifier' :: Assignment Name +fieldIdentifier' = symbol FieldIdentifier *> (name <$> source) + floatLiteral :: Assignment Term floatLiteral = makeTerm <$> symbol FloatLiteral <*> (Literal.Float <$> source) @@ -295,6 +298,9 @@ runeLiteral = makeTerm <$> symbol Grammar.RuneLiteral <*> (Go.Syntax.Rune <$> so typeIdentifier :: Assignment Term typeIdentifier = makeTerm <$> symbol TypeIdentifier <*> (Syntax.Identifier . name <$> source) +typeIdentifier' :: Assignment Name +typeIdentifier' = symbol TypeIdentifier *> (name <$> source) + nil :: Assignment Term nil = makeTerm <$> symbol Nil <*> (Literal.Null <$ source) @@ -344,7 +350,7 @@ pointerType :: Assignment Term pointerType = makeTerm <$> symbol PointerType <*> children (Type.Pointer <$> expression) qualifiedType :: Assignment Term -qualifiedType = makeTerm <$> symbol QualifiedType <*> children (Expression.MemberAccess <$> expression <*> typeIdentifier) +qualifiedType = makeTerm <$> symbol QualifiedType <*> children (Expression.MemberAccess <$> expression <*> typeIdentifier') sliceType :: Assignment Term sliceType = makeTerm <$> symbol SliceType <*> children (Type.Slice <$> expression) @@ -488,7 +494,7 @@ parenthesizedExpression :: Assignment Term parenthesizedExpression = symbol ParenthesizedExpression *> children expressions selectorExpression :: Assignment Term -selectorExpression = makeWithContext <$> symbol SelectorExpression <*> children ((,,) <$> expression <*> optional comment <*> fieldIdentifier) +selectorExpression = makeWithContext <$> symbol SelectorExpression <*> children ((,,) <$> expression <*> optional comment <*> fieldIdentifier') where makeWithContext loc (lhs, comment, rhs) = maybe (makeTerm loc (Expression.MemberAccess lhs rhs)) (\c -> makeTerm loc (Syntax.Context (c :| []) (makeTerm loc (Expression.MemberAccess lhs rhs)))) comment sliceExpression :: Assignment Term diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 781b905b0..1a830bec8 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 (Just scopeAddress) aliasSlot <- lookupSlot (Declaration alias) withScope scopeAddress $ do diff --git a/src/Language/Java/Assignment.hs b/src/Language/Java/Assignment.hs index 1e6860f7d..93bccd136 100644 --- a/src/Language/Java/Assignment.hs +++ b/src/Language/Java/Assignment.hs @@ -303,7 +303,7 @@ typeIdentifier :: Assignment Term typeIdentifier = makeTerm <$> symbol TypeIdentifier <*> (Syntax.Identifier . name <$> source) scopedIdentifier :: Assignment Term -scopedIdentifier = makeTerm <$> symbol ScopedIdentifier <*> children (Expression.MemberAccess <$> term expression <*> identifier) +scopedIdentifier = makeTerm <$> symbol ScopedIdentifier <*> children (Expression.MemberAccess <$> term expression <*> identifier') superInterfaces :: Assignment [Term] superInterfaces = symbol SuperInterfaces *> children (symbol InterfaceTypeList *> children(manyTerm type')) @@ -337,7 +337,7 @@ generic :: Assignment Term generic = makeTerm <$> symbol Grammar.GenericType <*> children(Java.Syntax.GenericType <$> term type' <*> manyTerm type') methodInvocation :: Assignment Term -methodInvocation = makeTerm <$> symbol MethodInvocation <*> children (uncurry Expression.Call <$> (callFunction <$> expression <*> optional ((,) <$ optional (token AnonRParen) <* token AnonDot <*> manyTerm typeArgument <*> identifier)) <*> (argumentList <|> pure []) <*> emptyTerm) +methodInvocation = makeTerm <$> symbol MethodInvocation <*> children (uncurry Expression.Call <$> (callFunction <$> expression <*> optional ((,) <$ optional (token AnonRParen) <* token AnonDot <*> manyTerm typeArgument <*> identifier')) <*> (argumentList <|> pure []) <*> emptyTerm) where callFunction a (Just (typeArguments, b)) = (typeArguments, makeTerm1 (Expression.MemberAccess a b)) callFunction a Nothing = ([], a) @@ -347,7 +347,7 @@ methodReference = makeTerm <$> symbol Grammar.MethodReference <*> children (Java where new = makeTerm <$> token AnonNew <*> pure Java.Syntax.NewKeyword explicitConstructorInvocation :: Assignment Term -explicitConstructorInvocation = makeTerm <$> symbol ExplicitConstructorInvocation <*> children (uncurry Expression.Call <$> (callFunction <$> term expression <*> optional ((,) <$ optional (token AnonRParen) <* token AnonDot <*> manyTerm type' <*> identifier)) <*> argumentList <*> emptyTerm) +explicitConstructorInvocation = makeTerm <$> symbol ExplicitConstructorInvocation <*> children (uncurry Expression.Call <$> (callFunction <$> term expression <*> optional ((,) <$ optional (token AnonRParen) <* token AnonDot <*> manyTerm type' <*> identifier')) <*> argumentList <*> emptyTerm) where callFunction a (Just (typeArguments, b)) = (typeArguments, makeTerm1 (Expression.MemberAccess a b)) callFunction a Nothing = ([], a) @@ -402,7 +402,7 @@ type' = choice [ , makeTerm <$> symbol FloatingPointType <*> children (pure Type.Float) , makeTerm <$> symbol BooleanType <*> children (pure Type.Bool) , symbol ArrayType *> children (array <$> type' <*> dims) -- type rule recurs into itself - , makeTerm <$> symbol ScopedTypeIdentifier <*> children (Expression.MemberAccess <$> term type' <*> identifier) + , makeTerm <$> symbol ScopedTypeIdentifier <*> children (Expression.MemberAccess <$> term type' <*> identifier') , wildcard , identifier , typeIdentifier @@ -638,7 +638,7 @@ castExpression :: Assignment Term castExpression = makeTerm <$> symbol CastExpression <*> children (flip Type.Annotation <$> type' <*> term expression) fieldAccess :: Assignment Term -fieldAccess = makeTerm <$> symbol FieldAccess <*> children (Expression.MemberAccess <$> term expression <*> identifier) +fieldAccess = makeTerm <$> symbol FieldAccess <*> children (Expression.MemberAccess <$> term expression <*> identifier') spreadParameter :: Assignment Term spreadParameter = makeTerm <$> symbol Grammar.SpreadParameter <*> children (Java.Syntax.SpreadParameter <$> (makeSingleDecl <$> manyTerm modifier <*> type' <*> variableDeclarator)) diff --git a/src/Language/PHP/Assignment.hs b/src/Language/PHP/Assignment.hs index a044532e9..71560b084 100644 --- a/src/Language/PHP/Assignment.hs +++ b/src/Language/PHP/Assignment.hs @@ -303,7 +303,7 @@ parenthesizedExpression :: Assignment Term parenthesizedExpression = symbol ParenthesizedExpression *> children (term expression) classConstantAccessExpression :: Assignment Term -classConstantAccessExpression = makeTerm <$> symbol ClassConstantAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> name) +classConstantAccessExpression = makeTerm <$> symbol ClassConstantAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> name') variable :: Assignment Term variable = callableVariable <|> scopedPropertyAccessExpression <|> memberAccessExpression <|> castExpression @@ -318,11 +318,11 @@ callableVariable = choice [ ] memberCallExpression :: Assignment Term -memberCallExpression = makeTerm <$> symbol MemberCallExpression <*> children (Expression.Call [] <$> (makeMemberAccess <$> location <*> term dereferencableExpression <*> memberName) <*> arguments <*> emptyTerm) +memberCallExpression = makeTerm <$> symbol MemberCallExpression <*> children (Expression.Call [] <$> (makeMemberAccess <$> location <*> term dereferencableExpression <*> memberName') <*> arguments <*> emptyTerm) where makeMemberAccess loc expr memberName = makeTerm loc (Expression.MemberAccess expr memberName) scopedCallExpression :: Assignment Term -scopedCallExpression = makeTerm <$> symbol ScopedCallExpression <*> children (Expression.Call [] <$> (makeMemberAccess <$> location <*> term scopeResolutionQualifier <*> memberName) <*> arguments <*> emptyTerm) +scopedCallExpression = makeTerm <$> symbol ScopedCallExpression <*> children (Expression.Call [] <$> (makeMemberAccess <$> location <*> term scopeResolutionQualifier <*> memberName') <*> arguments <*> emptyTerm) where makeMemberAccess loc expr memberName = makeTerm loc (Expression.MemberAccess expr memberName) functionCallExpression :: Assignment Term @@ -340,13 +340,13 @@ subscriptExpression :: Assignment Term subscriptExpression = makeTerm <$> symbol SubscriptExpression <*> children (Expression.Subscript <$> term dereferencableExpression <*> (pure <$> (term expression <|> emptyTerm))) memberAccessExpression :: Assignment Term -memberAccessExpression = makeTerm <$> symbol MemberAccessExpression <*> children (Expression.MemberAccess <$> term dereferencableExpression <*> memberName) +memberAccessExpression = makeTerm <$> symbol MemberAccessExpression <*> children (Expression.MemberAccess <$> term dereferencableExpression <*> memberName') dereferencableExpression :: Assignment Term dereferencableExpression = symbol DereferencableExpression *> children (term (variable <|> expression <|> arrayCreationExpression <|> string)) scopedPropertyAccessExpression :: Assignment Term -scopedPropertyAccessExpression = makeTerm <$> symbol ScopedPropertyAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> simpleVariable') +scopedPropertyAccessExpression = makeTerm <$> symbol ScopedPropertyAccessExpression <*> children (Expression.MemberAccess <$> term scopeResolutionQualifier <*> simpleVariable'') scopeResolutionQualifier :: Assignment Term scopeResolutionQualifier = choice [ diff --git a/src/Language/Python/Assignment.hs b/src/Language/Python/Assignment.hs index 9dc016b98..a24be365b 100644 --- a/src/Language/Python/Assignment.hs +++ b/src/Language/Python/Assignment.hs @@ -32,6 +32,7 @@ import qualified Data.Syntax.Literal as Literal import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import qualified Data.Term as Term +import qualified Data.Text as T import Language.Python.Grammar as Grammar import Language.Python.Syntax as Python.Syntax import Prologue @@ -114,7 +115,6 @@ type Syntax = , Syntax.Error , Syntax.Identifier , Type.Annotation - , Python.Syntax.Alias , [] ] @@ -377,6 +377,9 @@ yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children (term ( expr identifier :: Assignment Term identifier = makeTerm <$> (symbol Identifier <|> symbol Identifier' <|> symbol DottedName) <*> (Syntax.Identifier . name <$> source) +identifier' :: Assignment Name +identifier' = (symbol Identifier <|> symbol Identifier' <|> symbol DottedName) *> (name <$> source) + set :: Assignment Term set = makeTerm <$> symbol Set <*> children (Literal.Set <$> manyTerm expression) @@ -412,11 +415,11 @@ import' = makeTerm'' <$> symbol ImportStatement <*> children (manyTerm (aliase -- `import a as b` aliasedImport = makeTerm <$> symbol AliasedImport <*> children (Python.Syntax.QualifiedAliasedImport <$> importPath <*> expression) -- `import a` - plainImport = makeTerm <$> symbol DottedName <*> children (Python.Syntax.QualifiedImport <$> NonEmpty.some1 identifier) + plainImport = makeTerm <$> symbol DottedName <*> children (Python.Syntax.QualifiedImport . NonEmpty.map T.unpack <$> NonEmpty.some1 identifierSource) -- `from a import foo ` - importSymbol = makeNameAliasPair <$> (symbol Identifier <|> symbol Identifier' <|> symbol DottedName) <*> (mkIdentifier <$> location <*> source) + importSymbol = makeNameAliasPair <$> aliasIdentifier <*> pure Nothing -- `from a import foo as bar` - aliasImportSymbol = makeTerm <$> symbol AliasedImport <*> children (Python.Syntax.Alias <$> identifier <*> identifier) + aliasImportSymbol = symbol AliasedImport *> children (makeNameAliasPair <$> aliasIdentifier <*> (Just <$> aliasIdentifier)) -- `from a import *` wildcard = symbol WildcardImport *> (name <$> source) $> [] @@ -426,8 +429,9 @@ import' = makeTerm'' <$> symbol ImportStatement <*> children (manyTerm (aliase importPrefix = symbol ImportPrefix *> source identifierSource = (symbol Identifier <|> symbol Identifier') *> source - makeNameAliasPair location alias = makeTerm location (Python.Syntax.Alias alias alias) - mkIdentifier location source = makeTerm location (Syntax.Identifier (name source)) + aliasIdentifier = (symbol Identifier <|> symbol Identifier') *> (name <$> source) <|> symbol DottedName *> (name <$> source) + makeNameAliasPair from (Just alias) = Python.Syntax.Alias from alias + makeNameAliasPair from Nothing = Python.Syntax.Alias from from assertStatement :: Assignment Term assertStatement = makeTerm <$> symbol AssertStatement <*> children (Expression.Call [] <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier . name <$> source)) <*> manyTerm expression <*> emptyTerm) @@ -484,7 +488,7 @@ continueStatement :: Assignment Term continueStatement = makeTerm <$> symbol ContinueStatement <*> (Statement.Continue <$> emptyTerm <* advance) memberAccess :: Assignment Term -memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> term expression <*> identifier) +memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> term expression <*> identifier') subscript :: Assignment Term subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> term expression <*> manyTerm expression) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index eaa055226..61d3529fc 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -123,6 +123,7 @@ instance Evaluatable Import where path <- NonEmpty.last <$> resolvePythonModules (RelativeQualifiedName n (Just (qualifiedName (formatName aliasValue' :| [])))) ((moduleScope, moduleFrame), _) <- require path + span <- ask @Span -- Construct a proxy scope containing an import edge to the imported module's last returned scope. importScope <- newScope (Map.singleton ScopeGraph.Import [ moduleScope ]) @@ -189,7 +190,7 @@ instance Evaluatable QualifiedImport where eval _ _ (QualifiedImport qualifiedNames) = do qualifiedName <- fmap (T.unpack . formatName) <$> traverse (\term -> maybeM (throwNoNameError term) (declaredName term)) qualifiedNames modulePaths <- resolvePythonModules (QualifiedName qualifiedName) - let namesAndPaths = toList (NonEmpty.zip (NonEmpty.zip qualifiedNames (Data.Abstract.Evaluatable.name . T.pack <$> qualifiedName)) modulePaths) + let namesAndPaths = toList (NonEmpty.zip (Data.Abstract.Evaluatable.name . T.pack <$> qualifiedName) modulePaths) go namesAndPaths unit @@ -208,7 +209,7 @@ instance Evaluatable QualifiedImport where assign aliasSlot val withFrame objFrame $ do - let (namePaths, rest) = List.partition ((== name) . snd . fst) namesAndPaths + let (namePaths, rest) = List.partition ((== name) . fst) namesAndPaths for_ namePaths $ \(_, modulePath) -> do mkScopeMap modulePath $ \scopeMap -> do withFrame objFrame $ do @@ -231,7 +232,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 (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..89363e47b 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -77,8 +77,7 @@ instance Evaluatable Send where lhsFrame <- Abstract.scopedEnvironment lhsValue let callFunction = do - span <- ask @Span - reference (Reference sel) span ScopeGraph.Call (Declaration sel) + reference (Reference sel) (Declaration sel) func <- deref =<< lookupSlot (Declaration sel) args <- traverse eval sendArgs boundFunc <- bindThis lhsValue func @@ -210,7 +209,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 (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) childFrame <- newFrame classScope frameEdges @@ -260,7 +259,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 (Just classScope) currentFrame' <- currentFrame let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame') @@ -326,7 +325,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 Nothing) (const (pure ())) maybeSlot lhs <- ref assignmentTarget rhs <- eval assignmentValue diff --git a/src/Language/TypeScript/Assignment.hs b/src/Language/TypeScript/Assignment.hs index 20ddda62d..e9e143c02 100644 --- a/src/Language/TypeScript/Assignment.hs +++ b/src/Language/TypeScript/Assignment.hs @@ -298,7 +298,7 @@ ternaryExpression :: Assignment Term ternaryExpression = makeTerm <$> symbol Grammar.TernaryExpression <*> children (Statement.If <$> term expression <*> term expression <*> term expression) memberExpression :: Assignment Term -memberExpression = makeTerm <$> (symbol Grammar.MemberExpression <|> symbol Grammar.MemberExpression') <*> children (Expression.MemberAccess <$> term expression <*> propertyIdentifier) +memberExpression = makeTerm <$> (symbol Grammar.MemberExpression <|> symbol Grammar.MemberExpression') <*> children (Expression.MemberAccess <$> term expression <*> propertyIdentifier') newExpression :: Assignment Term newExpression = makeTerm <$> symbol Grammar.NewExpression <*> children (Expression.New <$> term constructableExpression <*> (typeArguments' <|> emptyTerm) <*> (arguments <|> pure [])) diff --git a/src/Language/TypeScript/Syntax/Import.hs b/src/Language/TypeScript/Syntax/Import.hs index 6a2fd248a..4553e11cc 100644 --- a/src/Language/TypeScript/Syntax/Import.hs +++ b/src/Language/TypeScript/Syntax/Import.hs @@ -13,7 +13,6 @@ import Data.JSON.Fields import qualified Data.Map.Strict as Map import Diffing.Algorithm import Language.TypeScript.Resolution -import Data.Span (emptySpan) data Import a = Import { importSymbols :: ![Alias], importFrom :: ImportPath } deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, NFData1, Ord, Show, ToJSONFields1, Traversable) @@ -36,9 +35,7 @@ instance Evaluatable Import where -- Insert import references into the import scope starting from the perspective of the import scope. withScopeAndFrame moduleFrame $ do 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) (Declaration aliasValue) scopeAddress -- Create edges from the current scope/frame to the import scope/frame. insertImportEdge scopeAddress @@ -60,7 +57,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 (Just importScope) aliasSlot <- lookupSlot (Declaration alias) assign aliasSlot =<< object aliasFrame @@ -90,8 +87,7 @@ instance Evaluatable QualifiedExport where insertExportEdge exportScope -- Create an export edge from the current scope to the export scope 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) (Declaration aliasValue) -- Create an export edge from a new scope to the qualifed export's scope. unit @@ -117,8 +113,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) (Declaration aliasValue) exportScope insertExportEdge exportScope insertFrameLink ScopeGraph.Export (Map.singleton exportScope exportFrame) @@ -139,7 +134,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 Nothing defaultSlot <- lookupSlot declaration assign defaultSlot valueRef diff --git a/src/Language/TypeScript/Syntax/JSX.hs b/src/Language/TypeScript/Syntax/JSX.hs index c4e7c9824..ade425718 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 Nothing lhs <- ref requiredParameterSubject rhs <- eval requiredParameterValue diff --git a/src/Language/TypeScript/Syntax/JavaScript.hs b/src/Language/TypeScript/Syntax/JavaScript.hs index 0f0bbc671..d8bbf9488 100644 --- a/src/Language/TypeScript/Syntax/JavaScript.hs +++ b/src/Language/TypeScript/Syntax/JavaScript.hs @@ -3,6 +3,7 @@ module Language.TypeScript.Syntax.JavaScript where import Prologue + import Control.Abstract.Heap import Control.Abstract.ScopeGraph hiding (Import) import Data.Abstract.Evaluatable @@ -25,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 (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..704e15142 100644 --- a/src/Language/TypeScript/Syntax/TypeScript.hs +++ b/src/Language/TypeScript/Syntax/TypeScript.hs @@ -13,7 +13,6 @@ import Data.Semigroup.App import Data.Semigroup.Foldable import qualified Data.Text as T import Diffing.Algorithm -import qualified Data.Abstract.ScopeGraph as ScopeGraph -- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo } newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier { contents :: T.Text } @@ -212,7 +211,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 (Just childScope) currentFrame' <- currentFrame let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame') @@ -268,13 +267,13 @@ instance Evaluatable AbstractClass where superclassFrame <- scopedEnvironment =<< deref slot pure $ case (scope, superclassFrame) of (Just scope, Just frame) -> Just (scope, frame) - _ -> Nothing + _ -> Nothing let superclassEdges = (Superclass, ) . pure . fst <$> catMaybes superScopes 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 (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 2b1211050..8cd7166f0 100644 --- a/src/Language/TypeScript/Syntax/Types.hs +++ b/src/Language/TypeScript/Syntax/Types.hs @@ -9,7 +9,6 @@ import Data.Abstract.Evaluatable as Evaluatable import Data.JSON.Fields import qualified Data.Text as T import Diffing.Algorithm -import qualified Data.Abstract.ScopeGraph as ScopeGraph -- | Lookup type for a type-level key in a typescript map. data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a } @@ -61,14 +60,12 @@ newtype TypeIdentifier a = TypeIdentifier { contents :: T.Text } instance Declarations1 TypeIdentifier where liftDeclaredName _ (TypeIdentifier identifier) = Just (Evaluatable.name identifier) - liftDeclaredAlias _ (TypeIdentifier identifier) = Just (Evaluatable.name identifier) -- TODO: TypeIdentifier shouldn't evaluate to an address in the heap? 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)) (Declaration (Evaluatable.name contents)) unit data NestedTypeIdentifier a = NestedTypeIdentifier { left :: !a, right :: !a } diff --git a/src/Proto3/Google/Timestamp.hs b/src/Proto3/Google/Timestamp.hs index aee87c933..f95b4ac7a 100644 --- a/src/Proto3/Google/Timestamp.hs +++ b/src/Proto3/Google/Timestamp.hs @@ -4,6 +4,7 @@ module Proto3.Google.Timestamp (Timestamp (..)) where import Prologue +import Data.Aeson import Proto3.Suite -- | Predefined timestamp message provided by Google. The schema can be found @@ -11,4 +12,4 @@ import Proto3.Suite data Timestamp = Timestamp { timestampSeconds :: Int64 , timestampNanos :: Int32 - } deriving (Eq, Show, Generic, Message, Named, NFData) + } deriving (Eq, Ord, Show, Generic, Message, Named, NFData, FromJSON, ToJSON) diff --git a/src/Proto3/Google/Wrapped.hs b/src/Proto3/Google/Wrapped.hs index 458555ec7..c4b0e96f9 100644 --- a/src/Proto3/Google/Wrapped.hs +++ b/src/Proto3/Google/Wrapped.hs @@ -14,7 +14,7 @@ import Proto3.Suite -- a separate data type for each of these wrappers: we just need to declare 'Named' instances for each instance -- for which we want to link the Google-named wrapped types. newtype Wrapped a = Wrapped { value :: a } - deriving (Eq, Show, Generic, NFData) + deriving (Eq, Show, Ord, Generic, NFData) instance Named (Wrapped Text) where nameOf _ = "StringValue" instance Named (Wrapped ByteString) where nameOf _ = "BytesValue" diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs index 3096fd6ab..f30a72db5 100644 --- a/src/Rendering/Graph.hs +++ b/src/Rendering/Graph.hs @@ -18,8 +18,10 @@ import Data.Patch import Data.String (IsString (..)) import Data.Term import Prologue -import Semantic.API.Helpers -import Semantic.API.Types +import Semantic.Api.Helpers +import Semantic.Api.V1.CodeAnalysisPB + +import qualified Data.Text as T -- TODO: rename as this isn't a render renderTreeGraph :: (Ord vertex, Recursive t, ToTreeGraph vertex (Base t)) => t -> Graph vertex @@ -45,10 +47,10 @@ diffStyle name = (defaultStyle (fromString . show . diffVertexId)) { graphName = fromString (quote name) , vertexAttributes = vertexAttributes } where quote a = "\"" <> a <> "\"" - vertexAttributes (DiffTreeVertex _ (Just (Deleted (Just DeletedTerm{..})))) = [ "label" := fromString term, "color" := "red" ] - vertexAttributes (DiffTreeVertex _ (Just (Inserted (Just InsertedTerm{..})))) = [ "label" := fromString term, "color" := "green" ] + vertexAttributes (DiffTreeVertex _ (Just (Deleted (Just DeletedTerm{..})))) = [ "label" := fromString (T.unpack term), "color" := "red" ] + vertexAttributes (DiffTreeVertex _ (Just (Inserted (Just InsertedTerm{..})))) = [ "label" := fromString (T.unpack term), "color" := "green" ] vertexAttributes (DiffTreeVertex _ (Just (Replaced (Just ReplacedTerm{..})))) = [ "label" := "Replacement", "color" := "orange", "style" := "dashed" ] - vertexAttributes (DiffTreeVertex _ (Just (Merged (Just MergedTerm{..})))) = [ "label" := fromString term ] + vertexAttributes (DiffTreeVertex _ (Just (Merged (Just MergedTerm{..})))) = [ "label" := fromString (T.unpack term) ] vertexAttributes _ = [] class ToTreeGraph vertex t | t -> vertex where @@ -70,22 +72,22 @@ instance (ConstructorName syntax, Foldable syntax) => termAlgebra (In ann syntax) = do i <- fresh parent <- ask - let root = vertex (TermVertex i (constructorName syntax) (spanToSpan (locationSpan ann))) + let root = vertex (TermVertex (fromIntegral i) (T.pack (constructorName syntax)) (spanToSpan (locationSpan ann))) subGraph <- foldl' (\acc x -> overlay <$> acc <*> local (const root) x) (pure mempty) syntax pure (parent `connect` root `overlay` subGraph) instance (ConstructorName syntax, Foldable syntax) => ToTreeGraph DiffTreeVertex (DiffF syntax Location Location) where toTreeGraph d = case d of - Merge t@(In (a1, a2) syntax) -> diffAlgebra t (Merged (Just (MergedTerm (constructorName syntax) (ann a1) (ann a2)))) - Patch (Delete t1@(In a1 syntax)) -> diffAlgebra t1 (Deleted (Just (DeletedTerm (constructorName syntax) (ann a1)))) - Patch (Insert t2@(In a2 syntax)) -> diffAlgebra t2 (Inserted (Just (InsertedTerm (constructorName syntax) (ann a2)))) + Merge t@(In (a1, a2) syntax) -> diffAlgebra t (Merged (Just (MergedTerm (T.pack (constructorName syntax)) (ann a1) (ann a2)))) + Patch (Delete t1@(In a1 syntax)) -> diffAlgebra t1 (Deleted (Just (DeletedTerm (T.pack (constructorName syntax)) (ann a1)))) + Patch (Insert t2@(In a2 syntax)) -> diffAlgebra t2 (Inserted (Just (InsertedTerm (T.pack (constructorName syntax)) (ann a2)))) Patch (Replace t1@(In a1 syntax1) t2@(In a2 syntax2)) -> do i <- fresh parent <- ask - let (beforeName, beforeSpan) = (constructorName syntax1, ann a1) - let (afterName, afterSpan) = (constructorName syntax2, ann a2) - let replace = vertex (DiffTreeVertex i (Just (Replaced (Just (ReplacedTerm beforeName beforeSpan afterName afterSpan))))) + let (beforeName, beforeSpan) = (T.pack (constructorName syntax1), ann a1) + let (afterName, afterSpan) = (T.pack (constructorName syntax2), ann a2) + let replace = vertex (DiffTreeVertex (fromIntegral i) (Just (Replaced (Just (ReplacedTerm beforeName beforeSpan afterName afterSpan))))) graph <- local (const replace) (overlay <$> diffAlgebra t1 (Deleted (Just (DeletedTerm beforeName beforeSpan))) <*> diffAlgebra t2 (Inserted (Just (InsertedTerm afterName afterSpan)))) pure (parent `connect` replace `overlay` graph) where @@ -96,10 +98,10 @@ instance (ConstructorName syntax, Foldable syntax) => , Member (Reader (Graph DiffTreeVertex)) sig , Carrier sig m , Monad m - ) => f (m (Graph DiffTreeVertex)) -> DiffTreeTerm -> m (Graph DiffTreeVertex) + ) => f (m (Graph DiffTreeVertex)) -> DiffTreeVertexDiffTerm -> m (Graph DiffTreeVertex) diffAlgebra syntax a = do i <- fresh parent <- ask - let root = vertex (DiffTreeVertex i (Just a)) + let root = vertex (DiffTreeVertex (fromIntegral i) (Just a)) subGraph <- foldl' (\acc x -> overlay <$> acc <*> local (const root) x) (pure mempty) syntax pure (parent `connect` root `overlay` subGraph) diff --git a/src/Semantic/API.hs b/src/Semantic/API.hs index f2659d3db..a284654af 100644 --- a/src/Semantic/API.hs +++ b/src/Semantic/API.hs @@ -1,4 +1,4 @@ -module Semantic.API +module Semantic.Api ( module DiffsAPI , module SymbolsAPI @@ -7,8 +7,8 @@ module Semantic.API , module Types ) where -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.Types as Types +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(..)) diff --git a/src/Semantic/API/Diffs.hs b/src/Semantic/API/Diffs.hs index f3f61c41e..4ff363278 100644 --- a/src/Semantic/API/Diffs.hs +++ b/src/Semantic/API/Diffs.hs @@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, ConstraintKinds, TypeOperators, RankNTypes #-} -module Semantic.API.Diffs +module Semantic.Api.Diffs ( parseDiffBuilder , DiffOutputFormat(..) , diffGraph @@ -26,15 +26,16 @@ import Data.Language import Data.Location import Data.Term import qualified Data.Text as T +import qualified Data.Vector as V import Diffing.Algorithm (Diffable) import Parsing.Parser import Prologue import Rendering.Graph import Rendering.JSON hiding (JSON) import qualified Rendering.JSON -import Semantic.API.Helpers -import Semantic.API.Types hiding (Blob, BlobPair) -import qualified Semantic.API.Types as API +import Semantic.Api.Helpers +import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, BlobPair, Language(..)) +import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task as Task import Semantic.Telemetry as Stat import Serializing.Format hiding (JSON) @@ -72,21 +73,21 @@ renderJSONGraph :: (Applicative m, Functor syntax, Foldable syntax, ConstructorN renderJSONGraph blobPair = pure . renderJSONAdjDiff blobPair . renderTreeGraph diffGraph :: (Traversable t, DiffEffects sig m) => t API.BlobPair -> m DiffTreeGraphResponse -diffGraph blobs = DiffTreeGraphResponse . toList <$> distributeFor (apiBlobPairToBlobPair <$> blobs) go +diffGraph blobs = DiffTreeGraphResponse . V.fromList . toList <$> distributeFor (apiBlobPairToBlobPair <$> blobs) go where go :: (DiffEffects sig m) => BlobPair -> m DiffTreeFileGraph go blobPair = doDiff blobPair (const pure) render `catchError` \(SomeException e) -> - pure (DiffTreeFileGraph path lang mempty mempty [ParseError (show e)]) + pure (DiffTreeFileGraph path lang mempty mempty (V.fromList [ParseError (T.pack (show e))])) where path = T.pack $ pathForBlobPair blobPair - lang = languageForBlobPair blobPair + lang = languageToApiLanguage $ languageForBlobPair blobPair render :: (Foldable syntax, Functor syntax, ConstructorName syntax, Applicative m) => BlobPair -> Diff syntax Location Location -> m DiffTreeFileGraph render _ diff = let graph = renderTreeGraph diff toEdge (Edge (a, b)) = DiffTreeEdge (diffVertexId a) (diffVertexId b) - in pure $ DiffTreeFileGraph path lang (vertexList graph) (fmap toEdge (edgeList graph)) mempty + in pure $ DiffTreeFileGraph path lang (V.fromList (vertexList graph)) (V.fromList (fmap toEdge (edgeList graph))) mempty sexpDiff :: (DiffEffects sig m) => BlobPair -> m Builder diff --git a/src/Semantic/API/Helpers.hs b/src/Semantic/API/Helpers.hs index a942fe365..5e86bc458 100644 --- a/src/Semantic/API/Helpers.hs +++ b/src/Semantic/API/Helpers.hs @@ -1,24 +1,27 @@ {-# LANGUAGE LambdaCase #-} -module Semantic.API.Helpers +module Semantic.Api.Helpers ( spanToSpan , spanToLegacySpan , toChangeType , apiBlobToBlob , apiBlobPairToBlobPair + , apiLanguageToLanguage + , languageToApiLanguage ) where import Data.Bifunctor.Join import qualified Data.Blob as Data +import qualified Data.Language as Data import Data.Source (fromText) import qualified Data.Span as Data import qualified Data.Text as T import Data.These -import qualified Semantic.API.LegacyTypes as Legacy -import qualified Semantic.API.Types as API +import qualified Semantic.Api.LegacyTypes as Legacy +import qualified Semantic.Api.V1.CodeAnalysisPB as API spanToSpan :: Data.Span -> Maybe API.Span spanToSpan Data.Span{..} = Just $ API.Span (toPos spanStart) (toPos spanEnd) - where toPos Data.Pos{..} = Just $ API.Position posLine posColumn + where toPos Data.Pos{..} = Just $ API.Position (fromIntegral posLine) (fromIntegral posColumn) spanToLegacySpan :: Data.Span -> Maybe Legacy.Span spanToLegacySpan Data.Span{..} = Just $ Legacy.Span (toPos spanStart) (toPos spanEnd) @@ -32,7 +35,37 @@ toChangeType = \case _ -> API.None apiBlobToBlob :: API.Blob -> Data.Blob -apiBlobToBlob API.Blob{..} = Data.Blob (fromText content) path language +apiBlobToBlob API.Blob{..} = Data.Blob (fromText content) (T.unpack path) (apiLanguageToLanguage language) + +apiLanguageToLanguage :: API.Language -> 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 + +languageToApiLanguage :: Data.Language -> API.Language +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 apiBlobPairToBlobPair :: API.BlobPair -> Data.BlobPair apiBlobPairToBlobPair (API.BlobPair (Just before) (Just after)) = Join (These (apiBlobToBlob before) (apiBlobToBlob after)) diff --git a/src/Semantic/API/LegacyTypes.hs b/src/Semantic/API/LegacyTypes.hs index 2bde52f7d..5aebf7cb0 100644 --- a/src/Semantic/API/LegacyTypes.hs +++ b/src/Semantic/API/LegacyTypes.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DerivingVia, DeriveAnyClass, DuplicateRecordFields #-} -module Semantic.API.LegacyTypes +module Semantic.Api.LegacyTypes ( DiffTreeRequest(..) , ParseTreeRequest(..) , ParseTreeSymbolResponse(..) diff --git a/src/Semantic/API/Symbols.hs b/src/Semantic/API/Symbols.hs index 9267cc44b..cf7c11e42 100644 --- a/src/Semantic/API/Symbols.hs +++ b/src/Semantic/API/Symbols.hs @@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, TypeOperators, DerivingStrategies #-} -module Semantic.API.Symbols +module Semantic.Api.Symbols ( legacyParseSymbols , parseSymbols , parseSymbolsBuilder @@ -15,14 +15,16 @@ import Data.ByteString.Builder import Data.Location import Data.Maybe import Data.Term +import qualified Data.Text as T +import qualified Data.Vector as V import Data.Text (pack) import Parsing.Parser import Prologue -import Semantic.API.Helpers -import qualified Semantic.API.LegacyTypes as Legacy -import Semantic.API.Terms (ParseEffects, doParse) -import Semantic.API.Types hiding (Blob) -import qualified Semantic.API.Types as API +import Semantic.Api.Helpers +import qualified Semantic.Api.LegacyTypes as Legacy +import Semantic.Api.Terms (ParseEffects, doParse) +import Semantic.Api.V1.CodeAnalysisPB hiding (Blob) +import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task import Serializing.Format import Tags.Taggable @@ -56,18 +58,18 @@ parseSymbolsBuilder blobs = legacyParseSymbols blobs >>= serialize JSON parseSymbols :: (Member Distribute sig, ParseEffects sig m, Traversable t) => t API.Blob -> m ParseTreeSymbolResponse -parseSymbols blobs = ParseTreeSymbolResponse . toList <$> distributeFor (apiBlobToBlob <$> blobs) go +parseSymbols blobs = ParseTreeSymbolResponse . V.fromList . toList <$> distributeFor (apiBlobToBlob <$> blobs) go where go :: (Member (Error SomeException) sig, Member Task sig, Carrier sig m, Monad m) => Blob -> m File go blob@Blob{..} = (doParse blob >>= withSomeTerm (renderToSymbols blob)) `catchError` (\(SomeException e) -> pure $ errorFile (show e)) where - errorFile e = File (pack blobPath) blobLanguage mempty [ParseError e] + errorFile e = File (pack blobPath) (languageToApiLanguage blobLanguage) mempty (V.fromList [ParseError (T.pack e)]) renderToSymbols :: (IsTaggable f, Applicative m) => Blob -> Term f Location -> m File renderToSymbols blob@Blob{..} term = pure $ either (errorFile . show) (tagsToFile blob) (runTagging blob term) tagsToFile :: Blob -> [Tag] -> File - tagsToFile Blob{..} tags = File (pack blobPath) blobLanguage (fmap tagToSymbol tags) mempty + tagsToFile Blob{..} tags = File (pack blobPath) (languageToApiLanguage blobLanguage) (V.fromList (fmap tagToSymbol tags)) mempty tagToSymbol :: Tag -> Symbol tagToSymbol Tag{..} @@ -76,4 +78,5 @@ parseSymbols blobs = ParseTreeSymbolResponse . toList <$> distributeFor (apiBlob , kind = kind , line = fromMaybe mempty line , span = spanToSpan span + , docs = fmap Docstring docs } diff --git a/src/Semantic/API/TOCSummaries.hs b/src/Semantic/API/TOCSummaries.hs index 580807bfa..ff8d7c0b7 100644 --- a/src/Semantic/API/TOCSummaries.hs +++ b/src/Semantic/API/TOCSummaries.hs @@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, TypeOperators, DerivingStrategies #-} -module Semantic.API.TOCSummaries (diffSummary, legacyDiffSummary, diffSummaryBuilder) where +module Semantic.Api.TOCSummaries (diffSummary, legacyDiffSummary, diffSummaryBuilder) where import Analysis.TOCSummary (Declaration, declarationAlgebra) import Control.Effect.Error @@ -10,11 +10,12 @@ import Data.Diff import qualified Data.Map.Monoidal as Map import Data.Span (emptySpan) import qualified Data.Text as T +import qualified Data.Vector as V import Rendering.TOC -import Semantic.API.Diffs -import Semantic.API.Helpers -import Semantic.API.Types hiding (Blob, BlobPair) -import qualified Semantic.API.Types as API +import Semantic.Api.Diffs +import Semantic.Api.Helpers +import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, BlobPair) +import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task as Task import Serializing.Format @@ -37,23 +38,23 @@ legacyDiffSummary = distributeFoldMap go render blobPair = pure . renderToCDiff blobPair diffSummary :: (DiffEffects sig m) => [API.BlobPair] -> m DiffTreeTOCResponse -diffSummary blobs = DiffTreeTOCResponse <$> distributeFor (apiBlobPairToBlobPair <$> blobs) go +diffSummary blobs = DiffTreeTOCResponse . V.fromList <$> distributeFor (apiBlobPairToBlobPair <$> blobs) go where go :: (DiffEffects sig m) => BlobPair -> m TOCSummaryFile go blobPair = doDiff blobPair (decorate . declarationAlgebra) render `catchError` \(SomeException e) -> - pure $ TOCSummaryFile path lang mempty [TOCSummaryError (T.pack (show e)) Nothing] + pure $ TOCSummaryFile path lang mempty (V.fromList [TOCSummaryError (T.pack (show e)) Nothing]) where path = T.pack $ pathKeyForBlobPair blobPair - lang = languageForBlobPair blobPair + lang = languageToApiLanguage $ languageForBlobPair blobPair render :: (Foldable syntax, Functor syntax, Applicative m) => BlobPair -> Diff syntax (Maybe Declaration) (Maybe Declaration) -> m TOCSummaryFile render blobPair diff = pure $ foldr go (TOCSummaryFile path lang mempty mempty) (diffTOC diff) where path = T.pack $ pathKeyForBlobPair blobPair - lang = languageForBlobPair blobPair + lang = languageToApiLanguage $ languageForBlobPair blobPair go :: TOCSummary -> TOCSummaryFile -> TOCSummaryFile go TOCSummary{..} TOCSummaryFile{..} - = TOCSummaryFile path language (TOCSummaryChange summaryCategoryName summaryTermName (spanToSpan summarySpan) (toChangeType summaryChangeType) : changes) errors + = TOCSummaryFile path language (V.cons (TOCSummaryChange summaryCategoryName summaryTermName (spanToSpan summarySpan) (toChangeType summaryChangeType)) changes) errors go ErrorSummary{..} TOCSummaryFile{..} - = TOCSummaryFile path language changes (TOCSummaryError errorText (spanToSpan errorSpan) : errors) + = TOCSummaryFile path language changes (V.cons (TOCSummaryError errorText (spanToSpan errorSpan)) errors) diff --git a/src/Semantic/API/Terms.hs b/src/Semantic/API/Terms.hs index f920d086a..c2d58a4ad 100644 --- a/src/Semantic/API/Terms.hs +++ b/src/Semantic/API/Terms.hs @@ -1,5 +1,5 @@ {-# LANGUAGE ConstraintKinds, GADTs, TypeOperators, DerivingStrategies #-} -module Semantic.API.Terms +module Semantic.Api.Terms ( termGraph , parseTermBuilder @@ -28,36 +28,37 @@ import Data.JSON.Fields import Data.Language import Data.Location import Data.Quieterm +import Data.Term import qualified Data.Text as T +import qualified Data.Vector as V import Parsing.Parser import Prologue import Rendering.Graph import Rendering.JSON hiding (JSON) import qualified Rendering.JSON -import Semantic.API.Helpers -import Semantic.API.Types hiding (Blob) -import qualified Semantic.API.Types as API +import Semantic.Api.Helpers +import Semantic.Api.V1.CodeAnalysisPB hiding (Blob, Language (..)) +import qualified Semantic.Api.V1.CodeAnalysisPB as API import Semantic.Task import Serializing.Format hiding (JSON) import qualified Serializing.Format as Format import Tags.Taggable -import Data.Term termGraph :: (Traversable t, Member Distribute sig, ParseEffects sig m) => t API.Blob -> m ParseTreeGraphResponse -termGraph blobs = ParseTreeGraphResponse . toList <$> distributeFor (fmap apiBlobToBlob blobs) go +termGraph blobs = ParseTreeGraphResponse . V.fromList . toList <$> distributeFor (fmap apiBlobToBlob blobs) go where go :: ParseEffects sig m => Blob -> m ParseTreeFileGraph go blob = (doParse blob >>= withSomeTerm (pure . render)) `catchError` \(SomeException e) -> - pure (ParseTreeFileGraph path lang mempty mempty [ParseError (show e)]) + pure (ParseTreeFileGraph path lang mempty mempty (V.fromList [ParseError (T.pack (show e))])) where - path = T.pack (blobPath blob) - lang = blobLanguage blob + path = T.pack $ blobPath blob + lang = languageToApiLanguage $ blobLanguage blob render :: (Foldable syntax, Functor syntax, ConstructorName syntax) => Term syntax Location -> ParseTreeFileGraph render t = let graph = renderTreeGraph t toEdge (Edge (a, b)) = TermEdge (vertexId a) (vertexId b) - in ParseTreeFileGraph path lang (vertexList graph) (fmap toEdge (edgeList graph)) mempty + in ParseTreeFileGraph path lang (V.fromList (vertexList graph)) (V.fromList (fmap toEdge (edgeList graph))) mempty data TermOutputFormat = TermJSONTree diff --git a/src/Semantic/API/Types.hs b/src/Semantic/API/Types.hs deleted file mode 100644 index 06b72e2bd..000000000 --- a/src/Semantic/API/Types.hs +++ /dev/null @@ -1,343 +0,0 @@ -{-# LANGUAGE DerivingVia, DeriveAnyClass, DuplicateRecordFields, LambdaCase #-} -module Semantic.API.Types - ( - -- Parse APIs - ParseTreeRequest(..) - , Blob(..) - , BlobPair(..) - - -- Symbols for jump-to-definition - , ParseTreeSymbolResponse(..) - , File(..) - , Symbol(..) - - -- Diff APIs - , DiffTreeRequest(..) - - -- TOC Summaries - , DiffTreeTOCResponse(..) - , TOCSummaryFile(..) - , TOCSummaryChange(..) - , TOCSummaryError(..) - , ChangeType(..) - - -- Diff tree graphs - , DiffTreeGraphResponse(..) - , DiffTreeFileGraph(..) - , DiffTreeEdge(..) - , DiffTreeVertex(..) - , DiffTreeTerm(..) - , DeletedTerm(..) - , InsertedTerm(..) - , ReplacedTerm(..) - , MergedTerm(..) - - -- Parse tree graphs - , ParseTreeGraphResponse(..) - , ParseTreeFileGraph(..) - , TermVertex(..) - , TermEdge(..) - , ParseError(..) - - -- Health Check - , PingRequest(..) - , PingResponse(..) - - -- Common Types - , Span(..) - , Position(..) - - -- Mime Types - , Protobuf - ) where - -import Data.Aeson -import Data.Bifunctor (first) -import Data.ByteString.Lazy.Char8 as BC -import Data.Char (toUpper) -import Data.Graph (VertexTag (..)) -import Data.Language -import Data.String -import qualified Data.Text as T -import GHC.Generics -import Network.HTTP.Media ((//)) -import Prologue -import Proto3.Suite as Proto3 -import Servant.API - --- These types represent the public API of semantic and are used to generate --- `proto/semantic.proto`. --- --- Some guidelines: --- --- * Don't write Message, Named, ToJSON, or FromJSON instances by hand, derive --- them. --- --- * For non-primitive types, you'll always want to use Maybe as protobuf --- fields are always optional. --- --- * It's usually best to map internal types to these API types so that the --- API contract can be changed intentionally. This also makes it so that core --- functionality doesn't have to deal with all the Maybes. --- --- * Keep field names short and meaningful for external consumers. It's better --- to skirt Haskell naming conventions in favor of consistency in our proto --- files. - --- --- Parse/Term APIs --- - -newtype ParseTreeRequest = ParseTreeRequest { blobs :: [Blob] } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, FromJSON) - -data Blob - = Blob - { content :: T.Text - , path :: FilePath - , language :: Language - } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, FromJSON) - -data BlobPair - = BlobPair - { before :: Maybe Blob - , after :: Maybe Blob - } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, FromJSON) - --- --- Symbols API --- -newtype ParseTreeSymbolResponse = ParseTreeSymbolResponse { files :: [File] } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data File - = File - { path :: T.Text - , language :: Language - , symbols :: [Symbol] - , errors :: [ParseError] - } - deriving stock (Generic, Eq, Show) - deriving anyclass (Named, Message, ToJSON) - -data Symbol - = Symbol - { symbol :: T.Text - , kind :: T.Text - , line :: T.Text - , span :: Maybe Span - } - deriving stock (Generic, Eq, Show) - deriving anyclass (Named, Message, ToJSON) - --- --- Term Graph API --- -newtype ParseTreeGraphResponse = ParseTreeGraphResponse { files :: [ParseTreeFileGraph] } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data ParseTreeFileGraph - = ParseTreeFileGraph - { path :: T.Text - , language :: Language - , vertices :: [TermVertex] - , edges :: [TermEdge] - , errors :: [ParseError] - } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data TermEdge = TermEdge { source :: Int, target :: Int } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data TermVertex = TermVertex { vertexId :: Int, term :: String, span :: Maybe Span } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) -instance VertexTag TermVertex where uniqueTag = vertexId - -newtype ParseError = ParseError { error :: String } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - --- --- Diff APIs --- - -newtype DiffTreeRequest = DiffTreeRequest { blobs :: [BlobPair] } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, FromJSON) - --- --- TOC Summaries API --- -newtype DiffTreeTOCResponse = DiffTreeTOCResponse { files :: [TOCSummaryFile] } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data TOCSummaryFile = TOCSummaryFile - { path :: T.Text - , language :: Language - , changes :: [TOCSummaryChange] - , errors :: [TOCSummaryError] - } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data TOCSummaryChange = TOCSummaryChange - { category :: T.Text - , term :: T.Text - , span :: Maybe Span - , changeType :: ChangeType - } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data ChangeType - = None - | Added - | Removed - | Modified - deriving stock (Eq, Ord, Show, Enum, Bounded, Generic) - deriving anyclass (Named, MessageField, ToJSON) - -instance HasDefault ChangeType where def = None - -instance Finite ChangeType where - enumerate _ = fmap go [None ..] where - go x = (fromString (fmap toUpper (show x)), fromEnum x) - -instance Primitive ChangeType where - primType _ = primType (Proxy @(Enumerated ChangeType)) - encodePrimitive f = encodePrimitive f . Enumerated . Right - decodePrimitive = decodePrimitive >>= \case - (Enumerated (Right r)) -> pure r - other -> Prelude.fail ("ChangeType decodeMessageField: unexpected value" <> show other) - -data TOCSummaryError = TOCSummaryError - { error :: T.Text - , span :: Maybe Span - } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - --- --- Diff Tree Graph API --- - -newtype DiffTreeGraphResponse = DiffTreeGraphResponse { files :: [DiffTreeFileGraph] } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data DiffTreeFileGraph - = DiffTreeFileGraph - { path :: T.Text - , language :: Language - , vertices :: [DiffTreeVertex] - , edges :: [DiffTreeEdge] - , errors :: [ParseError] - } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data DiffTreeEdge = DiffTreeEdge { source :: Int, target :: Int } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data DiffTreeVertex = DiffTreeVertex { diffVertexId :: Int, diffTerm :: Maybe DiffTreeTerm } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) -instance VertexTag DiffTreeVertex where uniqueTag = diffVertexId - --- NB: Current proto generation only supports sum types with single named fields. -data DiffTreeTerm - = Deleted { deleted :: Maybe DeletedTerm } - | Inserted { inserted :: Maybe InsertedTerm } - | Replaced { replaced :: Maybe ReplacedTerm } - | Merged { merged :: Maybe MergedTerm } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data DeletedTerm = DeletedTerm { term :: String, span :: Maybe Span } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data InsertedTerm = InsertedTerm { term :: String, span :: Maybe Span } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data ReplacedTerm = ReplacedTerm { beforeTerm :: String, beforeSpan :: Maybe Span, afterTerm :: String, afterSpan :: Maybe Span } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data MergedTerm = MergedTerm { term :: String, beforeSpan :: Maybe Span, afterSpan :: Maybe Span } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - - --- --- Health Check API --- - -newtype PingRequest = PingRequest { service :: String } - deriving stock (Eq, Show, Generic) - deriving anyclass (Message, Named, FromJSON) - -data PingResponse - = PingResponse - { status :: String - , hostname :: String - , timestamp :: String - , sha :: String - } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -instance MimeRender PlainText PingResponse where - mimeRender _ PingResponse{..} = BC.pack $ - status <> " - " <> hostname <> " - " <> sha <> " - " <> timestamp <> "\n" - - --- --- Common Types --- - -data Position = Position - { line :: Int - , column :: Int - } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - -data Span = Span - { start :: Maybe Position - , end :: Maybe Position - } - deriving stock (Eq, Ord, Show, Generic) - deriving anyclass (Message, Named, ToJSON) - --- --- Custom Mime Types --- --- Servant doesn't come with protobuf support out of the box, but it's --- very easy to add this as a valid type for decoding and encoding: all --- you have to do is map proto3-suite's encoding and decoding functions --- to the MimeRender/MimeUnrender typeclasses. - -data Protobuf - -instance Accept Protobuf where - contentType _ = "application" // "protobuf" - -instance Message a => MimeRender Protobuf a where - mimeRender _ = Proto3.toLazyByteString - -instance Message a => MimeUnrender Protobuf a where - mimeUnrender _ = first show . Proto3.fromByteString . BC.toStrict diff --git a/src/Semantic/API/V1/CodeAnalysisPB.hs b/src/Semantic/API/V1/CodeAnalysisPB.hs new file mode 100644 index 000000000..e8ac36603 --- /dev/null +++ b/src/Semantic/API/V1/CodeAnalysisPB.hs @@ -0,0 +1,564 @@ +-- Code generated by protoc-gen-haskell 0.1.0, DO NOT EDIT. +{-# LANGUAGE DerivingVia, DeriveAnyClass, DuplicateRecordFields #-} +{-# OPTIONS_GHC -Wno-unused-imports -Wno-missing-export-lists #-} +module Semantic.Api.V1.CodeAnalysisPB where + +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) + +data PingRequest = PingRequest + { service :: Text + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message PingRequest where + encodeMessage _ PingRequest{..} = mconcat + [ encodeMessageField 1 service + ] + decodeMessage _ = PingRequest + <$> at decodeMessageField 1 + dotProto = undefined + +data PingResponse = PingResponse + { status :: Text + , hostname :: Text + , timestamp :: Text + , sha :: Text + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message PingResponse where + encodeMessage _ PingResponse{..} = mconcat + [ encodeMessageField 1 status + , encodeMessageField 2 hostname + , encodeMessageField 3 timestamp + , encodeMessageField 4 sha + ] + decodeMessage _ = PingResponse + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> at decodeMessageField 3 + <*> at decodeMessageField 4 + dotProto = undefined + +data ParseTreeRequest = ParseTreeRequest + { blobs :: Vector Blob + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message ParseTreeRequest where + encodeMessage _ ParseTreeRequest{..} = mconcat + [ encodeMessageField 1 (NestedVec blobs) + ] + decodeMessage _ = ParseTreeRequest + <$> (nestedvec <$> at decodeMessageField 1) + dotProto = undefined + +data ParseTreeSymbolResponse = ParseTreeSymbolResponse + { files :: Vector File + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message ParseTreeSymbolResponse where + encodeMessage _ ParseTreeSymbolResponse{..} = mconcat + [ encodeMessageField 1 (NestedVec files) + ] + decodeMessage _ = ParseTreeSymbolResponse + <$> (nestedvec <$> at decodeMessageField 1) + dotProto = undefined + +data ParseTreeGraphResponse = ParseTreeGraphResponse + { files :: Vector ParseTreeFileGraph + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message ParseTreeGraphResponse where + encodeMessage _ ParseTreeGraphResponse{..} = mconcat + [ encodeMessageField 1 (NestedVec files) + ] + decodeMessage _ = ParseTreeGraphResponse + <$> (nestedvec <$> at decodeMessageField 1) + dotProto = undefined + +data ParseTreeFileGraph = ParseTreeFileGraph + { path :: Text + , language :: Language + , vertices :: Vector TermVertex + , edges :: Vector TermEdge + , errors :: Vector ParseError + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message ParseTreeFileGraph where + encodeMessage _ ParseTreeFileGraph{..} = mconcat + [ encodeMessageField 1 path + , encodeMessageField 2 language + , encodeMessageField 3 (NestedVec vertices) + , encodeMessageField 4 (NestedVec edges) + , encodeMessageField 5 (NestedVec errors) + ] + decodeMessage _ = ParseTreeFileGraph + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> (nestedvec <$> at decodeMessageField 3) + <*> (nestedvec <$> at decodeMessageField 4) + <*> (nestedvec <$> at decodeMessageField 5) + dotProto = undefined + +data TermEdge = TermEdge + { source :: Int64 + , target :: Int64 + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message TermEdge where + encodeMessage _ TermEdge{..} = mconcat + [ encodeMessageField 1 source + , encodeMessageField 2 target + ] + decodeMessage _ = TermEdge + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + dotProto = undefined + +data TermVertex = TermVertex + { vertexId :: Int64 + , term :: Text + , span :: Maybe Span + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message TermVertex where + encodeMessage _ TermVertex{..} = mconcat + [ encodeMessageField 1 vertexId + , encodeMessageField 2 term + , encodeMessageField 3 (Nested span) + ] + decodeMessage _ = TermVertex + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> at decodeMessageField 3 + dotProto = undefined + +data ParseError = ParseError + { error :: Text + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message ParseError where + encodeMessage _ ParseError{..} = mconcat + [ encodeMessageField 1 error + ] + decodeMessage _ = ParseError + <$> at decodeMessageField 1 + dotProto = undefined + +data DiffTreeRequest = DiffTreeRequest + { blobs :: Vector BlobPair + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message DiffTreeRequest where + encodeMessage _ DiffTreeRequest{..} = mconcat + [ encodeMessageField 1 (NestedVec blobs) + ] + decodeMessage _ = DiffTreeRequest + <$> (nestedvec <$> at decodeMessageField 1) + dotProto = undefined + +data DiffTreeTOCResponse = DiffTreeTOCResponse + { files :: Vector TOCSummaryFile + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message DiffTreeTOCResponse where + encodeMessage _ DiffTreeTOCResponse{..} = mconcat + [ encodeMessageField 1 (NestedVec files) + ] + decodeMessage _ = DiffTreeTOCResponse + <$> (nestedvec <$> at decodeMessageField 1) + dotProto = undefined + +data TOCSummaryFile = TOCSummaryFile + { path :: Text + , language :: Language + , changes :: Vector TOCSummaryChange + , errors :: Vector TOCSummaryError + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message TOCSummaryFile where + encodeMessage _ TOCSummaryFile{..} = mconcat + [ encodeMessageField 1 path + , encodeMessageField 2 language + , encodeMessageField 3 (NestedVec changes) + , encodeMessageField 4 (NestedVec errors) + ] + decodeMessage _ = TOCSummaryFile + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> (nestedvec <$> at decodeMessageField 3) + <*> (nestedvec <$> at decodeMessageField 4) + dotProto = undefined + +data TOCSummaryChange = TOCSummaryChange + { category :: Text + , term :: Text + , span :: Maybe Span + , changeType :: ChangeType + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message TOCSummaryChange where + encodeMessage _ TOCSummaryChange{..} = mconcat + [ encodeMessageField 1 category + , encodeMessageField 2 term + , encodeMessageField 3 (Nested span) + , encodeMessageField 4 changeType + ] + decodeMessage _ = TOCSummaryChange + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> at decodeMessageField 3 + <*> at decodeMessageField 4 + dotProto = undefined + +data TOCSummaryError = TOCSummaryError + { error :: Text + , span :: Maybe Span + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message TOCSummaryError where + encodeMessage _ TOCSummaryError{..} = mconcat + [ encodeMessageField 1 error + , encodeMessageField 2 (Nested span) + ] + decodeMessage _ = TOCSummaryError + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + dotProto = undefined + +data DiffTreeGraphResponse = DiffTreeGraphResponse + { files :: Vector DiffTreeFileGraph + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message DiffTreeGraphResponse where + encodeMessage _ DiffTreeGraphResponse{..} = mconcat + [ encodeMessageField 1 (NestedVec files) + ] + decodeMessage _ = DiffTreeGraphResponse + <$> (nestedvec <$> at decodeMessageField 1) + dotProto = undefined + +data DiffTreeFileGraph = DiffTreeFileGraph + { path :: Text + , language :: Language + , vertices :: Vector DiffTreeVertex + , edges :: Vector DiffTreeEdge + , errors :: Vector ParseError + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message DiffTreeFileGraph where + encodeMessage _ DiffTreeFileGraph{..} = mconcat + [ encodeMessageField 1 path + , encodeMessageField 2 language + , encodeMessageField 3 (NestedVec vertices) + , encodeMessageField 4 (NestedVec edges) + , encodeMessageField 5 (NestedVec errors) + ] + decodeMessage _ = DiffTreeFileGraph + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> (nestedvec <$> at decodeMessageField 3) + <*> (nestedvec <$> at decodeMessageField 4) + <*> (nestedvec <$> at decodeMessageField 5) + dotProto = undefined + +data DiffTreeEdge = DiffTreeEdge + { source :: Int64 + , target :: Int64 + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message DiffTreeEdge where + encodeMessage _ DiffTreeEdge{..} = mconcat + [ encodeMessageField 1 source + , encodeMessageField 2 target + ] + decodeMessage _ = DiffTreeEdge + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + dotProto = undefined + +data DiffTreeVertexDiffTerm + = Deleted { deleted :: Maybe DeletedTerm } + | Inserted { inserted :: Maybe InsertedTerm } + | Replaced { replaced :: Maybe ReplacedTerm } + | Merged { merged :: Maybe MergedTerm } + deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Message, Named, FromJSON, ToJSON) + +data DiffTreeVertex = DiffTreeVertex + { diffVertexId :: Int64 + , diffTerm :: Maybe DiffTreeVertexDiffTerm + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message DiffTreeVertex where + encodeMessage _ DiffTreeVertex{..} = mconcat + [ encodeMessageField 1 diffVertexId + , case diffTerm of + Nothing -> mempty + Just (Deleted deleted) -> encodeMessageField 2 deleted + Just (Inserted inserted) -> encodeMessageField 3 inserted + Just (Replaced replaced) -> encodeMessageField 4 replaced + Just (Merged merged) -> encodeMessageField 5 merged + ] + decodeMessage _ = DiffTreeVertex + <$> at decodeMessageField 1 + <*> oneof + Nothing + [ (2, Just . Deleted <$> decodeMessageField) + , (3, Just . Inserted <$> decodeMessageField) + , (4, Just . Replaced <$> decodeMessageField) + , (5, Just . Merged <$> decodeMessageField) + ] + dotProto = undefined + +data DeletedTerm = DeletedTerm + { term :: Text + , span :: Maybe Span + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message DeletedTerm where + encodeMessage _ DeletedTerm{..} = mconcat + [ encodeMessageField 1 term + , encodeMessageField 2 (Nested span) + ] + decodeMessage _ = DeletedTerm + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + dotProto = undefined + +data InsertedTerm = InsertedTerm + { term :: Text + , span :: Maybe Span + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message InsertedTerm where + encodeMessage _ InsertedTerm{..} = mconcat + [ encodeMessageField 1 term + , encodeMessageField 2 (Nested span) + ] + decodeMessage _ = InsertedTerm + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + dotProto = undefined + +data ReplacedTerm = ReplacedTerm + { beforeTerm :: Text + , beforeSpan :: Maybe Span + , afterTerm :: Text + , afterSpan :: Maybe Span + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message ReplacedTerm where + encodeMessage _ ReplacedTerm{..} = mconcat + [ encodeMessageField 1 beforeTerm + , encodeMessageField 2 (Nested beforeSpan) + , encodeMessageField 3 afterTerm + , encodeMessageField 4 (Nested afterSpan) + ] + decodeMessage _ = ReplacedTerm + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> at decodeMessageField 3 + <*> at decodeMessageField 4 + dotProto = undefined + +data MergedTerm = MergedTerm + { term :: Text + , beforeSpan :: Maybe Span + , afterSpan :: Maybe Span + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message MergedTerm where + encodeMessage _ MergedTerm{..} = mconcat + [ encodeMessageField 1 term + , encodeMessageField 2 (Nested beforeSpan) + , encodeMessageField 3 (Nested afterSpan) + ] + decodeMessage _ = MergedTerm + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> at decodeMessageField 3 + dotProto = undefined + +data Blob = Blob + { content :: Text + , path :: Text + , language :: Language + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message Blob where + encodeMessage _ Blob{..} = mconcat + [ encodeMessageField 1 content + , encodeMessageField 2 path + , encodeMessageField 3 language + ] + decodeMessage _ = Blob + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> at decodeMessageField 3 + dotProto = undefined + +data BlobPair = BlobPair + { before :: Maybe Blob + , after :: Maybe Blob + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message BlobPair where + encodeMessage _ BlobPair{..} = mconcat + [ encodeMessageField 1 (Nested before) + , encodeMessageField 2 (Nested after) + ] + decodeMessage _ = BlobPair + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + dotProto = undefined + +data File = File + { path :: Text + , language :: Language + , symbols :: Vector Symbol + , errors :: Vector ParseError + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message File where + encodeMessage _ File{..} = mconcat + [ encodeMessageField 1 path + , encodeMessageField 2 language + , encodeMessageField 3 (NestedVec symbols) + , encodeMessageField 4 (NestedVec errors) + ] + decodeMessage _ = File + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> (nestedvec <$> at decodeMessageField 3) + <*> (nestedvec <$> at decodeMessageField 4) + dotProto = undefined + +data Symbol = Symbol + { symbol :: Text + , kind :: Text + , line :: Text + , span :: Maybe Span + , docs :: Maybe Docstring + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message Symbol where + encodeMessage _ Symbol{..} = mconcat + [ encodeMessageField 1 symbol + , encodeMessageField 2 kind + , encodeMessageField 3 line + , encodeMessageField 4 (Nested span) + , encodeMessageField 5 (Nested docs) + ] + decodeMessage _ = Symbol + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + <*> at decodeMessageField 3 + <*> at decodeMessageField 4 + <*> at decodeMessageField 5 + dotProto = undefined + +data Docstring = Docstring + { docstring :: Text + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message Docstring where + encodeMessage _ Docstring{..} = mconcat + [ encodeMessageField 1 docstring + ] + decodeMessage _ = Docstring + <$> at decodeMessageField 1 + dotProto = undefined + +data Position = Position + { line :: Int64 + , column :: Int64 + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message Position where + encodeMessage _ Position{..} = mconcat + [ encodeMessageField 1 line + , encodeMessageField 2 column + ] + decodeMessage _ = Position + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + dotProto = undefined + +data Span = Span + { start :: Maybe Position + , end :: Maybe Position + } deriving stock (Eq, Ord, Show, Generic) + deriving anyclass (Named, FromJSON, ToJSON) + +instance Message Span where + encodeMessage _ Span{..} = mconcat + [ encodeMessageField 1 (Nested start) + , encodeMessageField 2 (Nested end) + ] + decodeMessage _ = Span + <$> at decodeMessageField 1 + <*> at decodeMessageField 2 + dotProto = undefined + +data ChangeType + = None + | Added + | Removed + | Modified + deriving stock (Eq, Ord, Show, Enum, Bounded, Generic) + deriving anyclass (Named, MessageField, FromJSON, ToJSON) + deriving Primitive via PrimitiveEnum ChangeType +instance HasDefault ChangeType where def = None + +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, FromJSON, ToJSON) + deriving Primitive via PrimitiveEnum Language +instance HasDefault Language where def = Unknown diff --git a/src/Semantic/Analysis.hs b/src/Semantic/Analysis.hs index fbde37f5b..1163d01ca 100644 --- a/src/Semantic/Analysis.hs +++ b/src/Semantic/Analysis.hs @@ -73,7 +73,7 @@ evaluate lang runModule modules = do let (scopeEdges, frameLinks) = case (parentScope, parentFrame) of (Just parentScope, Just parentFrame) -> (Map.singleton Lexical [ parentScope ], Map.singleton Lexical (Map.singleton parentScope parentFrame)) _ -> mempty - scopeAddress <- if Prologue.null scopeEdges then newPreludeScope scopeEdges else newScope scopeEdges + scopeAddress <- newScope scopeEdges frameAddress <- newFrame scopeAddress frameLinks val <- runInModule scopeAddress frameAddress m pure ((scopeAddress, frameAddress), val) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 10a3ee843..488cacf8a 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -3,14 +3,14 @@ module Semantic.CLI (main) where import Control.Exception as Exc (displayException) import Data.File -import Data.Language (ensureLanguage, languageForFilePath) +import Data.Language (languageForFilePath) import Data.List (intercalate, uncons) import Data.List.Split (splitWhen) import Data.Handle import Data.Project import Options.Applicative hiding (style) import Prologue -import Semantic.API hiding (File) +import Semantic.Api hiding (File) import qualified Semantic.AST as AST import Semantic.Config import qualified Semantic.Graph as Graph @@ -29,7 +29,7 @@ main = do (options, task) <- customExecParser (prefs showHelpOnEmpty) arguments config <- defaultConfig options res <- withTelemetry config $ \ (TelemetryQueues logger statter _) -> - Task.runTask (Task.TaskSession config "-" logger statter) task + Task.runTask (Task.TaskSession config "-" False logger statter) task either (die . displayException) pure res -- | A parser for the application's command-line arguments. @@ -84,7 +84,7 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa pure $ Task.readBlobs filesOrStdin >>= renderer tsParseCommand :: Mod CommandFields (Task.TaskEff Builder) -tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Don't produce output, but show timing stats")) +tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Generate raw tree-sitter parse trees for path(s)")) where tsParseArgumentsParser = do format <- flag AST.SExpression AST.SExpression (long "sexpression" <> help "Output s-expression ASTs (default)") @@ -126,9 +126,9 @@ filePathReader :: ReadM File filePathReader = eitherReader parseFilePath where parseFilePath arg = case splitWhen (== ':') arg of - [a, b] | Just lang <- readMaybe b >>= ensureLanguage -> Right (File a lang) - | Just lang <- readMaybe a >>= ensureLanguage -> Right (File b lang) - [path] -> maybe (Left $ "Cannot identify language for path: " <> path) (Right . File path) (ensureLanguage (languageForFilePath path)) + [a, b] | Just lang <- readMaybe a -> Right (File a lang) + | Just lang <- readMaybe b -> Right (File b lang) + [path] -> Right (File path (languageForFilePath path)) args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE") options :: Eq a => [(String, a)] -> Mod OptionFields a -> Parser a diff --git a/src/Semantic/REPL.hs b/src/Semantic/REPL.hs index 365d82391..4eaf3b1bc 100644 --- a/src/Semantic/REPL.hs +++ b/src/Semantic/REPL.hs @@ -54,45 +54,47 @@ instance Exception Quit rubyREPL = repl (Proxy @'Language.Ruby) rubyParser -repl proxy parser paths = defaultConfig debugOptions >>= \ config -> runM . runDistribute . runResource (runM . runDistribute) . runTimeout (runM . runDistribute . runResource (runM . runDistribute)) . runError @SomeException . runTelemetryIgnoringStat (logOptionsFromConfig config) . runTraceInTelemetry . runReader config . Files.runFiles . runResolution . runTaskF $ do - blobs <- catMaybes <$> traverse readBlobFromFile (flip File (Language.reflect proxy) <$> paths) - package <- fmap (fmap quieterm) <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) []) - modules <- topologicalSort <$> runImportGraphToModules proxy (snd <$> package) - homeDir <- liftIO getHomeDirectory - prefs <- liftIO (readPrefs (homeDir <> "/.haskeline")) - let settingsDir = homeDir <> "/.local/semantic" - liftIO $ createDirectoryIfMissing True settingsDir - let settings = Settings - { complete = noCompletion - , historyFile = Just (settingsDir <> "/repl_history") - , autoAddHistory = True - } - runEvaluator - . runREPL prefs settings - . fmap snd - . runState ([] @Breakpoint) - . runReader Step - . runEvaluator - . id @(Evaluator _ Precise (Value _ Precise) _ _) - . raiseHandler runTraceByPrinting - . runHeap - . runScopeGraph - . raiseHandler runFresh - . fmap reassociate - . runLoadError - . runUnspecialized - . runScopeError - . runHeapError - . runEvalError - . runResolutionError - . runAddressError - . runValueError - . runModuleTable - . runModules (ModuleTable.modulePaths (packageModules (snd <$> package))) - . raiseHandler (runReader (packageInfo package)) - . raiseHandler (runState (lowerBound @Span)) - . raiseHandler (runReader (lowerBound @Span)) - $ evaluate proxy (runDomainEffects (evalTerm (withTermSpans . step (fmap moduleBody <$> ModuleTable.toPairs (packageModules (fst <$> package)))))) modules +repl proxy parser paths = + withOptions debugOptions $ \config logger statter -> + runM . runDistribute . runResource (runM . runDistribute) . runTimeout (runM . runDistribute . runResource (runM . runDistribute)) . runError @SomeException . runTelemetryIgnoringStat (logOptionsFromConfig config) . runTraceInTelemetry . runReader (TaskSession config "-" False logger statter) . Files.runFiles . runResolution . runTaskF $ do + blobs <- catMaybes <$> traverse readBlobFromFile (flip File (Language.reflect proxy) <$> paths) + package <- fmap (fmap quieterm) <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) []) + modules <- topologicalSort <$> runImportGraphToModules proxy (snd <$> package) + homeDir <- liftIO getHomeDirectory + prefs <- liftIO (readPrefs (homeDir <> "/.haskeline")) + let settingsDir = homeDir <> "/.local/semantic" + liftIO $ createDirectoryIfMissing True settingsDir + let settings = Settings + { complete = noCompletion + , historyFile = Just (settingsDir <> "/repl_history") + , autoAddHistory = True + } + runEvaluator + . runREPL prefs settings + . fmap snd + . runState ([] @Breakpoint) + . runReader Step + . runEvaluator + . id @(Evaluator _ Precise (Value _ Precise) _ _) + . raiseHandler runTraceByPrinting + . runHeap + . runScopeGraph + . raiseHandler runFresh + . fmap reassociate + . runLoadError + . runUnspecialized + . runScopeError + . runHeapError + . runEvalError + . runResolutionError + . runAddressError + . runValueError + . runModuleTable + . runModules (ModuleTable.modulePaths (packageModules (snd <$> package))) + . raiseHandler (runReader (packageInfo package)) + . raiseHandler (runState (lowerBound @Span)) + . raiseHandler (runReader (lowerBound @Span)) + $ evaluate proxy (runDomainEffects (evalTerm (withTermSpans . step (fmap moduleBody <$> ModuleTable.toPairs (packageModules (fst <$> package)))))) modules -- TODO: REPL for typechecking/abstract semantics -- TODO: drive the flow from within the REPL instead of from without diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index b54a34cd5..430a1de9b 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -98,7 +98,7 @@ type TaskEff = Eff (TaskC ( Eff (ResolutionC ( Eff (Files.FilesC - ( Eff (ReaderC Config + ( Eff (ReaderC TaskSession ( Eff (TraceInTelemetryC ( Eff (TelemetryC ( Eff (ErrorC SomeException @@ -154,13 +154,14 @@ data TaskSession = TaskSession { config :: Config , requestID :: String + , isPublic :: Bool , logger :: LogQueue , statter :: StatQueue } -- | Execute a 'TaskEff' yielding its result value in 'IO'. runTask :: TaskSession -> TaskEff a -> IO (Either SomeException a) -runTask TaskSession{..} task = do +runTask taskSession@TaskSession{..} task = do (result, stat) <- withTiming "run" [] $ do let run :: TaskEff a -> IO (Either SomeException a) run @@ -171,7 +172,7 @@ runTask TaskSession{..} task = do . runError . runTelemetry logger statter . runTraceInTelemetry - . runReader config + . runReader taskSession . Files.runFiles . runResolution . runTaskF @@ -182,7 +183,7 @@ runTask TaskSession{..} task = do -- | Execute a 'TaskEff' yielding its result value in 'IO' using all default options and configuration. runTaskWithOptions :: Options -> TaskEff a -> IO (Either SomeException a) runTaskWithOptions options task = withOptions options $ \ config logger statter -> - runTask (TaskSession config "-" logger statter) task + runTask (TaskSession config "-" False logger statter) task -- | Yield config and telemetry queues for options. withOptions :: Options -> (Config -> LogQueue -> StatQueue -> IO a) -> IO a @@ -229,7 +230,7 @@ instance Effect Task where -- | Run a 'Task' effect by performing the actions in 'IO'. runTaskF :: ( Member (Error SomeException) sig , Member (Lift IO) sig - , Member (Reader Config) sig + , Member (Reader TaskSession) sig , Member Resource sig , Member Telemetry sig , Member Timeout sig @@ -243,7 +244,7 @@ runTaskF = runTaskC . interpret newtype TaskC m a = TaskC { runTaskC :: m a } -instance (Member (Error SomeException) sig, Member (Lift IO) sig, Member (Reader Config) sig, Member Resource sig, Member Telemetry sig, Member Timeout sig, Member Trace sig, Carrier sig m, MonadIO m) => Carrier (Task :+: sig) (TaskC m) where +instance (Member (Error SomeException) sig, Member (Lift IO) sig, Member (Reader TaskSession) sig, Member Resource sig, Member Telemetry sig, Member Timeout sig, Member Trace sig, Carrier sig m, MonadIO m) => Carrier (Task :+: sig) (TaskC m) where ret = TaskC . ret eff = TaskC . handleSum (eff . handleCoercible) (\case Parse parser blob k -> runParser blob parser >>= runTaskC . k @@ -252,19 +253,22 @@ instance (Member (Error SomeException) sig, Member (Lift IO) sig, Member (Reader Semantic.Task.Diff terms k -> runTaskC (k (diffTermPair terms)) Render renderer input k -> runTaskC (k (renderer input)) Serialize format input k -> do - formatStyle <- asks (bool Plain Colourful . configIsTerminal) + formatStyle <- asks (bool Plain Colourful . configIsTerminal . config) runTaskC (k (runSerialize formatStyle format input))) -- | Log an 'Error.Error' at the specified 'Level'. logError :: (Member Telemetry sig, Carrier sig m) - => Config + => TaskSession -> Level -> Blob -> Error.Error String -> [(String, String)] -> m () -logError Config{..} level blob err = writeLog level (Error.formatError configLogPrintSource configIsTerminal blob err) +logError TaskSession{..} level blob err = + let configLogPrintSource' = configLogPrintSource config + configIsTerminal' = configIsTerminal config + in writeLog level (Error.formatError configLogPrintSource' configIsTerminal' blob err) data ParserCancelled = ParserTimedOut | AssignmentTimedOut deriving (Show, Typeable) @@ -272,14 +276,14 @@ data ParserCancelled = ParserTimedOut | AssignmentTimedOut instance Exception ParserCancelled -- | Parse a 'Blob' in 'IO'. -runParser :: (Member (Error SomeException) sig, Member (Lift IO) sig, Member (Reader Config) sig, Member Resource sig, Member Telemetry sig, Member Timeout sig, Member Trace sig, Carrier sig m, MonadIO m) +runParser :: (Member (Error SomeException) sig, Member (Lift IO) sig, Member (Reader TaskSession) sig, Member Resource sig, Member Telemetry sig, Member Timeout sig, Member Trace sig, Carrier sig m, MonadIO m) => Blob -> Parser term -> m term runParser blob@Blob{..} parser = case parser of ASTParser language -> time "parse.tree_sitter_ast_parse" languageTag $ do - config <- ask + config <- asks config parseToAST (configTreeSitterParseTimeout config) language blob >>= maybeM (throwError (SomeException ParserTimedOut)) @@ -301,7 +305,7 @@ runParser blob@Blob{..} parser = case parser of , Element Syntax.Error syntaxes , Member (Error SomeException) sig , Member (Lift IO) sig - , Member (Reader Config) sig + , Member (Reader TaskSession) sig , Member Resource sig , Member Telemetry sig , Member Timeout sig @@ -314,34 +318,37 @@ runParser blob@Blob{..} parser = case parser of -> assignment (Term (Sum syntaxes) Assignment.Location) -> m (Term (Sum syntaxes) Assignment.Location) runAssignment assign parser assignment = do - config <- ask - let blobFields = ("path", if configLogPrintSource config then blobPath else "") : languageTag + taskSession <- ask + let requestID' = ("github_request_id", requestID taskSession) + let isPublic' = ("github_is_public", show (isPublic taskSession)) + let blobFields = ("path", if isPublic taskSession || configLogPrintSource (config taskSession) then blobPath else "") + let logFields = requestID' : isPublic' : blobFields : languageTag ast <- runParser blob parser `catchError` \ (SomeException err) -> do writeStat (increment "parse.parse_failures" languageTag) - writeLog Error "failed parsing" (("task", "parse") : blobFields) + writeLog Error "failed parsing" (("task", "parse") : logFields) throwError (toException err) - res <- timeout (configAssignmentTimeout config) . time "parse.assign" languageTag $ + res <- timeout (configAssignmentTimeout (config taskSession)) . time "parse.assign" languageTag $ case assign blobSource assignment ast of Left err -> do writeStat (increment "parse.assign_errors" languageTag) - logError config Error blob err (("task", "assign") : blobFields) + logError taskSession Error blob err (("task", "assign") : logFields) throwError (toException err) Right term -> do for_ (zip (errors term) [(0::Integer)..]) $ \ (err, i) -> case Error.errorActual err of Just "ParseError" -> do when (i == 0) $ writeStat (increment "parse.parse_errors" languageTag) - logError config Warning blob err (("task", "parse") : blobFields) - when (optionsFailOnParseError (configOptions config)) $ throwError (toException err) + logError taskSession Warning blob err (("task", "parse") : logFields) + when (optionsFailOnParseError (configOptions (config taskSession))) $ throwError (toException err) _ -> do when (i == 0) $ writeStat (increment "parse.assign_warnings" languageTag) - logError config Warning blob err (("task", "assign") : blobFields) - when (optionsFailOnWarning (configOptions config)) $ throwError (toException err) + logError taskSession Warning blob err (("task", "assign") : logFields) + when (optionsFailOnWarning (configOptions (config taskSession))) $ throwError (toException err) term <$ writeStat (count "parse.nodes" (length term) languageTag) case res of - Just r | not (configFailParsingForTesting config) + Just r | not (configFailParsingForTesting (config taskSession)) -> pure r _ -> do writeStat (increment "assign.assign_timeouts" languageTag) - writeLog Error "assignment timeout" (("task", "assign") : blobFields) + writeLog Error "assignment timeout" (("task", "assign") : logFields) throwError (SomeException AssignmentTimedOut) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 98488ad33..28bf95df5 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -27,6 +27,7 @@ import Data.Graph.ControlFlowVertex import qualified Data.Language as Language import Data.List (uncons) import Data.Project hiding (readFile) +import Data.Quieterm (Quieterm, quieterm) import Data.Sum (weaken) import Data.Term import qualified Language.Go.Assignment @@ -44,7 +45,6 @@ import System.Exit (die) import System.FilePath.Posix (takeDirectory) import Data.Location -import Data.Quieterm -- The type signatures in these functions are pretty gnarly, but these functions -- are hit sufficiently often in the CLI and test suite so as to merit avoiding @@ -583,7 +583,7 @@ type LanguageSyntax lang syntax = ( Language.SLanguage lang , Apply FreeVariables1 syntax) evaluateProject proxy parser paths = withOptions debugOptions $ \ config logger statter -> - evaluateProject' (TaskSession config "-" logger statter) proxy parser paths + evaluateProject' (TaskSession config "-" False logger statter) proxy parser paths -- Evaluate a project consisting of the listed paths. -- TODO: This is used by our specs and should be moved into SpecHelpers.hs @@ -663,7 +663,6 @@ evaluateProjectForScopeGraph proxy parser project = runTask' $ do (raiseHandler (runReader (lowerBound @Span)) (evaluate proxy (runDomainEffects (evalTerm withTermSpans)) modules))))))) - evaluateProjectWithCaching :: ( term ~ Term (Sum syntax) Location , qterm ~ Quieterm (Sum syntax) Location , LanguageSyntax lang syntax diff --git a/src/Tags/Taggable.hs b/src/Tags/Taggable.hs index f7a0d6d19..3e89eea6b 100644 --- a/src/Tags/Taggable.hs +++ b/src/Tags/Taggable.hs @@ -496,7 +496,6 @@ instance Taggable Java.TryWithResources instance Taggable Java.AssertStatement instance Taggable Java.AnnotationTypeElement -instance Taggable Python.Alias instance Taggable Python.Ellipsis instance Taggable Python.FutureImport instance Taggable Python.Import diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 8a34d29ce..e6f8461e2 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.Unknown (Just associatedScope) + declare (ScopeGraph.Declaration "identity") Default Public emptySpan (Just associatedScope) withScope associatedScope $ do - declare (Declaration x) Default Public emptySpan ScopeGraph.Unknown Nothing + declare (Declaration x) Default Public emptySpan Nothing identity <- function "identity" [ x ] (SpecEff (Heap.lookupSlot (ScopeGraph.Declaration (SpecHelpers.name "x")) >>= deref)) associatedScope val <- integer 123 diff --git a/test/Examples.hs b/test/Examples.hs index e15a1d94f..0b39834cf 100644 --- a/test/Examples.hs +++ b/test/Examples.hs @@ -17,7 +17,7 @@ import Data.Quieterm import Data.Typeable (cast) import Data.Void import Parsing.Parser -import Semantic.API (TermOutputFormat (..), parseTermBuilder) +import Semantic.Api (TermOutputFormat (..), parseTermBuilder) import Semantic.Config (Config (..), Options (..), defaultOptions) import qualified Semantic.IO as IO import Semantic.Task @@ -32,7 +32,7 @@ import Test.Hspec main :: IO () main = withOptions opts $ \ config logger statter -> hspec . parallel $ do - let args = TaskSession config "-" logger statter + let args = TaskSession config "-" False logger statter runIO setupExampleRepos diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 3b3b29a4d..4630ef7ca 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -24,7 +24,7 @@ import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration import Rendering.TOC import Semantic.Config -import Semantic.API (diffSummaryBuilder) +import Semantic.Api (diffSummaryBuilder) import Serializing.Format as Format import SpecHelpers diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index 1217896d9..2f6119109 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -4,7 +4,7 @@ import Control.Monad (when) import qualified Data.ByteString as B import Data.ByteString.Builder import Data.Foldable (for_) -import Semantic.API hiding (File, Blob, BlobPair) +import Semantic.Api hiding (File, Blob, BlobPair) import Semantic.CLI import Semantic.IO import Semantic.Task diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs index 65e4f4130..a6f5674de 100644 --- a/test/Semantic/Spec.hs +++ b/test/Semantic/Spec.hs @@ -2,7 +2,7 @@ module Semantic.Spec (spec) where import Data.Diff import Data.Patch -import Semantic.API hiding (Blob) +import Semantic.Api hiding (Blob) import System.Exit import SpecHelpers diff --git a/test/Spec.hs b/test/Spec.hs index 09cb8eca6..c5ce62356 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -40,7 +40,7 @@ import Test.Hspec main :: IO () main = do withOptions defaultOptions { optionsLogLevel = Nothing } $ \ config logger statter -> hspec $ do - let args = TaskSession config "-" logger statter + let args = TaskSession config "-" False logger statter describe "Semantic.Stat" Semantic.Stat.Spec.spec parallel $ do describe "Analysis.Go" (Analysis.Go.Spec.spec args) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 3ea222dad..460dd2ca3 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -51,7 +51,7 @@ import Data.List.NonEmpty as X (NonEmpty(..)) import Data.Range as X import Data.Semilattice.Lower as X import Data.Source as X -import Data.Span as X hiding (start, end) +import Data.Span as X hiding (HasSpan(..)) import Data.String import Data.Sum import Data.Term as X @@ -82,7 +82,7 @@ import Data.Set (Set) import qualified Semantic.IO as IO import Semantic.Config (Config(..), optionsLogLevel) import Semantic.Telemetry (LogQueue, StatQueue) -import Semantic.API hiding (File, Blob, BlobPair) +import Semantic.Api hiding (File, Blob, BlobPair) import System.Exit (die) import Control.Exception (displayException) @@ -112,7 +112,7 @@ parseTestFile parser path = runTaskOrDie $ do term <- parse parser blob pure (blob, term) --- Run a Task and call `die` if it returns an Exception. +-- Run a Task and call `die` if it returns an Exception. runTaskOrDie :: TaskEff a -> IO a runTaskOrDie task = runTaskWithOptions defaultOptions { optionsLogLevel = Nothing } task >>= either (die . displayException) pure