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

bench/Main.hs

@@ -1,9 +1,22 @@
+{-# LANGUAGE DataKinds, FlexibleContexts, TypeFamilies, TypeApplications #-}
+
 module Main where
 
-import Criterion.Main
-import Semantic.Util
-import Data.Monoid
-import Control.Monad
+import           Control.Monad
+import           Criterion.Main
+import qualified Data.Language as Language
+import           Data.Proxy
+import           Parsing.Parser
+import           Semantic.Config (defaultOptions)
+import           Semantic.Task (withOptions)
+import           Semantic.Util hiding (evalRubyProject, evalPythonProject, evaluateProject)
+
+-- Duplicating this stuff from Util to shut off the logging
+evalRubyProject   = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Ruby)   rubyParser   Language.Ruby
+evalPythonProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Language.Python) pythonParser Language.Python
+
+evaluateProject proxy parser lang paths = withOptions defaultOptions $ \ config logger statter ->
+  evaluateProject' (TaskConfig config logger statter) proxy parser lang paths
 
 -- We use `fmap show` to ensure that all the parts of the result of evaluation are
 -- evaluated themselves. While an NFData instance is the most morally correct way
@@ -11,19 +24,27 @@ import Control.Monad
 -- project—coercing the result into a string will suffice, though it throws off the
 -- memory allocation results a bit.
 pyEval :: FilePath -> Benchmarkable
-pyEval = whnfIO . fmap show . evalPythonProject . ("bench/bench-fixtures/python/" <>)
+pyEval p = whnfIO . fmap show . evalPythonProject $ ["bench/bench-fixtures/python/" <> p]
 
 rbEval :: FilePath -> Benchmarkable
-rbEval = whnfIO . fmap show . evalRubyProject . ("bench/bench-fixtures/ruby/" <>)
+rbEval p = whnfIO . fmap show . evalRubyProject $ ["bench/bench-fixtures/ruby/" <> p]
+
+pyCall :: FilePath -> Benchmarkable
+pyCall p = whnfIO $ callGraphProject pythonParser (Proxy @'Language.Python) Language.Python defaultOptions ["bench/bench-fixtures/python/" <> p]
+
+rbCall :: FilePath -> Benchmarkable
+rbCall p = whnfIO $ callGraphProject rubyParser (Proxy @'Language.Ruby) Language.Ruby defaultOptions ["bench/bench-fixtures/ruby/" <> p]
 
 main :: IO ()
 main = defaultMain
   [ bgroup "python" [ bench "assignment" $ pyEval "simple-assignment.py"
                     , bench "function def" $ pyEval "function-definition.py"
                     , bench "if + function calls" $ pyEval "if-statement-functions.py"
+                    , bench "call graph" $ pyCall "if-statement-functions.py"
                     ]
   , bgroup "ruby" [ bench "assignment" $ rbEval "simple-assignment.rb"
                   , bench "function def" $ rbEval "function-definition.rb"
                   , bench "if + function calls" $ rbEval "if-statement-functions.rb"
+                  , bench "call graph" $ rbCall "if-statement-functions.rb"
                   ]
   ]

proto/code_analysis.proto

@@ -2,9 +2,10 @@ syntax = "proto3";
 
 package github.semantic;
 
-import "ruby.proto";
-import "json.proto";
-import "typescript.proto";
+import "ruby-terms.proto";
+import "ruby-diffs.proto";
+import "json-terms.proto";
+import "typescript-terms.proto";
 import "types.proto";
 import "error_details.proto";
 
@@ -24,8 +25,8 @@ service CodeAnalysis {
   //
   // Summarize an AST diff of source blobs.
   rpc SummarizeDiff (SummarizeDiffRequest) returns (SummarizeDiffResponse);
-  // AST diff of source blobs
-  // rpc Diff (DiffRequest) returns (DiffResponse) {}
+  // Diff the ASTs of source blobs
+  rpc DiffTree (DiffTreeRequest) returns (DiffTreeResponse);
 
   // Analyzing
   //
@@ -51,15 +52,15 @@ message ParseTreeResponse {
 }
 
 message RubyResponse {
-  repeated ruby.RubyTerm terms = 1;
+  repeated ruby_terms.RubyTerm terms = 1;
 }
 
 message JSONResponse {
-  repeated json.JSONTerm terms = 1;
+  repeated json_terms.JSONTerm terms = 1;
 }
 
 message TypeScriptResponse {
-  repeated typescript.TypeScriptTerm terms = 1;
+  repeated typescript_terms.TypeScriptTerm terms = 1;
 }
 
 message SummarizeDiffRequest  {
@@ -71,6 +72,20 @@ message SummarizeDiffResponse {
   repeated ParseError errors = 2;
 }
 
+message DiffTreeRequest  {
+  repeated BlobPair blobPairs = 1;
+}
+
+message DiffTreeResponse {
+  oneof response_type {
+    RubyDiffResponse ruby = 1;
+  }
+}
+
+message RubyDiffResponse {
+  repeated ruby_diffs.RubyDiff diffs = 1;
+}
+
 message CallGraphRequest {
   Project project = 1;
 }
@@ -89,11 +104,6 @@ message ImportGraphResponse {
   DebugInfo error_info = 2;
 }
 
-message BlobPair {
-  Blob before = 1;
-  Blob after = 2;
-}
-
 message DiffSummary {
   string term = 1;
   string name = 2;

proto/json-terms.proto

@@ -1,11 +1,12 @@
+// This file was generated by proto-gen. Do not edit by hand.
 syntax = "proto3";
 
-package github.semantic.json;
+package github.semantic.json_terms;
 
 import "types.proto";
 
-option java_package = "com.github.semantic.json";
-option go_package = "github.com/semantic/json;json";
+option java_package = "com.github.semantic.json_terms";
+option go_package = "github.com/semantic/json_terms;json";
 
 message JSONTerm {
   JSONSyntax syntax = 1;

proto/ruby-diffs.proto

@@ -0,0 +1,499 @@
+// This file was generated by proto-gen. Do not edit by hand.
+syntax = "proto3";
+
+package github.semantic.ruby_diffs;
+
+import "types.proto";
+
+option java_package = "com.github.semantic.ruby_diffs";
+option go_package = "github.com/semantic/ruby_diffs;ruby";
+
+message RubyDiff {
+  oneof diff {
+    Merge merge = 1;
+    Delete delete = 2;
+    Insert insert = 3;
+    Replace replace = 4;
+  }
+  message Merge {
+    RubySyntax syntax = 1;
+  }
+  message Delete {
+    RubySyntax before = 1;
+  }
+  message Insert {
+    RubySyntax after = 1;
+  }
+  message Replace {
+    RubySyntax before = 1;
+    RubySyntax after = 2;
+  }
+}
+
+message Comment {
+  string commentContent = 1;
+}
+
+message Function {
+  repeated RubyDiff functionContext = 1;
+  RubyDiff functionName = 2;
+  repeated RubyDiff functionParameters = 3;
+  RubyDiff functionBody = 4;
+}
+
+message Method {
+  repeated RubyDiff methodContext = 1;
+  RubyDiff methodReceiver = 2;
+  RubyDiff methodName = 3;
+  repeated RubyDiff methodParameters = 4;
+  RubyDiff methodBody = 5;
+}
+
+message File { }
+
+message Line { }
+
+message Error {
+  repeated ErrorSite errorCallStack = 1;
+  repeated string errorExpected = 2;
+  string errorActual = 3;
+  repeated RubyDiff errorChildren = 4;
+}
+
+message And {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message BAnd {
+  RubyDiff left = 1;
+  RubyDiff right = 2;
+}
+
+message BOr {
+  RubyDiff left = 1;
+  RubyDiff right = 2;
+}
+
+message BXOr {
+  RubyDiff left = 1;
+  RubyDiff right = 2;
+}
+
+message Call {
+  repeated RubyDiff callContext = 1;
+  RubyDiff callFunction = 2;
+  repeated RubyDiff callParams = 3;
+  RubyDiff callBlock = 4;
+}
+
+message Comparison {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Complement {
+  RubyDiff value = 1;
+}
+
+message DividedBy {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Enumeration {
+  RubyDiff enumerationStart = 1;
+  RubyDiff enumerationEnd = 2;
+  RubyDiff enumerationStep = 3;
+}
+
+message Equal {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message FloorDivision {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message GreaterThan {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message GreaterThanEqual {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message LShift {
+  RubyDiff left = 1;
+  RubyDiff right = 2;
+}
+
+message LessThan {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message LessThanEqual {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Matches {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Member {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message MemberAccess {
+  RubyDiff lhs = 1;
+  bytes rhs = 2;
+}
+
+message Minus {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Modulo {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Negate {
+  RubyDiff term = 1;
+}
+
+message Not {
+  RubyDiff term = 1;
+}
+
+message NotMatches {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Or {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Plus {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Power {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message RShift {
+  RubyDiff left = 1;
+  RubyDiff right = 2;
+}
+
+message ScopeResolution {
+  repeated RubyDiff scopes = 1;
+}
+
+message StrictEqual {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Subscript {
+  RubyDiff lhs = 1;
+  repeated RubyDiff rhs = 2;
+}
+
+message Times {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message XOr {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Array {
+  repeated RubyDiff arrayElements = 1;
+}
+
+message Boolean {
+  bool booleanContent = 1;
+}
+
+message Complex {
+  string value = 1;
+}
+
+message Float {
+  string floatContent = 1;
+}
+
+message Hash {
+  repeated RubyDiff hashElements = 1;
+}
+
+message Integer {
+  string integerContent = 1;
+}
+
+message KeyValue {
+  RubyDiff key = 1;
+  RubyDiff value = 2;
+}
+
+message Null { }
+
+message Rational {
+  string value = 1;
+}
+
+message Regex {
+  string regexContent = 1;
+}
+
+message String {
+  repeated RubyDiff stringElements = 1;
+}
+
+message Symbol {
+  string symbolContent = 1;
+}
+
+message TextElement {
+  string textElementContent = 1;
+}
+
+message Class {
+  RubyDiff classIdentifier = 1;
+  repeated RubyDiff classSuperClass = 2;
+  RubyDiff classBody = 3;
+}
+
+message Load {
+  RubyDiff loadPath = 1;
+  repeated RubyDiff loadWrap = 2;
+}
+
+message LowPrecedenceAnd {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message LowPrecedenceOr {
+  RubyDiff lhs = 1;
+  RubyDiff rhs = 2;
+}
+
+message Module {
+  RubyDiff moduleIdentifier = 1;
+  repeated RubyDiff moduleStatements = 2;
+}
+
+message Require {
+  bool requireRelative = 1;
+  RubyDiff requirePath = 2;
+}
+
+message Send {
+  repeated RubyDiff sendReceiver = 1;
+  repeated RubyDiff sendSelector = 2;
+  repeated RubyDiff sendArgs = 3;
+  repeated RubyDiff sendBlock = 4;
+}
+
+message Assignment {
+  repeated RubyDiff assignmentContext = 1;
+  RubyDiff assignmentTarget = 2;
+  RubyDiff assignmentValue = 3;
+}
+
+message Break {
+  RubyDiff term = 1;
+}
+
+message Catch {
+  RubyDiff catchException = 1;
+  RubyDiff catchBody = 2;
+}
+
+message Continue {
+  RubyDiff term = 1;
+}
+
+message Else {
+  RubyDiff elseCondition = 1;
+  RubyDiff elseBody = 2;
+}
+
+message Finally {
+  RubyDiff term = 1;
+}
+
+message ForEach {
+  RubyDiff forEachBinding = 1;
+  RubyDiff forEachSubject = 2;
+  RubyDiff forEachBody = 3;
+}
+
+message If {
+  RubyDiff ifCondition = 1;
+  RubyDiff ifThenBody = 2;
+  RubyDiff ifElseBody = 3;
+}
+
+message Match {
+  RubyDiff matchSubject = 1;
+  RubyDiff matchPatterns = 2;
+}
+
+message Pattern {
+  RubyDiff value = 1;
+  RubyDiff patternBody = 2;
+}
+
+message Retry {
+  RubyDiff term = 1;
+}
+
+message Return {
+  RubyDiff term = 1;
+}
+
+message ScopeEntry {
+  repeated RubyDiff terms = 1;
+}
+
+message ScopeExit {
+  repeated RubyDiff terms = 1;
+}
+
+message Statements {
+  repeated RubyDiff statements = 1;
+}
+
+message Try {
+  RubyDiff tryBody = 1;
+  repeated RubyDiff tryCatch = 2;
+}
+
+message While {
+  RubyDiff whileCondition = 1;
+  RubyDiff whileBody = 2;
+}
+
+message Yield {
+  RubyDiff term = 1;
+}
+
+message RubySyntax {
+  oneof syntax {
+    Comment comment = 1;
+    Function function = 2;
+    Boolean boolean = 3;
+    Method method = 4;
+    File file = 5;
+    Line line = 6;
+    Plus plus = 7;
+    Minus minus = 8;
+    Times times = 9;
+    DividedBy dividedBy = 10;
+    Modulo modulo = 11;
+    Power power = 12;
+    Negate negate = 13;
+    FloorDivision floorDivision = 14;
+    BAnd bAnd = 15;
+    BOr bOr = 16;
+    BXOr bXOr = 17;
+    LShift lShift = 18;
+    RShift rShift = 19;
+    Complement complement = 20;
+    And and = 21;
+    Not not = 22;
+    Or or = 23;
+    XOr xOr = 24;
+    Call call = 25;
+    LessThan lessThan = 26;
+    LessThanEqual lessThanEqual = 27;
+    GreaterThan greaterThan = 28;
+    GreaterThanEqual greaterThanEqual = 29;
+    Equal equal = 30;
+    StrictEqual strictEqual = 31;
+    Comparison comparison = 32;
+    Enumeration enumeration = 33;
+    Matches matches = 34;
+    NotMatches notMatches = 35;
+    MemberAccess memberAccess = 36;
+    ScopeResolution scopeResolution = 37;
+    Subscript subscript = 38;
+    Member member = 39;
+    Array array = 40;
+    Complex complex = 41;
+    Float float = 42;
+    Hash hash = 43;
+    Integer integer = 44;
+    KeyValue keyValue = 45;
+    Null null = 46;
+    Rational rational = 47;
+    Regex regex = 48;
+    String string = 49;
+    Symbol symbol = 50;
+    TextElement textElement = 51;
+    Assignment assignment = 52;
+    Break break = 53;
+    Catch catch = 54;
+    Continue continue = 55;
+    Else else = 56;
+    Finally finally = 57;
+    ForEach forEach = 58;
+    If if = 59;
+    Match match = 60;
+    Pattern pattern = 61;
+    Retry retry = 62;
+    Return return = 63;
+    ScopeEntry scopeEntry = 64;
+    ScopeExit scopeExit = 65;
+    Statements statements = 66;
+    Try try = 67;
+    While while = 68;
+    Yield yield = 69;
+    Context context = 70;
+    Empty empty = 71;
+    Error error = 72;
+    Identifier identifier = 73;
+    Class class = 74;
+    Load load = 75;
+    LowPrecedenceAnd lowPrecedenceAnd = 76;
+    LowPrecedenceOr lowPrecedenceOr = 77;
+    Module module = 78;
+    Require require = 79;
+    Send send = 80;
+    List list = 81;
+  }
+}
+
+message Context {
+  repeated RubyDiff contextTerms = 1;
+  RubyDiff contextSubject = 2;
+}
+
+message Empty { }
+
+message Identifier {
+  bytes name = 1;
+}
+
+message List {
+  repeated RubyDiff listContent = 1;
+}

proto/ruby-terms.proto

@@ -1,11 +1,12 @@
+// This file was generated by proto-gen. Do not edit by hand.
 syntax = "proto3";
 
-package github.semantic.ruby;
+package github.semantic.ruby_terms;
 
 import "types.proto";
 
-option java_package = "com.github.semantic.ruby";
-option go_package = "github.com/semantic/ruby;ruby";
+option java_package = "com.github.semantic.ruby_terms";
+option go_package = "github.com/semantic/ruby_terms;ruby";
 
 message RubyTerm {
   RubySyntax syntax = 1;

proto/types.proto

@@ -1,3 +1,4 @@
+// This file was generated by proto-gen. Do not edit by hand.
 syntax = "proto3";
 
 package github.semantic;
@@ -26,6 +27,11 @@ enum VertexType {
   VARIABLE = 2;
 }
 
+message BlobPair {
+  Blob before = 1;
+  Blob after = 2;
+}
+
 message Blob {
   bytes blobSource = 1;
   string blobPath = 2;

proto/typescript-terms.proto

@@ -1,11 +1,12 @@
+// This file was generated by proto-gen. Do not edit by hand.
 syntax = "proto3";
 
-package github.semantic.typescript;
+package github.semantic.typescript_terms;
 
 import "types.proto";
 
-option java_package = "com.github.semantic.typescript";
-option go_package = "github.com/semantic/typescript;typescript";
+option java_package = "com.github.semantic.typescript_terms";
+option go_package = "github.com/semantic/typescript_terms;typescript";
 
 message TypeScriptTerm {
   TypeScriptSyntax syntax = 1;

semantic.cabal

@@ -83,7 +83,6 @@ library
                      , Data.Language
                      , Data.Map.Monoidal
                      , Data.Mergeable
-                     , Data.Options
                      , Data.Patch
                      , Data.Project
                      , Data.Range
@@ -249,9 +248,9 @@ library
                      , StrictData
                      , TypeApplications
   if flag(release)
-    ghc-options:       -Wall -Werror -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O1 -j
+    ghc-options:       -Wall -Werror -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O1 -j
   else
-    ghc-options:       -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j
+    ghc-options:       -Wall -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j
   ghc-prof-options:    -fprof-auto
 
 executable semantic

src/Analysis/Abstract/Caching.hs

@@ -125,8 +125,8 @@ scatter :: (Foldable t, Member NonDet effects, Member (State (Heap address (Cell
 scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value)
 
 
-caching :: (Alternative f, Effects effects) => TermEvaluator term address value (NonDet ': Reader (Cache term address (Cell address) value) ': State (Cache term address (Cell address) value) ': effects) a -> TermEvaluator term address value effects (Cache term address (Cell address) value, f a)
+caching :: Effects effects => TermEvaluator term address value (NonDet ': Reader (Cache term address (Cell address) value) ': State (Cache term address (Cell address) value) ': effects) a -> TermEvaluator term address value effects (Cache term address (Cell address) value, [a])
 caching
   = runState lowerBound
   . runReader lowerBound
-  . runNonDetA
+  . runNonDet

src/Analysis/Abstract/Graph.hs

@@ -47,12 +47,12 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexName))
 -- | Add vertices to the graph for evaluated identifiers.
 graphingTerms :: ( Element Syntax.Identifier syntax
                  , Member (Reader ModuleInfo) effects
-                 , Member (Env (Hole (Located address))) effects
+                 , Member (Env (Hole context (Located address))) effects
                  , Member (State (Graph Vertex)) effects
                  , Base term ~ TermF (Sum syntax) ann
                  )
-              => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a)
-              -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a)
+              => SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a)
+              -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a)
 graphingTerms recur term@(In _ syntax) = do
   case project syntax of
     Just (Syntax.Identifier name) -> do
@@ -128,11 +128,11 @@ moduleInclusion v = do
   appendGraph (vertex (moduleVertex m) `connect` vertex v)
 
 -- | Add an edge from the passed variable name to the module it originated within.
-variableDefinition :: ( Member (Env (Hole (Located address))) effects
+variableDefinition :: ( Member (Env (Hole context (Located address))) effects
                       , Member (State (Graph Vertex)) effects
                       )
                    => Name
-                   -> TermEvaluator term (Hole (Located address)) value effects ()
+                   -> TermEvaluator term (Hole context (Located address)) value effects ()
 variableDefinition name = do
   graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . addressModule) . toMaybe) <$> TermEvaluator (lookupEnv name)
   appendGraph (vertex (Variable (formatName name)) `connect` graph)

src/Assigning/Assignment.hs

@@ -83,7 +83,6 @@ module Assigning.Assignment
 , putLocals
 -- Results
 , Error(..)
-, errorCallStack
 , nodeError
 , firstSet
 -- Running
@@ -224,8 +223,8 @@ manyThrough step stop = go
   where go = (,) [] <$> stop <|> first . (:) <$> step <*> go
 
 
-nodeError :: HasCallStack => [Either String grammar] -> Node grammar -> Error (Either String grammar)
-nodeError expected Node{..} = Error nodeSpan expected (Just (Right nodeSymbol))
+nodeError :: CallStack -> [Either String grammar] -> Node grammar -> Error (Either String grammar)
+nodeError cs expected Node{..} = Error nodeSpan expected (Just (Right nodeSymbol)) cs
 
 
 firstSet :: (Enum grammar, Ix grammar) => Assignment ast grammar a -> [grammar]
@@ -279,23 +278,26 @@ runAssignment source = \ assignment state -> go assignment state >>= requireExha
                   Many rule -> fix (\ recur state -> (go rule state >>= \ (a, state') -> first (a:) <$> if state == state' then pure ([], state') else recur state') `catchError` const (pure ([], state))) state >>= uncurry yield
                   Alt (a:as) -> sconcat (flip yield state <$> a:|as)
                   Label child label -> go child state `catchError` (\ err -> throwError err { errorExpected = [Left label] }) >>= uncurry yield
-                  Fail s -> throwError ((makeError node) { errorActual = Just (Left s) })
+                  Fail s -> throwError ((makeError' node) { errorActual = Just (Left s) })
                   Choose _ (Just atEnd) _ | Nothing <- node -> go atEnd state >>= uncurry yield
-                  _ -> Left (makeError node)
+                  _ -> Left (makeError' node)
 
                 state@State{..} = case (runTracing t, initialState) of
                   (Choose table _ _, State { stateNodes = Term (In node _) : _ }) | symbolType (nodeSymbol node) /= Regular, symbols@(_:_) <- Table.tableAddresses table, all ((== Regular) . symbolType) symbols -> skipTokens initialState
                   _ -> initialState
                 expectedSymbols = firstSet (t `Then` return)
-                makeError = withStateCallStack (tracingCallSite t) state $ maybe (Error (Span statePos statePos) (fmap Right expectedSymbols) Nothing) (nodeError (fmap Right expectedSymbols))
+                assignmentStack = maybe emptyCallStack (fromCallSiteList . pure) (tracingCallSite t)
+                makeError' = maybe
+                             (Error (Span statePos statePos) (fmap Right expectedSymbols) Nothing assignmentStack)
+                             (nodeError assignmentStack (fmap Right expectedSymbols))
 
 requireExhaustive :: Symbol grammar => Maybe (String, SrcLoc) -> (result, State ast grammar) -> Either (Error (Either String grammar)) (result, State ast grammar)
-requireExhaustive callSite (a, state) = let state' = skipTokens state in case stateNodes state' of
-  [] -> Right (a, state')
-  Term (In node _) : _ -> Left (withStateCallStack callSite state (nodeError [] node))
-
-withStateCallStack :: Maybe (String, SrcLoc) -> State ast grammar -> (HasCallStack => a) -> a
-withStateCallStack callSite state = withCallStack (freezeCallStack (fromCallSiteList (maybe id (:) callSite (stateCallSites state))))
+requireExhaustive callSite (a, state) =
+  let state' = skipTokens state
+      stack = fromCallSiteList (maybe id (:) callSite (stateCallSites state))
+  in case stateNodes state' of
+    [] -> Right (a, state')
+    Term (In node _) : _ -> Left (nodeError stack [] node)
 
 skipTokens :: Symbol grammar => State ast grammar -> State ast grammar
 skipTokens state = state { stateNodes = dropWhile ((/= Regular) . symbolType . nodeSymbol . termAnnotation) (stateNodes state) }

src/Assigning/Assignment/Deterministic.hs

@@ -60,13 +60,13 @@ choose :: (Enum symbol, HasCallStack)
 choose nullable firstSet table src state follow = case stateInput state of
   []  -> case nullable of
     Nullable f -> Right (state, f state)
-    _          -> Left (withFrozenCallStack (Error (stateSpan state) (Right . toEnum <$> IntSet.toList firstSet) Nothing))
+    _          -> Left (makeError (stateSpan state) (Right . toEnum <$> IntSet.toList firstSet) Nothing)
   s:_ -> case fromEnum (astSymbol s) `IntMap.lookup` table of
     Just k -> k src state follow
     _      -> notFound (astSymbol s) state follow
   where notFound s state follow = case nullable of
           Nullable f | any (fromEnum s `IntSet.member`) follow -> Right (state, f state)
-          _                                                    -> Left (withFrozenCallStack (Error (stateSpan state) (Right . toEnum <$> IntSet.toList firstSet) (Just (Right s))))
+          _                                                    -> Left (makeError (stateSpan state) (Right . toEnum <$> IntSet.toList firstSet) (Just (Right s)))
 
 instance (Enum symbol, Ord symbol) => Applicative (Assignment symbol) where
   pure a = Assignment (pure a) lowerBound []
@@ -99,15 +99,15 @@ instance (Enum symbol, Ord symbol) => Alternative (Assignment symbol) where
 instance (Enum symbol, Ord symbol, Show symbol) => Assigning symbol (Assignment symbol) where
   leafNode s = Assignment NotNullable (IntSet.singleton (fromEnum s))
     [ (s, \ src state _ -> case stateInput state of
-      []  -> Left (withFrozenCallStack (Error (stateSpan state) [Right s] Nothing))
+      []  -> Left (makeError (stateSpan state) [Right s] Nothing)
       s:_ -> case decodeUtf8' (sourceBytes (Source.slice (astRange s) src)) of
-        Left err   -> Left (withFrozenCallStack (Error (astSpan s) [Left "valid utf-8"] (Just (Left (show err)))))
+        Left err   -> Left (makeError (astSpan s) [Left "valid utf-8"] (Just (Left (show err))))
         Right text -> Right (advanceState state, text))
     ]
 
   branchNode s a = Assignment NotNullable (IntSet.singleton (fromEnum s))
     [ (s, \ src state _ -> case stateInput state of
-      []  -> Left (withFrozenCallStack (Error (stateSpan state) [Right s] Nothing))
+      []  -> Left (makeError (stateSpan state) [Right s] Nothing)
       s:_ -> first (const (advanceState state)) <$> runAssignment a src state { stateInput = astChildren s })
     ]
 
@@ -132,7 +132,7 @@ runAssignment (Assignment nullable firstSet table) src input
     Left err -> Left err
     Right (state', a') -> case stateInput state' of
       []   -> Right (state', a')
-      s':_ -> Left (withFrozenCallStack (Error (stateSpan state') [] (Just (Right (astSymbol s')))))
+      s':_ -> Left (makeError (stateSpan state') [] (Just (Right (astSymbol s'))))
 
 
 data Nullable symbol a

src/Control/Abstract/Addressable.hs

@@ -40,12 +40,12 @@ instance (Addressable address effects, Member (Reader ModuleInfo) effects, Membe
   allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule)
   derefCell (Located loc _ _) = relocate . derefCell loc
 
-instance Addressable address effects => Addressable (Hole address) effects where
-  type Cell (Hole address) = Cell address
+instance (Addressable address effects, Ord context, Show context) => Addressable (Hole context address) effects where
+  type Cell (Hole context address) = Cell address
 
   allocCell name = relocate (Total <$> allocCell name)
   derefCell (Total loc) = relocate . derefCell loc
-  derefCell Partial     = const (pure Nothing)
+  derefCell (Partial _) = const (pure Nothing)
 
 relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a
 relocate = raiseEff . lowerEff

src/Control/Abstract/Hole.hs

@@ -1,15 +1,21 @@
-module Control.Abstract.Hole where
+module Control.Abstract.Hole
+  ( AbstractHole (..)
+  , Hole (..)
+  , toMaybe
+  ) where
+
+import Prologue
 
 class AbstractHole a where
   hole :: a
 
 
-data Hole a = Partial | Total a
+data Hole context a = Partial context | Total a
   deriving (Foldable, Functor, Eq, Ord, Show, Traversable)
 
-instance AbstractHole (Hole a) where
-  hole = Partial
+instance Lower context => AbstractHole (Hole context a) where
+  hole = Partial lowerBound
 
-toMaybe :: Hole a -> Maybe a
-toMaybe Partial = Nothing
-toMaybe (Total a) = Just a
+toMaybe :: Hole context a -> Maybe a
+toMaybe (Partial _) = Nothing
+toMaybe (Total a)   = Just a

src/Control/Abstract/Primitive.hs

@@ -1,4 +1,11 @@
-module Control.Abstract.Primitive where
+module Control.Abstract.Primitive
+  ( define
+  , defineClass
+  , defineNamespace
+  , builtInPrint
+  , builtInExport
+  , lambda
+  ) where
 
 import Control.Abstract.Context
 import Control.Abstract.Environment

src/Data/AST.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE DataKinds #-}
-module Data.AST where
+module Data.AST
+  ( Node (..)
+  , AST
+  , Location
+  , nodeLocation
+  ) where
 
 import Data.Range
 import Data.Record

src/Data/Abstract/Address.hs

@@ -1,5 +1,11 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
-module Data.Abstract.Address where
+module Data.Abstract.Address
+  ( Precise (..)
+  , Located (..)
+  , Latest (..)
+  , All (..)
+  , Monovariant (..)
+  ) where
 
 import Data.Abstract.Module (ModuleInfo)
 import Data.Abstract.Name

src/Data/Abstract/Cache.hs

@@ -1,5 +1,13 @@
 {-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-}
-module Data.Abstract.Cache where
+module Data.Abstract.Cache
+  ( Cache
+  , Cached (..)
+  , Cacheable
+  , cacheLookup
+  , cacheSet
+  , cacheInsert
+  , cacheKeys
+  ) where
 
 import Data.Abstract.Configuration
 import Data.Abstract.Heap

src/Data/Abstract/Configuration.hs

@@ -1,4 +1,4 @@
-module Data.Abstract.Configuration where
+module Data.Abstract.Configuration ( Configuration (..) ) where
 
 import Data.Abstract.Environment
 import Data.Abstract.Heap

src/Data/Abstract/Declarations.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-}
-module Data.Abstract.Declarations  where
+module Data.Abstract.Declarations
+  ( Declarations (..)
+  , Declarations1 (..)
+  ) where
 
 import Data.Abstract.Name
 import Data.Sum

src/Data/Abstract/FreeVariables.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, UndecidableInstances #-}
-module Data.Abstract.FreeVariables where
+module Data.Abstract.FreeVariables
+  ( FreeVariables (..)
+  , FreeVariables1 (..)
+  ) where
 
 import Data.Abstract.Name
 import           Data.Sum

src/Data/Abstract/Heap.hs

@@ -1,5 +1,13 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Data.Abstract.Heap where
+module Data.Abstract.Heap
+  ( Heap
+  , heapLookup
+  , heapLookupAll
+  , heapInsert
+  , heapInit
+  , heapSize
+  , heapRestrict
+  ) where
 
 import Data.Abstract.Live
 import qualified Data.Map.Monoidal as Monoidal

src/Data/Abstract/Live.hs

@@ -1,5 +1,15 @@
 {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
-module Data.Abstract.Live where
+module Data.Abstract.Live
+  ( Live (..)
+  , fromAddresses
+  , liveSingleton
+  , liveInsert
+  , liveDelete
+  , liveDifference
+  , liveMember
+  , liveSplit
+  , liveMap
+  ) where
 
 import Data.Set as Set
 import Prologue

src/Data/Abstract/Package.hs

@@ -1,4 +1,9 @@
-module Data.Abstract.Package where
+module Data.Abstract.Package
+  ( Package (..)
+  , PackageInfo (..)
+  , PackageName
+  , Data.Abstract.Package.fromModules
+  ) where
 
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable

src/Data/Abstract/Path.hs

@@ -1,4 +1,8 @@
-module Data.Abstract.Path where
+module Data.Abstract.Path
+  ( dropRelativePrefix
+  , joinPaths
+  , stripQuotes
+  ) where
 
 import Prologue
 import qualified Data.Text as T

src/Data/Abstract/Ref.hs

@@ -1,5 +1,8 @@
 {-# LANGUAGE GADTs #-}
-module Data.Abstract.Ref where
+module Data.Abstract.Ref
+  ( ValueRef (..)
+  , Ref (..)
+  ) where
 
 import Data.Abstract.Name
 

src/Data/Abstract/Value/Abstract.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE GADTs, UndecidableInstances #-}
-module Data.Abstract.Value.Abstract where
+module Data.Abstract.Value.Abstract ( Abstract (..) ) where
 
 import Control.Abstract
 import Data.Abstract.Environment as Env

src/Data/Abstract/Value/Concrete.hs

@@ -1,5 +1,12 @@
 {-# LANGUAGE GADTs, RankNTypes, TypeOperators, UndecidableInstances, LambdaCase #-}
-module Data.Abstract.Value.Concrete where
+module Data.Abstract.Value.Concrete
+  ( Value (..)
+  , ValueError (..)
+  , ClosureBody (..)
+  , runValueError
+  , runValueErrorWith
+  , throwValueError
+  ) where
 
 import Control.Abstract
 import Data.Abstract.Environment (Environment, Bindings)

src/Data/Blob.hs

@@ -20,6 +20,8 @@ import Data.Aeson
 import Data.JSON.Fields
 import Data.Language
 import Data.Source as Source
+import qualified Proto3.Wire.Encode as Encode
+import qualified Proto3.Wire.Decode as Decode
 
 -- | The source, path, and language of a blob.
 data Blob = Blob
@@ -50,6 +52,25 @@ inferringLanguage src pth lang
 -- delete, a blob to insert, or a pair of blobs to diff.
 type BlobPair = Join These Blob
 
+instance Message BlobPair where
+  encodeMessage _ pair = case pair of
+    (Join (These a b)) -> Encode.embedded 1 (encodeMessage 1 a) <> Encode.embedded 2 (encodeMessage 1 b)
+    (Join (This a)) -> Encode.embedded 1 (encodeMessage 1 a)
+    (Join (That b)) -> Encode.embedded 2 (encodeMessage 1 b)
+  decodeMessage _ = Join <$> (these <|> this <|> that)
+    where
+      embeddedAt parser = Decode.at (Decode.embedded'' parser)
+      these = These <$> embeddedAt (decodeMessage 1) 1 <*> embeddedAt (decodeMessage 1) 2
+      this = This <$> embeddedAt (decodeMessage 1) 1
+      that = That <$> embeddedAt (decodeMessage 1) 2
+  dotProto _ =
+    [ DotProtoMessageField $ DotProtoField 1 (Prim . Named $ Single "Blob") (Single "before") [] Nothing
+    , DotProtoMessageField $ DotProtoField 2 (Prim . Named $ Single "Blob") (Single "after") [] Nothing
+    ]
+
+instance Named BlobPair where
+  nameOf _ = "BlobPair"
+
 instance FromJSON BlobPair where
   parseJSON = withObject "BlobPair" $ \o -> do
     before <- o .:? "before"

src/Data/Diff.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators #-}
+{-# LANGUAGE DataKinds, RankNTypes, TypeFamilies, TypeOperators, ScopedTypeVariables, UndecidableInstances #-}
 module Data.Diff
 ( Diff(..)
 , DiffF(..)
@@ -31,6 +31,11 @@ import Data.Patch
 import Data.Record
 import Data.Term
 import Text.Show
+import Prologue
+import Proto3.Suite.Class
+import Proto3.Suite.DotProto
+import qualified Proto3.Wire.Encode as Encode
+import qualified Proto3.Wire.Decode as Decode
 
 -- | A recursive structure indicating the changed & unchanged portions of a labelled tree.
 newtype Diff syntax ann1 ann2 = Diff { unDiff :: DiffF syntax ann1 ann2 (Diff syntax ann1 ann2) }
@@ -152,6 +157,53 @@ instance (Show1 syntax, Show ann1, Show ann2) => Show1 (DiffF syntax ann1 ann2)
 instance (Show1 syntax, Show ann1, Show ann2, Show recur) => Show (DiffF syntax ann1 ann2 recur) where
   showsPrec = showsPrec3
 
+instance ((Show (f (Diff f () ()))), (Show (f (Term f ()))), Show1 f, Named1 f, Message1 f, Named (Diff f () ()), Foldable f, Functor f) => Message (Diff f () ()) where
+  encodeMessage _ (Diff (Merge (In _ f))) = Encode.embedded 1 (Encode.embedded 1 (liftEncodeMessage encodeMessage 1 f))
+  encodeMessage _ (Diff (Patch (Delete (In _ f)))) =
+    Encode.embedded 2 (Encode.embedded 1 (liftEncodeMessage encodeMessage 1 f))
+  encodeMessage _ (Diff (Patch (Insert (In _ f)))) =
+    Encode.embedded 3 (Encode.embedded 1 (liftEncodeMessage encodeMessage 1 f))
+  encodeMessage _ (Diff (Patch (Replace (In _ f) (In _ g)))) =
+    Encode.embedded 4 (Encode.embedded 1 (liftEncodeMessage encodeMessage 1 f) <> Encode.embedded 2 (liftEncodeMessage encodeMessage 1 g))
+  decodeMessage _ = Decode.oneof undefined [(1, m), (2, d), (3, i), (4, r)]
+    where
+      embeddedAt parser = Decode.at (Decode.embedded'' parser)
+      m = merge ((), ()) <$> Decode.embedded'' (embeddedAt (liftDecodeMessage decodeMessage 1) 1)
+      i = inserting . termIn () <$> Decode.embedded'' (embeddedAt (liftDecodeMessage decodeMessage 1) 1)
+      d = deleting . termIn () <$> Decode.embedded'' (embeddedAt (liftDecodeMessage decodeMessage 1) 1)
+      r =
+        (\(a, b) -> replacing (termIn () a) (termIn () b))
+          <$> Decode.embedded'' ((,) <$> embeddedAt (liftDecodeMessage decodeMessage 1) 1 <*> embeddedAt (liftDecodeMessage decodeMessage 1) 2)
+
+  dotProto (_ :: Proxy (Diff f () ())) =
+    [ DotProtoMessageOneOf (Single "diff")
+      [ DotProtoField 1 (Prim . Named $ Single "Merge") (Single "merge") [] Nothing
+      , DotProtoField 2 (Prim . Named $ Single "Delete") (Single "delete") [] Nothing
+      , DotProtoField 3 (Prim . Named $ Single "Insert") (Single "insert") [] Nothing
+      , DotProtoField 4 (Prim . Named $ Single "Replace") (Single "replace") [] Nothing
+      ]
+    , DotProtoMessageDefinition
+        ( DotProtoMessage
+          ( Single "Merge" )
+          [ DotProtoMessageField (DotProtoField 1 (Prim . Named $ Single (nameOf1 (Proxy @f))) (Single "syntax") [] Nothing)
+          ] )
+    , DotProtoMessageDefinition
+        ( DotProtoMessage
+          ( Single "Delete" )
+          [ DotProtoMessageField (DotProtoField 1 (Prim . Named $ Single (nameOf1 (Proxy @f))) (Single "before") [] Nothing)
+          ] )
+    , DotProtoMessageDefinition
+        ( DotProtoMessage
+          ( Single "Insert" )
+          [ DotProtoMessageField (DotProtoField 1 (Prim . Named $ Single (nameOf1 (Proxy @f))) (Single "after") [] Nothing)
+          ] )
+    , DotProtoMessageDefinition
+        ( DotProtoMessage
+          ( Single "Replace" )
+          [ DotProtoMessageField (DotProtoField 1 (Prim . Named $ Single (nameOf1 (Proxy @f))) (Single "before") [] Nothing)
+          , DotProtoMessageField (DotProtoField 2 (Prim . Named $ Single (nameOf1 (Proxy @f))) (Single "after") [] Nothing)
+          ] )
+    ]
 
 instance Functor syntax => Bifunctor (Diff syntax) where
   bimap f g = go where go = Diff . trimap f g go . unDiff

src/Data/Error.hs

@@ -1,32 +1,42 @@
-{-# LANGUAGE GADTs, ImplicitParams, RankNTypes, StandaloneDeriving #-}
-module Data.Error where
+{-# LANGUAGE GADTs, RankNTypes #-}
+module Data.Error
+  ( Error (..)
+  , formatError
+  , makeError
+  , showExpectation
+  , withSGRCode
+  ) where
 
 import Prologue
-import Data.Blob
+
 import Data.ByteString (isSuffixOf)
 import Data.ByteString.Char8 (pack, unpack)
 import Data.Ix (inRange)
 import Data.List (intersperse)
-import Data.Source
-import Data.Span
 import System.Console.ANSI
 
-data Error grammar = HasCallStack => Error { errorSpan :: Span, errorExpected :: [grammar], errorActual :: Maybe grammar }
-  deriving (Typeable)
+import Data.Blob
+import Data.Source
+import Data.Span
+
+-- | Rather than using the Error constructor directly, you probably
+-- want to call 'makeError', which takes care of inserting the call
+-- stack for you.
+data Error grammar = Error
+  { errorSpan      :: Span
+  , errorExpected  :: [grammar]
+  , errorActual    :: Maybe grammar
+  , errorCallStack :: CallStack
+  } deriving (Show, Functor, Typeable)
+
+-- | This instance does not take into account the call stack.
+instance Eq grammar => Eq (Error grammar) where
+  (Error s e a _) == (Error s' e' a' _) = (s == s') && (e == e') && (a == a')
 
-deriving instance Eq grammar => Eq (Error grammar)
-deriving instance Foldable Error
-deriving instance Functor Error
-deriving instance Show grammar => Show (Error grammar)
-deriving instance Traversable Error
 instance Exception (Error String)
 
-errorCallStack :: Error grammar -> CallStack
-errorCallStack Error{} = callStack
-
-
-withCallStack :: CallStack -> (HasCallStack => a) -> a
-withCallStack cs action = let ?callStack = cs in action
+makeError :: HasCallStack => Span -> [grammar] -> Maybe grammar -> Error grammar
+makeError s e a = withFrozenCallStack (Error s e a callStack)
 
 type IncludeSource = Bool
 type Colourize = Bool
@@ -64,11 +74,11 @@ showExpectation colourize = go
 
 showSymbols :: Colourize -> [String] -> ShowS
 showSymbols colourize = go
-  where go [] = showString "end of input nodes"
-        go [symbol] = showSymbol symbol
-        go [a, b] = showSymbol a . showString " or " . showSymbol b
+  where go []        = showString "end of input nodes"
+        go [symbol]  = showSymbol symbol
+        go [a, b]    = showSymbol a . showString " or " . showSymbol b
         go [a, b, c] = showSymbol a . showString ", " . showSymbol b . showString ", or " . showSymbol c
-        go (h:t) = showSymbol h . showString ", " . go t
+        go (h:t)     = showSymbol h . showString ", " . go t
         showSymbol = withSGRCode colourize [SetColor Foreground Vivid Red] . showString
 
 showSpan :: Maybe FilePath -> Span -> ShowS

src/Data/Graph/Vertex.hs

@@ -6,14 +6,14 @@ module Data.Graph.Vertex
   , vertexToType
   ) where
 
-import Prologue hiding (packageName)
+import Prologue
 
 import           Data.Aeson
 import qualified Data.Text as T
 
 import Data.Abstract.Module (ModuleInfo (..))
 import Data.Abstract.Name
-import Data.Abstract.Package (PackageInfo (..))
+import Data.Abstract.Package hiding (Package (Package))
 
 -- | A vertex of some specific type.
 data Vertex
@@ -23,7 +23,7 @@ data Vertex
   deriving (Eq, Ord, Show, Generic, Hashable)
 
 packageVertex :: PackageInfo -> Vertex
-packageVertex = Package . formatName . packageName
+packageVertex = Package . formatName . Data.Abstract.Package.packageName
 
 moduleVertex :: ModuleInfo -> Vertex
 moduleVertex = Module . T.pack . modulePath

src/Data/Language.hs

@@ -1,5 +1,12 @@
 {-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase #-}
-module Data.Language where
+module Data.Language
+  ( Language (..)
+  , ensureLanguage
+  , extensionsForLanguage
+  , knownLanguage
+  , languageForFilePath
+  , languageForType
+  ) where
 
 import           Data.Aeson
 import           Data.Char (toUpper)

src/Data/Mergeable.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DefaultSignatures, TypeOperators, UndecidableInstances #-}
-module Data.Mergeable where
+module Data.Mergeable ( Mergeable (..) ) where
 
 import Control.Applicative
 import Data.Functor.Identity

src/Data/Options.hs

@@ -1 +0,0 @@
-module Data.Options where

src/Data/Record.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE ConstraintKinds, DataKinds, GADTs, KindSignatures, MultiParamTypeClasses, TypeFamilies, TypeOperators, UndecidableInstances #-}
-module Data.Record where
+module Data.Record
+  ( Record (..)
+  , HasField (..)
+  , rhead
+  , rtail
+  ) where
 
 import Data.Aeson
 import Data.JSON.Fields

src/Data/SplitDiff.hs

@@ -1,4 +1,7 @@
-module Data.SplitDiff where
+module Data.SplitDiff
+  ( SplitPatch (..)
+  , getRange
+  ) where
 
 import Control.Monad.Free
 import Data.Range
@@ -20,6 +23,3 @@ getRange diff = getField $ case diff of
 
 -- | A diff with only one side’s annotations.
 type SplitDiff syntax ann = Free (TermF syntax ann) (SplitPatch (Term syntax ann))
-
-unSplit :: Functor syntax => SplitDiff syntax ann -> Term syntax ann
-unSplit = iter Term . fmap splitTerm

src/Data/Syntax.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes, DeriveAnyClass, GADTs, TypeOperators, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, KindSignatures, RankNTypes, ConstraintKinds, GeneralizedNewtypeDeriving, DerivingStrategies #-}
-{-# OPTIONS_GHC -Wno-redundant-constraints -fno-warn-orphans #-} -- For HasCallStack
+{-# OPTIONS_GHC -Wno-missing-export-lists -Wno-redundant-constraints -fno-warn-orphans #-} -- For HasCallStack
 module Data.Syntax where
 
 import Data.Abstract.Evaluatable
@@ -220,7 +220,8 @@ errorSyntax :: Error.Error String -> [a] -> Error a
 errorSyntax Error.Error{..} = Error (ErrorStack $ errorSite <$> getCallStack callStack) errorExpected errorActual
 
 unError :: Span -> Error a -> Error.Error String
-unError span Error{..} = Error.withCallStack (freezeCallStack (fromCallSiteList $ unErrorSite <$> unErrorStack errorCallStack)) (Error.Error span errorExpected errorActual)
+unError span Error{..} = Error.Error span errorExpected errorActual stack
+  where stack = fromCallSiteList $ unErrorSite <$> unErrorStack errorCallStack
 
 data ErrorSite = ErrorSite { errorMessage :: String, errorLocation :: SrcLoc }
   deriving (Eq, Show, Generic, Named, Message)

src/Data/Syntax/Comment.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Comment where
 
 import Data.Abstract.Evaluatable

src/Data/Syntax/Declaration.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Declaration where
 
 import qualified Data.Abstract.Environment as Env

src/Data/Syntax/Directive.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Directive where
 
 import           Data.Abstract.Evaluatable

src/Data/Syntax/Expression.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Expression where
 
 import Data.Abstract.Evaluatable hiding (Member)

src/Data/Syntax/Literal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, ViewPatterns, ScopedTypeVariables, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Literal where
 
 import           Data.Abstract.Evaluatable

src/Data/Syntax/Statement.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, ScopedTypeVariables, UndecidableInstances, ViewPatterns, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Statement where
 
 import Data.Abstract.Evaluatable

src/Data/Syntax/Type.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, UndecidableInstances #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Data.Syntax.Type where
 
 import Data.Abstract.Evaluatable

src/Diffing/Algorithm.hs

@@ -1,5 +1,18 @@
 {-# LANGUAGE DefaultSignatures, GADTs, TypeOperators, UndecidableInstances #-}
-module Diffing.Algorithm where
+module Diffing.Algorithm
+  ( AlgorithmF (..)
+  , Algorithm
+  , Diffable (..)
+  , Equivalence (..)
+  , diff
+  , diffThese
+  , diffMaybe
+  , linearly
+  , byReplacing
+  , comparableTerms
+  , equivalentTerms
+  , algorithmForTerms
+  ) where
 
 import Control.Monad.Free.Freer
 import Data.Diff

src/Language/Go/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Go.Grammar where
 
 import Language.Haskell.TH

src/Language/Go/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Go.Syntax where
 
 import           Data.Abstract.Evaluatable

src/Language/Go/Type.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Go.Type where
 
 import Prologue

src/Language/Haskell/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Haskell.Grammar where
 
 import Language.Haskell.TH

src/Language/Haskell/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Haskell.Syntax where
 
 import           Data.Abstract.Evaluatable

src/Language/JSON/Assignment.hs

@@ -14,6 +14,7 @@ import Data.Sum
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Literal as Literal
 import qualified Data.Term as Term
+import qualified Data.Diff as Diff
 import Language.JSON.Grammar as Grammar
 import Proto3.Suite (Named1(..), Named(..))
 import Prologue
@@ -39,6 +40,9 @@ instance Named1 (Sum Syntax) where
 instance Named (Term.Term (Sum Syntax) ()) where
   nameOf _ = "JSONTerm"
 
+instance Named (Diff.Diff (Sum Syntax) () ()) where
+  nameOf _ = "JSONDiff"
+
 
 assignment :: Assignment Term
 assignment = value <|> parseError

src/Language/JSON/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.JSON.Grammar where
 
 import Language.Haskell.TH

src/Language/Java/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Java.Grammar where
 
 import Language.Haskell.TH

src/Language/Java/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Java.Syntax where
 
 import Data.Abstract.Evaluatable

src/Language/Markdown/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Markdown.Syntax where
 
 import Prologue hiding (Text)

src/Language/PHP/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.PHP.Grammar where
 
 import Language.Haskell.TH

src/Language/PHP/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.PHP.Syntax where
 
 import           Data.Abstract.Evaluatable

src/Language/Python/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Python.Grammar where
 
 import Language.Haskell.TH

src/Language/Python/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Python.Syntax where
 
 import           Data.Abstract.Environment as Env

src/Language/Ruby/Assignment.hs

@@ -34,6 +34,7 @@ import qualified Data.Syntax.Expression as Expression
 import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
 import qualified Data.Term as Term
+import qualified Data.Diff as Diff
 import           Language.Ruby.Grammar as Grammar
 import qualified Language.Ruby.Syntax as Ruby.Syntax
 import           Prologue hiding (for)
@@ -133,6 +134,9 @@ instance Named1 (Sum Syntax) where
 instance Named (Term.Term (Sum Syntax) ()) where
   nameOf _ = "RubyTerm"
 
+instance Named (Diff.Diff (Sum Syntax) () ()) where
+  nameOf _ = "RubyDiff"
+
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
 assignment :: Assignment Term
 assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> many expression) <|> parseError

src/Language/Ruby/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Ruby.Grammar where
 
 import Language.Haskell.TH

src/Language/Ruby/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, TupleSections #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.Ruby.Syntax where
 
 import           Control.Monad (unless)

src/Language/TypeScript/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.Diff as Diff
 import Language.TypeScript.Grammar as Grammar
 import qualified Language.TypeScript.Syntax as TypeScript.Syntax
 import Prologue
@@ -214,6 +215,9 @@ instance Named1 (Sum Syntax) where
 instance Named (Term.Term (Sum Syntax) ()) where
   nameOf _ = "TypeScriptTerm"
 
+instance Named (Diff.Diff (Sum Syntax) () ()) where
+  nameOf _ = "TypeScriptDiff"
+
 -- | Assignment from AST in TypeScript’s grammar onto a program in TypeScript’s syntax.
 assignment :: Assignment Term
 assignment = handleError $ makeTerm <$> symbol Program <*> children (Statement.Statements <$> manyTerm statement) <|> parseError

src/Language/TypeScript/Grammar.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.TypeScript.Grammar where
 
 import Language.Haskell.TH

src/Language/TypeScript/Syntax.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass, DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.TypeScript.Syntax where
 
 import qualified Data.Abstract.Environment as Env

src/Semantic/AST.hs

@@ -1,5 +1,11 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
-module Semantic.AST where
+module Semantic.AST
+  ( SomeAST (..)
+  , withSomeAST
+  , astParseBlob
+  , ASTFormat (..)
+  , runASTParse
+  ) where
 
 import Data.AST
 import Data.Blob

src/Semantic/Config.hs

@@ -1,6 +1,17 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Semantic.Config where
+module Semantic.Config
+  ( Config (..)
+  , defaultConfig
+  , Options (..)
+  , defaultOptions
+  , debugOptions
+  , lookupStatsAddr
+  , withHaystackFromConfig
+  , withLoggerFromConfig
+  , withStatterFromConfig
+  , withTelemetry
+  ) where
 
 import           Network.BSD
 import           Network.HTTP.Client.TLS

src/Semantic/Diff.hs

@@ -1,5 +1,11 @@
 {-# LANGUAGE ConstraintKinds, GADTs, RankNTypes, ScopedTypeVariables #-}
-module Semantic.Diff where
+module Semantic.Diff
+  ( runDiff
+  , runRubyDiff
+  , runTypeScriptDiff
+  , runJSONDiff
+  , diffBlobTOCPairs
+  ) where
 
 import Analysis.ConstructorName (ConstructorName)
 import Analysis.Declaration (HasDeclaration, declarationAlgebra)
@@ -18,6 +24,9 @@ import Semantic.IO (noLanguageForBlob)
 import Semantic.Telemetry as Stat
 import Semantic.Task as Task
 import Serializing.Format
+import qualified Language.TypeScript.Assignment as TypeScript
+import qualified Language.Ruby.Assignment as Ruby
+import qualified Language.JSON.Assignment as JSON
 
 runDiff :: (Member Distribute effs, Member (Exc SomeException) effs, Member (Lift IO) effs, Member Task effs, Member Telemetry effs) => DiffRenderer output -> [BlobPair] -> Eff effs Builder
 runDiff ToCDiffRenderer         = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderToCDiff) >=> serialize JSON
@@ -26,6 +35,39 @@ runDiff SExpressionDiffRenderer = withParsedBlobPairs (const pure) (const (seria
 runDiff ShowDiffRenderer        = withParsedBlobPairs (const pure) (const (serialize Show))
 runDiff DOTDiffRenderer         = withParsedBlobPairs (const pure) (const (render renderTreeGraph)) >=> serialize (DOT (diffStyle "diffs"))
 
+runRubyDiff :: (Member Telemetry effs, Member (Lift IO) effs, Member Distribute effs, Member Task effs) => [BlobPair] -> Eff effs [Diff (Sum Ruby.Syntax) () ()]
+runRubyDiff = flip distributeFor (\ (blobs :: BlobPair) -> do
+    terms <- distributeFor blobs (parse rubyParser)
+    diffs <- diffTerms blobs terms
+    pure (bimap (const ()) (const ()) diffs))
+    where
+      diffTerms blobs terms = time "diff" languageTag $ do
+        diff <- diff (runJoin terms)
+        diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
+        where languageTag = languageTagForBlobPair blobs
+
+runTypeScriptDiff :: (Member Telemetry effs, Member (Lift IO) effs, Member Distribute effs, Member Task effs) => [BlobPair] -> Eff effs [Diff (Sum TypeScript.Syntax) () ()]
+runTypeScriptDiff = flip distributeFor (\ (blobs :: BlobPair) -> do
+    terms <- distributeFor blobs (parse typescriptParser)
+    diffs <- diffTerms blobs terms
+    pure (bimap (const ()) (const ()) diffs))
+    where
+      diffTerms blobs terms = time "diff" languageTag $ do
+        diff <- diff (runJoin terms)
+        diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
+        where languageTag = languageTagForBlobPair blobs
+
+runJSONDiff :: (Member Telemetry effs, Member (Lift IO) effs, Member Distribute effs, Member Task effs) => [BlobPair] -> Eff effs [Diff (Sum JSON.Syntax) () ()]
+runJSONDiff = flip distributeFor (\ (blobs :: BlobPair) -> do
+    terms <- distributeFor blobs (parse jsonParser)
+    diffs <- diffTerms blobs terms
+    pure (bimap (const ()) (const ()) diffs))
+    where
+      diffTerms blobs terms = time "diff" languageTag $ do
+        diff <- diff (runJoin terms)
+        diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
+        where languageTag = languageTagForBlobPair blobs
+
 data SomeTermPair typeclasses ann where
   SomeTermPair :: ApplyAll typeclasses syntax => Join These (Term syntax ann) -> SomeTermPair typeclasses ann
 

src/Semantic/Env.hs

@@ -1,4 +1,7 @@
-module Semantic.Env where
+module Semantic.Env
+  ( envLookupInt
+  , envLookupString
+  ) where
 
 import Control.Monad.IO.Class
 import Prologue

src/Semantic/Graph.hs

@@ -27,7 +27,6 @@ import           Analysis.Abstract.Caching
 import           Analysis.Abstract.Collecting
 import           Analysis.Abstract.Graph as Graph
 import           Control.Abstract
-import           Control.Monad.Effect (reinterpret)
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
@@ -35,7 +34,7 @@ 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.Abstract.Value.Concrete (Value,ValueError (..), runValueErrorWith)
 import           Data.Graph
 import           Data.Project
 import           Data.Record
@@ -90,9 +89,12 @@ runCallGraph :: ( HasField ann Span
 runCallGraph lang includePackages modules package = do
   let analyzeTerm = withTermSpans . graphingTerms . cachingTerms
       analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules
-      extractGraph (_, (_, (graph, _))) = simplify graph
+      extractGraph (graph, _) = simplify graph
       runGraphAnalysis
-        = runState (lowerBound @(Heap (Hole (Located Monovariant)) All Abstract))
+        = runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract
+        . graphing
+        . caching
+        . runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract))
         . runFresh 0
         . resumingLoadError
         . resumingUnspecialized
@@ -100,13 +102,10 @@ runCallGraph lang includePackages modules package = do
         . resumingEvalError
         . resumingResolutionError
         . resumingAddressError
-        . runTermEvaluator @_ @(Hole (Located Monovariant)) @Abstract
-        . graphing
-        . caching @[]
         . runReader (packageInfo package)
         . runReader (lowerBound @Span)
         . providingLiveSet
-        . runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole (Located Monovariant)), Hole (Located Monovariant))))))
+        . runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole (Maybe Name) (Located Monovariant)), Hole (Maybe Name) (Located Monovariant))))))
         . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
   extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm modules))
 
@@ -130,7 +129,7 @@ runImportGraph lang (package :: Package term)
   | [m :| []] <- toList (packageModules package) = vertex m <$ trace ("single module, skipping import graph computation for " <> modulePath (moduleInfo m))
   | otherwise =
   let analyzeModule = graphingModuleInfo
-      extractGraph (_, (_, (graph, _))) = do
+      extractGraph (_, (graph, _)) = do
         info <- graph
         maybe lowerBound (foldMap vertex) (ModuleTable.lookup (modulePath info) (packageModules package))
       runImportGraphAnalysis
@@ -146,7 +145,7 @@ runImportGraph lang (package :: Package term)
         . runState lowerBound
         . runReader lowerBound
         . runModules (ModuleTable.modulePaths (packageModules package))
-        . runTermEvaluator @_ @_ @(Value (Hole Precise) (ImportGraphEff term (Hole Precise) effs))
+        . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ImportGraphEff term (Hole (Maybe Name) Precise) effs))
         . runReader (packageInfo package)
         . runReader lowerBound
   in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate @_ @_ @_ @_ @term lang analyzeModule id (ModuleTable.toPairs (packageModules package) >>= toList . snd)))
@@ -214,10 +213,10 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr
   NotFoundError nameToResolve _ _ -> pure  nameToResolve
   GoImportError pathToResolve     -> pure [pathToResolve])
 
-resumingLoadError :: (Member Trace effects, AbstractHole address, Effects effects) => Evaluator address value (Resumable (LoadError address) ': effects) a -> Evaluator address value effects a
+resumingLoadError :: (AbstractHole address, Effectful (m address value), Effects effects, Functor (m address value effects), Member Trace effects) => m address value (Resumable (LoadError address) ': effects) a -> m address value effects a
 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 :: (Applicative (m effects), Effectful m, Effects effects, Member Fresh effects, Member Trace effects) => m (Resumable EvalError ': effects) a -> m effects a
 resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow err) *> case err of
   DefaultExportError{}  -> pure ()
   ExportError{}         -> pure ()
@@ -226,15 +225,15 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow
   RationalFormatError{} -> pure 0
   NoNameError           -> gensym)
 
-resumingUnspecialized :: (Member Trace effects, AbstractHole value, Effects effects) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a
+resumingUnspecialized :: (AbstractHole value, Effectful (m value), Effects effects, Functor (m value effects), Member Trace effects) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects a
 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: " <> prettyShow err) *> case err of
-  UnallocatedAddress _   -> pure lowerBound
-  UninitializedAddress _ -> pure hole)
+resumingAddressError :: (AbstractHole value, Applicative (m address value effects), Effectful (m address value), Effects effects, Lower (Cell address value), Member Trace effects, Show address) => m address value (Resumable (AddressError address value) ': effects) a -> m address value effects a
+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 :: (Applicative (m address (Value address body) effects), Effectful (m address (Value address body)), Effects effects, Member Trace effects, Show address) => m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects a
 resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> prettyShow err) *> case err of
   CallError val     -> pure val
   StringError val   -> pure (pack (prettyShow val))
@@ -250,10 +249,8 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> pretty
   KeyValueError{}   -> pure (hole, hole)
   ArithmeticError{} -> pure hole)
 
-resumingEnvironmentError :: (AbstractHole address, Effects effects) => Evaluator address value (Resumable (EnvironmentError address) ': effects) a -> Evaluator address value effects ([Name], a)
-resumingEnvironmentError
-  = runState []
-  . reinterpret (\ (Resumable (FreeVariable name)) -> modify' (name :) $> hole)
+resumingEnvironmentError :: (Applicative (m (Hole (Maybe Name) address) value effects), Effectful (m (Hole (Maybe Name) address) value), Effects effects) => m (Hole (Maybe Name) address) value (Resumable (EnvironmentError (Hole (Maybe Name) address)) ': effects) a -> m (Hole (Maybe Name) address) value effects a
+resumingEnvironmentError = runResumableWith (\ (FreeVariable name) -> pure (Partial (Just name)))
 
 resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects))
                      , Effects effects

src/Semantic/Parse.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE GADTs, RankNTypes #-}
-module Semantic.Parse where
+module Semantic.Parse
+  ( runParse
+  , runRubyParse
+  , runTypeScriptParse
+  , runJSONParse
+  ) where
 
 import Analysis.ConstructorName (ConstructorName)
 import Analysis.Declaration (HasDeclaration, declarationAlgebra)

src/Semantic/Resolution.hs

@@ -1,5 +1,10 @@
 {-# LANGUAGE ConstraintKinds, GADTs, KindSignatures, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
-module Semantic.Resolution where
+module Semantic.Resolution
+  ( Resolution (..)
+  , nodeJSResolutionMap
+  , resolutionMap
+  , runResolution
+  ) where
 
 import           Control.Monad.Effect
 import           Data.Aeson

src/Semantic/Telemetry/Haystack.hs

@@ -1,4 +1,10 @@
-module Semantic.Telemetry.Haystack where
+module Semantic.Telemetry.Haystack
+  ( HaystackClient (..)
+  , ErrorReport (..)
+  , ErrorLogger
+  , haystackClient
+  , reportError
+  ) where
 
 import           Control.Exception
 import           Crypto.Hash

src/Semantic/Telemetry/Log.hs

@@ -1,4 +1,12 @@
-module Semantic.Telemetry.Log where
+module Semantic.Telemetry.Log
+  ( Level (..)
+  , LogOptions (..)
+  , Message (..)
+  , LogFormatter
+  , logfmtFormatter
+  , terminalFormatter
+  , writeLogMessage
+  ) where
 
 import           Control.Monad.IO.Class
 import           Data.Error (withSGRCode)

src/Semantic/Util.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
-{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-export-lists #-}
 module Semantic.Util where
 
 import Prelude hiding (readFile)
@@ -82,7 +82,7 @@ checking
   . runFresh 0
   . runPrintingTrace
   . runTermEvaluator @_ @Monovariant @Type
-  . caching @[]
+  . caching
   . providingLiveSet
   . fmap reassociate
   . runLoadError
@@ -102,15 +102,14 @@ evalTypeScriptProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Lang
 
 typecheckGoFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Go) goParser Language.Go
 
-callGraphRubyProject paths = runTaskWithOptions debugOptions $ do
-  let proxy = Proxy @'Language.Ruby
-  let lang = Language.Ruby
+callGraphProject parser proxy lang opts paths = runTaskWithOptions opts $ do
   blobs <- catMaybes <$> traverse readFile (flip File lang <$> paths)
-  package <- parsePackage rubyParser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang [])
+  package <- parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang [])
   modules <- topologicalSort <$> runImportGraph proxy package
   x <- runCallGraph proxy False modules package
-  pure (x, modules)
+  pure (x, (() <$) <$> modules)
 
+callGraphRubyProject = callGraphProject rubyParser (Proxy @'Language.Ruby) Language.Ruby debugOptions
 
 -- Evaluate a project consisting of the listed paths.
 evaluateProject proxy parser lang paths = withOptions debugOptions $ \ config logger statter ->

src/Semantic/Version.hs

@@ -1,6 +1,9 @@
 {-# OPTIONS_GHC -fforce-recomp #-} -- So that gitHash is correct.
 {-# LANGUAGE TemplateHaskell #-}
-module Semantic.Version where
+module Semantic.Version
+  ( buildSHA
+  , buildVersion
+  ) where
 
 import Data.Version (showVersion)
 import Development.GitRev

test/Assigning/Assignment/Spec.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DataKinds, OverloadedLists #-}
 module Assigning.Assignment.Spec (spec) where
 
 import Assigning.Assignment
@@ -114,7 +114,7 @@ spec = do
       fst <$> runAssignment "hello" red (makeState [node Red 0 5 []]) `shouldBe` Right (Out "hello")
 
     it "does not advance past the current node" $
-      runAssignment "hi" (symbol Red) (makeState [ node Red 0 2 [] ]) `shouldBe` Left (Error (Span (Pos 1 1) (Pos 1 3)) [] (Just (Right Red)))
+      runAssignment "hi" (symbol Red) (makeState [ node Red 0 2 [] ]) `shouldBe` Left (Error (Span (Pos 1 1) (Pos 1 3)) [] (Just (Right Red)) [])
 
   describe "without catchError" $ do
     it "assignment returns unexpected symbol error" $
@@ -122,14 +122,14 @@ spec = do
         red
         (makeState [node Green 0 1 []])
         `shouldBe`
-          Left (Error (Span (Pos 1 1) (Pos 1 2)) [Right Red] (Just (Right Green)))
+          Left (Error (Span (Pos 1 1) (Pos 1 2)) [Right Red] (Just (Right Green)) [])
 
     it "assignment returns unexpected end of input" $
       runAssignment "A"
         (symbol Green *> children (some red))
         (makeState [node Green 0 1 []])
         `shouldBe`
-          Left (Error (Span (Pos 1 1) (Pos 1 1)) [Right Red] Nothing)
+          Left (Error (Span (Pos 1 1) (Pos 1 1)) [Right Red] Nothing [])
 
   describe "eof" $ do
     it "matches at the end of branches" $
@@ -151,28 +151,28 @@ spec = do
         (red `catchError` \ _ -> OutError <$ location <*> source)
         (makeState [node Green 0 1 []])
         `shouldBe`
-          Left (Error (Span (Pos 1 1) (Pos 1 2)) [Right Red] (Just (Right Green)))
+          Left (Error (Span (Pos 1 1) (Pos 1 2)) [Right Red] (Just (Right Green)) [])
 
     it "doesn’t catch unexpected end of branch" $
       fst <$> runAssignment ""
         (red `catchError` \ _ -> OutError <$ location <*> source)
         (makeState [])
         `shouldBe`
-          Left (Error (Span (Pos 1 1) (Pos 1 1)) [Right Red] Nothing)
+          Left (Error (Span (Pos 1 1) (Pos 1 1)) [Right Red] Nothing [])
 
     it "doesn’t catch exhaustiveness errors" $
       fst <$> runAssignment "AA"
         (red `catchError` \ _ -> OutError <$ location <*> source)
         (makeState [node Red 0 1 [], node Red 1 2 []])
         `shouldBe`
-          Left (Error (Span (Pos 1 2) (Pos 1 3)) [] (Just (Right Red)))
+          Left (Error (Span (Pos 1 2) (Pos 1 3)) [] (Just (Right Red)) [])
 
     it "can error inside the handler" $
       runAssignment "A"
         (symbol Green *> children red `catchError` const blue)
         (makeState [node Green 0 1 []])
         `shouldBe`
-          Left (Error (Span (Pos 1 1) (Pos 1 1)) [Right Red] Nothing)
+          Left (Error (Span (Pos 1 1) (Pos 1 1)) [Right Red] Nothing [])
 
   describe "many" $ do
     it "takes ones and only one zero width repetition" $
@@ -205,7 +205,7 @@ spec = do
     it "does not match if its subrule does not match" $
       runAssignment "a" (children red) (makeState [node Blue 0 1 [node Green 0 1 []]])
       `shouldBe`
-        Left (Error (Span (Pos 1 1) (Pos 1 2)) [Right Red] (Just (Right Green)))
+        Left (Error (Span (Pos 1 1) (Pos 1 2)) [Right Red] (Just (Right Green)) [])
 
     it "matches nested children" $
       fst <$> runAssignment "1"

test/Data/Functor/Listable.hs

@@ -22,6 +22,7 @@ module Data.Functor.Listable
 , liftCons4
 , liftCons5
 , ListableF(..)
+, ListableF2(..)
 , addWeight
 , ofWeight
 , ListableSyntax
@@ -42,6 +43,7 @@ import Data.Range
 import Data.Record
 import Data.Semigroup (Semigroup(..))
 import Data.Source
+import Data.Blob
 import Data.Span
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Literal as Literal
@@ -126,6 +128,13 @@ liftCons5 tiers1 tiers2 tiers3 tiers4 tiers5 f = mapT (uncurry5 f) (tiers1 >< ti
 newtype ListableF f a = ListableF { unListableF :: f a }
   deriving Show
 
+-- | Convenient wrapper for 'Listable2' type constructors and 'Listable' types, where a 'Listable' instance would necessarily be orphaned.
+newtype ListableF2 f a b = ListableF2 { unListableF2 :: f a b }
+  deriving Show
+
+instance (Listable2 f, Listable a, Listable b) => Listable (ListableF2 f a b) where
+  tiers = ListableF2 `mapT` tiers2
+
 
 -- Instances
 
@@ -521,6 +530,12 @@ instance Listable Pos where
 instance Listable Span where
   tiers = cons2 Span
 
+instance Listable Blob where
+  tiers = cons3 Blob
+
+instance Listable (Join These Blob) where
+  tiers = liftTiers tiers
+
 instance Listable Source where
   tiers = fromUTF8 `mapT` tiers
 

test/Proto3/Roundtrip.hs

@@ -4,19 +4,23 @@ module Proto3.Roundtrip (spec) where
 
 import SpecHelpers
 
+import Data.Blob
 import Data.Span
 import qualified Data.ByteString.Lazy as L
 import Data.Source
+import Data.Functor.Foldable
 import Proto3.Suite
 import qualified Proto3.Wire.Encode as E
 import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
 import qualified Data.Syntax.Declaration as Declaration
 import Data.Term (Term)
+import Data.Diff (Diff)
 import Data.Sum
-import Language.JSON.Assignment (Syntax)
+import Language.Ruby.Assignment (Syntax)
 import qualified Language.Ruby.Assignment as Ruby
 import Data.Functor.Classes
+import qualified Data.Syntax.Expression as Expression
 
 shouldRoundtrip :: (Eq a, Show a, Message a) => a -> Expectation
 shouldRoundtrip a = go a `shouldBe` Right a
@@ -26,8 +30,16 @@ shouldRoundtrip1 :: forall f a. (Show (f a), Eq (f a), Show1 f, Eq1 f, Eq a, Sho
 shouldRoundtrip1 a = go a `shouldBe` Right a
   where go = fromByteString1 . L.toStrict . toLazyByteString1
 
+instance Named1 (Sum '[Literal.Null]) where nameOf1 _ = "NullSyntax"
+
 spec :: Spec
 spec = parallel $ do
+  describe "blobs" $
+    prop "roundtrips" $
+      \sp -> shouldRoundtrip @Blob sp
+  describe "blob pairs" $
+    prop "roundtrips" $
+      \sp -> shouldRoundtrip @BlobPair sp
   describe "spans" $
     prop "roundtrips" $
       \sp -> shouldRoundtrip @Span sp
@@ -44,6 +56,10 @@ spec = parallel $ do
     prop "roundtrips" $
       \sp -> shouldRoundtrip1 @Literal.Float @(Term (Sum Syntax) ()) (unListableF sp)
 
+  describe "negate" $
+    prop "roundtrips" $
+      \sp -> shouldRoundtrip1 @Expression.Negate @(Term (Sum '[Literal.Null]) ()) (unListableF sp)
+
   describe "booleans" $
     prop "roundtrips" $
       \sp -> shouldRoundtrip1 @Literal.Boolean @(Term (Sum Syntax) ()) (unListableF sp)
@@ -52,6 +68,11 @@ spec = parallel $ do
     prop "roundtrips" $
       \sp -> shouldRoundtrip @(Term (Sum Syntax) ()) (unListableF sp)
 
+  -- describe "diffs of syntax" $
+  --   prop "roundtrips" $
+  --     \sp -> do
+  --       shouldRoundtrip @(Diff (Sum Syntax) () ()) (unListableF2 sp)
+
   describe "arrays" $
     prop "roundtrips" $
       \sp -> shouldRoundtrip1 @Literal.Array @(Term (Sum Syntax) ()) (unListableF sp)