Merge pull request #2090 from github/external-modules

Surface external/unknown modules in the import graph

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

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

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 ""

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

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)))))

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