Merge remote-tracking branch 'origin/master' into java-assignment-continued

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;
 }
 

proto/types.proto

@@ -42,7 +42,7 @@ message ErrorSite {
   SrcLoc errorLocation = 2;
 }
 
-message ImportGraph {
+message AdjacencyList {
   repeated Vertex graphVertices = 1;
   repeated Edge graphEdges = 2;
 }

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

src/Data/Graph/Adjacency.hs

@@ -1,12 +1,12 @@
 {-# LANGUAGE DeriveAnyClass, LambdaCase, ScopedTypeVariables #-}
 
-module Data.Graph.Adjacency.Import
+module Data.Graph.Adjacency
-  ( ImportGraph (..)
+  ( 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
+graphToAdjacencyList :: Graph V.Vertex -> AdjacencyList
-graphToImportGraph = taggedGraphToImportGraph . tagGraph . simplify
+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
+taggedGraphToAdjacencyList :: Graph (V.Vertex, Tag) -> AdjacencyList
-taggedGraphToImportGraph = accumToAdj . adjMapToAccum . adjacencyMap . toGraph . simplify
+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 -> AdjacencyList
-        accumToAdj (Acc vs es) = ImportGraph (fromList vs) (fromList (toList es))
+        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.
+-- | This is the reverse of 'graphToAdjacencyList'. Don't use this outside of a testing context.
--- N.B. @importGraphToGraph . graphToImportGraph@ is 'id', but @graphToImportGraph . importGraphToGraph@ is not.
+-- N.B. @importGraphToGraph . graphToAdjacencyList@ is 'id', but @graphToAdjacencyList . importGraphToGraph@ is not.
-importGraphToGraph :: ImportGraph -> Graph V.Vertex
+importGraphToGraph :: AdjacencyList -> Graph V.Vertex
-importGraphToGraph (ImportGraph vs es) = simplify built
+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 :: AdjacencyList -> Bool
-isCoherent (ImportGraph vs es) = all edgeValid es where
+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))

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 {
+  where opts = LogOptions { logOptionsLevel     = optionsLogLevel configOptions
-      logOptionsLevel     = optionsLogLevel configOptions
+                          , logOptionsFormatter = configLogFormatter
-    , logOptionsFormatter = configLogFormatter
+                          , logOptionsContext   = logOptionsContext' configIsTerminal
-    , logOptionsContext   =
+                          }
-      [ ("app", configAppName)
+        logOptionsContext' = \case
-      , ("pid", show configProcessID)
+                            False -> [ ("app", configAppName)
-      , ("hostname", configHostName)
+                                     , ("pid", show configProcessID)
-      , ("sha", buildSHA)
+                                     , ("hostname", configHostName)
-      ] <> [("request_id", x) | x <- toList (optionsRequestID configOptions) ]
+                                     , ("sha", buildSHA)
-    }
+                                     ] <> [("request_id", x) | x <- toList (optionsRequestID configOptions) ]
+                            _ -> []
+
 
 withHaystackFromConfig :: Config -> Haystack.ErrorLogger -> (HaystackQueue -> IO c) -> IO c
 withHaystackFromConfig Config{..} errorLogger =

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

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"

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

test/fixtures/python/graphing/conditional/conditional.py

@@ -0,0 +1,8 @@
+cond = True
+
+if cond:
+    def merle(): pass
+    merle()
+else:
+    def taako(): pass
+    taako()

test/fixtures/python/graphing/simple/simple.py

@@ -0,0 +1,4 @@
+def magnus():
+    return "string"
+
+magnus()

test/fixtures/python/graphing/typeerror/typeerror.py

@@ -0,0 +1,5 @@
+var = 1 + "thing"
+
+def lup(): pass
+
+lup()

test/fixtures/python/graphing/unbound/unbound.py

@@ -0,0 +1,5 @@
+var = thing + 1
+
+def lucretia(): pass
+
+lucretia()