diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 45abf2865..02f5e379f 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -3,6 +3,7 @@ module Analysis.Abstract.Graph ( Graph(..) , Vertex(..) , moduleVertex +, unknownModuleVertex , style , appendGraph , variableDefinition @@ -36,13 +37,15 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexIdentifier)) { vertexAttributes = vertexAttributes , edgeAttributes = edgeAttributes } - where vertexAttributes Package{} = [ "style" := "dashed", "shape" := "box" ] - vertexAttributes Module{} = [ "style" := "dotted, rounded", "shape" := "box" ] + where vertexAttributes Package{} = [ "style" := "dashed", "shape" := "box" ] + vertexAttributes Module{} = [ "style" := "dotted, rounded", "shape" := "box" ] + vertexAttributes UnknownModule{} = [ "style" := "dotted, rounded", "shape" := "box", "color" := "red", "fontcolor" := "red" ] vertexAttributes Variable{..} = [ "label" := T.encodeUtf8Builder (vertexName <> " (Variable)"), "tooltip" := T.encodeUtf8Builder (showSpan vertexSpan), "style" := "rounded", "shape" := "box" ] vertexAttributes Method{..} = [ "label" := T.encodeUtf8Builder (vertexName <> " (Method)"), "tooltip" := T.encodeUtf8Builder (showSpan vertexSpan) , "style" := "rounded", "shape" := "box" ] vertexAttributes Function{..} = [ "label" := T.encodeUtf8Builder (vertexName <> " (Function)"), "tooltip" := T.encodeUtf8Builder (showSpan vertexSpan), "style" := "rounded", "shape" := "box" ] + edgeAttributes Module{} Module{} = [ "len" := "5.0", "label" := "imports" ] + edgeAttributes Module{} UnknownModule{} = [ "len" := "5.0", "label" := "imports" ] edgeAttributes Package{} Module{} = [ "len" := "5.0", "style" := "dashed" ] - edgeAttributes Module{} Module{} = [ "len" := "5.0", "label" := "imports" ] edgeAttributes Variable{} Module{} = [ "len" := "5.0", "color" := "blue", "label" := "refers to symbol defined in" ] edgeAttributes _ Module{} = [ "len" := "5.0", "color" := "blue", "label" := "defined in" ] edgeAttributes Method{} Variable{} = [ "len" := "2.0", "color" := "green", "label" := "calls" ] @@ -124,11 +127,14 @@ graphingModules recur m = do appendGraph (vertex v) local (const v) $ eavesdrop @(Modules address) (\ m -> case m of - -- NB: path is null for Languages like Ruby that have module imports that require concrete value semantics. - Load path | not (Prologue.null path) -> moduleInclusion (moduleVertex (ModuleInfo path)) - Lookup path | not (Prologue.null path) -> moduleInclusion (moduleVertex (ModuleInfo path)) + Load path -> includeModule path + Lookup path -> includeModule path _ -> pure ()) (recur m) + where + -- NB: path is null for Languages like Ruby that have module imports that require concrete value semantics. + includeModule path = let path' = if Prologue.null path then "unknown, concrete semantics required" else path + in moduleInclusion (moduleVertex (ModuleInfo path')) -- | Add vertices to the graph for imported modules. graphingModuleInfo :: forall term address value effects a diff --git a/src/Data/Graph/Adjacency.hs b/src/Data/Graph/Adjacency.hs index cf587fb3e..e7e12766e 100644 --- a/src/Data/Graph/Adjacency.hs +++ b/src/Data/Graph/Adjacency.hs @@ -42,6 +42,7 @@ import qualified Data.Graph.Vertex as V data VertexType = PACKAGE | MODULE + | UNKNOWN_MODULE | VARIABLE | METHOD | FUNCTION @@ -119,6 +120,7 @@ taggedGraphToAdjacencyList = accumToAdj . adjMapToAccum . adjacencyMap . toGraph t = case s of V.Package{} -> PACKAGE V.Module{} -> MODULE + V.UnknownModule{} -> UNKNOWN_MODULE V.Variable{} -> VARIABLE V.Method{} -> METHOD V.Function{} -> FUNCTION @@ -161,8 +163,9 @@ importGraphToGraph (AdjacencyList vs es) = simplify built pbToVertex :: Vertex -> V.Vertex pbToVertex (Vertex t c _) = case t of - MODULE -> V.Module c PACKAGE -> V.Package c + MODULE -> V.Module c + UNKNOWN_MODULE -> V.UnknownModule c VARIABLE -> V.Variable c "unknown" emptySpan METHOD -> V.Method c "unknown" emptySpan FUNCTION -> V.Function c "unknown" emptySpan diff --git a/src/Data/Graph/Vertex.hs b/src/Data/Graph/Vertex.hs index 4162662be..613042c01 100644 --- a/src/Data/Graph/Vertex.hs +++ b/src/Data/Graph/Vertex.hs @@ -3,6 +3,7 @@ module Data.Graph.Vertex ( Vertex (..) , packageVertex , moduleVertex +, unknownModuleVertex , variableVertex , methodVertex , functionVertex @@ -30,11 +31,12 @@ import Prologue hiding (packageName) -- | A vertex of some specific type. data Vertex - = Package { vertexName :: Text } - | Module { vertexName :: Text } - | Variable { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } - | Method { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } - | Function { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } + = Package { vertexName :: Text } + | Module { vertexName :: Text } + | UnknownModule { vertexName :: Text } + | Variable { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } + | Method { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } + | Function { vertexName :: Text, vertexModuleName :: Text, vertexSpan :: Span } deriving (Eq, Ord, Show, Generic, Hashable) packageVertex :: PackageInfo -> Vertex @@ -43,6 +45,9 @@ packageVertex (PackageInfo name _) = Package (formatName name) moduleVertex :: ModuleInfo -> Vertex moduleVertex = Module . T.pack . modulePath +unknownModuleVertex :: ModuleInfo -> Vertex +unknownModuleVertex = UnknownModule . T.pack . modulePath + variableVertex :: Text -> ModuleInfo -> Span -> Vertex variableVertex name ModuleInfo{..} = Variable name (T.pack modulePath) @@ -58,6 +63,7 @@ instance ToJSON Vertex where vertexIdentifier :: Vertex -> Text vertexIdentifier v@Package{..} = vertexName <> " (" <> vertexToType v <> ")" vertexIdentifier v@Module{..} = vertexName <> " (" <> vertexToType v <> ")" +vertexIdentifier v@UnknownModule{..} = vertexName <> " (" <> vertexToType v <> ")" vertexIdentifier v = vertexModuleName v <> "::" <> vertexName v <> " (" <> vertexToType v <> " " <> showSpan (vertexSpan v) <> ")" showSpan :: Span -> Text @@ -67,11 +73,12 @@ showSpan (Span (Pos a b) (Pos c d)) = T.pack $ <> "[" <> show c <> ", " <> show d <> "]" vertexToType :: Vertex -> Text -vertexToType Package{} = "Package" -vertexToType Module{} = "Module" -vertexToType Variable{} = "Variable" -vertexToType Method{} = "Method" -vertexToType Function{} = "Function" +vertexToType Package{} = "Package" +vertexToType Module{} = "Module" +vertexToType UnknownModule{} = "Unknown Module" +vertexToType Variable{} = "Variable" +vertexToType Method{} = "Method" +vertexToType Function{} = "Function" instance Lower Vertex where lowerBound = Package "" diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 6170cea13..e4ae7b0c4 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -3,6 +3,8 @@ module Semantic.Graph ( runGraph , runCallGraph , runImportGraph +, runImportGraphToModules +, runImportGraphToModuleInfos , GraphType(..) , Graph , Vertex @@ -60,11 +62,11 @@ runGraph :: forall effs. (Member Distribute effs, Member (Exc SomeException) eff runGraph ImportGraph _ project | SomeAnalysisParser parser lang <- someAnalysisParser (Proxy :: Proxy AnalysisClasses) (projectLanguage project) = do package <- parsePackage parser project - fmap (Graph.moduleVertex . moduleInfo) <$> runImportGraph lang package + runImportGraphToModuleInfos lang package runGraph CallGraph includePackages project | SomeAnalysisParser parser lang <- someAnalysisParser (Proxy :: Proxy AnalysisClasses) (projectLanguage project) = do package <- parsePackage parser project - modules <- topologicalSort <$> runImportGraph lang package + modules <- topologicalSort <$> runImportGraphToModules lang package runCallGraph lang includePackages modules package runCallGraph :: ( HasField fields Span @@ -112,9 +114,23 @@ runCallGraph lang includePackages modules package = do . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm modules)) +runImportGraphToModuleInfos :: forall effs lang term. + ( Declarations term + , Evaluatable (Base term) + , FreeVariables term + , HasPrelude lang + , HasPostlude lang + , Member Trace effs + , Recursive term + , Effects effs + ) + => Proxy lang + -> Package term + -> Eff effs (Graph Vertex) +runImportGraphToModuleInfos lang (package :: Package term) = runImportGraph lang package allModuleInfos + where allModuleInfos info = maybe (vertex (unknownModuleVertex info)) (foldMap (vertex . moduleVertex . moduleInfo)) (ModuleTable.lookup (modulePath info) (packageModules package)) - -runImportGraph :: forall effs lang term. +runImportGraphToModules :: forall effs lang term. ( Declarations term , Evaluatable (Base term) , FreeVariables term @@ -127,14 +143,26 @@ runImportGraph :: forall effs lang term. => Proxy lang -> Package term -> Eff effs (Graph (Module term)) -runImportGraph lang (package :: Package term) - -- Optimization for the common (when debugging) case of one-and-only-one module. - | [m :| []] <- toList (packageModules package) = vertex m <$ trace ("single module, skipping import graph computation for " <> modulePath (moduleInfo m)) - | otherwise = +runImportGraphToModules lang (package :: Package term) = runImportGraph lang package resolveOrLowerBound + where resolveOrLowerBound info = maybe lowerBound (foldMap vertex) (ModuleTable.lookup (modulePath info) (packageModules package)) + +runImportGraph :: forall effs lang term vertex. + ( Declarations term + , Evaluatable (Base term) + , FreeVariables term + , HasPrelude lang + , HasPostlude lang + , Member Trace effs + , Recursive term + , Effects effs + ) + => Proxy lang + -> Package term + -> (ModuleInfo -> Graph vertex) + -> Eff effs (Graph vertex) +runImportGraph lang (package :: Package term) f = let analyzeModule = graphingModuleInfo - extractGraph (_, (graph, _)) = do - info <- graph - maybe lowerBound (foldMap vertex) (ModuleTable.lookup (modulePath info) (packageModules package)) + extractGraph (_, (graph, _)) = graph >>= f runImportGraphAnalysis = runState lowerBound . runFresh 0 diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 2d7f4d612..f467af8a4 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -106,7 +106,7 @@ typecheckGoFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Langu callGraphProject parser proxy lang opts paths = runTaskWithOptions opts $ do blobs <- catMaybes <$> traverse readFile (flip File lang <$> paths) package <- parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang []) - modules <- topologicalSort <$> runImportGraph proxy package + modules <- topologicalSort <$> runImportGraphToModules proxy package x <- runCallGraph proxy False modules package pure (x, (() <$) <$> modules) @@ -121,7 +121,7 @@ data TaskConfig = TaskConfig Config LogQueue StatQueue evaluateProject' (TaskConfig config logger statter) proxy parser lang paths = either (die . displayException) pure <=< runTaskWithConfig config logger statter $ do blobs <- catMaybes <$> traverse readFile (flip File lang <$> paths) package <- fmap quieterm <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang []) - modules <- topologicalSort <$> runImportGraph proxy package + modules <- topologicalSort <$> runImportGraphToModules proxy package trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules) pure (runTermEvaluator @_ @_ @(Value Precise (UtilEff Precise)) (runReader (packageInfo package) @@ -134,7 +134,7 @@ evaluateProject' (TaskConfig config logger statter) proxy parser lang paths = ei evaluateProjectWithCaching proxy parser lang path = runTaskWithOptions debugOptions $ do project <- readProject Nothing path lang [] package <- fmap quieterm <$> parsePackage parser project - modules <- topologicalSort <$> runImportGraph proxy package + modules <- topologicalSort <$> runImportGraphToModules proxy package pure (runReader (packageInfo package) (runReader (lowerBound @Span) (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Monovariant))))) diff --git a/test/Graphing/Calls/Spec.hs b/test/Graphing/Calls/Spec.hs index 202089150..176df9c2f 100644 --- a/test/Graphing/Calls/Spec.hs +++ b/test/Graphing/Calls/Spec.hs @@ -23,7 +23,7 @@ callGraphPythonProject paths = runTaskWithOptions defaultOptions $ do 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 + modules <- topologicalSort <$> runImportGraphToModules proxy package runCallGraph proxy False modules package spec :: Spec