From a90d70fa364881a54290c473a2ea1eaaf2558614 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 12:41:07 -0400
Subject: [PATCH 01/34] generalize Project

---
 src/Data/Project.hs        | 56 +++++++++++++++++++++++++++++++-------
 src/Semantic/Graph.hs      | 11 ++++----
 src/Semantic/IO.hs         | 16 +++++++----
 src/Semantic/Resolution.hs |  3 +-
 4 files changed, 64 insertions(+), 22 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 1c75ccc2e..3e47530a5 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -1,25 +1,58 @@
+{-# LANGUAGE DeriveAnyClass #-}
 module Data.Project where
 
-import Data.Text as T (pack)
+import Data.Blob
 import Data.Language
+import qualified Data.Text as T
 import Prologue
+import Proto3.Suite
 import System.FilePath.Posix
 
-data Project = Project
-  { projectRootDir     :: FilePath
-  , projectFiles       :: [File]
+data Project blobs paths path = Project
+  { projectRootDir     :: path
+  , projectBlobs       :: blobs Blob
   , projectLanguage    :: Language
-  , projectEntryPoints :: [File]
-  , projectExcludeDirs :: [FilePath]
-  }
-  deriving (Eq, Ord, Show)
+  , projectEntryPaths  :: paths path
+  , projectExcludeDirs :: paths path
+  } deriving (Functor, Generic, Named)
 
-projectName :: Project -> Text
+deriving instance ( MessageField path
+                  , MessageField (paths path)
+                  , MessageField (blobs Blob)
+                  ) => Message (Project blobs paths path)
+
+deriving instance (Eq path, Eq (blobs Blob), Eq (paths path)) => Eq (Project blobs paths path)
+deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (Project blobs paths path)
+
+type Concrete = Project [] [] FilePath
+type PB = Project NestedVec UnpackedVec Text
+
+fromPB :: PB -> Concrete
+fromPB Project {..} = Project
+  { projectRootDir     = T.unpack projectRootDir
+  , projectBlobs       = go projectBlobs
+  , projectLanguage    = projectLanguage
+  , projectEntryPaths  = T.unpack <$> go projectEntryPaths
+  , projectExcludeDirs = T.unpack <$> go projectExcludeDirs
+  } where go :: Foldable f => f a -> [a]
+          go = foldr (:) []
+
+projectName :: Concrete -> Text
 projectName = T.pack . dropExtensions . takeFileName . projectRootDir
 
-projectExtensions :: Project -> [String]
+projectExtensions :: Concrete -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage
 
+projectEntryPoints :: Concrete -> [File]
+projectEntryPoints (Project {..})= foldr go [] projectBlobs
+  where go b acc =
+          if blobPath b `elem` projectEntryPaths
+          then toFile b : acc
+          else acc
+
+projectFiles :: Concrete -> [File]
+projectFiles = fmap toFile . projectBlobs where
+
 
 data File = File
   { filePath     :: FilePath
@@ -29,3 +62,6 @@ data File = File
 file :: FilePath -> File
 file path = File path (languageForFilePath path)
   where languageForFilePath = languageForType . takeExtension
+
+toFile :: Blob -> File
+toFile (Blob _ p l) = File p l
diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index b18c32dcd..9d778618e 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -27,6 +27,7 @@ import           Data.Abstract.Package as Package
 import           Data.Abstract.Value (Value, ValueError (..), runValueErrorWith)
 import           Data.Graph
 import           Data.Project
+import qualified Data.Project as Project (Concrete)
 import           Data.Record
 import           Data.Term
 import           Data.Text (pack)
@@ -40,7 +41,7 @@ data GraphType = ImportGraph | CallGraph
 runGraph :: ( Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
          => GraphType
          -> Bool
-         -> Project
+         -> Project.Concrete
          -> Eff effs (Graph Vertex)
 runGraph graphType includePackages project
   | SomeAnalysisParser parser prelude <- someAnalysisParser
@@ -71,21 +72,21 @@ runGraph graphType includePackages project
 parsePackage :: (Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
              => Parser term -- ^ A parser.
              -> Maybe File  -- ^ Prelude (optional).
-             -> Project     -- ^ Project to parse into a package.
+             -> Project.Concrete     -- ^ Project to parse into a package.
              -> Eff effs (Package term)
 parsePackage parser preludeFile project@Project{..} = do
   prelude <- traverse (parseModule parser Nothing) preludeFile
   p <- parseModules parser project
   resMap <- Task.resolutionMap project
-  let pkg = Package.fromModules n Nothing prelude (length projectEntryPoints) p resMap
+  let pkg = Package.fromModules n Nothing prelude (length projectEntryPaths) p resMap
   pkg <$ trace ("project: " <> show pkg)
 
   where
     n = name (projectName project)
 
     -- | Parse all files in a project into 'Module's.
-    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project -> Eff effs [Module term]
-    parseModules parser Project{..} = distributeFor (projectEntryPoints <> projectFiles) (WrapTask . parseModule parser (Just projectRootDir))
+    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project.Concrete -> Eff effs [Module term]
+    parseModules parser Project{..} = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule parser (Just projectRootDir))
 
 -- | Parse a file into a 'Module'.
 parseModule :: (Member Files effs, Member Task effs) => Parser term -> Maybe FilePath -> File -> Eff effs (Module term)
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index c6aa9a8af..8af6c7a23 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -39,12 +39,14 @@ import           Control.Monad.IO.Class
 import           Data.Aeson
 import qualified Data.Blob as Blob
 import           Data.Bool
-import           Data.Project
+import           Data.Project (File (..), Project (..))
+import qualified Data.Project as Project
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
 import           Data.Language
 import           Data.Source (fromUTF8, fromText)
+import qualified Data.Text as T
 import           Prelude hiding (readFile)
 import           Prologue hiding (MonadError (..), fail)
 import           System.Directory (doesDirectoryExist)
@@ -98,7 +100,7 @@ readBlobFromPath file = do
   maybeFile <- readFile file
   maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
 
-readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
+readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project.Concrete
 readProjectFromPaths maybeRoot path lang excludeDirs = do
   isDir <- isDirectory path
   let (filterFun, entryPoints, rootDir) = if isDir
@@ -106,9 +108,11 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
       else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot)
 
   paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
-  pure $ Project rootDir (toFile <$> paths) lang entryPoints excludeDirs
+  blobs <- traverse (readBlobFromPath . toFile) paths
+
+  pure $ Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
   where
-    toFile path = File path lang
+    toFile p = File p lang
     exts = extensionsForLanguage lang
 
 -- Recursively find files in a directory.
@@ -203,7 +207,7 @@ readBlobPairs :: Member Files effs => Either (Handle 'IO.ReadMode) [Both File] -
 readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
 readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
 
-readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project
+readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project.Concrete
 readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
 
 findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
@@ -247,7 +251,7 @@ data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
 -- | An effect to read/write 'Blob.Blob's from 'Handle's or 'FilePath's.
 data Files out where
   Read        :: Source out -> Files out
-  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project
+  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project.Concrete
   FindFiles   :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
   Write       :: Destination -> B.Builder -> Files ()
 
diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs
index 438af10c3..81fa45e9b 100644
--- a/src/Semantic/Resolution.hs
+++ b/src/Semantic/Resolution.hs
@@ -6,6 +6,7 @@ import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
 import           Data.Blob
 import           Data.Project
+import qualified Data.Project as Project (Concrete)
 import qualified Data.Map as Map
 import           Data.Source
 import           Data.Language
@@ -29,7 +30,7 @@ nodeJSResolutionMap rootDir prop excludeDirs = do
       where relPkgDotJSONPath = makeRelative rootDir path
             relEntryPath x = takeDirectory relPkgDotJSONPath </> x
 
-resolutionMap :: Member Resolution effs => Project -> Eff effs (Map FilePath FilePath)
+resolutionMap :: Member Resolution effs => Project.Concrete -> Eff effs (Map FilePath FilePath)
 resolutionMap Project{..} = case projectLanguage of
   TypeScript -> send (NodeJSResolution projectRootDir "types" projectExcludeDirs)
   JavaScript -> send (NodeJSResolution projectRootDir "main" projectExcludeDirs)

From c3542f31eda688d79d4c906bfdf43844bb155e07 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 12:43:10 -0400
Subject: [PATCH 02/34] Generate Projects in proto-gen

---
 types.proto | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/types.proto b/types.proto
index 7d586835e..052442ae2 100644
--- a/types.proto
+++ b/types.proto
@@ -12,6 +12,9 @@ enum Language {Unknown = 0;
                Ruby = 9;
                TypeScript = 10;
                PHP = 11;}
+enum VertexType {PACKAGE = 0;
+                 MODULE = 1;
+                 VARIABLE = 2;}
 message Blob { bytes blobSource = 1;
                string blobPath = 2;
                Language blobLanguage = 3;
@@ -22,20 +25,35 @@ message Pos { int64 posLine = 1;
 message Span { Pos spanStart = 1;
                Pos spanEnd = 2;
              }
+message Vertex { VertexType vertexType = 1;
+                 string vertexContents = 2;
+                 uint64 vertexTag = 3;
+               }
+message Edge { uint64 edgeFrom = 1;
+               uint64 edgeTo = 2;
+             }
+message AdjList { repeated Vertex graphVertices = 1;
+                  repeated Edge graphEdges = 2;
+                }
+message Guide { string rootDir = 1;
+                repeated Blob allBlobs = 2;
+                repeated Blob entryPoints = 3;
+                repeated string excludes = 4 [packed = false];
+              }
 message Array { repeated Term arrayElements = 1;
               }
 message Boolean { bool booleanContent = 1;
                 }
 message Hash { repeated Term hashElements = 1;
              }
-message Float { bytes floatContent = 1;
+message Float { string floatContent = 1;
               }
 message KeyValue { Term key = 1;
                    Term value = 2;
                  }
 message Null {
              }
-message TextElement { bytes textElementContent = 1;
+message TextElement { string textElementContent = 1;
                     }
 message Term { oneof syntax {Array array = 1;
                              Boolean boolean = 2;

From dd8c8b07622bbe9cb067b069c64263490656dd8a Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 12:48:23 -0400
Subject: [PATCH 03/34] Port AdjList and create the messages

---
 semantic.cabal            |   3 +
 semantic.proto            |  10 +++
 src/Data/Graph/AdjList.hs | 160 ++++++++++++++++++++++++++++++++++++++
 src/Data/Graph/Vertex.hs  |  37 +++++++++
 4 files changed, 210 insertions(+)
 create mode 100644 src/Data/Graph/AdjList.hs
 create mode 100644 src/Data/Graph/Vertex.hs

diff --git a/semantic.cabal b/semantic.cabal
index 205b90825..4cc36cb24 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -76,6 +76,8 @@ library
                      , Data.Functor.Both
                      , Data.Functor.Classes.Generic
                      , Data.Graph
+                     , Data.Graph.AdjList
+                     , Data.Graph.Vertex
                      , Data.JSON.Fields
                      , Data.Language
                      , Data.Map.Monoidal
@@ -214,6 +216,7 @@ library
                      , proto3-wire
                      , unix
                      , unordered-containers
+                     , vector
                      , haskell-tree-sitter
                      , tree-sitter-go
                      , tree-sitter-haskell
diff --git a/semantic.proto b/semantic.proto
index 68bad2620..e1b8db9df 100644
--- a/semantic.proto
+++ b/semantic.proto
@@ -19,16 +19,26 @@ service SemanticAPI {
   rpc HealthCheck(HealthCheckRequest) returns (HealthCheckResponse);
   rpc FetchSummaries (SummariesRequest) returns (SummariesResponse) {}
   rpc ParseBlobs (ParseRequest) returns (ParseResponse) {}
+  rpc GraphImports (ImportGraphRequest) returns (ImportGraphResponse) {}
 }
 
 message SummariesRequest  {
   repeated BlobPair blobPairs = 1;
 }
 
+message ImportGraphRequest {
+  Project project = 1;
+}
+
 message ParseRequest {
   repeated Blob source = 1;
 }
 
+message ImportGraphResponse {
+  AdjList graph = 1;
+  repeated string errorMessages = 2;
+}
+
 message BlobPair {
   Blob before = 1;
   Blob after = 2;
diff --git a/src/Data/Graph/AdjList.hs b/src/Data/Graph/AdjList.hs
new file mode 100644
index 000000000..698a3c4e9
--- /dev/null
+++ b/src/Data/Graph/AdjList.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE DeriveAnyClass, LambdaCase, TupleSections #-}
+
+module Data.Graph.AdjList
+  ( AdjList (..)
+  , Edge (..)
+  , Tag
+  , Vertex (..)
+  , VertexType (..)
+  , graphToAdjList
+  , adjListToGraph
+  , tagGraph
+  , isCoherent
+  ) where
+
+import Prologue
+
+import           Algebra.Graph.AdjacencyMap (adjacencyMap)
+import           Algebra.Graph.Class (ToGraph (..), edges, vertices)
+import           Control.Monad.Effect
+import           Control.Monad.Effect.Fresh
+import           Data.Aeson
+import           Data.Coerce
+import           Data.HashMap.Strict ((!))
+import qualified Data.HashMap.Strict as HashMap
+import           Data.HashSet (HashSet)
+import qualified Data.HashSet as HashSet
+import           Data.Map (Map)
+import qualified Data.Map as Map
+import           Data.Set (Set)
+import qualified Data.Set as Set
+import qualified Data.Vector as Vec
+import           Data.Word
+import           GHC.Exts (fromList)
+import qualified Proto3.Suite as PB
+
+import           Data.Graph
+import qualified Data.Graph.Vertex as V
+
+-- There are a lot of boilerplate instances for protobuf compatibility in this file.
+-- Some of them could be reduced by changing the data types and using generic deriving,
+-- but then you have to sacrifice derived JSON instances. Ultimately the protobuf ones
+-- aren't too onerous to write by hand.
+
+-- | Sum type corresponding to a protobuf enum for vertex types.
+data VertexType
+  = PACKAGE
+  | MODULE
+  | VARIABLE
+    deriving (Eq, Ord, Show, Enum, Bounded, Generic, ToJSON, FromJSON, PB.Named, PB.Finite, PB.MessageField)
+
+-- | Defaults to 'PACKAGE'.
+instance PB.HasDefault VertexType where def = PACKAGE
+
+-- | Piggybacks on top of the 'Enumerated' instance, as the generated code would.
+-- This instance will get easier when we have DerivingVia.
+instance PB.Primitive VertexType where
+  primType _ = PB.primType (Proxy @(PB.Enumerated VertexType))
+  encodePrimitive f = PB.encodePrimitive f . PB.Enumerated . Right
+  decodePrimitive   = PB.decodePrimitive >>= \case
+    (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 'AdjList'.
+type Tag = Word64
+
+-- | A protobuf-compatible vertex type, with a unique 'Tag' identifier.
+data Vertex = Vertex
+  { vertexType     :: VertexType
+  , vertexContents :: Text
+  , vertexTag      :: Tag
+  } deriving (Eq, Ord, Show, Generic, PB.Message, PB.Named)
+
+-- | A protobuf-compatible edge type. Only tag information is carried;
+-- consumers are expected to look up nodes in the vertex list when necessary.
+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
+-- 'graphToAdjList' on an algebraic 'Graph'. This representation is less efficient and
+-- fluent than an ordinary 'Graph', but is more amenable to serialization.
+data AdjList = AdjList
+  { 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.
+graphToAdjList :: Graph V.Vertex -> AdjList
+graphToAdjList = taggedGraphToAdjList . tagGraph
+
+-- * Internal interface stuff
+
+-- Using a PBGraph as the accumulator for the fold would incur
+-- significant overhead associated with Vector concatenation.
+-- We use this and then pay the O(v + e) to-Vector cost once.
+data Acc = Acc ![Vertex] !(HashSet Edge)
+
+-- Convert a graph with tagged members to a protobuf-compatible adjacency list.
+-- The Tag is necessary to build a canonical adjacency list.
+-- Since import graphs can be very large, this is written with speed in mind, in
+-- that we convert the graph to algebraic-graphs's 'AdjacencyMap' and then fold
+-- 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.
+taggedGraphToAdjList :: Graph (V.Vertex, Tag) -> AdjList
+taggedGraphToAdjList = accumToAdj . munge . adjacencyMap . toGraph . simplify
+  where munge :: Map (V.Vertex, Tag) (Set (V.Vertex, Tag)) -> Acc
+        munge = Map.foldlWithKey go (Acc [] mempty)
+
+        go :: Acc -> (V.Vertex, Tag) -> Set (V.Vertex, Tag) -> Acc
+        go (Acc vs es) (v, from) edges = Acc (vertexToPB v from : vs) (Set.foldr' add es edges)
+          where add (_, to) = HashSet.insert (Edge from to)
+
+        accumToAdj :: Acc -> AdjList
+        accumToAdj (Acc vs es) = AdjList (fromList vs) (fromList (toList es))
+
+        vertexToPB :: V.Vertex -> Tag -> Vertex
+        vertexToPB s = Vertex t (V.vertexName s) where
+          t = case s of
+            V.Package{}  -> PACKAGE
+            V.Module{}   -> MODULE
+            V.Variable{} -> VARIABLE
+
+-- Annotate all vertices of a 'Graph' with a 'Tag', starting from 0.
+tagGraph :: Graph vertex -> Graph (vertex, Tag)
+tagGraph = run . runFresh 1 . go where
+  go :: Graph vertex -> Eff '[Fresh] (Graph (vertex, Tag))
+  go = traverse (\v -> (v, ) . fromIntegral <$> fresh)
+
+-- | This is the reverse of 'graphToAdjList'. Don't use this outside of a testing context.
+-- N.B. @adjListToGraph . graphToAdjList@ is 'id', but @graphToAdjList . adjListToGraph@ is not.
+adjListToGraph :: AdjList -> Graph V.Vertex
+adjListToGraph (AdjList vs es) = simplify built
+  where built = allEdges <> vertices unreferencedVertices
+
+        allEdges :: Graph V.Vertex
+        allEdges = fmap fst (edges (foldr addEdge [] es))
+        addEdge (Edge f t) xs = ((adjMap ! f, f), (adjMap ! t, t)) : xs
+        adjMap = foldMap (\v -> HashMap.singleton (vertexTag v) (pbToVertex v)) vs
+
+        unreferencedVertices :: [V.Vertex]
+        unreferencedVertices = pbToVertex <$> toList (Vec.filter isUnreferenced (coerce vs))
+
+        isUnreferenced :: Vertex -> Bool
+        isUnreferenced v = not (vertexTag v `HashSet.member` edgedTags)
+
+        edgedTags :: HashSet Tag
+        edgedTags = HashSet.fromList $ concatMap unEdge es where unEdge (Edge f t) = [f, t]
+
+        pbToVertex :: Vertex -> V.Vertex
+        pbToVertex (Vertex t c _) = case t of
+          MODULE   -> V.Module c
+          PACKAGE  -> V.Package c
+          VARIABLE -> V.Variable c
+
+
+-- | For debugging: returns True if all edges reference a valid vertex tag.
+isCoherent :: AdjList -> Bool
+isCoherent (AdjList vs es) = all edgeValid es where
+  edgeValid (Edge a b) = HashSet.member a allTags && HashSet.member b allTags
+  allTags = HashSet.fromList (toList (vertexTag <$> vs))
diff --git a/src/Data/Graph/Vertex.hs b/src/Data/Graph/Vertex.hs
new file mode 100644
index 000000000..c42071cd9
--- /dev/null
+++ b/src/Data/Graph/Vertex.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveAnyClass #-}
+module Data.Graph.Vertex
+  ( Vertex (..)
+  , moduleVertex
+  , packageVertex
+  , vertexToType
+  ) where
+
+import Prologue hiding (packageName)
+
+import           Data.Aeson
+import qualified Data.Text as T
+
+import Data.Abstract.Module (ModuleInfo (..))
+import Data.Abstract.Name
+import Data.Abstract.Package (PackageInfo (..))
+
+-- | A vertex of some specific type.
+data Vertex
+  = Package  { vertexName :: Text }
+  | Module   { vertexName :: Text }
+  | Variable { vertexName :: Text }
+  deriving (Eq, Ord, Show, Generic, Hashable)
+
+packageVertex :: PackageInfo -> Vertex
+packageVertex = Package . formatName . packageName
+
+moduleVertex :: ModuleInfo -> Vertex
+moduleVertex = Module . T.pack . modulePath
+
+instance ToJSON Vertex where
+  toJSON v = object [ "name" .= vertexName v, "type" .= vertexToType v ]
+
+vertexToType :: Vertex -> Text
+vertexToType Package{}  = "package"
+vertexToType Module{}   = "module"
+vertexToType Variable{} = "variable"

From 0eac55e45476729bc2c5e222688affce0a0138b5 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 12:51:14 -0400
Subject: [PATCH 04/34] update protos

---
 types.proto | 21 ++++++---------------
 1 file changed, 6 insertions(+), 15 deletions(-)

diff --git a/types.proto b/types.proto
index 052442ae2..8444acc3f 100644
--- a/types.proto
+++ b/types.proto
@@ -12,9 +12,6 @@ enum Language {Unknown = 0;
                Ruby = 9;
                TypeScript = 10;
                PHP = 11;}
-enum VertexType {PACKAGE = 0;
-                 MODULE = 1;
-                 VARIABLE = 2;}
 message Blob { bytes blobSource = 1;
                string blobPath = 2;
                Language blobLanguage = 3;
@@ -25,21 +22,15 @@ message Pos { int64 posLine = 1;
 message Span { Pos spanStart = 1;
                Pos spanEnd = 2;
              }
-message Vertex { VertexType vertexType = 1;
-                 string vertexContents = 2;
-                 uint64 vertexTag = 3;
-               }
-message Edge { uint64 edgeFrom = 1;
-               uint64 edgeTo = 2;
-             }
 message AdjList { repeated Vertex graphVertices = 1;
                   repeated Edge graphEdges = 2;
                 }
-message Guide { string rootDir = 1;
-                repeated Blob allBlobs = 2;
-                repeated Blob entryPoints = 3;
-                repeated string excludes = 4 [packed = false];
-              }
+message Project { string projectRootDir = 1;
+                  repeated Blob projectBlobs = 2;
+                  Language projectLanguage = 3;
+                  repeated string projectEntryPaths = 4 [packed = false];
+                  repeated string projectExcludeDirs = 5 [packed = false];
+                }
 message Array { repeated Term arrayElements = 1;
               }
 message Boolean { bool booleanContent = 1;

From 14b01603e41ab7fb8e45170bfad61fc6a8de4973 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 14:40:12 -0400
Subject: [PATCH 05/34] it works as long as you package the prelude and comment
 out Util

---
 src/Analysis/Abstract/Graph.hs | 27 +---------
 src/Data/Project.hs            | 73 ++++++++++++++++++++++++++-
 src/Semantic/Graph.hs          | 54 ++++++++++++++++++++
 src/Semantic/IO.hs             | 30 ++++++++---
 src/Semantic/Resolution.hs     |  2 +-
 src/Semantic/Task.hs           | 46 +++++++++++++++++
 src/Semantic/Util.hs           | 91 +++++++++++++++++++---------------
 types.proto                    | 10 ++++
 8 files changed, 257 insertions(+), 76 deletions(-)

diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs
index 4939e036b..035e73d18 100644
--- a/src/Analysis/Abstract/Graph.hs
+++ b/src/Analysis/Abstract/Graph.hs
@@ -22,6 +22,7 @@ import           Data.Abstract.Package (PackageInfo(..))
 import           Data.Aeson hiding (Result)
 import           Data.ByteString.Builder
 import           Data.Graph
+import           Data.Graph.Vertex
 import           Data.Sum
 import qualified Data.Syntax as Syntax
 import           Data.Term
@@ -29,13 +30,6 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import           Prologue hiding (packageName, project)
 
--- | A vertex of some specific type.
-data Vertex
-  = Package  { vertexName :: Text }
-  | Module   { vertexName :: Text }
-  | Variable { vertexName :: Text }
-  deriving (Eq, Ord, Show)
-
 style :: Style Vertex Builder
 style = (defaultStyle (T.encodeUtf8Builder . vertexName))
   { vertexAttributes = vertexAttributes
@@ -88,13 +82,6 @@ graphingModules recur m = interpose @(Modules address value) pure (\ m yield ->
   _ -> send m >>= yield)
   (recur m)
 
-
-packageVertex :: PackageInfo -> Vertex
-packageVertex = Package . formatName . packageName
-
-moduleVertex :: ModuleInfo -> Vertex
-moduleVertex = Module . T.pack . modulePath
-
 -- | Add an edge from the current package to the passed vertex.
 packageInclusion :: ( Effectful m
                     , Member (Reader PackageInfo) effects
@@ -133,17 +120,5 @@ appendGraph :: (Effectful m, Member (State (Graph Vertex)) effects) => Graph Ver
 appendGraph = modify' . (<>)
 
 
-instance ToJSON Vertex where
-  toJSON v = object [ "name" .= vertexToText v, "type" .= vertexToType v ]
-
-vertexToText :: Vertex -> Text
-vertexToText = vertexName
-
-vertexToType :: Vertex -> Text
-vertexToType Package{}  = "package"
-vertexToType Module{}   = "module"
-vertexToType Variable{} = "variable"
-
-
 graphing :: Effectful m => m (State (Graph Vertex) ': effects) result -> m effects (result, Graph Vertex)
 graphing = runState mempty
diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 3e47530a5..6daa65ec3 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -1,12 +1,22 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE MultiWayIf #-}
+
 module Data.Project where
 
+import Prelude hiding (readFile)
+import Prologue hiding (throwError)
+
+import Control.Monad.Effect
+import Control.Monad.IO.Class
+import Data.Source
+import Control.Monad.Effect.Exception
 import Data.Blob
 import Data.Language
 import qualified Data.Text as T
-import Prologue
 import Proto3.Suite
 import System.FilePath.Posix
+import qualified Data.ByteString as B
+import Debug.Trace
 
 data Project blobs paths path = Project
   { projectRootDir     :: path
@@ -65,3 +75,64 @@ file path = File path (languageForFilePath path)
 
 toFile :: Blob -> File
 toFile (Blob _ p l) = File p l
+
+data ProjectException
+  = FileNotFound FilePath
+  | EmptyPairProvided
+  | PairNotFound (Both FilePath)
+  | HandleNotSupported
+  | WritesNotSupported
+  | NoLanguagesSpecified
+  | UnknownLanguage
+  | MultipleLanguagesSpecified [Language]
+  | TODO
+    deriving (Show, Eq, Typeable, Exception)
+
+readBlobFromPath :: Member (Exc SomeException) effs
+                 => Concrete
+                 -> File
+                 -> Eff effs Blob
+readBlobFromPath g f = readFile g f >>= maybeM (throwError (SomeException (FileNotFound (filePath f))))
+
+addPrelude :: MonadIO m
+           => Concrete
+           -> File
+           -> m Concrete
+addPrelude g File{..} = do
+  traceM "Adding to prelude"
+  contents <- liftIO (B.readFile filePath)
+  let blob = Blob (fromUTF8 contents) filePath fileLanguage
+  pure $ g { projectBlobs = blob : projectBlobs g }
+
+readFile :: Member (Exc SomeException) effs
+         => Concrete
+         -> File
+         -> Eff effs (Maybe Blob)
+readFile Project{..} f =
+  let p         = filePath f
+      candidate = find (\b -> blobPath b == p) (traceShowId projectBlobs)
+  in if
+    | p == "/dev/null"  -> pure Nothing
+    | isJust candidate  -> pure candidate
+    | otherwise         -> throwError (SomeException (FileNotFound p))
+
+readBlobPair :: Member (Exc SomeException) effs
+             => Concrete
+             -> File
+             -> File
+             -> Eff effs BlobPair
+readBlobPair g f1 f2 = Join <$> join (maybeThese <$> readFile g f1 <*> readFile g f2)
+
+maybeThese :: Member (Exc SomeException) effs => Maybe a -> Maybe b -> Eff effs (These a b)
+maybeThese a b = case (a, b) of
+  (Just a, Nothing) -> pure (This a)
+  (Nothing, Just b) -> pure (That b)
+  (Just a, Just b)  -> pure (These a b)
+  _                 -> throwError (SomeException EmptyPairProvided)
+
+findFiles :: Member (Exc SomeException) effs
+          => Concrete
+          -> FilePath
+          -> [String]
+          -> Eff effs [FilePath]
+findFiles _ _ _ = throwError (SomeException TODO)
diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index 9d778618e..bb5be8c8a 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE GADTs, TypeOperators #-}
 module Semantic.Graph
 ( runGraph
+, runGraph'
 , GraphType(..)
 , Graph
 , Vertex
@@ -20,6 +21,8 @@ import           Analysis.Abstract.Evaluating
 import           Analysis.Abstract.Graph
 import           Control.Abstract
 import           Control.Monad.Effect (reinterpret)
+import           Control.Monad.Effect.State
+import           Control.Monad.IO.Class
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
@@ -30,6 +33,7 @@ import           Data.Project
 import qualified Data.Project as Project (Concrete)
 import           Data.Record
 import           Data.Term
+import           Debug.Trace (traceShowId, traceM)
 import           Data.Text (pack)
 import           Parsing.Parser
 import           Prologue hiding (MonadError (..))
@@ -88,6 +92,56 @@ parsePackage parser preludeFile project@Project{..} = do
     parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project.Concrete -> Eff effs [Module term]
     parseModules parser Project{..} = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule parser (Just projectRootDir))
 
+runGraph' :: ( Member (Distribute WrappedTask') effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
+         => GraphType
+         -> Bool
+         -> Project.Concrete
+         -> Eff effs (Graph Vertex)
+runGraph' graphType includePackages project
+  | SomeAnalysisParser parser prelude <- someAnalysisParser
+    (Proxy :: Proxy '[ Evaluatable, Declarations1, FreeVariables1, Functor, Eq1, Ord1, Show1 ]) (projectLanguage project) = do
+    package <- parsePackage' parser prelude project
+    let analyzeTerm = withTermSpans . case graphType of
+          ImportGraph -> id
+          CallGraph   -> graphingTerms
+        analyzeModule = (if includePackages then graphingPackages else id) . graphingModules
+    analyze runGraphAnalysis (evaluatePackageWith analyzeModule analyzeTerm package) >>= extractGraph
+    where extractGraph result = case result of
+            (((_, graph), _), _) -> pure (simplify graph)
+          runGraphAnalysis
+            = run
+            . evaluating
+            . runIgnoringTrace
+            . resumingLoadError
+            . resumingUnspecialized
+            . resumingEnvironmentError
+            . resumingEvalError
+            . resumingResolutionError
+            . resumingAddressError
+            . resumingValueError
+            . runTermEvaluator @_ @_ @(Value (Hole (Located Precise)) (Eff _))
+            . graphing
+
+-- | Parse a list of files into a 'Package'.
+parsePackage' :: (Member (Distribute WrappedTask') effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
+             => Parser term -- ^ A parser.
+             -> Maybe File  -- ^ Prelude (optional).
+             -> Project.Concrete     -- ^ Project to parse into a package.
+             -> Eff effs (Package term)
+parsePackage' parser preludeFile project@Project{..} = do
+  prelude <- traverse (parseModule parser Nothing) preludeFile
+  p <- parseModules parser project
+  resMap <- Task.resolutionMap project
+  let pkg = Package.fromModules n Nothing prelude (length projectEntryPaths) p resMap
+  pkg <$ trace ("project: " <> show pkg)
+
+  where
+    n = name (projectName project)
+
+    -- | Parse all files in a project into 'Module's.
+    parseModules :: Member (Distribute WrappedTask') effs => Parser term -> Project.Concrete -> Eff effs [Module term]
+    parseModules parser Project{..} = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask' . parseModule parser (Just projectRootDir))
+
 -- | Parse a file into a 'Module'.
 parseModule :: (Member Files effs, Member Task effs) => Parser term -> Maybe FilePath -> File -> Eff effs (Module term)
 parseModule parser rootDir file = do
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index 8af6c7a23..0071b88ff 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -26,6 +26,7 @@ module Semantic.IO
 , readProjectFromPaths
 , rethrowing
 , runFiles
+, runFilesGuided
 , stderr
 , stdin
 , stdout
@@ -34,19 +35,20 @@ module Semantic.IO
 
 import qualified Control.Exception as Exc
 import           Control.Monad.Effect
+import           Control.Monad.Effect.Reader
+import           Control.Monad.Effect.State
 import           Control.Monad.Effect.Exception
 import           Control.Monad.IO.Class
 import           Data.Aeson
 import qualified Data.Blob as Blob
 import           Data.Bool
-import           Data.Project (File (..), Project (..))
 import qualified Data.Project as Project
+import           Data.Project (File (..), ProjectException (..))
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
 import           Data.Language
 import           Data.Source (fromUTF8, fromText)
-import qualified Data.Text as T
 import           Prelude hiding (readFile)
 import           Prologue hiding (MonadError (..), fail)
 import           System.Directory (doesDirectoryExist)
@@ -56,12 +58,14 @@ import           System.Exit
 import           System.FilePath
 import           System.FilePath.Glob
 import qualified System.IO as IO
-import           Text.Read
+import           Text.Read hiding (get)
+import           Debug.Trace (trace)
 
 -- | Read a utf8-encoded file to a 'Blob'.
 readFile :: forall m. MonadIO m => File -> m (Maybe Blob.Blob)
 readFile (File "/dev/null" _) = pure Nothing
 readFile (File path language) = do
+  liftIO (print "Wrong readFile")
   raw <- liftIO (Just <$> B.readFile path)
   pure $ Blob.sourceBlob path language . fromUTF8 <$> raw
 
@@ -102,17 +106,20 @@ readBlobFromPath file = do
 
 readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project.Concrete
 readProjectFromPaths maybeRoot path lang excludeDirs = do
+  liftIO $ putStrLn "Starting readProjectFromPath"
   isDir <- isDirectory path
   let (filterFun, entryPoints, rootDir) = if isDir
       then (id, [], fromMaybe path maybeRoot)
       else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot)
 
-  paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
-  blobs <- traverse (readBlobFromPath . toFile) paths
 
-  pure $ Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
+  paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
+  blobs <- traverse readBlobFromPath (toFile <$> paths)
+  let p = Project.Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
+  liftIO $ putStrLn "Done"
+  pure p
   where
-    toFile p = File p lang
+    toFile path = File path lang
     exts = extensionsForLanguage lang
 
 -- Recursively find files in a directory.
@@ -267,6 +274,15 @@ runFiles = interpret $ \ files -> case files of
   Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
   Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
 
+runFilesGuided :: (Member (State Project.Concrete) effs, Member (Exc SomeException) effs, Member IO effs) => Eff (Files ': effs) a -> Eff effs a
+runFilesGuided = interpret $ \files -> case files of
+  Read (FromHandle _)            -> throwError (SomeException HandleNotSupported)
+  Read (FromPairHandle _)        -> throwError (SomeException HandleNotSupported)
+  Write _ _                      -> throwError (SomeException WritesNotSupported)
+  Read (FromPath path)           -> get >>= \p -> Project.readBlobFromPath p path
+  Read (FromPathPair paths)      -> get >>= \p -> runBothWith (Project.readBlobPair p) paths
+  FindFiles dir exts excludeDirs -> get >>= \p -> Project.findFiles (p { Project.projectExcludeDirs = excludeDirs }) dir exts
+  ReadProject{}                  -> get
 
 -- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
 --
diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs
index 81fa45e9b..3eda55ad6 100644
--- a/src/Semantic/Resolution.hs
+++ b/src/Semantic/Resolution.hs
@@ -5,7 +5,7 @@ import           Control.Monad.Effect
 import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
 import           Data.Blob
-import           Data.Project
+import           Data.Project hiding (findFiles)
 import qualified Data.Project as Project (Concrete)
 import qualified Data.Map as Map
 import           Data.Source
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index 9cf2496ba..13bd8932f 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -3,6 +3,7 @@ module Semantic.Task
 ( Task
 , TaskEff
 , WrappedTask(..)
+, WrappedTask'(..)
 , Level(..)
 , RAlgebra
 -- * I/O
@@ -38,6 +39,7 @@ module Semantic.Task
 -- * Interpreting
 , runTask
 , runTaskWithOptions
+, runTaskWithProject
 -- * Re-exports
 , Distribute
 , Eff
@@ -54,6 +56,7 @@ import           Control.Monad
 import           Control.Monad.Effect
 import           Control.Monad.Effect.Exception
 import           Control.Monad.Effect.Reader
+import           Control.Monad.Effect.State
 import           Control.Monad.Effect.Trace
 import           Data.Blob
 import           Data.Bool
@@ -64,6 +67,7 @@ import           Data.Record
 import           Data.Sum
 import qualified Data.Syntax as Syntax
 import           Data.Term
+import           Data.Project
 import           Diffing.Algorithm (Diffable)
 import           Diffing.Interpreter
 import           Parsing.CMark
@@ -92,10 +96,25 @@ type TaskEff = Eff '[Distribute WrappedTask
                     , Exc SomeException
                     , IO]
 
+type TaskEff' = Eff '[Distribute WrappedTask'
+                     , Task
+                     , Resolution
+                     , IO.Files
+                     , State Concrete
+                     , Reader Options
+                     , Trace
+                     , Telemetry
+                     , Exc SomeException
+                     , IO]
+
 -- | A wrapper for a 'Task', to embed in other effects.
 newtype WrappedTask a = WrapTask { unwrapTask :: TaskEff a }
   deriving (Applicative, Functor, Monad)
 
+-- | A wrapper for a 'Task', to embed in other effects.
+newtype WrappedTask' a = WrapTask' { unwrapTask' :: TaskEff' a }
+  deriving (Applicative, Functor, Monad)
+
 -- | A function to render terms or diffs.
 type Renderer i o = i -> o
 
@@ -153,6 +172,33 @@ runTaskWithOptions options task = do
   closeQueue logger
   either (die . displayException) pure result
 
+-- | Execute a 'TaskEff' with the passed 'Options', yielding its result value in 'IO'.
+runTaskWithProject :: Concrete -> Options -> TaskEff' a -> IO a
+runTaskWithProject proj options task = do
+  options <- configureOptionsForHandle stderr options
+  statter <- defaultStatsClient >>= newQueue sendStat
+  logger <- newQueue logMessage options
+
+  (result, stat) <- withTiming "run" [] $ do
+    let run :: TaskEff' a -> IO (Either SomeException a)
+        run = fmap (fmap fst) . runM . runError
+                   . runTelemetry logger statter
+                   . runTraceInTelemetry
+                   . runReader options
+                   . runState proj
+                   . IO.runFilesGuided
+                   . runResolution
+                   . runTaskF
+                   . runDistribute (run . unwrapTask')
+    run task
+  queue statter stat
+
+  closeQueue statter
+  closeStatClient (asyncQueueExtra statter)
+  closeQueue logger
+  either (die . displayException) pure result
+
+
 runTraceInTelemetry :: Member Telemetry effects => Eff (Trace ': effects) a -> Eff effects a
 runTraceInTelemetry = interpret (\ (Trace str) -> writeLog Debug str [])
 
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index 999ec0aad..8acd74307 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -33,52 +33,61 @@ import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Language.TypeScript.Assignment as TypeScript
 
-justEvaluating
-  = runM
-  . evaluating
-  . runPrintingTrace
-  . fmap reassociate
-  . runLoadError
-  . runUnspecialized
-  . runResolutionError
-  . runEnvironmentError
-  . runEvalError
-  . runAddressError
-  . runTermEvaluator @_ @Precise @(Value Precise (Eff _))
-  . runValueError
+-- justEvaluating
+--   = runM
+--   . evaluating
+--   . runPrintingTrace
+--   . fmap reassociate
+--   . runLoadError
+--   . runUnspecialized
+--   . runResolutionError
+--   . runEnvironmentError
+--   . runEvalError
+--   . runAddressError
+--   . runTermEvaluator @_ @Precise @(Value Precise (Eff _))
+--   . runValueError
 
-checking
-  = runM @_ @IO
-  . evaluating
-  . runPrintingTrace
-  . runTermEvaluator @_ @Monovariant @Type
-  . caching @[]
-  . providingLiveSet
-  . fmap reassociate
-  . runLoadError
-  . runUnspecialized
-  . runResolutionError
-  . runEnvironmentError
-  . runEvalError
-  . runAddressError
-  . runTypeError
+-- checking
+--   = runM @_ @IO
+--   . evaluating
+--   . runPrintingTrace
+--   . runTermEvaluator @_ @Monovariant @Type
+--   . caching @[]
+--   . providingLiveSet
+--   . fmap reassociate
+--   . runLoadError
+--   . runUnspecialized
+--   . runResolutionError
+--   . runEnvironmentError
+--   . runEvalError
+--   . runAddressError
+--   . runTypeError
 
-evalGoProject path = justEvaluating =<< evaluateProject goParser Language.Go Nothing path
-evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ruby rubyPrelude path
-evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path
-evalPythonProject path = justEvaluating =<< evaluateProject pythonParser Language.Python pythonPrelude path
-evalJavaScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.JavaScript javaScriptPrelude path
-evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.TypeScript Nothing path
+-- evalGoProject path = justEvaluating =<< evaluateProject goParser Language.Go Nothing path
+-- evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ruby rubyPrelude path
+-- evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path
+-- evalPythonProject path = justEvaluating =<< evaluateProject pythonParser Language.Python pythonPrelude path
+-- evalJavaScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.JavaScript javaScriptPrelude path
+-- evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.TypeScript Nothing path
 
-typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path
+-- typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path
 
-rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby
-pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python
-javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
+-- rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby
+-- pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python
+-- javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
 
--- Evaluate a project, starting at a single entrypoint.
-evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
-evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
+-- -- Evaluate a project, starting at a single entrypoint.
+-- evaluateProject :: a -> -
+-- evaluateProject = undefined
+-- evaluateProjectWithCaching :: a -> b
+-- evaluateProjectWithCaching = undefined
+-- evaluateProject :: _
+-- evaluateProject parser lang prelude path = do
+--   proj <- readProject Nothing path lang []
+--   evaluatePackageWith id withTermSpans proj . fmap quieterm <$> runTask' (parsePackage parser prelude proj)
+-- evaluateProjectWithCaching parser lang prelude path = do
+--   proj <- readProject Nothing path lang []
+--   evaluatePackageWith convergingModules (withTermSpans . cachingTerms) proj . fmap quieterm <$> runTask (parsePackage parser prelude)
 
 
 parseFile :: Parser term -> FilePath -> IO term
diff --git a/types.proto b/types.proto
index 8444acc3f..3d988e0f2 100644
--- a/types.proto
+++ b/types.proto
@@ -12,6 +12,9 @@ enum Language {Unknown = 0;
                Ruby = 9;
                TypeScript = 10;
                PHP = 11;}
+enum VertexType {PACKAGE = 0;
+                 MODULE = 1;
+                 VARIABLE = 2;}
 message Blob { bytes blobSource = 1;
                string blobPath = 2;
                Language blobLanguage = 3;
@@ -25,6 +28,13 @@ message Span { Pos spanStart = 1;
 message AdjList { repeated Vertex graphVertices = 1;
                   repeated Edge graphEdges = 2;
                 }
+message Vertex { VertexType vertexType = 1;
+                 string vertexContents = 2;
+                 uint64 vertexTag = 3;
+               }
+message Edge { uint64 edgeFrom = 1;
+               uint64 edgeTo = 2;
+             }
 message Project { string projectRootDir = 1;
                   repeated Blob projectBlobs = 2;
                   Language projectLanguage = 3;

From 18399518b9f1988e139427df87a948077d53484b Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 16:49:38 -0400
Subject: [PATCH 06/34] don't load all the preludes ahead of time

---
 src/Data/Language.hs | 2 +-
 src/Semantic/IO.hs   | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Data/Language.hs b/src/Data/Language.hs
index daddd8000..e56cc1346 100644
--- a/src/Data/Language.hs
+++ b/src/Data/Language.hs
@@ -21,7 +21,7 @@ data Language
     | Ruby
     | TypeScript
     | PHP
-    deriving (Eq, Generic, Ord, Read, Show, Bounded, ToJSON, Named, Enum, Finite, MessageField)
+    deriving (Eq, Generic, Ord, Read, Show, Bounded, Hashable, ToJSON, Named, Enum, Finite, MessageField)
 
 -- | Predicate failing on 'Unknown' and passing in all other cases.
 knownLanguage :: Language -> Bool
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index 0071b88ff..516052ce8 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -15,6 +15,7 @@ module Semantic.IO
 , noLanguageForBlob
 , openFileForReading
 , readBlob
+, readBlobFromPath
 , readBlobPairs
 , readBlobPairsFromHandle
 , readBlobs
@@ -65,7 +66,6 @@ import           Debug.Trace (trace)
 readFile :: forall m. MonadIO m => File -> m (Maybe Blob.Blob)
 readFile (File "/dev/null" _) = pure Nothing
 readFile (File path language) = do
-  liftIO (print "Wrong readFile")
   raw <- liftIO (Just <$> B.readFile path)
   pure $ Blob.sourceBlob path language . fromUTF8 <$> raw
 

From e59708dfd6d3a5836680a1de635dd5184502553f Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 16:53:38 -0400
Subject: [PATCH 07/34] docs

---
 src/Data/Graph/AdjList.hs | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/src/Data/Graph/AdjList.hs b/src/Data/Graph/AdjList.hs
index 698a3c4e9..43b5519f5 100644
--- a/src/Data/Graph/AdjList.hs
+++ b/src/Data/Graph/AdjList.hs
@@ -36,11 +36,6 @@ import qualified Proto3.Suite as PB
 import           Data.Graph
 import qualified Data.Graph.Vertex as V
 
--- There are a lot of boilerplate instances for protobuf compatibility in this file.
--- Some of them could be reduced by changing the data types and using generic deriving,
--- but then you have to sacrifice derived JSON instances. Ultimately the protobuf ones
--- aren't too onerous to write by hand.
-
 -- | Sum type corresponding to a protobuf enum for vertex types.
 data VertexType
   = PACKAGE
@@ -52,7 +47,8 @@ data VertexType
 instance PB.HasDefault VertexType where def = PACKAGE
 
 -- | Piggybacks on top of the 'Enumerated' instance, as the generated code would.
--- This instance will get easier when we have DerivingVia.
+-- This instance will get easier when we have DerivingVia, or a Generic instance
+-- that hooks into Enumerated.
 instance PB.Primitive VertexType where
   primType _ = PB.primType (Proxy @(PB.Enumerated VertexType))
   encodePrimitive f = PB.encodePrimitive f . PB.Enumerated . Right

From 84b8b5ceb72aff4b667607f0058e560b2931f2d6 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 17:05:04 -0400
Subject: [PATCH 08/34] cleanup

---
 src/Semantic/IO.hs   | 4 +---
 src/Semantic/Util.hs | 2 +-
 2 files changed, 2 insertions(+), 4 deletions(-)

diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index 516052ce8..72ba5a424 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -36,7 +36,6 @@ module Semantic.IO
 
 import qualified Control.Exception as Exc
 import           Control.Monad.Effect
-import           Control.Monad.Effect.Reader
 import           Control.Monad.Effect.State
 import           Control.Monad.Effect.Exception
 import           Control.Monad.IO.Class
@@ -60,7 +59,6 @@ import           System.FilePath
 import           System.FilePath.Glob
 import qualified System.IO as IO
 import           Text.Read hiding (get)
-import           Debug.Trace (trace)
 
 -- | Read a utf8-encoded file to a 'Blob'.
 readFile :: forall m. MonadIO m => File -> m (Maybe Blob.Blob)
@@ -274,7 +272,7 @@ runFiles = interpret $ \ files -> case files of
   Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
   Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
 
-runFilesGuided :: (Member (State Project.Concrete) effs, Member (Exc SomeException) effs, Member IO effs) => Eff (Files ': effs) a -> Eff effs a
+runFilesGuided :: (Member (State Project.Concrete) effs, Member (Exc SomeException) effs) => Eff (Files ': effs) a -> Eff effs a
 runFilesGuided = interpret $ \files -> case files of
   Read (FromHandle _)            -> throwError (SomeException HandleNotSupported)
   Read (FromPairHandle _)        -> throwError (SomeException HandleNotSupported)
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index 8acd74307..c538f35ad 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
-{-# OPTIONS_GHC -Wno-missing-signatures #-}
+{-# OPTIONS_GHC -Wno-missing-signatures -Wno-unused-imports #-}
 module Semantic.Util where
 
 import           Analysis.Abstract.Caching

From a69b80d4f48bbba6d6a55db8e3ff083fa218d996 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 17:10:25 -0400
Subject: [PATCH 09/34] warnings

---
 src/Analysis/Abstract/Graph.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs
index 035e73d18..559bbce76 100644
--- a/src/Analysis/Abstract/Graph.hs
+++ b/src/Analysis/Abstract/Graph.hs
@@ -19,14 +19,12 @@ import           Data.Abstract.Address
 import           Data.Abstract.Module (Module(moduleInfo), ModuleInfo(..))
 import           Data.Abstract.Name
 import           Data.Abstract.Package (PackageInfo(..))
-import           Data.Aeson hiding (Result)
 import           Data.ByteString.Builder
 import           Data.Graph
 import           Data.Graph.Vertex
 import           Data.Sum
 import qualified Data.Syntax as Syntax
 import           Data.Term
-import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import           Prologue hiding (packageName, project)
 

From 77856bc098016ac1309c20939008f20103ff9589 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Jun 2018 17:17:50 -0400
Subject: [PATCH 10/34] more warnings

---
 src/Semantic/Graph.hs | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index bb5be8c8a..55b8ecb6c 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -21,8 +21,6 @@ import           Analysis.Abstract.Evaluating
 import           Analysis.Abstract.Graph
 import           Control.Abstract
 import           Control.Monad.Effect (reinterpret)
-import           Control.Monad.Effect.State
-import           Control.Monad.IO.Class
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
@@ -33,7 +31,6 @@ import           Data.Project
 import qualified Data.Project as Project (Concrete)
 import           Data.Record
 import           Data.Term
-import           Debug.Trace (traceShowId, traceM)
 import           Data.Text (pack)
 import           Parsing.Parser
 import           Prologue hiding (MonadError (..))

From 220aaff4351dac4b1aba767fd75f82288a8474c5 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 11 Jun 2018 14:35:09 -0400
Subject: [PATCH 11/34] StrictData is on so we don't need explicit bangs

---
 src/Data/Graph/AdjList.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Graph/AdjList.hs b/src/Data/Graph/AdjList.hs
index 43b5519f5..4a48a17f3 100644
--- a/src/Data/Graph/AdjList.hs
+++ b/src/Data/Graph/AdjList.hs
@@ -88,7 +88,7 @@ graphToAdjList = taggedGraphToAdjList . tagGraph
 -- Using a PBGraph as the accumulator for the fold would incur
 -- significant overhead associated with Vector concatenation.
 -- We use this and then pay the O(v + e) to-Vector cost once.
-data Acc = Acc ![Vertex] !(HashSet Edge)
+data Acc = Acc [Vertex] (HashSet Edge)
 
 -- Convert a graph with tagged members to a protobuf-compatible adjacency list.
 -- The Tag is necessary to build a canonical adjacency list.

From ea1b44085a4807facafd020afd18cf9157841d18 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 11 Jun 2018 14:43:35 -0400
Subject: [PATCH 12/34] fix bumps in the road

---
 src/Data/Project.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 6daa65ec3..0bebafaf6 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -40,12 +40,11 @@ type PB = Project NestedVec UnpackedVec Text
 fromPB :: PB -> Concrete
 fromPB Project {..} = Project
   { projectRootDir     = T.unpack projectRootDir
-  , projectBlobs       = go projectBlobs
+  , projectBlobs       = toList projectBlobs
   , projectLanguage    = projectLanguage
-  , projectEntryPaths  = T.unpack <$> go projectEntryPaths
-  , projectExcludeDirs = T.unpack <$> go projectExcludeDirs
-  } where go :: Foldable f => f a -> [a]
-          go = foldr (:) []
+  , projectEntryPaths  = T.unpack <$> toList projectEntryPaths
+  , projectExcludeDirs = T.unpack <$> toList projectExcludeDirs
+  }
 
 projectName :: Concrete -> Text
 projectName = T.pack . dropExtensions . takeFileName . projectRootDir

From 084129cde0d327b5948ba1b3b49c491f7d5347df Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 11 Jun 2018 16:18:16 -0400
Subject: [PATCH 13/34] preliminary implementation of findFiles

---
 src/Data/Project.hs | 12 ++++++++++--
 src/Semantic/IO.hs  |  2 +-
 test/SpecHelpers.hs |  2 +-
 3 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 0bebafaf6..785ba2d48 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -129,9 +129,17 @@ maybeThese a b = case (a, b) of
   (Just a, Just b)  -> pure (These a b)
   _                 -> throwError (SomeException EmptyPairProvided)
 
+-- TODO: write some tests so we can be sure this actually works
+-- and does what findFileInDir does
 findFiles :: Member (Exc SomeException) effs
           => Concrete
           -> FilePath
           -> [String]
-          -> Eff effs [FilePath]
-findFiles _ _ _ = throwError (SomeException TODO)
+          -> [FilePath]
+findFiles Project{..} dir exts = do
+  p <- blobPath <$> projectBlobs
+  guard (p == dir)
+  guard (takeExtension p `elem` exts)
+  -- TODO: not clear to me the best way to ensure these are in the
+  -- exclude directories
+  pure p
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index f81f8bbc5..79aa196c3 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -289,7 +289,7 @@ runFilesGuided = interpret $ \files -> case files of
   Write _ _                      -> throwError (SomeException WritesNotSupported)
   Read (FromPath path)           -> get >>= \p -> Project.readBlobFromPath p path
   Read (FromPathPair paths)      -> get >>= \p -> runBothWith (Project.readBlobPair p) paths
-  FindFiles dir exts excludeDirs -> get >>= \p -> Project.findFiles (p { Project.projectExcludeDirs = excludeDirs }) dir exts
+  FindFiles dir exts excludeDirs -> get >>= \p -> pure (Project.findFiles (p { Project.projectExcludeDirs = excludeDirs }) dir exts)
   ReadProject{}                  -> get
 
 -- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index 970f35132..e91550299 100644
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@@ -30,7 +30,7 @@ import Data.Bifunctor (first)
 import Data.Blob as X
 import Data.ByteString.Builder (toLazyByteString)
 import Data.ByteString.Lazy (toStrict)
-import Data.Project as X
+import Data.Project as X hiding (findFiles)
 import Data.Functor.Listable as X
 import Data.Language as X
 import Data.List.NonEmpty as X (NonEmpty(..))

From 39cf6c35514a14b1e3dd2131a4a016835ef5bcfe Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 11 Jun 2018 17:10:44 -0400
Subject: [PATCH 14/34] whoops

---
 src/Data/Project.hs | 41 ++++++++++++++++++++++++++---------------
 1 file changed, 26 insertions(+), 15 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 785ba2d48..4ec53d61f 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -1,24 +1,29 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE DeriveAnyClass, KindSignatures, MultiWayIf #-}
 
 module Data.Project where
 
 import Prelude hiding (readFile)
 import Prologue hiding (throwError)
 
-import Control.Monad.Effect
-import Control.Monad.IO.Class
-import Data.Source
-import Control.Monad.Effect.Exception
-import Data.Blob
-import Data.Language
-import qualified Data.Text as T
-import Proto3.Suite
-import System.FilePath.Posix
+import           Control.Monad.Effect
+import           Control.Monad.Effect.Exception
+import           Control.Monad.IO.Class
+import           Data.Blob
 import qualified Data.ByteString as B
-import Debug.Trace
+import           Data.Language
+import           Data.Source
+import qualified Data.Text as T
+import           Debug.Trace
+import           Proto3.Suite
+import           System.FilePath.Posix
 
-data Project blobs paths path = Project
+-- | A 'Project' contains all the information that semantic needs
+-- to execute an analysis, diffing, or graphing pass. It is higher-kinded
+-- in terms of the container type for paths and blobs, as well as the
+-- path type (this is necessary because protobuf uses different vector
+-- representations for @repeated string@ and @repeated Blob@.
+-- You probably want to use the 'Concrete' or 'PB' type aliases.
+data Project (blobs :: * -> *) (paths :: * -> *) path = Project
   { projectRootDir     :: path
   , projectBlobs       :: blobs Blob
   , projectLanguage    :: Language
@@ -34,9 +39,16 @@ deriving instance ( MessageField path
 deriving instance (Eq path, Eq (blobs Blob), Eq (paths path)) => Eq (Project blobs paths path)
 deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (Project blobs paths path)
 
+-- | This 'Project' type is the one used during semantic's normal
+-- course of diffing, evaluation, and graphing. You probably want to
+-- use this one.
 type Concrete = Project [] [] FilePath
+
+-- | This 'Project' type is protobuf-compatible, and corresponds with
+-- the @Project@ message declaration present in types.proto. 
 type PB = Project NestedVec UnpackedVec Text
 
+-- | Convert from a packed protobuf representatio nto a more useful one.
 fromPB :: PB -> Concrete
 fromPB Project {..} = Project
   { projectRootDir     = T.unpack projectRootDir
@@ -131,8 +143,7 @@ maybeThese a b = case (a, b) of
 
 -- TODO: write some tests so we can be sure this actually works
 -- and does what findFileInDir does
-findFiles :: Member (Exc SomeException) effs
-          => Concrete
+findFiles :: Concrete
           -> FilePath
           -> [String]
           -> [FilePath]

From 25a3ad2e554fac171349d19f8590eca549e9bcb8 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Mon, 11 Jun 2018 17:38:31 -0400
Subject: [PATCH 15/34] split up Semantic.IO into Data.Handle and
 Semantic.Effect.Files

---
 semantic.cabal               |   2 +
 src/Data/Handle.hs           |  37 ++++++++++
 src/Parsing/TreeSitter.hs    |   1 +
 src/Semantic/CLI.hs          |   2 +
 src/Semantic/Effect/Files.hs | 113 ++++++++++++++++++++++++++++++
 src/Semantic/Graph.hs        |   2 +-
 src/Semantic/IO.hs           | 131 ++---------------------------------
 src/Semantic/Resolution.hs   |   2 +-
 src/Semantic/Task.hs         |  18 ++---
 9 files changed, 167 insertions(+), 141 deletions(-)
 create mode 100644 src/Data/Handle.hs
 create mode 100644 src/Semantic/Effect/Files.hs

diff --git a/semantic.cabal b/semantic.cabal
index 4475042d7..40c9af96e 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -78,6 +78,7 @@ library
                      , Data.Graph
                      , Data.Graph.AdjList
                      , Data.Graph.Vertex
+                     , Data.Handle
                      , Data.JSON.Fields
                      , Data.Language
                      , Data.Map.Monoidal
@@ -154,6 +155,7 @@ library
                      , Semantic.CLI
                      , Semantic.Diff
                      , Semantic.Distribute
+                     , Semantic.Effect.Files
                      , Semantic.Env
                      , Semantic.Graph
                      , Semantic.IO
diff --git a/src/Data/Handle.hs b/src/Data/Handle.hs
new file mode 100644
index 000000000..5c6a02d11
--- /dev/null
+++ b/src/Data/Handle.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE GADTs #-}
+
+module Data.Handle
+  ( Handle (..)
+  , IO.IOMode (..)
+  , getHandle
+  , stdin
+  , stdout
+  , stderr
+  , openFileForReading
+  ) where
+
+import qualified System.IO as IO
+
+data Handle mode where
+  ReadHandle  :: IO.Handle -> Handle 'IO.ReadMode
+  WriteHandle :: IO.Handle -> Handle 'IO.WriteMode
+
+deriving instance Eq   (Handle mode)
+deriving instance Show (Handle mode)
+
+getHandle :: Handle mode -> IO.Handle
+getHandle (ReadHandle  handle) = handle
+getHandle (WriteHandle handle) = handle
+
+stdin :: Handle 'IO.ReadMode
+stdin = ReadHandle IO.stdin
+
+stdout :: Handle 'IO.WriteMode
+stdout = WriteHandle IO.stdout
+
+stderr :: Handle 'IO.WriteMode
+stderr = WriteHandle IO.stderr
+
+openFileForReading :: FilePath -> IO (Handle 'IO.ReadMode)
+openFileForReading path = ReadHandle <$> IO.openFile path IO.ReadMode
+
diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 8ad708b39..b740d9a1d 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -22,6 +22,7 @@ import Foreign
 import Foreign.C.Types (CBool (..))
 import Foreign.Marshal.Array (allocaArray)
 import Semantic.IO hiding (Source)
+import Semantic.Effect.Files (catchException)
 import System.Timeout
 
 import qualified TreeSitter.Language as TS
diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index c92f8bbaf..3a34a5f12 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -7,6 +7,7 @@ module Semantic.CLI
 , Parse.runParse
 ) where
 
+
 import           Data.Project
 import           Data.Language (ensureLanguage)
 import           Data.List (intercalate)
@@ -24,6 +25,7 @@ import           Semantic.IO as IO
 import qualified Semantic.Log as Log
 import qualified Semantic.Parse as Parse
 import qualified Semantic.Task as Task
+import           Semantic.Effect.Files
 import           Serializing.Format
 import           Text.Read
 
diff --git a/src/Semantic/Effect/Files.hs b/src/Semantic/Effect/Files.hs
new file mode 100644
index 000000000..3fa50f613
--- /dev/null
+++ b/src/Semantic/Effect/Files.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Semantic.Effect.Files
+  ( Source (..)
+  , Destination (..)
+  , Files (..)
+  , catchException
+  , findFiles
+  , readBlob
+  , readBlobPairs
+  , readBlobs
+  , readProject
+  , runFiles
+  , runFilesGuided
+  , write
+  ) where
+
+import qualified Control.Exception as Exc
+import           Control.Monad.Effect
+import           Control.Monad.Effect.Exception
+import           Control.Monad.Effect.State
+import           Control.Monad.IO.Class
+import           Data.Blob
+import qualified Data.ByteString.Builder as B
+import           Data.Handle
+import           Data.Language
+import           Data.Project (File (..), ProjectException (..))
+import qualified Data.Project as Project
+import           Prelude hiding (readFile)
+import           Prologue hiding (MonadError (..), fail)
+import qualified System.IO as IO
+import           Semantic.IO
+
+data Source blob where
+  FromPath       :: File                -> Source Blob
+  FromHandle     :: Handle 'IO.ReadMode -> Source [Blob]
+  FromPathPair   :: Both File           -> Source BlobPair
+  FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair]
+
+data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
+
+-- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
+data Files out where
+  Read        :: Source out -> Files out
+  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project.Concrete
+  FindFiles   :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
+  Write       :: Destination -> B.Builder -> Files ()
+
+readBlob :: Member Files effs => File -> Eff effs Blob
+readBlob = send . Read . FromPath
+
+-- | A task which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
+readBlobs :: Member Files effs => Either (Handle 'IO.ReadMode) [File] -> Eff effs [Blob]
+readBlobs (Left handle) = send (Read (FromHandle handle))
+readBlobs (Right paths) = traverse (send . Read . FromPath) paths
+
+-- | A task which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
+readBlobPairs :: Member Files effs => Either (Handle 'IO.ReadMode) [Both File] -> Eff effs [BlobPair]
+readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
+readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
+
+readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project.Concrete
+readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
+
+findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
+findFiles dir exts = send . FindFiles dir exts
+
+-- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'.
+write :: Member Files effs => Destination -> B.Builder -> Eff effs ()
+write dest = send . Write dest
+
+
+-- | Run a 'Files' effect in 'IO'.
+runFiles :: (Member (Exc SomeException) effs, Member IO effs) => Eff (Files ': effs) a -> Eff effs a
+runFiles = interpret $ \ files -> case files of
+  Read (FromPath path)         -> rethrowing (readBlobFromPath path)
+  Read (FromHandle handle)     -> rethrowing (readBlobsFromHandle handle)
+  Read (FromPathPair paths)    -> rethrowing (runBothWith readFilePair paths)
+  Read (FromPairHandle handle) -> rethrowing (readBlobPairsFromHandle handle)
+  ReadProject rootDir dir language excludeDirs -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs)
+  FindFiles dir exts excludeDirs -> rethrowing (findFilesInDir dir exts excludeDirs)
+  Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
+  Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
+
+runFilesGuided :: (Member (State Project.Concrete) effs, Member (Exc SomeException) effs) => Eff (Files ': effs) a -> Eff effs a
+runFilesGuided = interpret $ \files -> case files of
+  Read (FromHandle _)            -> throwError (SomeException HandleNotSupported)
+  Read (FromPairHandle _)        -> throwError (SomeException HandleNotSupported)
+  Write _ _                      -> throwError (SomeException WritesNotSupported)
+  Read (FromPath path)           -> get >>= \p -> Project.readBlobFromPath p path
+  Read (FromPathPair paths)      -> get >>= \p -> runBothWith (Project.readBlobPair p) paths
+  FindFiles dir exts excludeDirs -> get >>= \p -> pure (Project.findFiles (p { Project.projectExcludeDirs = excludeDirs }) dir exts)
+  ReadProject{}                  -> get
+
+-- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
+--
+--   Note that while the type allows 'IO' to occur anywhere within the effect list, it must actually occur at the end to be able to run the computation.
+catchException :: ( Exc.Exception e
+                  , Member IO r
+                  )
+               => Eff r a
+               -> (e -> Eff r a)
+               -> Eff r a
+catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m
+
+-- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect.
+rethrowing :: ( Member (Exc SomeException) r
+              , Member IO r
+              )
+           => IO a
+           -> Eff r a
+rethrowing m = catchException (liftIO m) (throwError . toException @SomeException)
diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index 55b8ecb6c..7097fa801 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -34,7 +34,7 @@ import           Data.Term
 import           Data.Text (pack)
 import           Parsing.Parser
 import           Prologue hiding (MonadError (..))
-import           Semantic.IO (Files)
+import           Semantic.Effect.Files
 import           Semantic.Task as Task
 
 data GraphType = ImportGraph | CallGraph
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index 62d0a9660..07f7daafd 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -1,53 +1,31 @@
 {-# LANGUAGE DeriveAnyClass, DeriveDataTypeable, DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
 module Semantic.IO
-( Destination(..)
-, Files
-, Handle(..)
-, IO.IOMode(..)
+( module X
 , NoLanguageForBlob(..)
-, Source(..)
-, catchException
-, findFiles
 , findFilesInDir
-, getHandle
 , isDirectory
 , languageForFilePath
 , noLanguageForBlob
-, openFileForReading
-, readBlob
 , readBlobFromPath
-, readBlobPairs
 , readBlobPairsFromHandle
-, readBlobs
 , readBlobsFromDir
 , readBlobsFromHandle
 , decodeBlobPairs
 , decodeBlobs
 , readFile
 , readFilePair
-, readProject
 , readProjectFromPaths
-, rethrowing
-, runFiles
-, runFilesGuided
-, stderr
-, stdin
-, stdout
-, write
 ) where
 
-import qualified Control.Exception as Exc
 import           Control.Monad.Effect
-import           Control.Monad.Effect.State
 import           Control.Monad.Effect.Exception
 import           Control.Monad.IO.Class
 import           Data.Aeson
 import           Data.Blob
 import           Data.Bool
 import qualified Data.Project as Project
-import           Data.Project (File (..), ProjectException (..))
+import           Data.Project (File (..))
 import qualified Data.ByteString as B
-import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
 import           Data.Language
 import           Data.Source (fromUTF8)
@@ -61,6 +39,8 @@ import           System.FilePath
 import           System.FilePath.Glob
 import qualified System.IO as IO
 
+import           Data.Handle as X
+
 -- | Read a utf8-encoded file to a 'Blob'.
 readFile :: forall m. MonadIO m => File -> m (Maybe Blob)
 readFile (File "/dev/null" _) = pure Nothing
@@ -166,106 +146,3 @@ newtype NoLanguageForBlob = NoLanguageForBlob FilePath
 
 noLanguageForBlob :: Member (Exc SomeException) effs => FilePath -> Eff effs a
 noLanguageForBlob blobPath = throwError (SomeException (NoLanguageForBlob blobPath))
-
-
-readBlob :: Member Files effs => File -> Eff effs Blob
-readBlob = send . Read . FromPath
-
--- | A task which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
-readBlobs :: Member Files effs => Either (Handle 'IO.ReadMode) [File] -> Eff effs [Blob]
-readBlobs (Left handle) = send (Read (FromHandle handle))
-readBlobs (Right paths) = traverse (send . Read . FromPath) paths
-
--- | A task which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
-readBlobPairs :: Member Files effs => Either (Handle 'IO.ReadMode) [Both File] -> Eff effs [BlobPair]
-readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
-readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
-
-readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project.Concrete
-readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
-
-findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
-findFiles dir exts = send . FindFiles dir exts
-
--- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'.
-write :: Member Files effs => Destination -> B.Builder -> Eff effs ()
-write dest = send . Write dest
-
-data Handle mode where
-  ReadHandle  :: IO.Handle -> Handle 'IO.ReadMode
-  WriteHandle :: IO.Handle -> Handle 'IO.WriteMode
-
-deriving instance Eq   (Handle mode)
-deriving instance Show (Handle mode)
-
-getHandle :: Handle mode -> IO.Handle
-getHandle (ReadHandle  handle) = handle
-getHandle (WriteHandle handle) = handle
-
-stdin :: Handle 'IO.ReadMode
-stdin = ReadHandle IO.stdin
-
-stdout :: Handle 'IO.WriteMode
-stdout = WriteHandle IO.stdout
-
-stderr :: Handle 'IO.WriteMode
-stderr = WriteHandle IO.stderr
-
-openFileForReading :: FilePath -> IO (Handle 'IO.ReadMode)
-openFileForReading path = ReadHandle <$> IO.openFile path IO.ReadMode
-
-data Source blob where
-  FromPath       :: File                -> Source Blob
-  FromHandle     :: Handle 'IO.ReadMode -> Source [Blob]
-  FromPathPair   :: Both File           -> Source BlobPair
-  FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair]
-
-data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
-
--- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
-data Files out where
-  Read        :: Source out -> Files out
-  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project.Concrete
-  FindFiles   :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
-  Write       :: Destination -> B.Builder -> Files ()
-
--- | Run a 'Files' effect in 'IO'.
-runFiles :: (Member (Exc SomeException) effs, Member IO effs) => Eff (Files ': effs) a -> Eff effs a
-runFiles = interpret $ \ files -> case files of
-  Read (FromPath path)         -> rethrowing (readBlobFromPath path)
-  Read (FromHandle handle)     -> rethrowing (readBlobsFromHandle handle)
-  Read (FromPathPair paths)    -> rethrowing (runBothWith readFilePair paths)
-  Read (FromPairHandle handle) -> rethrowing (readBlobPairsFromHandle handle)
-  ReadProject rootDir dir language excludeDirs -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs)
-  FindFiles dir exts excludeDirs -> rethrowing (findFilesInDir dir exts excludeDirs)
-  Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
-  Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
-
-runFilesGuided :: (Member (State Project.Concrete) effs, Member (Exc SomeException) effs) => Eff (Files ': effs) a -> Eff effs a
-runFilesGuided = interpret $ \files -> case files of
-  Read (FromHandle _)            -> throwError (SomeException HandleNotSupported)
-  Read (FromPairHandle _)        -> throwError (SomeException HandleNotSupported)
-  Write _ _                      -> throwError (SomeException WritesNotSupported)
-  Read (FromPath path)           -> get >>= \p -> Project.readBlobFromPath p path
-  Read (FromPathPair paths)      -> get >>= \p -> runBothWith (Project.readBlobPair p) paths
-  FindFiles dir exts excludeDirs -> get >>= \p -> pure (Project.findFiles (p { Project.projectExcludeDirs = excludeDirs }) dir exts)
-  ReadProject{}                  -> get
-
--- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
---
---   Note that while the type allows 'IO' to occur anywhere within the effect list, it must actually occur at the end to be able to run the computation.
-catchException :: ( Exc.Exception e
-                  , Member IO r
-                  )
-               => Eff r a
-               -> (e -> Eff r a)
-               -> Eff r a
-catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m
-
--- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect.
-rethrowing :: ( Member (Exc SomeException) r
-              , Member IO r
-              )
-           => IO a
-           -> Eff r a
-rethrowing m = catchException (liftIO m) (throwError . toException @SomeException)
diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs
index 3eda55ad6..22ec7f2c0 100644
--- a/src/Semantic/Resolution.hs
+++ b/src/Semantic/Resolution.hs
@@ -11,7 +11,7 @@ import qualified Data.Map as Map
 import           Data.Source
 import           Data.Language
 import           Prologue
-import           Semantic.IO
+import           Semantic.Effect.Files
 import           System.FilePath.Posix
 
 
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index 166cd8b30..b0043e786 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -6,13 +6,7 @@ module Semantic.Task
 , WrappedTask'(..)
 , Level(..)
 , RAlgebra
--- * I/O
-, IO.readBlob
-, IO.readBlobs
-, IO.readBlobPairs
-, IO.readProject
-, IO.findFiles
-, IO.write
+, module Semantic.Effect.Files
 -- * Module Resolution
 , resolutionMap
 , Resolution
@@ -76,7 +70,7 @@ import           Parsing.Parser
 import           Parsing.TreeSitter
 import           Prologue hiding (MonadError (..), project)
 import           Semantic.Distribute
-import qualified Semantic.IO as IO
+import           Semantic.Effect.Files
 import           Semantic.Resolution
 import           Semantic.Log
 import           Semantic.Queue
@@ -90,7 +84,7 @@ import           System.IO (stderr)
 type TaskEff = Eff '[Distribute WrappedTask
                     , Task
                     , Resolution
-                    , IO.Files
+                    , Files
                     , Reader Options
                     , Trace
                     , Telemetry
@@ -100,7 +94,7 @@ type TaskEff = Eff '[Distribute WrappedTask
 type TaskEff' = Eff '[Distribute WrappedTask'
                      , Task
                      , Resolution
-                     , IO.Files
+                     , Files
                      , State Concrete
                      , Reader Options
                      , Trace
@@ -170,7 +164,7 @@ runTaskWithOptions' options logger statter task = do
                    . runTelemetry logger statter
                    . runTraceInTelemetry
                    . runReader options
-                   . IO.runFiles
+                   . runFiles
                    . runResolution
                    . runTaskF
                    . runDistribute (run . unwrapTask)
@@ -192,7 +186,7 @@ runTaskWithProject proj options task = do
                    . runTraceInTelemetry
                    . runReader options
                    . runState proj
-                   . IO.runFilesGuided
+                   . runFilesGuided
                    . runResolution
                    . runTaskF
                    . runDistribute (run . unwrapTask')

From c950e3af371e683ecc419b54743483dbff14a127 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 11:34:40 -0400
Subject: [PATCH 16/34] huge simplifications

---
 src/Data/Project.hs          | 36 +++++++++--------
 src/Semantic/Effect/Files.hs | 11 ------
 src/Semantic/Graph.hs        | 76 ++++++------------------------------
 src/Semantic/Task.hs         | 44 ---------------------
 4 files changed, 33 insertions(+), 134 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 4ec53d61f..4a8e9103a 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -1,6 +1,24 @@
 {-# LANGUAGE DeriveAnyClass, KindSignatures, MultiWayIf #-}
 
-module Data.Project where
+module Data.Project (
+  -- * Projects
+    Project (..)
+  , Concrete
+  , PB
+  , ProjectException (..)
+  , fromPB
+  , projectExtensions
+  , projectName
+  , projectEntryPoints
+  , projectFiles
+  , readFile
+  , readBlobFromPath
+  , readBlobPair
+  , addPrelude
+  -- * Files
+  , File (..)
+  , file
+  , )where
 
 import Prelude hiding (readFile)
 import Prologue hiding (throwError)
@@ -45,7 +63,7 @@ deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (Pro
 type Concrete = Project [] [] FilePath
 
 -- | This 'Project' type is protobuf-compatible, and corresponds with
--- the @Project@ message declaration present in types.proto. 
+-- the @Project@ message declaration present in types.proto.
 type PB = Project NestedVec UnpackedVec Text
 
 -- | Convert from a packed protobuf representatio nto a more useful one.
@@ -140,17 +158,3 @@ maybeThese a b = case (a, b) of
   (Nothing, Just b) -> pure (That b)
   (Just a, Just b)  -> pure (These a b)
   _                 -> throwError (SomeException EmptyPairProvided)
-
--- TODO: write some tests so we can be sure this actually works
--- and does what findFileInDir does
-findFiles :: Concrete
-          -> FilePath
-          -> [String]
-          -> [FilePath]
-findFiles Project{..} dir exts = do
-  p <- blobPath <$> projectBlobs
-  guard (p == dir)
-  guard (takeExtension p `elem` exts)
-  -- TODO: not clear to me the best way to ensure these are in the
-  -- exclude directories
-  pure p
diff --git a/src/Semantic/Effect/Files.hs b/src/Semantic/Effect/Files.hs
index 3fa50f613..35ba662e2 100644
--- a/src/Semantic/Effect/Files.hs
+++ b/src/Semantic/Effect/Files.hs
@@ -12,7 +12,6 @@ module Semantic.Effect.Files
   , readBlobs
   , readProject
   , runFiles
-  , runFilesGuided
   , write
   ) where
 
@@ -83,16 +82,6 @@ runFiles = interpret $ \ files -> case files of
   Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
   Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
 
-runFilesGuided :: (Member (State Project.Concrete) effs, Member (Exc SomeException) effs) => Eff (Files ': effs) a -> Eff effs a
-runFilesGuided = interpret $ \files -> case files of
-  Read (FromHandle _)            -> throwError (SomeException HandleNotSupported)
-  Read (FromPairHandle _)        -> throwError (SomeException HandleNotSupported)
-  Write _ _                      -> throwError (SomeException WritesNotSupported)
-  Read (FromPath path)           -> get >>= \p -> Project.readBlobFromPath p path
-  Read (FromPathPair paths)      -> get >>= \p -> runBothWith (Project.readBlobPair p) paths
-  FindFiles dir exts excludeDirs -> get >>= \p -> pure (Project.findFiles (p { Project.projectExcludeDirs = excludeDirs }) dir exts)
-  ReadProject{}                  -> get
-
 -- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
 --
 --   Note that while the type allows 'IO' to occur anywhere within the effect list, it must actually occur at the end to be able to run the computation.
diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index 7097fa801..498c424f5 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE GADTs, TypeOperators #-}
 module Semantic.Graph
 ( runGraph
-, runGraph'
 , GraphType(..)
 , Graph
 , Vertex
@@ -28,7 +27,7 @@ import           Data.Abstract.Package as Package
 import           Data.Abstract.Value (Value, ValueError (..), runValueErrorWith)
 import           Data.Graph
 import           Data.Project
-import qualified Data.Project as Project (Concrete)
+import qualified Data.Project as Project (readFile, Concrete)
 import           Data.Record
 import           Data.Term
 import           Data.Text (pack)
@@ -39,7 +38,7 @@ import           Semantic.Task as Task
 
 data GraphType = ImportGraph | CallGraph
 
-runGraph :: ( Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
+runGraph :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs, Member Resolution effs, Member Task effs, Member Trace effs)
          => GraphType
          -> Bool
          -> Project.Concrete
@@ -70,14 +69,14 @@ runGraph graphType includePackages project
             . graphing
 
 -- | Parse a list of files into a 'Package'.
-parsePackage :: (Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
+parsePackage :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs,  Member Resolution effs, Member Task effs, Member Trace effs)
              => Parser term -- ^ A parser.
              -> Maybe File  -- ^ Prelude (optional).
              -> Project.Concrete     -- ^ Project to parse into a package.
              -> Eff effs (Package term)
 parsePackage parser preludeFile project@Project{..} = do
-  prelude <- traverse (parseModule parser Nothing) preludeFile
-  p <- parseModules parser project
+  prelude <- traverse (parseModule project parser) preludeFile
+  p <- parseModules parser
   resMap <- Task.resolutionMap project
   let pkg = Package.fromModules n Nothing prelude (length projectEntryPaths) p resMap
   pkg <$ trace ("project: " <> show pkg)
@@ -86,65 +85,16 @@ parsePackage parser preludeFile project@Project{..} = do
     n = name (projectName project)
 
     -- | Parse all files in a project into 'Module's.
-    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project.Concrete -> Eff effs [Module term]
-    parseModules parser Project{..} = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule parser (Just projectRootDir))
-
-runGraph' :: ( Member (Distribute WrappedTask') effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
-         => GraphType
-         -> Bool
-         -> Project.Concrete
-         -> Eff effs (Graph Vertex)
-runGraph' graphType includePackages project
-  | SomeAnalysisParser parser prelude <- someAnalysisParser
-    (Proxy :: Proxy '[ Evaluatable, Declarations1, FreeVariables1, Functor, Eq1, Ord1, Show1 ]) (projectLanguage project) = do
-    package <- parsePackage' parser prelude project
-    let analyzeTerm = withTermSpans . case graphType of
-          ImportGraph -> id
-          CallGraph   -> graphingTerms
-        analyzeModule = (if includePackages then graphingPackages else id) . graphingModules
-    analyze runGraphAnalysis (evaluatePackageWith analyzeModule analyzeTerm package) >>= extractGraph
-    where extractGraph result = case result of
-            (((_, graph), _), _) -> pure (simplify graph)
-          runGraphAnalysis
-            = run
-            . evaluating
-            . runIgnoringTrace
-            . resumingLoadError
-            . resumingUnspecialized
-            . resumingEnvironmentError
-            . resumingEvalError
-            . resumingResolutionError
-            . resumingAddressError
-            . resumingValueError
-            . runTermEvaluator @_ @_ @(Value (Hole (Located Precise)) (Eff _))
-            . graphing
-
--- | Parse a list of files into a 'Package'.
-parsePackage' :: (Member (Distribute WrappedTask') effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
-             => Parser term -- ^ A parser.
-             -> Maybe File  -- ^ Prelude (optional).
-             -> Project.Concrete     -- ^ Project to parse into a package.
-             -> Eff effs (Package term)
-parsePackage' parser preludeFile project@Project{..} = do
-  prelude <- traverse (parseModule parser Nothing) preludeFile
-  p <- parseModules parser project
-  resMap <- Task.resolutionMap project
-  let pkg = Package.fromModules n Nothing prelude (length projectEntryPaths) p resMap
-  pkg <$ trace ("project: " <> show pkg)
-
-  where
-    n = name (projectName project)
-
-    -- | Parse all files in a project into 'Module's.
-    parseModules :: Member (Distribute WrappedTask') effs => Parser term -> Project.Concrete -> Eff effs [Module term]
-    parseModules parser Project{..} = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask' . parseModule parser (Just projectRootDir))
+    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Eff effs [Module term]
+    parseModules parser = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule project parser)
 
 -- | Parse a file into a 'Module'.
-parseModule :: (Member Files effs, Member Task effs) => Parser term -> Maybe FilePath -> File -> Eff effs (Module term)
-parseModule parser rootDir file = do
-  blob <- readBlob file
-  moduleForBlob rootDir blob <$> parse parser blob
-
+parseModule :: (Member (Exc SomeException) effs, Member Task effs) => Project.Concrete -> Parser term -> File -> Eff effs (Module term)
+parseModule proj parser file = do
+  mBlob <- Project.readFile proj file
+  case mBlob of
+    Just blob -> moduleForBlob (Just (projectRootDir proj)) blob <$> parse parser blob
+    Nothing   -> error ("file not found: " <> show file)
 
 withTermSpans :: ( HasField fields Span
                  , Member (Reader Span) effects
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index b0043e786..d66a0792f 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -3,7 +3,6 @@ module Semantic.Task
 ( Task
 , TaskEff
 , WrappedTask(..)
-, WrappedTask'(..)
 , Level(..)
 , RAlgebra
 , module Semantic.Effect.Files
@@ -33,7 +32,6 @@ module Semantic.Task
 -- * Interpreting
 , runTask
 , runTaskWithOptions
-, runTaskWithProject
 , runTaskWithOptions'
 -- * Re-exports
 , Distribute
@@ -91,25 +89,10 @@ type TaskEff = Eff '[Distribute WrappedTask
                     , Exc SomeException
                     , IO]
 
-type TaskEff' = Eff '[Distribute WrappedTask'
-                     , Task
-                     , Resolution
-                     , Files
-                     , State Concrete
-                     , Reader Options
-                     , Trace
-                     , Telemetry
-                     , Exc SomeException
-                     , IO]
-
 -- | A wrapper for a 'Task', to embed in other effects.
 newtype WrappedTask a = WrapTask { unwrapTask :: TaskEff a }
   deriving (Applicative, Functor, Monad)
 
--- | A wrapper for a 'Task', to embed in other effects.
-newtype WrappedTask' a = WrapTask' { unwrapTask' :: TaskEff' a }
-  deriving (Applicative, Functor, Monad)
-
 -- | A function to render terms or diffs.
 type Renderer i o = i -> o
 
@@ -172,33 +155,6 @@ runTaskWithOptions' options logger statter task = do
   queue statter stat
   pure result
 
--- | Execute a 'TaskEff' with the passed 'Options', yielding its result value in 'IO'.
-runTaskWithProject :: Concrete -> Options -> TaskEff' a -> IO a
-runTaskWithProject proj options task = do
-  options <- configureOptionsForHandle stderr options
-  statter <- defaultStatsClient >>= newQueue sendStat
-  logger <- newQueue logMessage options
-
-  (result, stat) <- withTiming "run" [] $ do
-    let run :: TaskEff' a -> IO (Either SomeException a)
-        run = fmap (fmap fst) . runM . runError
-                   . runTelemetry logger statter
-                   . runTraceInTelemetry
-                   . runReader options
-                   . runState proj
-                   . runFilesGuided
-                   . runResolution
-                   . runTaskF
-                   . runDistribute (run . unwrapTask')
-    run task
-  queue statter stat
-
-  closeQueue statter
-  closeStatClient (asyncQueueExtra statter)
-  closeQueue logger
-  either (die . displayException) pure result
-
-
 runTraceInTelemetry :: Member Telemetry effects => Eff (Trace ': effects) a -> Eff effects a
 runTraceInTelemetry = interpret (\ (Trace str) -> writeLog Debug str [])
 

From 17d673f57486eb9a533aa4aba726416e882ddff3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 11:35:37 -0400
Subject: [PATCH 17/34] WIP

---
 src/Semantic/Util.hs | 95 +++++++++++++++++++++-----------------------
 1 file changed, 45 insertions(+), 50 deletions(-)

diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index c538f35ad..19393533b 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -33,61 +33,56 @@ import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Language.TypeScript.Assignment as TypeScript
 
--- justEvaluating
---   = runM
---   . evaluating
---   . runPrintingTrace
---   . fmap reassociate
---   . runLoadError
---   . runUnspecialized
---   . runResolutionError
---   . runEnvironmentError
---   . runEvalError
---   . runAddressError
---   . runTermEvaluator @_ @Precise @(Value Precise (Eff _))
---   . runValueError
+justEvaluating
+  = runM
+  . evaluating
+  . runPrintingTrace
+  . fmap reassociate
+  . runLoadError
+  . runUnspecialized
+  . runResolutionError
+  . runEnvironmentError
+  . runEvalError
+  . runAddressError
+  . runTermEvaluator @_ @Precise @(Value Precise (Eff _))
+  . runValueError
 
--- checking
---   = runM @_ @IO
---   . evaluating
---   . runPrintingTrace
---   . runTermEvaluator @_ @Monovariant @Type
---   . caching @[]
---   . providingLiveSet
---   . fmap reassociate
---   . runLoadError
---   . runUnspecialized
---   . runResolutionError
---   . runEnvironmentError
---   . runEvalError
---   . runAddressError
---   . runTypeError
+checking
+  = runM @_ @IO
+  . evaluating
+  . runPrintingTrace
+  . runTermEvaluator @_ @Monovariant @Type
+  . caching @[]
+  . providingLiveSet
+  . fmap reassociate
+  . runLoadError
+  . runUnspecialized
+  . runResolutionError
+  . runEnvironmentError
+  . runEvalError
+  . runAddressError
+  . runTypeError
 
--- evalGoProject path = justEvaluating =<< evaluateProject goParser Language.Go Nothing path
--- evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ruby rubyPrelude path
--- evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path
--- evalPythonProject path = justEvaluating =<< evaluateProject pythonParser Language.Python pythonPrelude path
--- evalJavaScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.JavaScript javaScriptPrelude path
--- evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.TypeScript Nothing path
+evalGoProject path = justEvaluating =<< evaluateProject goParser Language.Go Nothing path
+evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ruby rubyPrelude path
+evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path
+evalPythonProject path = justEvaluating =<< evaluateProject pythonParser Language.Python pythonPrelude path
+evalJavaScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.JavaScript javaScriptPrelude path
+evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.TypeScript Nothing path
 
--- typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path
+typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path
 
--- rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby
--- pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python
--- javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
+rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby
+pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python
+javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
 
--- -- Evaluate a project, starting at a single entrypoint.
--- evaluateProject :: a -> -
--- evaluateProject = undefined
--- evaluateProjectWithCaching :: a -> b
--- evaluateProjectWithCaching = undefined
--- evaluateProject :: _
--- evaluateProject parser lang prelude path = do
---   proj <- readProject Nothing path lang []
---   evaluatePackageWith id withTermSpans proj . fmap quieterm <$> runTask' (parsePackage parser prelude proj)
--- evaluateProjectWithCaching parser lang prelude path = do
---   proj <- readProject Nothing path lang []
---   evaluatePackageWith convergingModules (withTermSpans . cachingTerms) proj . fmap quieterm <$> runTask (parsePackage parser prelude)
+-- Evaluate a project, starting at a single entrypoint.
+evaluateProject parser lang prelude path = do
+  proj <- readProject Nothing path lang []
+  evaluatePackageWith id withTermSpans proj . fmap quieterm <$> runTask' (parsePackage parser prelude proj)
+evaluateProjectWithCaching parser lang prelude path = do
+  proj <- readProject Nothing path lang []
+  evaluatePackageWith convergingModules (withTermSpans . cachingTerms) proj . fmap quieterm <$> runTask (parsePackage parser prelude)
 
 
 parseFile :: Parser term -> FilePath -> IO term

From 38be12425892f1c9ac3233e5170858129ff508c1 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 11:40:53 -0400
Subject: [PATCH 18/34] Revert "split up Semantic.IO into Data.Handle and
 Semantic.Effect.Files"

This reverts commit c0064862e756a1064dc29631f94e007d9bdfb10b.
---
 semantic.cabal             |   2 -
 src/Data/Handle.hs         |  37 ------------
 src/Parsing/TreeSitter.hs  |   1 -
 src/Semantic/CLI.hs        |   2 -
 src/Semantic/Graph.hs      |   2 +-
 src/Semantic/IO.hs         | 120 +++++++++++++++++++++++++++++++++++--
 src/Semantic/Resolution.hs |   2 +-
 src/Semantic/Task.hs       |  14 +++--
 src/Semantic/Util.hs       |  10 +---
 9 files changed, 131 insertions(+), 59 deletions(-)
 delete mode 100644 src/Data/Handle.hs

diff --git a/semantic.cabal b/semantic.cabal
index 40c9af96e..4475042d7 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -78,7 +78,6 @@ library
                      , Data.Graph
                      , Data.Graph.AdjList
                      , Data.Graph.Vertex
-                     , Data.Handle
                      , Data.JSON.Fields
                      , Data.Language
                      , Data.Map.Monoidal
@@ -155,7 +154,6 @@ library
                      , Semantic.CLI
                      , Semantic.Diff
                      , Semantic.Distribute
-                     , Semantic.Effect.Files
                      , Semantic.Env
                      , Semantic.Graph
                      , Semantic.IO
diff --git a/src/Data/Handle.hs b/src/Data/Handle.hs
deleted file mode 100644
index 5c6a02d11..000000000
--- a/src/Data/Handle.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE GADTs #-}
-
-module Data.Handle
-  ( Handle (..)
-  , IO.IOMode (..)
-  , getHandle
-  , stdin
-  , stdout
-  , stderr
-  , openFileForReading
-  ) where
-
-import qualified System.IO as IO
-
-data Handle mode where
-  ReadHandle  :: IO.Handle -> Handle 'IO.ReadMode
-  WriteHandle :: IO.Handle -> Handle 'IO.WriteMode
-
-deriving instance Eq   (Handle mode)
-deriving instance Show (Handle mode)
-
-getHandle :: Handle mode -> IO.Handle
-getHandle (ReadHandle  handle) = handle
-getHandle (WriteHandle handle) = handle
-
-stdin :: Handle 'IO.ReadMode
-stdin = ReadHandle IO.stdin
-
-stdout :: Handle 'IO.WriteMode
-stdout = WriteHandle IO.stdout
-
-stderr :: Handle 'IO.WriteMode
-stderr = WriteHandle IO.stderr
-
-openFileForReading :: FilePath -> IO (Handle 'IO.ReadMode)
-openFileForReading path = ReadHandle <$> IO.openFile path IO.ReadMode
-
diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index b740d9a1d..8ad708b39 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -22,7 +22,6 @@ import Foreign
 import Foreign.C.Types (CBool (..))
 import Foreign.Marshal.Array (allocaArray)
 import Semantic.IO hiding (Source)
-import Semantic.Effect.Files (catchException)
 import System.Timeout
 
 import qualified TreeSitter.Language as TS
diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 3a34a5f12..c92f8bbaf 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -7,7 +7,6 @@ module Semantic.CLI
 , Parse.runParse
 ) where
 
-
 import           Data.Project
 import           Data.Language (ensureLanguage)
 import           Data.List (intercalate)
@@ -25,7 +24,6 @@ import           Semantic.IO as IO
 import qualified Semantic.Log as Log
 import qualified Semantic.Parse as Parse
 import qualified Semantic.Task as Task
-import           Semantic.Effect.Files
 import           Serializing.Format
 import           Text.Read
 
diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index 498c424f5..5da1e009e 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -33,7 +33,7 @@ import           Data.Term
 import           Data.Text (pack)
 import           Parsing.Parser
 import           Prologue hiding (MonadError (..))
-import           Semantic.Effect.Files
+import           Semantic.IO (Files)
 import           Semantic.Task as Task
 
 data GraphType = ImportGraph | CallGraph
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index 07f7daafd..85bf1be2e 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -1,31 +1,52 @@
 {-# LANGUAGE DeriveAnyClass, DeriveDataTypeable, DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
 module Semantic.IO
-( module X
+( Destination(..)
+, Files
+, Handle(..)
+, IO.IOMode(..)
 , NoLanguageForBlob(..)
+, Source(..)
+, catchException
+, findFiles
 , findFilesInDir
+, getHandle
 , isDirectory
 , languageForFilePath
 , noLanguageForBlob
+, openFileForReading
+, readBlob
 , readBlobFromPath
+, readBlobPairs
 , readBlobPairsFromHandle
+, readBlobs
 , readBlobsFromDir
 , readBlobsFromHandle
 , decodeBlobPairs
 , decodeBlobs
 , readFile
 , readFilePair
+, readProject
 , readProjectFromPaths
+, rethrowing
+, runFiles
+, stderr
+, stdin
+, stdout
+, write
 ) where
 
+import qualified Control.Exception as Exc
 import           Control.Monad.Effect
+import           Control.Monad.Effect.State
 import           Control.Monad.Effect.Exception
 import           Control.Monad.IO.Class
 import           Data.Aeson
 import           Data.Blob
 import           Data.Bool
 import qualified Data.Project as Project
-import           Data.Project (File (..))
+import           Data.Project (File (..), ProjectException (..))
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
 import           Data.Language
 import           Data.Source (fromUTF8)
@@ -39,8 +60,6 @@ import           System.FilePath
 import           System.FilePath.Glob
 import qualified System.IO as IO
 
-import           Data.Handle as X
-
 -- | Read a utf8-encoded file to a 'Blob'.
 readFile :: forall m. MonadIO m => File -> m (Maybe Blob)
 readFile (File "/dev/null" _) = pure Nothing
@@ -146,3 +165,96 @@ newtype NoLanguageForBlob = NoLanguageForBlob FilePath
 
 noLanguageForBlob :: Member (Exc SomeException) effs => FilePath -> Eff effs a
 noLanguageForBlob blobPath = throwError (SomeException (NoLanguageForBlob blobPath))
+
+
+readBlob :: Member Files effs => File -> Eff effs Blob
+readBlob = send . Read . FromPath
+
+-- | A task which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
+readBlobs :: Member Files effs => Either (Handle 'IO.ReadMode) [File] -> Eff effs [Blob]
+readBlobs (Left handle) = send (Read (FromHandle handle))
+readBlobs (Right paths) = traverse (send . Read . FromPath) paths
+
+-- | A task which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
+readBlobPairs :: Member Files effs => Either (Handle 'IO.ReadMode) [Both File] -> Eff effs [BlobPair]
+readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
+readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
+
+readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project.Concrete
+readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
+
+findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
+findFiles dir exts = send . FindFiles dir exts
+
+-- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'.
+write :: Member Files effs => Destination -> B.Builder -> Eff effs ()
+write dest = send . Write dest
+
+data Handle mode where
+  ReadHandle  :: IO.Handle -> Handle 'IO.ReadMode
+  WriteHandle :: IO.Handle -> Handle 'IO.WriteMode
+
+deriving instance Eq   (Handle mode)
+deriving instance Show (Handle mode)
+
+getHandle :: Handle mode -> IO.Handle
+getHandle (ReadHandle  handle) = handle
+getHandle (WriteHandle handle) = handle
+
+stdin :: Handle 'IO.ReadMode
+stdin = ReadHandle IO.stdin
+
+stdout :: Handle 'IO.WriteMode
+stdout = WriteHandle IO.stdout
+
+stderr :: Handle 'IO.WriteMode
+stderr = WriteHandle IO.stderr
+
+openFileForReading :: FilePath -> IO (Handle 'IO.ReadMode)
+openFileForReading path = ReadHandle <$> IO.openFile path IO.ReadMode
+
+data Source blob where
+  FromPath       :: File                -> Source Blob
+  FromHandle     :: Handle 'IO.ReadMode -> Source [Blob]
+  FromPathPair   :: Both File           -> Source BlobPair
+  FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair]
+
+data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
+
+-- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
+data Files out where
+  Read        :: Source out -> Files out
+  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project.Concrete
+  FindFiles   :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
+  Write       :: Destination -> B.Builder -> Files ()
+
+-- | Run a 'Files' effect in 'IO'.
+runFiles :: (Member (Exc SomeException) effs, Member IO effs) => Eff (Files ': effs) a -> Eff effs a
+runFiles = interpret $ \ files -> case files of
+  Read (FromPath path)         -> rethrowing (readBlobFromPath path)
+  Read (FromHandle handle)     -> rethrowing (readBlobsFromHandle handle)
+  Read (FromPathPair paths)    -> rethrowing (runBothWith readFilePair paths)
+  Read (FromPairHandle handle) -> rethrowing (readBlobPairsFromHandle handle)
+  ReadProject rootDir dir language excludeDirs -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs)
+  FindFiles dir exts excludeDirs -> rethrowing (findFilesInDir dir exts excludeDirs)
+  Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
+  Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
+
+-- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
+--
+--   Note that while the type allows 'IO' to occur anywhere within the effect list, it must actually occur at the end to be able to run the computation.
+catchException :: ( Exc.Exception e
+                  , Member IO r
+                  )
+               => Eff r a
+               -> (e -> Eff r a)
+               -> Eff r a
+catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m
+
+-- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect.
+rethrowing :: ( Member (Exc SomeException) r
+              , Member IO r
+              )
+           => IO a
+           -> Eff r a
+rethrowing m = catchException (liftIO m) (throwError . toException @SomeException)
diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs
index 22ec7f2c0..3eda55ad6 100644
--- a/src/Semantic/Resolution.hs
+++ b/src/Semantic/Resolution.hs
@@ -11,7 +11,7 @@ import qualified Data.Map as Map
 import           Data.Source
 import           Data.Language
 import           Prologue
-import           Semantic.Effect.Files
+import           Semantic.IO
 import           System.FilePath.Posix
 
 
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index d66a0792f..c10d4993c 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -5,7 +5,13 @@ module Semantic.Task
 , WrappedTask(..)
 , Level(..)
 , RAlgebra
-, module Semantic.Effect.Files
+-- * I/O
+, IO.readBlob
+, IO.readBlobs
+, IO.readBlobPairs
+, IO.readProject
+, IO.findFiles
+, IO.write
 -- * Module Resolution
 , resolutionMap
 , Resolution
@@ -68,7 +74,7 @@ import           Parsing.Parser
 import           Parsing.TreeSitter
 import           Prologue hiding (MonadError (..), project)
 import           Semantic.Distribute
-import           Semantic.Effect.Files
+import qualified Semantic.IO as IO
 import           Semantic.Resolution
 import           Semantic.Log
 import           Semantic.Queue
@@ -82,7 +88,7 @@ import           System.IO (stderr)
 type TaskEff = Eff '[Distribute WrappedTask
                     , Task
                     , Resolution
-                    , Files
+                    , IO.Files
                     , Reader Options
                     , Trace
                     , Telemetry
@@ -147,7 +153,7 @@ runTaskWithOptions' options logger statter task = do
                    . runTelemetry logger statter
                    . runTraceInTelemetry
                    . runReader options
-                   . runFiles
+                   . IO.runFiles
                    . runResolution
                    . runTaskF
                    . runDistribute (run . unwrapTask)
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index 19393533b..999ec0aad 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
-{-# OPTIONS_GHC -Wno-missing-signatures -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
 module Semantic.Util where
 
 import           Analysis.Abstract.Caching
@@ -77,12 +77,8 @@ pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Py
 javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
 
 -- Evaluate a project, starting at a single entrypoint.
-evaluateProject parser lang prelude path = do
-  proj <- readProject Nothing path lang []
-  evaluatePackageWith id withTermSpans proj . fmap quieterm <$> runTask' (parsePackage parser prelude proj)
-evaluateProjectWithCaching parser lang prelude path = do
-  proj <- readProject Nothing path lang []
-  evaluatePackageWith convergingModules (withTermSpans . cachingTerms) proj . fmap quieterm <$> runTask (parsePackage parser prelude)
+evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
+evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
 
 
 parseFile :: Parser term -> FilePath -> IO term

From f0b96e793d1832ff8ba23e6b9b669df66b7edc4c Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 11:54:25 -0400
Subject: [PATCH 19/34] remove unused functions

---
 src/Data/Graph/AdjList.hs |  1 +
 src/Data/Project.hs       | 46 +--------------------------------------
 src/Semantic/IO.hs        |  3 +--
 src/Semantic/Task.hs      |  2 --
 4 files changed, 3 insertions(+), 49 deletions(-)

diff --git a/src/Data/Graph/AdjList.hs b/src/Data/Graph/AdjList.hs
index 4a48a17f3..3dca719c2 100644
--- a/src/Data/Graph/AdjList.hs
+++ b/src/Data/Graph/AdjList.hs
@@ -88,6 +88,7 @@ graphToAdjList = taggedGraphToAdjList . tagGraph
 -- Using a PBGraph as the accumulator for the fold would incur
 -- significant overhead associated with Vector concatenation.
 -- We use this and then pay the O(v + e) to-Vector cost once.
+-- The fields are strict because we have StrictData on.
 data Acc = Acc [Vertex] (HashSet Edge)
 
 -- Convert a graph with tagged members to a protobuf-compatible adjacency list.
diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 4a8e9103a..9361f2090 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -12,9 +12,6 @@ module Data.Project (
   , projectEntryPoints
   , projectFiles
   , readFile
-  , readBlobFromPath
-  , readBlobPair
-  , addPrelude
   -- * Files
   , File (..)
   , file
@@ -25,11 +22,8 @@ import Prologue hiding (throwError)
 
 import           Control.Monad.Effect
 import           Control.Monad.Effect.Exception
-import           Control.Monad.IO.Class
 import           Data.Blob
-import qualified Data.ByteString as B
 import           Data.Language
-import           Data.Source
 import qualified Data.Text as T
 import           Debug.Trace
 import           Proto3.Suite
@@ -92,7 +86,6 @@ projectEntryPoints (Project {..})= foldr go [] projectBlobs
 projectFiles :: Concrete -> [File]
 projectFiles = fmap toFile . projectBlobs where
 
-
 data File = File
   { filePath     :: FilePath
   , fileLanguage :: Language
@@ -102,37 +95,14 @@ file :: FilePath -> File
 file path = File path (languageForFilePath path)
   where languageForFilePath = languageForType . takeExtension
 
+-- This is kind of a wart; Blob should really hold a 'File'.
 toFile :: Blob -> File
 toFile (Blob _ p l) = File p l
 
 data ProjectException
   = FileNotFound FilePath
-  | EmptyPairProvided
-  | PairNotFound (Both FilePath)
-  | HandleNotSupported
-  | WritesNotSupported
-  | NoLanguagesSpecified
-  | UnknownLanguage
-  | MultipleLanguagesSpecified [Language]
-  | TODO
     deriving (Show, Eq, Typeable, Exception)
 
-readBlobFromPath :: Member (Exc SomeException) effs
-                 => Concrete
-                 -> File
-                 -> Eff effs Blob
-readBlobFromPath g f = readFile g f >>= maybeM (throwError (SomeException (FileNotFound (filePath f))))
-
-addPrelude :: MonadIO m
-           => Concrete
-           -> File
-           -> m Concrete
-addPrelude g File{..} = do
-  traceM "Adding to prelude"
-  contents <- liftIO (B.readFile filePath)
-  let blob = Blob (fromUTF8 contents) filePath fileLanguage
-  pure $ g { projectBlobs = blob : projectBlobs g }
-
 readFile :: Member (Exc SomeException) effs
          => Concrete
          -> File
@@ -144,17 +114,3 @@ readFile Project{..} f =
     | p == "/dev/null"  -> pure Nothing
     | isJust candidate  -> pure candidate
     | otherwise         -> throwError (SomeException (FileNotFound p))
-
-readBlobPair :: Member (Exc SomeException) effs
-             => Concrete
-             -> File
-             -> File
-             -> Eff effs BlobPair
-readBlobPair g f1 f2 = Join <$> join (maybeThese <$> readFile g f1 <*> readFile g f2)
-
-maybeThese :: Member (Exc SomeException) effs => Maybe a -> Maybe b -> Eff effs (These a b)
-maybeThese a b = case (a, b) of
-  (Just a, Nothing) -> pure (This a)
-  (Nothing, Just b) -> pure (That b)
-  (Just a, Just b)  -> pure (These a b)
-  _                 -> throwError (SomeException EmptyPairProvided)
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index 85bf1be2e..2b8420f8f 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -37,14 +37,13 @@ module Semantic.IO
 
 import qualified Control.Exception as Exc
 import           Control.Monad.Effect
-import           Control.Monad.Effect.State
 import           Control.Monad.Effect.Exception
 import           Control.Monad.IO.Class
 import           Data.Aeson
 import           Data.Blob
 import           Data.Bool
 import qualified Data.Project as Project
-import           Data.Project (File (..), ProjectException (..))
+import           Data.Project (File (..))
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index c10d4993c..a686184b1 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -55,7 +55,6 @@ import           Control.Monad
 import           Control.Monad.Effect
 import           Control.Monad.Effect.Exception
 import           Control.Monad.Effect.Reader
-import           Control.Monad.Effect.State
 import           Control.Monad.Effect.Trace
 import           Data.Blob
 import           Data.Bool
@@ -66,7 +65,6 @@ import           Data.Record
 import           Data.Sum
 import qualified Data.Syntax as Syntax
 import           Data.Term
-import           Data.Project
 import           Diffing.Algorithm (Diffable)
 import           Diffing.Interpreter
 import           Parsing.CMark

From 6c4bd4177f28865ca146a8ce92044573922bb404 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 12:02:16 -0400
Subject: [PATCH 20/34] not needed

---
 src/Data/Graph/AdjList.hs    |  10 ++--
 src/Semantic/Effect/Files.hs | 102 -----------------------------------
 2 files changed, 5 insertions(+), 107 deletions(-)
 delete mode 100644 src/Semantic/Effect/Files.hs

diff --git a/src/Data/Graph/AdjList.hs b/src/Data/Graph/AdjList.hs
index 3dca719c2..a3f190478 100644
--- a/src/Data/Graph/AdjList.hs
+++ b/src/Data/Graph/AdjList.hs
@@ -99,13 +99,13 @@ data Acc = Acc [Vertex] (HashSet Edge)
 -- 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.
 taggedGraphToAdjList :: Graph (V.Vertex, Tag) -> AdjList
-taggedGraphToAdjList = accumToAdj . munge . adjacencyMap . toGraph . simplify
-  where munge :: Map (V.Vertex, Tag) (Set (V.Vertex, Tag)) -> Acc
-        munge = Map.foldlWithKey go (Acc [] mempty)
+taggedGraphToAdjList = accumToAdj . adjMapToAccum . adjacencyMap . toGraph . simplify
+  where adjMapToAccum :: Map (V.Vertex, Tag) (Set (V.Vertex, Tag)) -> Acc
+        adjMapToAccum = Map.foldlWithKey go (Acc [] mempty)
 
         go :: Acc -> (V.Vertex, Tag) -> Set (V.Vertex, Tag) -> Acc
-        go (Acc vs es) (v, from) edges = Acc (vertexToPB v from : vs) (Set.foldr' add es edges)
-          where add (_, to) = HashSet.insert (Edge from to)
+        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 -> AdjList
         accumToAdj (Acc vs es) = AdjList (fromList vs) (fromList (toList es))
diff --git a/src/Semantic/Effect/Files.hs b/src/Semantic/Effect/Files.hs
deleted file mode 100644
index 35ba662e2..000000000
--- a/src/Semantic/Effect/Files.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE TypeOperators #-}
-
-module Semantic.Effect.Files
-  ( Source (..)
-  , Destination (..)
-  , Files (..)
-  , catchException
-  , findFiles
-  , readBlob
-  , readBlobPairs
-  , readBlobs
-  , readProject
-  , runFiles
-  , write
-  ) where
-
-import qualified Control.Exception as Exc
-import           Control.Monad.Effect
-import           Control.Monad.Effect.Exception
-import           Control.Monad.Effect.State
-import           Control.Monad.IO.Class
-import           Data.Blob
-import qualified Data.ByteString.Builder as B
-import           Data.Handle
-import           Data.Language
-import           Data.Project (File (..), ProjectException (..))
-import qualified Data.Project as Project
-import           Prelude hiding (readFile)
-import           Prologue hiding (MonadError (..), fail)
-import qualified System.IO as IO
-import           Semantic.IO
-
-data Source blob where
-  FromPath       :: File                -> Source Blob
-  FromHandle     :: Handle 'IO.ReadMode -> Source [Blob]
-  FromPathPair   :: Both File           -> Source BlobPair
-  FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair]
-
-data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
-
--- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
-data Files out where
-  Read        :: Source out -> Files out
-  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project.Concrete
-  FindFiles   :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
-  Write       :: Destination -> B.Builder -> Files ()
-
-readBlob :: Member Files effs => File -> Eff effs Blob
-readBlob = send . Read . FromPath
-
--- | A task which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
-readBlobs :: Member Files effs => Either (Handle 'IO.ReadMode) [File] -> Eff effs [Blob]
-readBlobs (Left handle) = send (Read (FromHandle handle))
-readBlobs (Right paths) = traverse (send . Read . FromPath) paths
-
--- | A task which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
-readBlobPairs :: Member Files effs => Either (Handle 'IO.ReadMode) [Both File] -> Eff effs [BlobPair]
-readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
-readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
-
-readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project.Concrete
-readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
-
-findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
-findFiles dir exts = send . FindFiles dir exts
-
--- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'.
-write :: Member Files effs => Destination -> B.Builder -> Eff effs ()
-write dest = send . Write dest
-
-
--- | Run a 'Files' effect in 'IO'.
-runFiles :: (Member (Exc SomeException) effs, Member IO effs) => Eff (Files ': effs) a -> Eff effs a
-runFiles = interpret $ \ files -> case files of
-  Read (FromPath path)         -> rethrowing (readBlobFromPath path)
-  Read (FromHandle handle)     -> rethrowing (readBlobsFromHandle handle)
-  Read (FromPathPair paths)    -> rethrowing (runBothWith readFilePair paths)
-  Read (FromPairHandle handle) -> rethrowing (readBlobPairsFromHandle handle)
-  ReadProject rootDir dir language excludeDirs -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs)
-  FindFiles dir exts excludeDirs -> rethrowing (findFilesInDir dir exts excludeDirs)
-  Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
-  Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
-
--- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
---
---   Note that while the type allows 'IO' to occur anywhere within the effect list, it must actually occur at the end to be able to run the computation.
-catchException :: ( Exc.Exception e
-                  , Member IO r
-                  )
-               => Eff r a
-               -> (e -> Eff r a)
-               -> Eff r a
-catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m
-
--- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect.
-rethrowing :: ( Member (Exc SomeException) r
-              , Member IO r
-              )
-           => IO a
-           -> Eff r a
-rethrowing m = catchException (liftIO m) (throwError . toException @SomeException)

From 30c7d0d554f9bd77514823293549aed806cba6a9 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 12:07:17 -0400
Subject: [PATCH 21/34] formatting

---
 src/Data/Project.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 9361f2090..a795deaec 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -15,7 +15,7 @@ module Data.Project (
   -- * Files
   , File (..)
   , file
-  , )where
+  ) where
 
 import Prelude hiding (readFile)
 import Prologue hiding (throwError)

From c563747f87a2aa5055bb6ce2347e6d662c4ba32c Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 12:09:40 -0400
Subject: [PATCH 22/34] tests compile now

---
 test/Semantic/IO/Spec.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs
index beafce0d1..d96bcdf7f 100644
--- a/test/Semantic/IO/Spec.hs
+++ b/test/Semantic/IO/Spec.hs
@@ -16,7 +16,7 @@ import qualified TreeSitter.Node as TS
 import qualified TreeSitter.Parser as TS
 import qualified TreeSitter.Tree as TS
 
-import SpecHelpers
+import SpecHelpers hiding (readFile)
 
 
 spec :: Spec

From e661e49f739ffaba48d45915e0faf65072236881 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 12:11:37 -0400
Subject: [PATCH 23/34] kill trace

---
 src/Data/Project.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index a795deaec..d4b9c5b79 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -25,7 +25,6 @@ import           Control.Monad.Effect.Exception
 import           Data.Blob
 import           Data.Language
 import qualified Data.Text as T
-import           Debug.Trace
 import           Proto3.Suite
 import           System.FilePath.Posix
 
@@ -109,7 +108,7 @@ readFile :: Member (Exc SomeException) effs
          -> Eff effs (Maybe Blob)
 readFile Project{..} f =
   let p         = filePath f
-      candidate = find (\b -> blobPath b == p) (traceShowId projectBlobs)
+      candidate = find (\b -> blobPath b == p) projectBlobs
   in if
     | p == "/dev/null"  -> pure Nothing
     | isJust candidate  -> pure candidate

From ffbe4dbbdabcb2df52f5aa203314cac665dae3be Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 13:17:06 -0400
Subject: [PATCH 24/34] fix bug in readProjectFromPaths

---
 src/Semantic/IO.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index 2b8420f8f..aca6ca72d 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -111,7 +111,7 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
 
 
   paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
-  blobs <- traverse readBlobFromPath (toFile <$> paths)
+  blobs <- traverse readBlobFromPath (entryPoints <> (toFile <$> paths))
   let p = Project.Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
   liftIO $ putStrLn "Done"
   pure p

From 6d287d8ccec73cf333b25c8ebfe68516884fba97 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 13:58:16 -0400
Subject: [PATCH 25/34] make sure Util loads a prelude

---
 src/Semantic/Util.hs | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index 999ec0aad..c665e7338 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -77,9 +77,23 @@ pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Py
 javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
 
 -- Evaluate a project, starting at a single entrypoint.
-evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
-evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
+evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
+evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
 
+addPrelude :: Member IO effs => Language.Language -> Concrete -> Eff effs Concrete
+addPrelude l proj = do
+  let p = case l of
+        Language.Ruby -> rubyPrelude
+        Language.Python -> pythonPrelude
+        Language.TypeScript -> javaScriptPrelude
+        Language.JavaScript -> javaScriptPrelude
+        _ -> Nothing
+
+  case p of
+    Nothing -> pure proj
+    Just pth -> do
+      bl <- readBlobFromPath pth
+      pure $ proj { projectBlobs = bl : projectBlobs proj }
 
 parseFile :: Parser term -> FilePath -> IO term
 parseFile parser = runTask . (parse parser <=< readBlob . file)

From 9c758ad3fec16813889d87bda09b7ed8b3a9fbde Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 14:00:51 -0400
Subject: [PATCH 26/34] Lint

---
 src/Analysis/Abstract/Graph.hs | 2 +-
 src/Data/Project.hs            | 6 +++---
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs
index 559bbce76..ad44d3654 100644
--- a/src/Analysis/Abstract/Graph.hs
+++ b/src/Analysis/Abstract/Graph.hs
@@ -26,7 +26,7 @@ import           Data.Sum
 import qualified Data.Syntax as Syntax
 import           Data.Term
 import qualified Data.Text.Encoding as T
-import           Prologue hiding (packageName, project)
+import           Prologue hiding (project)
 
 style :: Style Vertex Builder
 style = (defaultStyle (T.encodeUtf8Builder . vertexName))
diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index d4b9c5b79..284241023 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -76,14 +76,14 @@ projectExtensions :: Concrete -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage
 
 projectEntryPoints :: Concrete -> [File]
-projectEntryPoints (Project {..})= foldr go [] projectBlobs
+projectEntryPoints Project {..} = foldr go [] projectBlobs
   where go b acc =
           if blobPath b `elem` projectEntryPaths
           then toFile b : acc
           else acc
 
 projectFiles :: Concrete -> [File]
-projectFiles = fmap toFile . projectBlobs where
+projectFiles = fmap toFile . projectBlobs
 
 data File = File
   { filePath     :: FilePath
@@ -98,7 +98,7 @@ file path = File path (languageForFilePath path)
 toFile :: Blob -> File
 toFile (Blob _ p l) = File p l
 
-data ProjectException
+newtype ProjectException
   = FileNotFound FilePath
     deriving (Show, Eq, Typeable, Exception)
 

From 4d8fe33ad4e13975ffe7a48d0215c32c4d630be4 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 14:05:57 -0400
Subject: [PATCH 27/34] last few changes

---
 src/Semantic/Graph.hs      | 5 ++---
 src/Semantic/Resolution.hs | 2 +-
 2 files changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index 99c593d1c..74c6928c8 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -27,13 +27,12 @@ import           Data.Abstract.Package as Package
 import           Data.Abstract.Value (Value, ValueError (..), runValueErrorWith)
 import           Data.Graph
 import           Data.Project
-import qualified Data.Project as Project (readFile, Concrete)
+import qualified Data.Project as Project
 import           Data.Record
 import           Data.Term
 import           Data.Text (pack)
 import           Parsing.Parser
 import           Prologue hiding (MonadError (..))
-import           Semantic.IO (Files)
 import           Semantic.Task as Task
 
 data GraphType = ImportGraph | CallGraph
@@ -94,7 +93,7 @@ parseModule proj parser file = do
   mBlob <- Project.readFile proj file
   case mBlob of
     Just blob -> moduleForBlob (Just (projectRootDir proj)) blob <$> parse parser blob
-    Nothing   -> error ("file not found: " <> show file)
+    Nothing   -> throwError (SomeException (Project.FileNotFound (Project.filePath file)))
 
 withTermSpans :: ( HasField fields Span
                  , Member (Reader Span) effects
diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs
index 3eda55ad6..81fa45e9b 100644
--- a/src/Semantic/Resolution.hs
+++ b/src/Semantic/Resolution.hs
@@ -5,7 +5,7 @@ import           Control.Monad.Effect
 import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
 import           Data.Blob
-import           Data.Project hiding (findFiles)
+import           Data.Project
 import qualified Data.Project as Project (Concrete)
 import qualified Data.Map as Map
 import           Data.Source

From 63fdf40cb06f05b0156ab36182518bd279abed44 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 14:10:28 -0400
Subject: [PATCH 28/34] Concrete was a lousy name

---
 src/Data/Project.hs        | 30 +++++++++++++++---------------
 src/Semantic/Graph.hs      | 13 +++++++------
 src/Semantic/IO.hs         | 11 +++++------
 src/Semantic/Resolution.hs |  3 +--
 src/Semantic/Util.hs       |  2 +-
 5 files changed, 29 insertions(+), 30 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 284241023..f2fff11ee 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -2,8 +2,8 @@
 
 module Data.Project (
   -- * Projects
-    Project (..)
-  , Concrete
+    ProjectF (..)
+  , Project
   , PB
   , ProjectException (..)
   , fromPB
@@ -33,8 +33,8 @@ import           System.FilePath.Posix
 -- in terms of the container type for paths and blobs, as well as the
 -- path type (this is necessary because protobuf uses different vector
 -- representations for @repeated string@ and @repeated Blob@.
--- You probably want to use the 'Concrete' or 'PB' type aliases.
-data Project (blobs :: * -> *) (paths :: * -> *) path = Project
+-- You probably want to use the 'Project' or 'PB' type aliases.
+data ProjectF (blobs :: * -> *) (paths :: * -> *) path = Project
   { projectRootDir     :: path
   , projectBlobs       :: blobs Blob
   , projectLanguage    :: Language
@@ -45,22 +45,22 @@ data Project (blobs :: * -> *) (paths :: * -> *) path = Project
 deriving instance ( MessageField path
                   , MessageField (paths path)
                   , MessageField (blobs Blob)
-                  ) => Message (Project blobs paths path)
+                  ) => Message (ProjectF blobs paths path)
 
-deriving instance (Eq path, Eq (blobs Blob), Eq (paths path)) => Eq (Project blobs paths path)
-deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (Project blobs paths path)
+deriving instance (Eq path, Eq (blobs Blob), Eq (paths path)) => Eq (ProjectF blobs paths path)
+deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (ProjectF blobs paths path)
 
 -- | This 'Project' type is the one used during semantic's normal
 -- course of diffing, evaluation, and graphing. You probably want to
 -- use this one.
-type Concrete = Project [] [] FilePath
+type Project = ProjectF [] [] FilePath
 
 -- | This 'Project' type is protobuf-compatible, and corresponds with
 -- the @Project@ message declaration present in types.proto.
-type PB = Project NestedVec UnpackedVec Text
+type PB = ProjectF NestedVec UnpackedVec Text
 
 -- | Convert from a packed protobuf representatio nto a more useful one.
-fromPB :: PB -> Concrete
+fromPB :: PB -> Project
 fromPB Project {..} = Project
   { projectRootDir     = T.unpack projectRootDir
   , projectBlobs       = toList projectBlobs
@@ -69,20 +69,20 @@ fromPB Project {..} = Project
   , projectExcludeDirs = T.unpack <$> toList projectExcludeDirs
   }
 
-projectName :: Concrete -> Text
+projectName :: Project -> Text
 projectName = T.pack . dropExtensions . takeFileName . projectRootDir
 
-projectExtensions :: Concrete -> [String]
+projectExtensions :: Project -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage
 
-projectEntryPoints :: Concrete -> [File]
+projectEntryPoints :: Project -> [File]
 projectEntryPoints Project {..} = foldr go [] projectBlobs
   where go b acc =
           if blobPath b `elem` projectEntryPaths
           then toFile b : acc
           else acc
 
-projectFiles :: Concrete -> [File]
+projectFiles :: Project -> [File]
 projectFiles = fmap toFile . projectBlobs
 
 data File = File
@@ -103,7 +103,7 @@ newtype ProjectException
     deriving (Show, Eq, Typeable, Exception)
 
 readFile :: Member (Exc SomeException) effs
-         => Concrete
+         => Project
          -> File
          -> Eff effs (Maybe Blob)
 readFile Project{..} f =
diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index 74c6928c8..7de16fdd6 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -16,6 +16,8 @@ module Semantic.Graph
 , resumingEnvironmentError
 ) where
 
+import Prelude hiding (readFile)
+
 import           Analysis.Abstract.Evaluating
 import           Analysis.Abstract.Graph
 import           Control.Abstract
@@ -27,7 +29,6 @@ import           Data.Abstract.Package as Package
 import           Data.Abstract.Value (Value, ValueError (..), runValueErrorWith)
 import           Data.Graph
 import           Data.Project
-import qualified Data.Project as Project
 import           Data.Record
 import           Data.Term
 import           Data.Text (pack)
@@ -40,7 +41,7 @@ data GraphType = ImportGraph | CallGraph
 runGraph :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs, Member Resolution effs, Member Task effs, Member Trace effs)
          => GraphType
          -> Bool
-         -> Project.Concrete
+         -> Project
          -> Eff effs (Graph Vertex)
 runGraph graphType includePackages project
   | SomeAnalysisParser parser prelude <- someAnalysisParser
@@ -71,7 +72,7 @@ runGraph graphType includePackages project
 parsePackage :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs,  Member Resolution effs, Member Task effs, Member Trace effs)
              => Parser term -- ^ A parser.
              -> Maybe File  -- ^ Prelude (optional).
-             -> Project.Concrete     -- ^ Project to parse into a package.
+             -> Project     -- ^ Project to parse into a package.
              -> Eff effs (Package term)
 parsePackage parser preludeFile project@Project{..} = do
   prelude <- traverse (parseModule project parser) preludeFile
@@ -88,12 +89,12 @@ parsePackage parser preludeFile project@Project{..} = do
     parseModules parser = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule project parser)
 
 -- | Parse a file into a 'Module'.
-parseModule :: (Member (Exc SomeException) effs, Member Task effs) => Project.Concrete -> Parser term -> File -> Eff effs (Module term)
+parseModule :: (Member (Exc SomeException) effs, Member Task effs) => Project -> Parser term -> File -> Eff effs (Module term)
 parseModule proj parser file = do
-  mBlob <- Project.readFile proj file
+  mBlob <- readFile proj file
   case mBlob of
     Just blob -> moduleForBlob (Just (projectRootDir proj)) blob <$> parse parser blob
-    Nothing   -> throwError (SomeException (Project.FileNotFound (Project.filePath file)))
+    Nothing   -> throwError (SomeException (FileNotFound (filePath file)))
 
 withTermSpans :: ( HasField fields Span
                  , Member (Reader Span) effects
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index aca6ca72d..f254f4d9c 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -42,8 +42,7 @@ import           Control.Monad.IO.Class
 import           Data.Aeson
 import           Data.Blob
 import           Data.Bool
-import qualified Data.Project as Project
-import           Data.Project (File (..))
+import           Data.Project hiding (readFile)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
@@ -101,7 +100,7 @@ readBlobFromPath file = do
   maybeFile <- readFile file
   maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
 
-readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project.Concrete
+readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
 readProjectFromPaths maybeRoot path lang excludeDirs = do
   liftIO $ putStrLn "Starting readProjectFromPath"
   isDir <- isDirectory path
@@ -112,7 +111,7 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
 
   paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
   blobs <- traverse readBlobFromPath (entryPoints <> (toFile <$> paths))
-  let p = Project.Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
+  let p = Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
   liftIO $ putStrLn "Done"
   pure p
   where
@@ -179,7 +178,7 @@ readBlobPairs :: Member Files effs => Either (Handle 'IO.ReadMode) [Both File] -
 readBlobPairs (Left handle) = send (Read (FromPairHandle handle))
 readBlobPairs (Right paths) = traverse (send . Read . FromPathPair) paths
 
-readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project.Concrete
+readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project
 readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
 
 findFiles :: Member Files effs => FilePath -> [String] -> [FilePath] -> Eff effs [FilePath]
@@ -223,7 +222,7 @@ data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
 -- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
 data Files out where
   Read        :: Source out -> Files out
-  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project.Concrete
+  ReadProject :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project
   FindFiles   :: FilePath -> [String] -> [FilePath] -> Files [FilePath]
   Write       :: Destination -> B.Builder -> Files ()
 
diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs
index 81fa45e9b..438af10c3 100644
--- a/src/Semantic/Resolution.hs
+++ b/src/Semantic/Resolution.hs
@@ -6,7 +6,6 @@ import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
 import           Data.Blob
 import           Data.Project
-import qualified Data.Project as Project (Concrete)
 import qualified Data.Map as Map
 import           Data.Source
 import           Data.Language
@@ -30,7 +29,7 @@ nodeJSResolutionMap rootDir prop excludeDirs = do
       where relPkgDotJSONPath = makeRelative rootDir path
             relEntryPath x = takeDirectory relPkgDotJSONPath </> x
 
-resolutionMap :: Member Resolution effs => Project.Concrete -> Eff effs (Map FilePath FilePath)
+resolutionMap :: Member Resolution effs => Project -> Eff effs (Map FilePath FilePath)
 resolutionMap Project{..} = case projectLanguage of
   TypeScript -> send (NodeJSResolution projectRootDir "types" projectExcludeDirs)
   JavaScript -> send (NodeJSResolution projectRootDir "main" projectExcludeDirs)
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index c665e7338..b12049ddb 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -80,7 +80,7 @@ javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePat
 evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
 evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
 
-addPrelude :: Member IO effs => Language.Language -> Concrete -> Eff effs Concrete
+addPrelude :: Member IO effs => Language.Language -> Project -> Eff effs Project
 addPrelude l proj = do
   let p = case l of
         Language.Ruby -> rubyPrelude

From 248eb4f207c0c44a4492a9ab24031ec2eac89a18 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 14:12:14 -0400
Subject: [PATCH 29/34] clarify

---
 src/Data/Project.hs | 5 +++--
 src/Semantic/IO.hs  | 5 +----
 test/SpecHelpers.hs | 2 +-
 3 files changed, 5 insertions(+), 7 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index f2fff11ee..b23cb925d 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -28,7 +28,7 @@ import qualified Data.Text as T
 import           Proto3.Suite
 import           System.FilePath.Posix
 
--- | A 'Project' contains all the information that semantic needs
+-- | A 'ProjectF' contains all the information that semantic needs
 -- to execute an analysis, diffing, or graphing pass. It is higher-kinded
 -- in terms of the container type for paths and blobs, as well as the
 -- path type (this is necessary because protobuf uses different vector
@@ -94,7 +94,8 @@ file :: FilePath -> File
 file path = File path (languageForFilePath path)
   where languageForFilePath = languageForType . takeExtension
 
--- This is kind of a wart; Blob should really hold a 'File'.
+-- This is kind of a wart; Blob and File should be two views of
+-- the same higher-kinded datatype.
 toFile :: Blob -> File
 toFile (Blob _ p l) = File p l
 
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index f254f4d9c..ae7af4cea 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -102,7 +102,6 @@ readBlobFromPath file = do
 
 readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
 readProjectFromPaths maybeRoot path lang excludeDirs = do
-  liftIO $ putStrLn "Starting readProjectFromPath"
   isDir <- isDirectory path
   let (filterFun, entryPoints, rootDir) = if isDir
       then (id, [], fromMaybe path maybeRoot)
@@ -111,9 +110,7 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
 
   paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
   blobs <- traverse readBlobFromPath (entryPoints <> (toFile <$> paths))
-  let p = Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs
-  liftIO $ putStrLn "Done"
-  pure p
+  pure (Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs)
   where
     toFile path = File path lang
     exts = extensionsForLanguage lang
diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index 23feddb25..c75b392c0 100644
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@@ -30,7 +30,7 @@ import Data.Bifunctor (first)
 import Data.Blob as X
 import Data.ByteString.Builder (toLazyByteString)
 import Data.ByteString.Lazy (toStrict)
-import Data.Project as X hiding (findFiles)
+import Data.Project as X
 import Data.Functor.Listable as X
 import Data.Language as X
 import Data.List.NonEmpty as X (NonEmpty(..))

From 17bf0fa3a77ca2d85b41d382683608e0b57ccf94 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 12 Jun 2018 14:42:20 -0400
Subject: [PATCH 30/34] fix bogus instances

---
 src/Data/Project.hs | 10 ++++------
 1 file changed, 4 insertions(+), 6 deletions(-)

diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index b23cb925d..206e021d6 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -40,12 +40,7 @@ data ProjectF (blobs :: * -> *) (paths :: * -> *) path = Project
   , projectLanguage    :: Language
   , projectEntryPaths  :: paths path
   , projectExcludeDirs :: paths path
-  } deriving (Functor, Generic, Named)
-
-deriving instance ( MessageField path
-                  , MessageField (paths path)
-                  , MessageField (blobs Blob)
-                  ) => Message (ProjectF blobs paths path)
+  } deriving (Functor, Generic)
 
 deriving instance (Eq path, Eq (blobs Blob), Eq (paths path)) => Eq (ProjectF blobs paths path)
 deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (ProjectF blobs paths path)
@@ -59,6 +54,9 @@ type Project = ProjectF [] [] FilePath
 -- the @Project@ message declaration present in types.proto.
 type PB = ProjectF NestedVec UnpackedVec Text
 
+deriving instance Message PB
+instance Named PB where nameOf _ = "Project"
+
 -- | Convert from a packed protobuf representatio nto a more useful one.
 fromPB :: PB -> Project
 fromPB Project {..} = Project

From 4176229fa4b3251d78ba109f2c7f8a5a0a42411c Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Tue, 12 Jun 2018 17:08:23 -0700
Subject: [PATCH 31/34] New env helper names

---
 src/Semantic/Env.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Semantic/Env.hs b/src/Semantic/Env.hs
index 7c93f6788..f01e88a8b 100644
--- a/src/Semantic/Env.hs
+++ b/src/Semantic/Env.hs
@@ -5,11 +5,11 @@ import Prologue
 import System.Environment
 import Text.Read (readMaybe)
 
-envLookupHost :: MonadIO io => String -> String -> io String
-envLookupHost defaultHost k = liftIO $ fromMaybe defaultHost <$> lookupEnv k
+envLookupString :: MonadIO io => String -> String -> io String
+envLookupString defaultVal k = liftIO $ fromMaybe defaultVal <$> lookupEnv k
 
-envLookupPort :: MonadIO io => Int -> String -> io Int
-envLookupPort defaultPort k = liftIO $ parsePort <$> lookupEnv k
-  where parsePort x | Just s <- x
+envLookupInt :: MonadIO io => Int -> String -> io Int
+envLookupInt defaultVal k = liftIO $ parse <$> lookupEnv k
+  where parse x | Just s <- x
                     , Just p <- readMaybe s = p
-                    | otherwise = defaultPort
+                    | otherwise = defaultVal

From 9df85f54d85f8de0d7add5cbad997cb4e29803fb Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Tue, 12 Jun 2018 17:10:19 -0700
Subject: [PATCH 32/34] Use bounded stm queues

---
 src/Semantic/Queue.hs | 31 ++++++++++++++++---------------
 src/Semantic/Task.hs  |  5 +++--
 2 files changed, 19 insertions(+), 17 deletions(-)

diff --git a/src/Semantic/Queue.hs b/src/Semantic/Queue.hs
index 0f6ec5f3d..7b992ca3d 100644
--- a/src/Semantic/Queue.hs
+++ b/src/Semantic/Queue.hs
@@ -9,46 +9,47 @@ module Semantic.Queue
 where
 
 import Control.Concurrent.Async as Async
-import Control.Concurrent.STM.TMQueue
+import Control.Concurrent.STM.TBMQueue
+import Control.Monad
 import GHC.Conc
 
--- | 'AsyncQueue' represents a 'TMQueue' that's drained from a separate thread.
+-- | 'AsyncQueue' represents a 'TBMQueue' that's drained from a separate thread.
 -- It is intended to be used to queue data from a pure function and then process
 -- that data in IO on a separate thread. 'AsyncQueue' is parameterized by:
 --   * 'a'     - the type of message stored on the queue.
 --   * 'extra' - any other type needed to process messages on the queue.
 data AsyncQueue a extra
   = AsyncQueue
-  { asyncQueue :: TMQueue a    -- ^ The underlying 'TMQueue'.
-  , asyncQueueSink :: Async () -- ^ A sink that will drain the queue.
+  { asyncQueue      :: TBMQueue a    -- ^ The underlying 'TBMQueue'.
+  , asyncQueueSink  :: Async () -- ^ A sink that will drain the queue.
   , asyncQueueExtra :: extra   -- ^ Any exta data the queue needs to use.
   }
 
 
--- | Create a new AsyncQueue using the default sink.
-newQueue :: (extra -> a -> IO ()) -> extra -> IO (AsyncQueue a extra)
-newQueue = newQueue' . sink
+-- | Create a new AsyncQueue with the given capacity using the default sink.
+newQueue :: Int -> (extra -> a -> IO ()) -> extra -> IO (AsyncQueue a extra)
+newQueue i = newQueue' i . sink
 
--- | Create a new AsyncQueue, specifying a custom sink.
-newQueue' :: (extra -> TMQueue a -> IO ()) -> extra -> IO (AsyncQueue a extra)
-newQueue' f extra = do
-  q <- newTMQueueIO
+-- | Create a new AsyncQueue with the given capacity, specifying a custom sink.
+newQueue' :: Int -> (extra -> TBMQueue a -> IO ()) -> extra -> IO (AsyncQueue a extra)
+newQueue' i f extra = do
+  q <- newTBMQueueIO i
   s <- Async.async (f extra q)
   pure (AsyncQueue q s extra)
 
 -- | Queue a message.
 queue :: AsyncQueue a extra -> a -> IO ()
-queue AsyncQueue{..} = atomically . writeTMQueue asyncQueue
+queue AsyncQueue{..} = void . atomically . tryWriteTBMQueue asyncQueue
 
 -- | Drain messages from the queue, calling the specified function for each message.
-sink :: (extra -> a -> IO ()) -> extra -> TMQueue a -> IO ()
+sink :: (extra -> a -> IO ()) -> extra -> TBMQueue a -> IO ()
 sink f extra q = do
-  msg <- atomically (readTMQueue q)
+  msg <- atomically (readTBMQueue q)
   maybe (pure ()) go msg
   where go msg = f extra msg >> sink f extra q
 
 -- | Close the queue.
 closeQueue :: AsyncQueue a extra -> IO ()
 closeQueue AsyncQueue{..} = do
-  atomically (closeTMQueue asyncQueue)
+  atomically (closeTBMQueue asyncQueue)
   Async.wait asyncQueueSink
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index a787bb696..8da449dde 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -132,9 +132,10 @@ runTask = runTaskWithOptions defaultOptions
 -- | Execute a 'TaskEff' with the passed 'Options', yielding its result value in 'IO'.
 runTaskWithOptions :: Options -> TaskEff a -> IO a
 runTaskWithOptions options task = do
+  let size = 100 -- Max size of telemetry queues, less important for the CLI.
   options <- configureOptionsForHandle stderr options
-  statter <- defaultStatsClient >>= newQueue sendStat
-  logger <- newQueue logMessage options
+  statter <- defaultStatsClient >>= newQueue size sendStat
+  logger <- newQueue size logMessage options
 
   result <- runTaskWithOptions' options logger statter task
 

From bb6a4b0a8a3c73d09ccddbb4179395990074634c Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 13 Jun 2018 12:08:42 -0400
Subject: [PATCH 33/34] last few fixes

---
 src/Data/Graph/AdjList.hs |  2 +-
 src/Data/Project.hs       | 12 ++++++------
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Data/Graph/AdjList.hs b/src/Data/Graph/AdjList.hs
index a3f190478..d7f1b80aa 100644
--- a/src/Data/Graph/AdjList.hs
+++ b/src/Data/Graph/AdjList.hs
@@ -117,7 +117,7 @@ taggedGraphToAdjList = accumToAdj . adjMapToAccum . adjacencyMap . toGraph . sim
             V.Module{}   -> MODULE
             V.Variable{} -> VARIABLE
 
--- Annotate all vertices of a 'Graph' with a 'Tag', starting from 0.
+-- Annotate all vertices of a 'Graph' with a 'Tag', starting from 1.
 tagGraph :: Graph vertex -> Graph (vertex, Tag)
 tagGraph = run . runFresh 1 . go where
   go :: Graph vertex -> Eff '[Fresh] (Graph (vertex, Tag))
diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 206e021d6..19c24a9c3 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -4,7 +4,7 @@ module Data.Project (
   -- * Projects
     ProjectF (..)
   , Project
-  , PB
+  , PBProject
   , ProjectException (..)
   , fromPB
   , projectExtensions
@@ -52,13 +52,13 @@ type Project = ProjectF [] [] FilePath
 
 -- | This 'Project' type is protobuf-compatible, and corresponds with
 -- the @Project@ message declaration present in types.proto.
-type PB = ProjectF NestedVec UnpackedVec Text
+type PBProject = ProjectF NestedVec UnpackedVec Text
 
-deriving instance Message PB
-instance Named PB where nameOf _ = "Project"
+deriving instance Message PBProject
+instance Named PBProject where nameOf _ = "Project"
 
--- | Convert from a packed protobuf representatio nto a more useful one.
-fromPB :: PB -> Project
+-- | Convert from a packed protobuf representation to a more useful one.
+fromPB :: PBProject -> Project
 fromPB Project {..} = Project
   { projectRootDir     = T.unpack projectRootDir
   , projectBlobs       = toList projectBlobs

From 36d5b7562a1778d2cf849bddc0f5307783c0954a Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 13 Jun 2018 12:34:35 -0400
Subject: [PATCH 34/34] Revert "gRPC import graph"

---
 semantic.cabal                 |   3 -
 semantic.proto                 |  10 ---
 src/Analysis/Abstract/Graph.hs |  31 ++++++-
 src/Data/Graph/AdjList.hs      | 157 ---------------------------------
 src/Data/Graph/Vertex.hs       |  37 --------
 src/Data/Language.hs           |   2 +-
 src/Data/Project.hs            | 105 +++-------------------
 src/Semantic/Graph.hs          |  28 +++---
 src/Semantic/IO.hs             |   8 +-
 src/Semantic/Util.hs           |  18 +---
 test/Semantic/IO/Spec.hs       |   2 +-
 types.proto                    |  23 +----
 12 files changed, 62 insertions(+), 362 deletions(-)
 delete mode 100644 src/Data/Graph/AdjList.hs
 delete mode 100644 src/Data/Graph/Vertex.hs

diff --git a/semantic.cabal b/semantic.cabal
index 801c1b833..86110c8db 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -76,8 +76,6 @@ library
                      , Data.Functor.Both
                      , Data.Functor.Classes.Generic
                      , Data.Graph
-                     , Data.Graph.AdjList
-                     , Data.Graph.Vertex
                      , Data.JSON.Fields
                      , Data.Language
                      , Data.Map.Monoidal
@@ -223,7 +221,6 @@ library
                      , proto3-wire
                      , unix
                      , unordered-containers
-                     , vector
                      , haskell-tree-sitter
                      , tree-sitter-go
                      , tree-sitter-haskell
diff --git a/semantic.proto b/semantic.proto
index e1b8db9df..68bad2620 100644
--- a/semantic.proto
+++ b/semantic.proto
@@ -19,26 +19,16 @@ service SemanticAPI {
   rpc HealthCheck(HealthCheckRequest) returns (HealthCheckResponse);
   rpc FetchSummaries (SummariesRequest) returns (SummariesResponse) {}
   rpc ParseBlobs (ParseRequest) returns (ParseResponse) {}
-  rpc GraphImports (ImportGraphRequest) returns (ImportGraphResponse) {}
 }
 
 message SummariesRequest  {
   repeated BlobPair blobPairs = 1;
 }
 
-message ImportGraphRequest {
-  Project project = 1;
-}
-
 message ParseRequest {
   repeated Blob source = 1;
 }
 
-message ImportGraphResponse {
-  AdjList graph = 1;
-  repeated string errorMessages = 2;
-}
-
 message BlobPair {
   Blob before = 1;
   Blob after = 2;
diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs
index ad44d3654..4939e036b 100644
--- a/src/Analysis/Abstract/Graph.hs
+++ b/src/Analysis/Abstract/Graph.hs
@@ -19,14 +19,22 @@ import           Data.Abstract.Address
 import           Data.Abstract.Module (Module(moduleInfo), ModuleInfo(..))
 import           Data.Abstract.Name
 import           Data.Abstract.Package (PackageInfo(..))
+import           Data.Aeson hiding (Result)
 import           Data.ByteString.Builder
 import           Data.Graph
-import           Data.Graph.Vertex
 import           Data.Sum
 import qualified Data.Syntax as Syntax
 import           Data.Term
+import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
-import           Prologue hiding (project)
+import           Prologue hiding (packageName, project)
+
+-- | A vertex of some specific type.
+data Vertex
+  = Package  { vertexName :: Text }
+  | Module   { vertexName :: Text }
+  | Variable { vertexName :: Text }
+  deriving (Eq, Ord, Show)
 
 style :: Style Vertex Builder
 style = (defaultStyle (T.encodeUtf8Builder . vertexName))
@@ -80,6 +88,13 @@ graphingModules recur m = interpose @(Modules address value) pure (\ m yield ->
   _ -> send m >>= yield)
   (recur m)
 
+
+packageVertex :: PackageInfo -> Vertex
+packageVertex = Package . formatName . packageName
+
+moduleVertex :: ModuleInfo -> Vertex
+moduleVertex = Module . T.pack . modulePath
+
 -- | Add an edge from the current package to the passed vertex.
 packageInclusion :: ( Effectful m
                     , Member (Reader PackageInfo) effects
@@ -118,5 +133,17 @@ appendGraph :: (Effectful m, Member (State (Graph Vertex)) effects) => Graph Ver
 appendGraph = modify' . (<>)
 
 
+instance ToJSON Vertex where
+  toJSON v = object [ "name" .= vertexToText v, "type" .= vertexToType v ]
+
+vertexToText :: Vertex -> Text
+vertexToText = vertexName
+
+vertexToType :: Vertex -> Text
+vertexToType Package{}  = "package"
+vertexToType Module{}   = "module"
+vertexToType Variable{} = "variable"
+
+
 graphing :: Effectful m => m (State (Graph Vertex) ': effects) result -> m effects (result, Graph Vertex)
 graphing = runState mempty
diff --git a/src/Data/Graph/AdjList.hs b/src/Data/Graph/AdjList.hs
deleted file mode 100644
index d7f1b80aa..000000000
--- a/src/Data/Graph/AdjList.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# LANGUAGE DeriveAnyClass, LambdaCase, TupleSections #-}
-
-module Data.Graph.AdjList
-  ( AdjList (..)
-  , Edge (..)
-  , Tag
-  , Vertex (..)
-  , VertexType (..)
-  , graphToAdjList
-  , adjListToGraph
-  , tagGraph
-  , isCoherent
-  ) where
-
-import Prologue
-
-import           Algebra.Graph.AdjacencyMap (adjacencyMap)
-import           Algebra.Graph.Class (ToGraph (..), edges, vertices)
-import           Control.Monad.Effect
-import           Control.Monad.Effect.Fresh
-import           Data.Aeson
-import           Data.Coerce
-import           Data.HashMap.Strict ((!))
-import qualified Data.HashMap.Strict as HashMap
-import           Data.HashSet (HashSet)
-import qualified Data.HashSet as HashSet
-import           Data.Map (Map)
-import qualified Data.Map as Map
-import           Data.Set (Set)
-import qualified Data.Set as Set
-import qualified Data.Vector as Vec
-import           Data.Word
-import           GHC.Exts (fromList)
-import qualified Proto3.Suite as PB
-
-import           Data.Graph
-import qualified Data.Graph.Vertex as V
-
--- | Sum type corresponding to a protobuf enum for vertex types.
-data VertexType
-  = PACKAGE
-  | MODULE
-  | VARIABLE
-    deriving (Eq, Ord, Show, Enum, Bounded, Generic, ToJSON, FromJSON, PB.Named, PB.Finite, PB.MessageField)
-
--- | Defaults to 'PACKAGE'.
-instance PB.HasDefault VertexType where def = PACKAGE
-
--- | Piggybacks on top of the 'Enumerated' instance, as the generated code would.
--- This instance will get easier when we have DerivingVia, or a Generic instance
--- that hooks into Enumerated.
-instance PB.Primitive VertexType where
-  primType _ = PB.primType (Proxy @(PB.Enumerated VertexType))
-  encodePrimitive f = PB.encodePrimitive f . PB.Enumerated . Right
-  decodePrimitive   = PB.decodePrimitive >>= \case
-    (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 'AdjList'.
-type Tag = Word64
-
--- | A protobuf-compatible vertex type, with a unique 'Tag' identifier.
-data Vertex = Vertex
-  { vertexType     :: VertexType
-  , vertexContents :: Text
-  , vertexTag      :: Tag
-  } deriving (Eq, Ord, Show, Generic, PB.Message, PB.Named)
-
--- | A protobuf-compatible edge type. Only tag information is carried;
--- consumers are expected to look up nodes in the vertex list when necessary.
-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
--- 'graphToAdjList' on an algebraic 'Graph'. This representation is less efficient and
--- fluent than an ordinary 'Graph', but is more amenable to serialization.
-data AdjList = AdjList
-  { 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.
-graphToAdjList :: Graph V.Vertex -> AdjList
-graphToAdjList = taggedGraphToAdjList . tagGraph
-
--- * Internal interface stuff
-
--- Using a PBGraph as the accumulator for the fold would incur
--- significant overhead associated with Vector concatenation.
--- We use this and then pay the O(v + e) to-Vector cost once.
--- The fields are strict because we have StrictData on.
-data Acc = Acc [Vertex] (HashSet Edge)
-
--- Convert a graph with tagged members to a protobuf-compatible adjacency list.
--- The Tag is necessary to build a canonical adjacency list.
--- Since import graphs can be very large, this is written with speed in mind, in
--- that we convert the graph to algebraic-graphs's 'AdjacencyMap' and then fold
--- 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.
-taggedGraphToAdjList :: Graph (V.Vertex, Tag) -> AdjList
-taggedGraphToAdjList = accumToAdj . adjMapToAccum . adjacencyMap . toGraph . simplify
-  where adjMapToAccum :: Map (V.Vertex, Tag) (Set (V.Vertex, Tag)) -> Acc
-        adjMapToAccum = Map.foldlWithKey go (Acc [] mempty)
-
-        go :: Acc -> (V.Vertex, Tag) -> Set (V.Vertex, Tag) -> Acc
-        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 -> AdjList
-        accumToAdj (Acc vs es) = AdjList (fromList vs) (fromList (toList es))
-
-        vertexToPB :: V.Vertex -> Tag -> Vertex
-        vertexToPB s = Vertex t (V.vertexName s) where
-          t = case s of
-            V.Package{}  -> PACKAGE
-            V.Module{}   -> MODULE
-            V.Variable{} -> VARIABLE
-
--- Annotate all vertices of a 'Graph' with a 'Tag', starting from 1.
-tagGraph :: Graph vertex -> Graph (vertex, Tag)
-tagGraph = run . runFresh 1 . go where
-  go :: Graph vertex -> Eff '[Fresh] (Graph (vertex, Tag))
-  go = traverse (\v -> (v, ) . fromIntegral <$> fresh)
-
--- | This is the reverse of 'graphToAdjList'. Don't use this outside of a testing context.
--- N.B. @adjListToGraph . graphToAdjList@ is 'id', but @graphToAdjList . adjListToGraph@ is not.
-adjListToGraph :: AdjList -> Graph V.Vertex
-adjListToGraph (AdjList vs es) = simplify built
-  where built = allEdges <> vertices unreferencedVertices
-
-        allEdges :: Graph V.Vertex
-        allEdges = fmap fst (edges (foldr addEdge [] es))
-        addEdge (Edge f t) xs = ((adjMap ! f, f), (adjMap ! t, t)) : xs
-        adjMap = foldMap (\v -> HashMap.singleton (vertexTag v) (pbToVertex v)) vs
-
-        unreferencedVertices :: [V.Vertex]
-        unreferencedVertices = pbToVertex <$> toList (Vec.filter isUnreferenced (coerce vs))
-
-        isUnreferenced :: Vertex -> Bool
-        isUnreferenced v = not (vertexTag v `HashSet.member` edgedTags)
-
-        edgedTags :: HashSet Tag
-        edgedTags = HashSet.fromList $ concatMap unEdge es where unEdge (Edge f t) = [f, t]
-
-        pbToVertex :: Vertex -> V.Vertex
-        pbToVertex (Vertex t c _) = case t of
-          MODULE   -> V.Module c
-          PACKAGE  -> V.Package c
-          VARIABLE -> V.Variable c
-
-
--- | For debugging: returns True if all edges reference a valid vertex tag.
-isCoherent :: AdjList -> Bool
-isCoherent (AdjList vs es) = all edgeValid es where
-  edgeValid (Edge a b) = HashSet.member a allTags && HashSet.member b allTags
-  allTags = HashSet.fromList (toList (vertexTag <$> vs))
diff --git a/src/Data/Graph/Vertex.hs b/src/Data/Graph/Vertex.hs
deleted file mode 100644
index c42071cd9..000000000
--- a/src/Data/Graph/Vertex.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE DeriveAnyClass #-}
-module Data.Graph.Vertex
-  ( Vertex (..)
-  , moduleVertex
-  , packageVertex
-  , vertexToType
-  ) where
-
-import Prologue hiding (packageName)
-
-import           Data.Aeson
-import qualified Data.Text as T
-
-import Data.Abstract.Module (ModuleInfo (..))
-import Data.Abstract.Name
-import Data.Abstract.Package (PackageInfo (..))
-
--- | A vertex of some specific type.
-data Vertex
-  = Package  { vertexName :: Text }
-  | Module   { vertexName :: Text }
-  | Variable { vertexName :: Text }
-  deriving (Eq, Ord, Show, Generic, Hashable)
-
-packageVertex :: PackageInfo -> Vertex
-packageVertex = Package . formatName . packageName
-
-moduleVertex :: ModuleInfo -> Vertex
-moduleVertex = Module . T.pack . modulePath
-
-instance ToJSON Vertex where
-  toJSON v = object [ "name" .= vertexName v, "type" .= vertexToType v ]
-
-vertexToType :: Vertex -> Text
-vertexToType Package{}  = "package"
-vertexToType Module{}   = "module"
-vertexToType Variable{} = "variable"
diff --git a/src/Data/Language.hs b/src/Data/Language.hs
index b175240ee..85ba3d4a0 100644
--- a/src/Data/Language.hs
+++ b/src/Data/Language.hs
@@ -23,7 +23,7 @@ data Language
     | Ruby
     | TypeScript
     | PHP
-    deriving (Eq, Generic, Ord, Read, Show, Bounded, Hashable, ToJSON, Named, Enum, Finite, MessageField)
+    deriving (Eq, Generic, Ord, Read, Show, Bounded, ToJSON, Named, Enum, Finite, MessageField)
 
 instance FromJSON Language where
   parseJSON = withText "Language" $ \l -> pure $ case T.toLower l of
diff --git a/src/Data/Project.hs b/src/Data/Project.hs
index 19c24a9c3..1c75ccc2e 100644
--- a/src/Data/Project.hs
+++ b/src/Data/Project.hs
@@ -1,71 +1,18 @@
-{-# LANGUAGE DeriveAnyClass, KindSignatures, MultiWayIf #-}
+module Data.Project where
 
-module Data.Project (
-  -- * Projects
-    ProjectF (..)
-  , Project
-  , PBProject
-  , ProjectException (..)
-  , fromPB
-  , projectExtensions
-  , projectName
-  , projectEntryPoints
-  , projectFiles
-  , readFile
-  -- * Files
-  , File (..)
-  , file
-  ) where
+import Data.Text as T (pack)
+import Data.Language
+import Prologue
+import System.FilePath.Posix
 
-import Prelude hiding (readFile)
-import Prologue hiding (throwError)
-
-import           Control.Monad.Effect
-import           Control.Monad.Effect.Exception
-import           Data.Blob
-import           Data.Language
-import qualified Data.Text as T
-import           Proto3.Suite
-import           System.FilePath.Posix
-
--- | A 'ProjectF' contains all the information that semantic needs
--- to execute an analysis, diffing, or graphing pass. It is higher-kinded
--- in terms of the container type for paths and blobs, as well as the
--- path type (this is necessary because protobuf uses different vector
--- representations for @repeated string@ and @repeated Blob@.
--- You probably want to use the 'Project' or 'PB' type aliases.
-data ProjectF (blobs :: * -> *) (paths :: * -> *) path = Project
-  { projectRootDir     :: path
-  , projectBlobs       :: blobs Blob
+data Project = Project
+  { projectRootDir     :: FilePath
+  , projectFiles       :: [File]
   , projectLanguage    :: Language
-  , projectEntryPaths  :: paths path
-  , projectExcludeDirs :: paths path
-  } deriving (Functor, Generic)
-
-deriving instance (Eq path, Eq (blobs Blob), Eq (paths path)) => Eq (ProjectF blobs paths path)
-deriving instance (Show path, Show (blobs Blob), Show (paths path)) => Show (ProjectF blobs paths path)
-
--- | This 'Project' type is the one used during semantic's normal
--- course of diffing, evaluation, and graphing. You probably want to
--- use this one.
-type Project = ProjectF [] [] FilePath
-
--- | This 'Project' type is protobuf-compatible, and corresponds with
--- the @Project@ message declaration present in types.proto.
-type PBProject = ProjectF NestedVec UnpackedVec Text
-
-deriving instance Message PBProject
-instance Named PBProject where nameOf _ = "Project"
-
--- | Convert from a packed protobuf representation to a more useful one.
-fromPB :: PBProject -> Project
-fromPB Project {..} = Project
-  { projectRootDir     = T.unpack projectRootDir
-  , projectBlobs       = toList projectBlobs
-  , projectLanguage    = projectLanguage
-  , projectEntryPaths  = T.unpack <$> toList projectEntryPaths
-  , projectExcludeDirs = T.unpack <$> toList projectExcludeDirs
+  , projectEntryPoints :: [File]
+  , projectExcludeDirs :: [FilePath]
   }
+  deriving (Eq, Ord, Show)
 
 projectName :: Project -> Text
 projectName = T.pack . dropExtensions . takeFileName . projectRootDir
@@ -73,15 +20,6 @@ projectName = T.pack . dropExtensions . takeFileName . projectRootDir
 projectExtensions :: Project -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage
 
-projectEntryPoints :: Project -> [File]
-projectEntryPoints Project {..} = foldr go [] projectBlobs
-  where go b acc =
-          if blobPath b `elem` projectEntryPaths
-          then toFile b : acc
-          else acc
-
-projectFiles :: Project -> [File]
-projectFiles = fmap toFile . projectBlobs
 
 data File = File
   { filePath     :: FilePath
@@ -91,24 +29,3 @@ data File = File
 file :: FilePath -> File
 file path = File path (languageForFilePath path)
   where languageForFilePath = languageForType . takeExtension
-
--- This is kind of a wart; Blob and File should be two views of
--- the same higher-kinded datatype.
-toFile :: Blob -> File
-toFile (Blob _ p l) = File p l
-
-newtype ProjectException
-  = FileNotFound FilePath
-    deriving (Show, Eq, Typeable, Exception)
-
-readFile :: Member (Exc SomeException) effs
-         => Project
-         -> File
-         -> Eff effs (Maybe Blob)
-readFile Project{..} f =
-  let p         = filePath f
-      candidate = find (\b -> blobPath b == p) projectBlobs
-  in if
-    | p == "/dev/null"  -> pure Nothing
-    | isJust candidate  -> pure candidate
-    | otherwise         -> throwError (SomeException (FileNotFound p))
diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index 7de16fdd6..58317c321 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -16,8 +16,6 @@ module Semantic.Graph
 , resumingEnvironmentError
 ) where
 
-import Prelude hiding (readFile)
-
 import           Analysis.Abstract.Evaluating
 import           Analysis.Abstract.Graph
 import           Control.Abstract
@@ -34,11 +32,12 @@ import           Data.Term
 import           Data.Text (pack)
 import           Parsing.Parser
 import           Prologue hiding (MonadError (..))
+import           Semantic.IO (Files)
 import           Semantic.Task as Task
 
 data GraphType = ImportGraph | CallGraph
 
-runGraph :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs, Member Resolution effs, Member Task effs, Member Trace effs)
+runGraph :: ( Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
          => GraphType
          -> Bool
          -> Project
@@ -69,32 +68,31 @@ runGraph graphType includePackages project
             . graphing
 
 -- | Parse a list of files into a 'Package'.
-parsePackage :: (Member (Exc SomeException) effs, Member (Distribute WrappedTask) effs,  Member Resolution effs, Member Task effs, Member Trace effs)
+parsePackage :: (Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs)
              => Parser term -- ^ A parser.
              -> Maybe File  -- ^ Prelude (optional).
              -> Project     -- ^ Project to parse into a package.
              -> Eff effs (Package term)
 parsePackage parser preludeFile project@Project{..} = do
-  prelude <- traverse (parseModule project parser) preludeFile
-  p <- parseModules parser
+  prelude <- traverse (parseModule parser Nothing) preludeFile
+  p <- parseModules parser project
   resMap <- Task.resolutionMap project
-  let pkg = Package.fromModules n Nothing prelude (length projectEntryPaths) p resMap
+  let pkg = Package.fromModules n Nothing prelude (length projectEntryPoints) p resMap
   pkg <$ trace ("project: " <> show pkg)
 
   where
     n = name (projectName project)
 
     -- | Parse all files in a project into 'Module's.
-    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Eff effs [Module term]
-    parseModules parser = distributeFor (projectEntryPoints project <> projectFiles project) (WrapTask . parseModule project parser)
+    parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project -> Eff effs [Module term]
+    parseModules parser Project{..} = distributeFor (projectEntryPoints <> projectFiles) (WrapTask . parseModule parser (Just projectRootDir))
 
 -- | Parse a file into a 'Module'.
-parseModule :: (Member (Exc SomeException) effs, Member Task effs) => Project -> Parser term -> File -> Eff effs (Module term)
-parseModule proj parser file = do
-  mBlob <- readFile proj file
-  case mBlob of
-    Just blob -> moduleForBlob (Just (projectRootDir proj)) blob <$> parse parser blob
-    Nothing   -> throwError (SomeException (FileNotFound (filePath file)))
+parseModule :: (Member Files effs, Member Task effs) => Parser term -> Maybe FilePath -> File -> Eff effs (Module term)
+parseModule parser rootDir file = do
+  blob <- readBlob file
+  moduleForBlob rootDir blob <$> parse parser blob
+
 
 withTermSpans :: ( HasField fields Span
                  , Member (Reader Span) effects
diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs
index ae7af4cea..29680b7a9 100644
--- a/src/Semantic/IO.hs
+++ b/src/Semantic/IO.hs
@@ -15,7 +15,6 @@ module Semantic.IO
 , noLanguageForBlob
 , openFileForReading
 , readBlob
-, readBlobFromPath
 , readBlobPairs
 , readBlobPairsFromHandle
 , readBlobs
@@ -42,7 +41,7 @@ import           Control.Monad.IO.Class
 import           Data.Aeson
 import           Data.Blob
 import           Data.Bool
-import           Data.Project hiding (readFile)
+import           Data.Project
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Builder as B
 import qualified Data.ByteString.Lazy as BL
@@ -107,10 +106,8 @@ readProjectFromPaths maybeRoot path lang excludeDirs = do
       then (id, [], fromMaybe path maybeRoot)
       else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot)
 
-
   paths <- liftIO $ filterFun <$> findFilesInDir rootDir exts excludeDirs
-  blobs <- traverse readBlobFromPath (entryPoints <> (toFile <$> paths))
-  pure (Project rootDir blobs lang (filePath <$> entryPoints) excludeDirs)
+  pure $ Project rootDir (toFile <$> paths) lang entryPoints excludeDirs
   where
     toFile path = File path lang
     exts = extensionsForLanguage lang
@@ -235,6 +232,7 @@ runFiles = interpret $ \ files -> case files of
   Write (ToPath path)                   builder -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))
   Write (ToHandle (WriteHandle handle)) builder -> liftIO (B.hPutBuilder handle builder)
 
+
 -- | Catch exceptions in 'IO' actions embedded in 'Eff', handling them with the passed function.
 --
 --   Note that while the type allows 'IO' to occur anywhere within the effect list, it must actually occur at the end to be able to run the computation.
diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index b12049ddb..999ec0aad 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -77,23 +77,9 @@ pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Py
 javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
 
 -- Evaluate a project, starting at a single entrypoint.
-evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
-evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
+evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
+evaluateProjectWithCaching parser lang prelude path = evaluatePackageWith convergingModules (withTermSpans . cachingTerms) . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
 
-addPrelude :: Member IO effs => Language.Language -> Project -> Eff effs Project
-addPrelude l proj = do
-  let p = case l of
-        Language.Ruby -> rubyPrelude
-        Language.Python -> pythonPrelude
-        Language.TypeScript -> javaScriptPrelude
-        Language.JavaScript -> javaScriptPrelude
-        _ -> Nothing
-
-  case p of
-    Nothing -> pure proj
-    Just pth -> do
-      bl <- readBlobFromPath pth
-      pure $ proj { projectBlobs = bl : projectBlobs proj }
 
 parseFile :: Parser term -> FilePath -> IO term
 parseFile parser = runTask . (parse parser <=< readBlob . file)
diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs
index d96bcdf7f..beafce0d1 100644
--- a/test/Semantic/IO/Spec.hs
+++ b/test/Semantic/IO/Spec.hs
@@ -16,7 +16,7 @@ import qualified TreeSitter.Node as TS
 import qualified TreeSitter.Parser as TS
 import qualified TreeSitter.Tree as TS
 
-import SpecHelpers hiding (readFile)
+import SpecHelpers
 
 
 spec :: Spec
diff --git a/types.proto b/types.proto
index 3d988e0f2..7d586835e 100644
--- a/types.proto
+++ b/types.proto
@@ -12,9 +12,6 @@ enum Language {Unknown = 0;
                Ruby = 9;
                TypeScript = 10;
                PHP = 11;}
-enum VertexType {PACKAGE = 0;
-                 MODULE = 1;
-                 VARIABLE = 2;}
 message Blob { bytes blobSource = 1;
                string blobPath = 2;
                Language blobLanguage = 3;
@@ -25,36 +22,20 @@ message Pos { int64 posLine = 1;
 message Span { Pos spanStart = 1;
                Pos spanEnd = 2;
              }
-message AdjList { repeated Vertex graphVertices = 1;
-                  repeated Edge graphEdges = 2;
-                }
-message Vertex { VertexType vertexType = 1;
-                 string vertexContents = 2;
-                 uint64 vertexTag = 3;
-               }
-message Edge { uint64 edgeFrom = 1;
-               uint64 edgeTo = 2;
-             }
-message Project { string projectRootDir = 1;
-                  repeated Blob projectBlobs = 2;
-                  Language projectLanguage = 3;
-                  repeated string projectEntryPaths = 4 [packed = false];
-                  repeated string projectExcludeDirs = 5 [packed = false];
-                }
 message Array { repeated Term arrayElements = 1;
               }
 message Boolean { bool booleanContent = 1;
                 }
 message Hash { repeated Term hashElements = 1;
              }
-message Float { string floatContent = 1;
+message Float { bytes floatContent = 1;
               }
 message KeyValue { Term key = 1;
                    Term value = 2;
                  }
 message Null {
              }
-message TextElement { string textElementContent = 1;
+message TextElement { bytes textElementContent = 1;
                     }
 message Term { oneof syntax {Array array = 1;
                              Boolean boolean = 2;