diff --git a/proto/code_analysis.proto b/proto/code_analysis.proto index 059b615e6..160bc48b0 100644 --- a/proto/code_analysis.proto +++ b/proto/code_analysis.proto @@ -32,7 +32,7 @@ service CodeAnalysis { // Calculate an import graph for a project. rpc GraphImports (ImportGraphRequest) returns (ImportGraphResponse); - // rpc GraphCalls (CallGraphRequest) returns (CallGraphResponse); + rpc GraphCalls (CallGraphRequest) returns (CallGraphResponse); // Check health & status of the service. rpc CheckHealth (HealthCheckRequest) returns (HealthCheckResponse); @@ -71,12 +71,21 @@ message SummarizeDiffResponse { repeated ParseError errors = 2; } +message CallGraphRequest { + Project project = 1; +} + +message CallGraphResponse { + AdjacencyList graph = 1; + DebugInfo error_info = 2; +} + message ImportGraphRequest { Project project = 1; } message ImportGraphResponse { - ImportGraph graph = 1; + AdjacencyList graph = 1; DebugInfo error_info = 2; } diff --git a/proto/types.proto b/proto/types.proto index 22dc2f2bf..05b5b88d4 100644 --- a/proto/types.proto +++ b/proto/types.proto @@ -42,7 +42,7 @@ message ErrorSite { SrcLoc errorLocation = 2; } -message ImportGraph { +message AdjacencyList { repeated Vertex graphVertices = 1; repeated Edge graphEdges = 2; } diff --git a/semantic.cabal b/semantic.cabal index a34fe8a12..7d8a91c71 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -77,7 +77,7 @@ library , Data.Functor.Both , Data.Functor.Classes.Generic , Data.Graph - , Data.Graph.Adjacency.Import + , Data.Graph.Adjacency , Data.Graph.Vertex , Data.JSON.Fields , Data.Language @@ -289,6 +289,7 @@ test-suite test , Diffing.Algorithm.RWS.Spec , Diffing.Algorithm.SES.Spec , Diffing.Interpreter.Spec + , Graphing.Calls.Spec , Integration.Spec , Matching.Go.Spec , Numeric.Spec @@ -301,6 +302,7 @@ test-suite test , SpecHelpers , Test.Hspec.LeanCheck build-depends: aeson + , algebraic-graphs , array , async , base diff --git a/src/Data/Graph/Adjacency/Import.hs b/src/Data/Graph/Adjacency.hs similarity index 84% rename from src/Data/Graph/Adjacency/Import.hs rename to src/Data/Graph/Adjacency.hs index f80294828..ca2232277 100644 --- a/src/Data/Graph/Adjacency/Import.hs +++ b/src/Data/Graph/Adjacency.hs @@ -1,12 +1,12 @@ {-# LANGUAGE DeriveAnyClass, LambdaCase, ScopedTypeVariables #-} -module Data.Graph.Adjacency.Import - ( ImportGraph (..) +module Data.Graph.Adjacency + ( AdjacencyList (..) , Edge (..) , Tag , Vertex (..) , VertexType (..) - , graphToImportGraph + , graphToAdjacencyList , importGraphToGraph , tagGraph , isCoherent @@ -57,7 +57,7 @@ instance PB.Primitive VertexType where (PB.Enumerated (Right r)) -> pure r other -> Prelude.fail ("VertexType decodeMessageField: unexpected value" <> show other) --- | A tag used on each vertext of a 'Graph' to convert to an 'ImportGraph'. +-- | A tag used on each vertext of a 'Graph' to convert to an 'AdjacencyList'. type Tag = Word64 -- | A protobuf-compatible vertex type, with a unique 'Tag' identifier. @@ -73,16 +73,16 @@ data Edge = Edge { edgeFrom :: Tag, edgeTo :: Tag } deriving (Eq, Ord, Show, Generic, Hashable, PB.Named, PB.Message) -- | An adjacency list-representation of a graph. You generally build these by calling --- 'graphToImportGraph' on an algebraic 'Graph'. This representation is less efficient and +-- 'graphToAdjacencyList' on an algebraic 'Graph'. This representation is less efficient and -- fluent than an ordinary 'Graph', but is more amenable to serialization. -data ImportGraph = ImportGraph +data AdjacencyList = AdjacencyList { graphVertices :: PB.NestedVec Vertex , graphEdges :: PB.NestedVec Edge } deriving (Eq, Ord, Show, Generic, PB.Named, PB.Message) -- | Convert an algebraic graph to an adjacency list. -graphToImportGraph :: Graph V.Vertex -> ImportGraph -graphToImportGraph = taggedGraphToImportGraph . tagGraph . simplify +graphToAdjacencyList :: Graph V.Vertex -> AdjacencyList +graphToAdjacencyList = taggedGraphToAdjacencyList . tagGraph . simplify -- * Internal interface stuff @@ -99,8 +99,8 @@ data Acc = Acc [Vertex] (HashSet Edge) -- to build a 'Graph', avoiding inefficient vector concatenation. -- Time complexity, given V vertices and E edges, is at least O(2V + 2E + (V * E * log E)), -- plus whatever overhead converting the graph to 'AdjacencyMap' may entail. -taggedGraphToImportGraph :: Graph (V.Vertex, Tag) -> ImportGraph -taggedGraphToImportGraph = accumToAdj . adjMapToAccum . adjacencyMap . toGraph . simplify +taggedGraphToAdjacencyList :: Graph (V.Vertex, Tag) -> AdjacencyList +taggedGraphToAdjacencyList = accumToAdj . adjMapToAccum . adjacencyMap . toGraph . simplify where adjMapToAccum :: Map (V.Vertex, Tag) (Set (V.Vertex, Tag)) -> Acc adjMapToAccum = Map.foldlWithKey go (Acc [] mempty) @@ -108,8 +108,8 @@ taggedGraphToImportGraph = accumToAdj . adjMapToAccum . adjacencyMap . toGraph . go (Acc vs es) (v, from) edges = Acc (vertexToPB v from : vs) (Set.foldr' (add . snd) es edges) where add = HashSet.insert . Edge from - accumToAdj :: Acc -> ImportGraph - accumToAdj (Acc vs es) = ImportGraph (fromList vs) (fromList (toList es)) + accumToAdj :: Acc -> AdjacencyList + accumToAdj (Acc vs es) = AdjacencyList (fromList vs) (fromList (toList es)) vertexToPB :: V.Vertex -> Tag -> Vertex vertexToPB s = Vertex t (V.vertexName s) where @@ -134,10 +134,10 @@ tagGraph = unwrap . traverse go where modify' (HashMap.insert v next) pure (v, next) --- | This is the reverse of 'graphToImportGraph'. Don't use this outside of a testing context. --- N.B. @importGraphToGraph . graphToImportGraph@ is 'id', but @graphToImportGraph . importGraphToGraph@ is not. -importGraphToGraph :: ImportGraph -> Graph V.Vertex -importGraphToGraph (ImportGraph vs es) = simplify built +-- | This is the reverse of 'graphToAdjacencyList'. Don't use this outside of a testing context. +-- N.B. @importGraphToGraph . graphToAdjacencyList@ is 'id', but @graphToAdjacencyList . importGraphToGraph@ is not. +importGraphToGraph :: AdjacencyList -> Graph V.Vertex +importGraphToGraph (AdjacencyList vs es) = simplify built where built = allEdges <> vertices unreferencedVertices allEdges :: Graph V.Vertex @@ -162,7 +162,7 @@ importGraphToGraph (ImportGraph vs es) = simplify built -- | For debugging: returns True if all edges reference a valid vertex tag. -isCoherent :: ImportGraph -> Bool -isCoherent (ImportGraph vs es) = all edgeValid es where +isCoherent :: AdjacencyList -> Bool +isCoherent (AdjacencyList vs es) = all edgeValid es where edgeValid (Edge a b) = HashSet.member a allTags && HashSet.member b allTags allTags = HashSet.fromList (toList (vertexTag <$> vs)) diff --git a/src/Semantic/Config.hs b/src/Semantic/Config.hs index 1c2a2c560..a65c71c6b 100644 --- a/src/Semantic/Config.hs +++ b/src/Semantic/Config.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} + module Semantic.Config where import Network.BSD @@ -82,16 +84,18 @@ withTelemetry config action = withLoggerFromConfig :: Config -> (LogQueue -> IO c) -> IO c withLoggerFromConfig Config{..} = withLogger opts configMaxTelemetyQueueSize - where opts = LogOptions { - logOptionsLevel = optionsLogLevel configOptions - , logOptionsFormatter = configLogFormatter - , logOptionsContext = - [ ("app", configAppName) - , ("pid", show configProcessID) - , ("hostname", configHostName) - , ("sha", buildSHA) - ] <> [("request_id", x) | x <- toList (optionsRequestID configOptions) ] - } + where opts = LogOptions { logOptionsLevel = optionsLogLevel configOptions + , logOptionsFormatter = configLogFormatter + , logOptionsContext = logOptionsContext' configIsTerminal + } + logOptionsContext' = \case + False -> [ ("app", configAppName) + , ("pid", show configProcessID) + , ("hostname", configHostName) + , ("sha", buildSHA) + ] <> [("request_id", x) | x <- toList (optionsRequestID configOptions) ] + _ -> [] + withHaystackFromConfig :: Config -> Haystack.ErrorLogger -> (HaystackQueue -> IO c) -> IO c withHaystackFromConfig Config{..} errorLogger = diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index c529e189b..130f28f25 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -17,6 +17,7 @@ module Semantic.Graph , resumingAddressError , resumingValueError , resumingEnvironmentError +, resumingTypeError ) where @@ -32,6 +33,7 @@ import Data.Abstract.Evaluatable import Data.Abstract.Module import qualified Data.Abstract.ModuleTable as ModuleTable import Data.Abstract.Package as Package +import Data.Abstract.Value.Abstract import Data.Abstract.Value.Type import Data.Abstract.Value.Concrete (Value, ValueError (..), runValueErrorWith) import Data.Graph @@ -40,9 +42,12 @@ import Data.Record import qualified Data.Syntax as Syntax import Data.Term import Data.Text (pack) +import Language.Haskell.HsColour +import Language.Haskell.HsColour.Colourise import Parsing.Parser import Prologue hiding (MonadError (..), TypeError (..)) import Semantic.Task as Task +import Text.Show.Pretty (ppShow) data GraphType = ImportGraph | CallGraph @@ -87,7 +92,7 @@ runCallGraph lang includePackages modules package = do analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules extractGraph (_, (_, (graph, _))) = simplify graph runGraphAnalysis - = runState (lowerBound @(Heap (Hole (Located Monovariant)) All Type)) + = runState (lowerBound @(Heap (Hole (Located Monovariant)) All Abstract)) . runFresh 0 . resumingLoadError . resumingUnspecialized @@ -95,10 +100,9 @@ runCallGraph lang includePackages modules package = do . resumingEvalError . resumingResolutionError . resumingAddressError - . runTermEvaluator @_ @(Hole (Located Monovariant)) @Type + . runTermEvaluator @_ @(Hole (Located Monovariant)) @Abstract . graphing . caching @[] - . resumingTypeError . runReader (packageInfo package) . runReader (lowerBound @Span) . providingLiveSet @@ -181,7 +185,7 @@ parsePackage parser project@Project{..} = do p <- parseModules parser project resMap <- Task.resolutionMap project let pkg = Package.fromModules n p resMap - pkg <$ trace ("project: " <> show (() <$ pkg)) + pkg <$ trace ("project: " <> prettyShow (() <$ pkg)) where n = name (projectName project) @@ -206,7 +210,7 @@ withTermSpans :: ( HasField fields Span withTermSpans recur term = withCurrentSpan (getField (termFAnnotation term)) (recur term) resumingResolutionError :: (Applicative (m effects), Effectful m, Member Trace effects, Effects effects) => m (Resumable ResolutionError ': effects) a -> m effects a -resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionError:" <> show err) *> case err of +resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionError: " <> prettyShow err) *> case err of NotFoundError nameToResolve _ _ -> pure nameToResolve GoImportError pathToResolve -> pure [pathToResolve]) @@ -214,7 +218,7 @@ resumingLoadError :: (Member Trace effects, AbstractHole address, Effects effect resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> (lowerBound, hole)) resumingEvalError :: (Member Fresh effects, Member Trace effects, Effects effects) => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a -resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) *> case err of +resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow err) *> case err of DefaultExportError{} -> pure () ExportError{} -> pure () IntegerFormatError{} -> pure 0 @@ -223,17 +227,17 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) * NoNameError -> gensym) resumingUnspecialized :: (Member Trace effects, AbstractHole value, Effects effects) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a -resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized:" <> show err) $> hole) +resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized: " <> prettyShow err) $> hole) resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address, Effects effects) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a -resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> show err) *> case err of +resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError: " <> prettyShow err) *> case err of UnallocatedAddress _ -> pure lowerBound UninitializedAddress _ -> pure hole) resumingValueError :: (Member Trace effects, Show address, Effects effects) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a -resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of +resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> prettyShow err) *> case err of CallError val -> pure val - StringError val -> pure (pack (show val)) + StringError val -> pure (pack (prettyShow val)) BoolError{} -> pure True BoundsError{} -> pure hole IndexError{} -> pure hole @@ -258,6 +262,9 @@ resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects)) ) => m address Type (Resumable TypeError ': State TypeMap ': effects) a -> m address Type effects a -resumingTypeError = runTypesWith (\err -> trace ("TypeError " <> show err) *> case err of +resumingTypeError = runTypesWith (\err -> trace ("TypeError: " <> prettyShow err) *> case err of UnificationError l r -> pure l <|> pure r InfiniteType _ r -> pure r) + +prettyShow :: Show a => a -> String +prettyShow = hscolour TTY defaultColourPrefs False False "" False . ppShow diff --git a/test/Graphing/Calls/Spec.hs b/test/Graphing/Calls/Spec.hs new file mode 100644 index 000000000..b6e018527 --- /dev/null +++ b/test/Graphing/Calls/Spec.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE PackageImports #-} + +module Graphing.Calls.Spec ( spec ) where + +import Prelude hiding (readFile) +import Prologue +import SpecHelpers hiding (readFile) + +import Algebra.Graph +import Data.List (uncons) + +import "semantic" Data.Graph (Graph (..), topologicalSort) +import Data.Graph.Vertex +import qualified Data.Language as Language +import Semantic.Config (defaultOptions) +import Semantic.Graph +import Semantic.IO + +callGraphPythonProject paths = runTaskWithOptions defaultOptions $ do + let proxy = Proxy @'Language.Python + let lang = Language.Python + blobs <- catMaybes <$> traverse readFile (flip File lang <$> paths) + package <- parsePackage pythonParser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang []) + modules <- topologicalSort <$> runImportGraph proxy package + runCallGraph proxy False modules package + +spec :: Spec +spec = describe "call graphing" $ do + + let needs r n = unGraph r `shouldSatisfy` hasVertex (Variable n) + + it "should work for a simple example" $ do + res <- callGraphPythonProject ["test/fixtures/python/graphing/simple/simple.py"] + res `needs` "magnus" + + it "should evaluate both sides of an if-statement" $ do + res <- callGraphPythonProject ["test/fixtures/python/graphing/conditional/conditional.py"] + res `needs` "merle" + res `needs` "taako" + + it "should continue even when a type error is encountered" $ do + res <- callGraphPythonProject ["test/fixtures/python/graphing/typeerror/typeerror.py"] + res `needs` "lup" + + it "should continue when an unbound variable is encountered" $ do + res <- callGraphPythonProject ["test/fixtures/python/graphing/unbound/unbound.py"] + res `needs` "lucretia" diff --git a/test/Spec.hs b/test/Spec.hs index 84710a79b..b19d99eb7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -16,6 +16,7 @@ import qualified Data.Term.Spec import qualified Diffing.Algorithm.RWS.Spec import qualified Diffing.Algorithm.SES.Spec import qualified Diffing.Interpreter.Spec +import qualified Graphing.Calls.Spec import qualified Integration.Spec import qualified Matching.Go.Spec import qualified Numeric.Spec @@ -52,6 +53,7 @@ main = do describe "Diffing.Algorithm.RWS" Diffing.Algorithm.RWS.Spec.spec describe "Diffing.Algorithm.SES" Diffing.Algorithm.SES.Spec.spec describe "Diffing.Interpreter" Diffing.Interpreter.Spec.spec + describe "Graphing.Calls" Graphing.Calls.Spec.spec describe "Matching" Matching.Go.Spec.spec describe "Numeric" Numeric.Spec.spec describe "Rendering.TOC" Rendering.TOC.Spec.spec diff --git a/test/fixtures/python/graphing/conditional/conditional.py b/test/fixtures/python/graphing/conditional/conditional.py new file mode 100644 index 000000000..d15a3433b --- /dev/null +++ b/test/fixtures/python/graphing/conditional/conditional.py @@ -0,0 +1,8 @@ +cond = True + +if cond: + def merle(): pass + merle() +else: + def taako(): pass + taako() diff --git a/test/fixtures/python/graphing/simple/simple.py b/test/fixtures/python/graphing/simple/simple.py new file mode 100644 index 000000000..f35c3d818 --- /dev/null +++ b/test/fixtures/python/graphing/simple/simple.py @@ -0,0 +1,4 @@ +def magnus(): + return "string" + +magnus() diff --git a/test/fixtures/python/graphing/typeerror/typeerror.py b/test/fixtures/python/graphing/typeerror/typeerror.py new file mode 100644 index 000000000..4e10838b0 --- /dev/null +++ b/test/fixtures/python/graphing/typeerror/typeerror.py @@ -0,0 +1,5 @@ +var = 1 + "thing" + +def lup(): pass + +lup() diff --git a/test/fixtures/python/graphing/unbound/unbound.py b/test/fixtures/python/graphing/unbound/unbound.py new file mode 100644 index 000000000..ba02e8246 --- /dev/null +++ b/test/fixtures/python/graphing/unbound/unbound.py @@ -0,0 +1,5 @@ +var = thing + 1 + +def lucretia(): pass + +lucretia()