Merge branch 'master' into analyses-provide-and-handle-effects

semantic.cabal

@@ -27,6 +27,7 @@ library
                      , Analysis.Abstract.Evaluating
                      , Analysis.Abstract.ImportGraph
                      , Analysis.Abstract.Tracing
+                     , Analysis.Abstract.TypeChecking
                      , Analysis.CallGraph
                      , Analysis.ConstructorName
                      , Analysis.CyclomaticComplexity
@@ -166,6 +167,7 @@ library
                      , cmark-gfm
                      , containers
                      , directory
+                     , directory-tree
                      , effects
                      , filepath
                      , free

src/Analysis/Abstract/BadModuleResolutions.hs

@@ -20,5 +20,5 @@ instance ( Interpreter effects result rest m
     = interpret
     . runBadModuleResolutions
     . raiseHandler (relay pure (\ (Resumable err) yield -> traceM ("ResolutionError:" <> show err) *> case err of
-      RubyError       nameToResolve -> yield nameToResolve
+      NotFoundError nameToResolve _ _ -> yield  nameToResolve
-      TypeScriptError nameToResolve -> yield nameToResolve))
+      GoImportError pathToResolve     -> yield [pathToResolve]))

src/Analysis/Abstract/ImportGraph.hs

@@ -69,8 +69,7 @@ instance ( Effectful m
          , term ~ Term (Union syntax) ann
          )
       => MonadAnalysis (Located location term) term value effects (ImportGraphing m) where
-  analyzeTerm eval term@(In ann syntax) = do
+  analyzeTerm eval term@(In _ syntax) = do
-    traceShowM ann
     case prj syntax of
       Just (Syntax.Identifier name) -> do
         moduleInclusion (Variable (unName name))

src/Analysis/Abstract/TypeChecking.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, KindSignatures, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+
+module Analysis.Abstract.TypeChecking
+( TypeChecking
+) where
+
+import Control.Abstract.Analysis
+import Data.Abstract.Type
+import Prologue hiding (TypeError)
+
+newtype TypeChecking m (effects :: [* -> *]) a = TypeChecking { runTypeChecking :: m effects a }
+  deriving (Alternative, Applicative, Functor, Effectful, Monad)
+
+deriving instance MonadEvaluator location term value effects m => MonadEvaluator location term value effects (TypeChecking m)
+
+instance ( Effectful m
+         , Alternative (m effects)
+         , MonadAnalysis location term Type effects m
+         , Member (Resumable TypeError) effects
+         , Member NonDet effects
+         , MonadValue location Type effects (TypeChecking m)
+         )
+      => MonadAnalysis location term Type effects (TypeChecking m) where
+  analyzeTerm eval term =
+    resume @TypeError (liftAnalyze analyzeTerm eval term) (
+        \yield err -> case err of
+          -- TODO: These should all yield both sides of the exception,
+          -- but something is mysteriously busted in the innards of typechecking,
+          -- so doing that just yields an empty list in the result type, which isn't
+          -- extraordinarily helpful. Better for now to just die with an error and
+          -- tackle this issue in a separate PR.
+          BitOpError{}       -> throwResumable err
+          NumOpError{}       -> throwResumable err
+          UnificationError{} -> throwResumable err
+        )
+
+  analyzeModule = liftAnalyze analyzeModule
+
+instance ( Interpreter effects (Either (SomeExc TypeError) result) rest m
+         , MonadEvaluator location term value effects m
+         )
+      => Interpreter (Resumable TypeError ': effects) result rest (TypeChecking m) where
+  interpret
+    = interpret
+    . runTypeChecking
+    . raiseHandler runError

src/Control/Abstract/Evaluator.hs

@@ -37,6 +37,7 @@ module Control.Abstract.Evaluator
   , putLoadStack
   , modifyLoadStack
   , currentModule
+  , currentPackage
   -- Control
   , label
   , goto
@@ -60,6 +61,7 @@ import Data.Abstract.FreeVariables
 import Data.Abstract.Heap
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable
+import Data.Abstract.Package
 import Data.Abstract.Origin
 import Data.Empty
 import qualified Data.IntMap as IntMap
@@ -308,6 +310,12 @@ currentModule = do
   o <- raise ask
   maybeM (raise (fail "unable to get currentModule")) $ withSomeOrigin (originModule @term) o
 
+-- | Get the currently evaluating 'PackageInfo'.
+currentPackage :: forall location term value effects m . MonadEvaluator location term value effects m => m effects PackageInfo
+currentPackage = do
+  o <- raise ask
+  maybeM (raise (fail "unable to get currentPackage")) $ withSomeOrigin (originPackage @term) o
+
 
 -- Control
 

src/Data/Abstract/Evaluatable.hs

@@ -38,6 +38,7 @@ import           Data.Abstract.Module
 import           Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Origin (SomeOrigin, packageOrigin)
 import           Data.Abstract.Package as Package
+import           Data.Language
 import           Data.Scientific (Scientific)
 import           Data.Semigroup.App
 import           Data.Semigroup.Foldable
@@ -54,7 +55,6 @@ type MonadEvaluatable location term value effects m =
   , Member (Exc.Exc (LoopThrow value)) effects
   , Member Fail effects
   , Member (Resumable (Unspecialized value)) effects
-  , Member (Resumable (ValueError location value)) effects
   , Member (Resumable (LoadError term value)) effects
   , Member (Resumable (EvalError value)) effects
   , Member (Resumable (ResolutionError value)) effects
@@ -78,17 +78,20 @@ data LoopThrow value
 
 -- | An error thrown when we can't resolve a module from a qualified name.
 data ResolutionError value resume where
-  RubyError :: String -> ResolutionError value ModulePath
+  NotFoundError :: String   -- ^ The path that was not found.
-  TypeScriptError :: String -> ResolutionError value ModulePath
+                -> [String] -- ^ List of paths searched that shows where semantic looked for this module.
+                -> Language -- ^ Language.
+                -> ResolutionError value ModulePath
+
+  GoImportError :: FilePath -> ResolutionError value [ModulePath]
 
 deriving instance Eq (ResolutionError a b)
 deriving instance Show (ResolutionError a b)
-instance Show1 (ResolutionError value) where
+instance Show1 (ResolutionError value) where liftShowsPrec _ _ = showsPrec
-  liftShowsPrec _ _ = showsPrec
 instance Eq1 (ResolutionError value) where
-  liftEq _ (RubyError a) (RubyError b)             = a == b
+  liftEq _ (NotFoundError a _ l1) (NotFoundError b _ l2) = a == b && l1 == l2
-  liftEq _ (TypeScriptError a) (TypeScriptError b) = a == b
+  liftEq _ (GoImportError a) (GoImportError b) = a == b
-  liftEq _ _ _                                     = False
+  liftEq _ _ _ = False
 
 -- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.
 data LoadError term value resume where

src/Data/Abstract/Package.hs

@@ -1,8 +1,10 @@
+{-# LANGUAGE TupleSections #-}
 module Data.Abstract.Package where
 
 import Data.Abstract.FreeVariables
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
+import qualified Data.Map as Map
 
 type PackageName = Name
 
@@ -31,12 +33,8 @@ data Package term = Package
   }
   deriving (Eq, Functor, Ord, Show)
 
-fromModules :: PackageName -> Maybe Version -> Maybe (Module term) -> [Module term] -> Package term
+fromModules :: PackageName -> Maybe Version -> Maybe (Module term) -> Int -> [Module term] -> Package term
-fromModules name version prelude = Package (PackageInfo name version) . go prelude
+fromModules name version prelude entryPoints modules =
+  Package (PackageInfo name version) (PackageBody (ModuleTable.fromModules modules) prelude entryPoints')
   where
-    go :: Maybe (Module term) -> [Module term] -> PackageBody term
+    entryPoints' = ModuleTable . Map.fromList $ (,Nothing) . modulePath . moduleInfo <$> if entryPoints == 0 then modules else take entryPoints modules
-    go p []     = PackageBody mempty p mempty
-    go p (m:ms) = PackageBody (ModuleTable.fromModules (m : ms)) p entryPoints
-      where
-        entryPoints = ModuleTable.singleton path Nothing
-        path = modulePath (moduleInfo m)

src/Data/Abstract/Type.hs

@@ -1,14 +1,18 @@
-{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE GADTs, TypeFamilies, UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- For the MonadValue instance, which requires MonadEvaluator to resolve its functional dependency.
-module Data.Abstract.Type where
+module Data.Abstract.Type
+  ( Type (..)
+  , TypeError (..)
+  , unify
+  ) where
 
 import Control.Abstract.Analysis
 import Data.Abstract.Address
 import Data.Abstract.Environment as Env
 import Data.Align (alignWith)
 import Data.Semigroup.Reducer (Reducer)
-import Prelude hiding (fail)
+import Prelude
-import Prologue
+import Prologue hiding (TypeError)
 
 type TName = Int
 
@@ -33,9 +37,26 @@ data Type
 
 -- TODO: À la carte representation of types.
 
+data TypeError resume where
+  NumOpError       :: Type -> Type -> TypeError Type
+  BitOpError       :: Type -> Type -> TypeError Type
+  UnificationError :: Type -> Type -> TypeError Type
+
+deriving instance Show (TypeError resume)
+
+instance Show1 TypeError where
+  liftShowsPrec _ _ _ (NumOpError l r)       = showString "NumOpError " . shows [l, r]
+  liftShowsPrec _ _ _ (BitOpError l r)       = showString "BitOpError " . shows [l, r]
+  liftShowsPrec _ _ _ (UnificationError l r) = showString "UnificationError " . shows [l, r]
+
+instance Eq1 TypeError where
+  liftEq _ (BitOpError a b) (BitOpError c d)             = a == c && b == d
+  liftEq _ (NumOpError a b) (NumOpError c d)             = a == c && b == d
+  liftEq _ (UnificationError a b) (UnificationError c d) = a == c && b == d
+  liftEq _ _ _                                           = False
 
 -- | Unify two 'Type's.
-unify :: (Effectful m, Applicative (m effects), Member Fail effects) => Type -> Type -> m effects Type
+unify :: (Effectful m, Applicative (m effects), Member (Resumable TypeError) effects) => Type -> Type -> m effects Type
 unify (a1 :-> b1) (a2 :-> b2) = (:->) <$> unify a1 a2 <*> unify b1 b2
 unify a Null = pure a
 unify Null b = pure b
@@ -45,8 +66,7 @@ unify a (Var _) = pure a
 unify (Product as) (Product bs) = Product <$> sequenceA (alignWith (these pure pure unify) as bs)
 unify t1 t2
   | t1 == t2  = pure t2
-  | otherwise = raise (fail ("cannot unify " ++ show t1 ++ " with " ++ show t2))
+  | otherwise = throwResumable (UnificationError t1 t2)
-
 
 instance Ord location => ValueRoots location Type where
   valueRoots _ = mempty
@@ -57,8 +77,8 @@ instance AbstractHole Type where
 
 -- | Discard the value arguments (if any), constructing a 'Type' instead.
 instance ( Alternative (m effects)
-         , Member Fail effects
          , Member Fresh effects
+         , Member (Resumable TypeError) effects
          , MonadAddressable location effects m
          , MonadEvaluator location term Type effects m
          , Reducer Type (Cell location Type)
@@ -93,28 +113,31 @@ instance ( Alternative (m effects)
 
   scopedEnvironment _ = pure mempty
 
-  asString _ = raise (fail "Must evaluate to Value to use asString")
+  asString t = unify t String $> ""
-  asPair _   = raise (fail "Must evaluate to Value to use asPair")
+  asPair t   = do
-  asBool _ = raise (fail "Must evaluate to Value to use asBool")
+    t1 <- raise fresh
+    t2 <- raise fresh
+    unify t (Product [Var t1, Var t2]) $> (Var t1, Var t2)
+  asBool t   = unify t Bool *> (pure True <|> pure False)
 
   isHole ty = pure (ty == Hole)
 
   ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')
 
-  liftNumeric _ Float = pure Float
+  liftNumeric _ Float      = pure Float
   liftNumeric _ Int        = pure Int
-  liftNumeric _ _          = raise (fail "Invalid type in unary numeric operation")
+  liftNumeric _ t          = throwResumable (NumOpError t Hole)
 
   liftNumeric2 _ left right = case (left, right) of
     (Float, Int) -> pure Float
     (Int, Float) -> pure Float
-    _                 -> unify left right
+    _            -> unify left right
 
   liftBitwise _ Int = pure Int
-  liftBitwise _ t   = raise (fail ("Invalid type passed to unary bitwise operation: " <> show t))
+  liftBitwise _ t   = throwResumable (BitOpError t Hole)
 
   liftBitwise2 _ Int Int = pure Int
-  liftBitwise2 _ t1 t2   = raise (fail ("Invalid types passed to binary bitwise operation: " <> show (t1, t2)))
+  liftBitwise2 _ t1 t2   = throwResumable (BitOpError t1 t2)
 
   liftComparison (Concrete _) left right = case (left, right) of
     (Float, Int) ->                     pure Bool
@@ -128,9 +151,10 @@ instance ( Alternative (m effects)
   call op params = do
     tvar <- raise fresh
     paramTypes <- sequenceA params
-    unified <- op `unify` (Product paramTypes :-> Var tvar)
+    let needed = Product paramTypes :-> Var tvar
+    unified <- op `unify` needed
     case unified of
       _ :-> ret -> pure ret
-      _         -> raise (fail "unification with a function produced something other than a function")
+      gotten    -> throwResumable (UnificationError needed gotten)
 
   loop f = f empty

src/Data/Abstract/Value.hs

@@ -202,7 +202,11 @@ instance AbstractHole (Value location) where
   hole = injValue Hole
 
 -- | Construct a 'Value' wrapping the value arguments (if any).
-instance (Monad (m effects), MonadEvaluatable location term (Value location) effects m) => MonadValue location (Value location) effects m where
+instance ( Monad (m effects)
+         , Member (Resumable (ValueError location (Value location))) effects
+         , MonadEvaluatable location term (Value location) effects m
+         )
+      => MonadValue location (Value location) effects m where
   unit     = pure . injValue $ Unit
   integer  = pure . injValue . Integer . Number.Integer
   boolean  = pure . injValue . Boolean
@@ -282,7 +286,7 @@ instance (Monad (m effects), MonadEvaluatable location term (Value location) eff
         tentative x i j = attemptUnsafeArithmetic (x i j)
 
         -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor
-        specialize :: MonadEvaluatable location term value effects m => Either ArithException Number.SomeNumber -> m effects value
+        specialize :: (Member (Resumable (ValueError location value)) effects, MonadEvaluatable location term value effects m) => Either ArithException Number.SomeNumber -> m effects value
         specialize (Left exc) = throwValueError (ArithmeticError exc)
         specialize (Right (Number.SomeNumber (Number.Integer i))) = integer i
         specialize (Right (Number.SomeNumber (Number.Ratio r)))   = rational r

src/Data/File.hs

@@ -2,7 +2,6 @@ module Data.File where
 
 import           Data.ByteString.Char8 as BC (pack)
 import           Data.Language
-import qualified Data.List.NonEmpty as NonEmpty
 import           Prologue
 import           System.FilePath.Posix
 
@@ -12,28 +11,20 @@ data File = File
   }
   deriving (Eq, Ord, Show)
 
+data Project = Project
+  { projectRootDir :: FilePath
+  , projectFiles :: [File]
+  , projectLanguage :: Language
+  , projectEntryPoints :: [File]
+  }
+  deriving (Eq, Ord, Show)
+
 file :: FilePath -> File
 file path = File path (languageForFilePath path)
   where languageForFilePath = languageForType . takeExtension
 
-data Project = Project
-  { projectEntryPoints :: NonEmpty File
-  , projectRootDir :: FilePath
-  , projectFiles :: [File]
-  }
-  deriving (Eq, Ord, Show)
-
-projectAllFiles :: Project -> [File]
-projectAllFiles Project{..} = NonEmpty.toList projectEntryPoints <> projectFiles
-
 projectName :: Project -> ByteString
 projectName = BC.pack . dropExtensions . takeFileName . projectRootDir
 
-projectLanguage :: Project -> Maybe Language
-projectLanguage = fileLanguage. projectEntryPoint
-
-projectEntryPoint :: Project -> File
-projectEntryPoint = NonEmpty.head . projectEntryPoints
-
 projectExtensions :: Project -> [String]
 projectExtensions = extensionsForLanguage . projectLanguage

src/Data/Language.hs

@@ -33,13 +33,12 @@ languageForType mediaType = case mediaType of
     ".phpt" -> Just PHP
     _ -> Nothing
 
-extensionsForLanguage :: Maybe Language -> [String]
+extensionsForLanguage :: Language -> [String]
-extensionsForLanguage Nothing         = []
+extensionsForLanguage language = case language of
-extensionsForLanguage (Just language) = case language of
+  Go -> [".go"]
-  Go -> ["go"]
+  JavaScript -> [".js"]
-  JavaScript -> ["js"]
+  PHP -> [".php"]
-  PHP -> ["php"]
+  Python -> [".py"]
-  Python -> ["py"]
+  Ruby -> [".rb"]
-  Ruby -> ["rb"]
+  TypeScript -> [".ts", ".tsx", ".d.tsx"]
-  TypeScript -> ["ts", "tsx", "d.tsx"]
   _ -> []

src/Language/Go/Syntax.hs

@@ -1,32 +1,49 @@
-{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveAnyClass, ScopedTypeVariables #-}
 module Language.Go.Syntax where
 
-import Data.Abstract.Evaluatable hiding (Label)
+import           Data.Abstract.Evaluatable hiding (Label)
-import Data.Abstract.Module
+import           Data.Abstract.FreeVariables (Name (..), name)
-import Data.Abstract.Path
+import           Data.Abstract.Module
-import Data.Abstract.FreeVariables (name)
+import qualified Data.Abstract.Package as Package
-import Diffing.Algorithm
+import           Data.Abstract.Path
-import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString as B
-import System.FilePath.Posix
+import qualified Data.ByteString.Char8 as BC
-import Prologue
+import           Diffing.Algorithm
+import           Prologue
+import           System.FilePath.Posix
 
-newtype ImportPath = ImportPath { unPath :: FilePath }
+data Relative = Relative | NonRelative
+  deriving (Eq, Ord, Show)
+
+data ImportPath = ImportPath { unPath :: FilePath, pathIsRelative :: Relative }
   deriving (Eq, Ord, Show)
 
 importPath :: ByteString -> ImportPath
-importPath str = let path = stripQuotes str in ImportPath (BC.unpack path)
+importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (pathType path)
-  where stripQuotes = B.filter (`B.notElem` "\'\"")
+  where
+    stripQuotes = B.filter (`B.notElem` "\'\"")
+    pathType xs | not (B.null xs), BC.head xs == '.' = Relative
+                | otherwise = NonRelative
 
 defaultAlias :: ImportPath -> Name
 defaultAlias = name . BC.pack . takeFileName . unPath
 
--- TODO: need to delineate between relative and absolute Go imports
+resolveGoImport :: forall value term location effects m. MonadEvaluatable location term value effects m => ImportPath -> m effects [ModulePath]
-resolveGoImport :: MonadEvaluatable location term value effects m => FilePath -> m effects [ModulePath]
+resolveGoImport (ImportPath path Relative) = do
-resolveGoImport relImportPath = do
   ModuleInfo{..} <- currentModule
-  let relRootDir = takeDirectory modulePath
+  paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path)
-  listModulesInDir (joinPaths relRootDir relImportPath)
+  case paths of
+    [] -> throwResumable @(ResolutionError value) $ GoImportError path
+    _ -> pure paths
+resolveGoImport (ImportPath path NonRelative) = do
+  package <- BC.unpack . unName . Package.packageName <$> currentPackage
+  traceM ("attempting to resolve " <> show path <> " for package " <> package)
+  case splitDirectories path of
+    -- Import an absolute path that's defined in this package being analyized.
+    -- First two are source, next is package name, remaining are path to package
+    -- (e.g. github.com/golang/<package>/path...).
+    (_ : _ : p : xs) | p == package -> listModulesInDir (joinPath xs)
+    _ -> throwResumable @(ResolutionError value) $ GoImportError path
 
 -- | Import declarations (symbols are added directly to the calling environment).
 --
@@ -39,10 +56,10 @@ instance Ord1 Import where liftCompare = genericLiftCompare
 instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Import where
-  eval (Import (ImportPath name) _) = do
+  eval (Import importPath _) = do
-    paths <- resolveGoImport name
+    paths <- resolveGoImport importPath
     for_ paths $ \path -> do
-      (importedEnv, _) <- traceResolve name path $ isolate (require path)
+      (importedEnv, _) <- traceResolve (unPath importPath) path $ isolate (require path)
       modifyEnv (mappend importedEnv)
     unit
 
@@ -58,12 +75,12 @@ instance Ord1 QualifiedImport where liftCompare = genericLiftCompare
 instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable QualifiedImport where
-  eval (QualifiedImport (ImportPath name) aliasTerm) = do
+  eval (QualifiedImport importPath aliasTerm) = do
-    paths <- resolveGoImport name
+    paths <- resolveGoImport importPath
     alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm)
     void $ letrec' alias $ \addr -> do
       for_ paths $ \path -> do
-        (importedEnv, _) <- traceResolve name path $ isolate (require path)
+        (importedEnv, _) <- traceResolve (unPath importPath) path $ isolate (require path)
         modifyEnv (mappend importedEnv)
 
       makeNamespace alias addr []
@@ -78,9 +95,9 @@ instance Ord1 SideEffectImport where liftCompare = genericLiftCompare
 instance Show1 SideEffectImport where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable SideEffectImport where
-  eval (SideEffectImport (ImportPath name) _) = do
+  eval (SideEffectImport importPath _) = do
-    paths <- resolveGoImport name
+    paths <- resolveGoImport importPath
-    for_ paths $ \path -> traceResolve name path $ isolate (require path)
+    for_ paths $ \path -> traceResolve (unPath importPath) path $ isolate (require path)
     unit
 
 -- A composite literal in Go

src/Language/PHP/Syntax.hs

@@ -1,10 +1,11 @@
-{-# LANGUAGE DeriveAnyClass, ViewPatterns #-}
+{-# LANGUAGE DeriveAnyClass, ViewPatterns, ScopedTypeVariables #-}
 module Language.PHP.Syntax where
 
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Module
 import           Data.Abstract.Path
 import qualified Data.ByteString.Char8 as BC
+import qualified Data.Language as Language
 import           Diffing.Algorithm
 import           Prelude hiding (fail)
 import           Prologue hiding (Text)
@@ -34,25 +35,21 @@ instance Evaluatable VariableName
 -- file, the complete contents of the included file are treated as though it
 -- were defined inside that function.
 
-resolvePHPName :: MonadEvaluatable location term value effects m => ByteString -> m effects ModulePath
+resolvePHPName :: forall value location term effects m. MonadEvaluatable location term value effects m => ByteString -> m effects ModulePath
-resolvePHPName n = resolve [name] >>= maybeM (raise (fail notFound))
+resolvePHPName n = do
+  modulePath <- resolve [name]
+  maybe (throwResumable @(ResolutionError value) $ NotFoundError name [name] Language.PHP) pure modulePath
   where name = toName n
-        notFound = "Unable to resolve: " <> name
         toName = BC.unpack . dropRelativePrefix . stripQuotes
 
-doInclude :: MonadEvaluatable location term value effects m => Subterm t (m effects value) -> m effects value
+include :: MonadEvaluatable location term value effects m
-doInclude pathTerm = do
+        => Subterm t (m effects value)
+        -> (ModulePath -> m effects (Environment location value, value))
+        -> m effects value
+include pathTerm f = do
   name <- subtermValue pathTerm >>= asString
   path <- resolvePHPName name
-  (importedEnv, v) <- traceResolve name path $ isolate (load path)
+  (importedEnv, v) <- traceResolve name path $ isolate (f path)
-  modifyEnv (mappend importedEnv)
-  pure v
-
-doIncludeOnce :: MonadEvaluatable location term value effects m => Subterm t (m effects value) -> m effects value
-doIncludeOnce pathTerm = do
-  name <- subtermValue pathTerm >>= asString
-  path <- resolvePHPName name
-  (importedEnv, v) <- traceResolve name path $ isolate (require path)
   modifyEnv (mappend importedEnv)
   pure v
 
@@ -64,7 +61,7 @@ instance Ord1 Require where liftCompare    = genericLiftCompare
 instance Show1 Require where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Require where
-  eval (Require path) = doInclude path
+  eval (Require path) = include path load
 
 
 newtype RequireOnce a = RequireOnce a
@@ -75,7 +72,7 @@ instance Ord1 RequireOnce where liftCompare = genericLiftCompare
 instance Show1 RequireOnce where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable RequireOnce where
-  eval (RequireOnce path) = doIncludeOnce path
+  eval (RequireOnce path) = include path require
 
 
 newtype Include a = Include a
@@ -86,7 +83,7 @@ instance Ord1 Include where liftCompare    = genericLiftCompare
 instance Show1 Include where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Include where
-  eval (Include path) = doInclude path
+  eval (Include path) = include path load
 
 
 newtype IncludeOnce a = IncludeOnce a
@@ -97,7 +94,7 @@ instance Ord1 IncludeOnce where liftCompare    = genericLiftCompare
 instance Show1 IncludeOnce where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable IncludeOnce where
-  eval (IncludeOnce path) = doIncludeOnce path
+  eval (IncludeOnce path) = include path require
 
 
 newtype ArrayElement a = ArrayElement a

src/Language/Python/Syntax.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses #-}
+{-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables #-}
 module Language.Python.Syntax where
 
 import           Data.Abstract.Environment as Env
@@ -8,7 +8,7 @@ import           Data.Abstract.Module
 import           Data.Align.Generic
 import qualified Data.ByteString.Char8 as BC
 import           Data.Functor.Classes.Generic
-import           Data.List (intercalate)
+import qualified Data.Language as Language
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Mergeable
 import           Diffing.Algorithm
@@ -51,14 +51,14 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (BC.unpack prefix) (J
 -- Subsequent imports of `parent.two` or `parent.three` will execute
 --     `parent/two/__init__.py` and
 --     `parent/three/__init__.py` respectively.
-resolvePythonModules :: MonadEvaluatable location term value effects m => QualifiedName -> m effects (NonEmpty ModulePath)
+resolvePythonModules :: forall value term location effects m. MonadEvaluatable location term value effects m => QualifiedName -> m effects (NonEmpty ModulePath)
 resolvePythonModules q = do
   relRootDir <- rootDir q <$> currentModule
   for (moduleNames q) $ \name -> do
     x <- search relRootDir name
     traceResolve name x $ pure x
   where
-    rootDir (QualifiedName _) ModuleInfo{..}           = takeDirectory modulePath
+    rootDir (QualifiedName _) ModuleInfo{..}           = mempty -- overall rootDir of the Package.
     rootDir (RelativeQualifiedName n _) ModuleInfo{..} = upDir numDots (takeDirectory modulePath)
       where numDots = pred (length n)
             upDir n dir | n <= 0 = dir
@@ -68,17 +68,14 @@ resolvePythonModules q = do
     moduleNames (RelativeQualifiedName x Nothing)      = error $ "importing from '" <> show x <> "' is not implemented"
     moduleNames (RelativeQualifiedName _ (Just paths)) = moduleNames paths
 
-    notFound xs = "Unable to resolve module import: " <> friendlyName q <> ", searched: " <> show xs
     search rootDir x = do
+      traceM ("searching for " <> show x <> " in " <> show rootDir)
       let path = normalise (rootDir </> normalise x)
       let searchPaths = [ path </> "__init__.py"
                         , path <.> ".py"
                         ]
-      resolve searchPaths >>= maybeM (raise (fail (notFound searchPaths)))
+      modulePath <- resolve searchPaths
-
+      maybe (throwResumable @(ResolutionError value) $ NotFoundError path searchPaths Language.Python) pure modulePath
-    friendlyName :: QualifiedName -> String
-    friendlyName (QualifiedName xs)                = intercalate "." (NonEmpty.toList xs)
-    friendlyName (RelativeQualifiedName prefix qn) = prefix <> maybe "" friendlyName qn
 
 
 -- | Import declarations (symbols are added directly to the calling environment).

src/Language/Ruby/Syntax.hs

@@ -7,6 +7,7 @@ import           Data.Abstract.Module (ModulePath)
 import           Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Path
 import qualified Data.ByteString.Char8 as BC
+import qualified Data.Language as Language
 import           Diffing.Algorithm
 import           Prelude hiding (fail)
 import           Prologue
@@ -19,15 +20,16 @@ import           System.FilePath.Posix
 resolveRubyName :: forall value term location effects m. MonadEvaluatable location term value effects m => ByteString -> m effects ModulePath
 resolveRubyName name = do
   let name' = cleanNameOrPath name
-  modulePath <- resolve [name' <.> "rb"]
+  let paths = [name' <.> "rb"]
-  maybe (throwResumable @(ResolutionError value) $ RubyError name') pure modulePath
+  modulePath <- resolve paths
+  maybe (throwResumable @(ResolutionError value) $ NotFoundError name' paths Language.Ruby) pure modulePath
 
 -- load "/root/src/file.rb"
 resolveRubyPath :: forall value term location effects m. MonadEvaluatable location term value effects m => ByteString -> m effects ModulePath
 resolveRubyPath path = do
   let name' = cleanNameOrPath path
   modulePath <- resolve [name']
-  maybe (throwResumable @(ResolutionError value) $ RubyError name') pure modulePath
+  maybe (throwResumable @(ResolutionError value) $ NotFoundError name' [name'] Language.Ruby) pure modulePath
 
 cleanNameOrPath :: ByteString -> String
 cleanNameOrPath = BC.unpack . dropRelativePrefix . stripQuotes

src/Language/TypeScript/Syntax.hs

@@ -8,6 +8,7 @@ import           Data.Abstract.Path
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString as B
 import           Data.Abstract.Module (ModulePath, ModuleInfo(..))
+import qualified Data.Language as Language
 import           Diffing.Algorithm
 import           Prelude
 import           Prologue
@@ -49,7 +50,7 @@ resolveRelativePath relImportPath exts = do
   let path = joinPaths relRootDir relImportPath
   resolveTSModule path exts >>= either notFound (\x -> traceResolve relImportPath x (pure x))
   where
-    notFound _ = throwResumable @(ResolutionError value) $ TypeScriptError relImportPath
+    notFound xs = throwResumable @(ResolutionError value) $ NotFoundError relImportPath xs Language.TypeScript
 
 -- | Resolve a non-relative TypeScript import to a known 'ModuleName' or fail.
 --
@@ -74,7 +75,7 @@ resolveNonRelativePath name exts = do
         Left xs | parentDir <- takeDirectory path , root /= parentDir -> go root parentDir (searched <> xs)
                 | otherwise -> notFound (searched <> xs)
         Right m -> traceResolve name m $ pure m
-    notFound _ = throwResumable @(ResolutionError value) $ TypeScriptError name
+    notFound xs = throwResumable @(ResolutionError value) $ NotFoundError name xs Language.TypeScript
 
 resolveTSModule :: MonadEvaluatable location term value effects m => FilePath -> [String] -> m effects (Either [FilePath] ModulePath)
 resolveTSModule path exts = maybe (Left searchPaths) Right <$> resolve searchPaths

src/Semantic/CLI.hs

@@ -7,8 +7,8 @@ module Semantic.CLI
 ) where
 
 import           Data.File
+import           Data.Language
 import           Data.List (intercalate)
-import qualified Data.List.NonEmpty as NonEmpty
 import           Data.List.Split (splitWhen)
 import           Data.Version (showVersion)
 import           Development.GitRev
@@ -25,7 +25,6 @@ import qualified Semantic.Task as Task
 import           System.IO (Handle, stdin, stdout)
 import           Text.Read
 
-
 main :: IO ()
 main = customExecParser (prefs showHelpOnEmpty) arguments >>= uncurry Task.runTaskWithOptions
 
@@ -35,8 +34,8 @@ runDiff (SomeRenderer diffRenderer) = Semantic.diffBlobPairs diffRenderer <=< Ta
 runParse :: SomeRenderer TermRenderer -> Either Handle [File] -> Task.TaskEff ByteString
 runParse (SomeRenderer parseTreeRenderer) = Semantic.parseBlobs parseTreeRenderer <=< Task.readBlobs
 
-runGraph :: SomeRenderer GraphRenderer -> Maybe FilePath -> NonEmpty File -> Task.TaskEff ByteString
+runGraph :: SomeRenderer GraphRenderer -> Maybe FilePath -> FilePath -> Language -> [FilePath] -> Task.TaskEff ByteString
-runGraph (SomeRenderer r) dir = Semantic.graph r <=< Task.readProject dir
+runGraph (SomeRenderer r) rootDir dir excludeDirs = Semantic.graph r <=< Task.readProject rootDir dir excludeDirs
 
 -- | A parser for the application's command-line arguments.
 --
@@ -85,20 +84,21 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
       filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin)
       pure $ runParse renderer filesOrStdin
 
-    graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute import/call graph for an entry point"))
+    graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute an import graph a directory or entry point"))
     graphArgumentsParser = do
       renderer <- flag (SomeRenderer DOTGraphRenderer) (SomeRenderer DOTGraphRenderer)  (long "dot" <> help "Output in DOT graph format (default)")
               <|> flag'                                (SomeRenderer JSONGraphRenderer) (long "json" <> help "Output JSON graph")
-      rootDir <- optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file's directory." <> metavar "DIRECTORY"))
+      rootDir <- optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIRECTORY"))
-      entryPoints <- NonEmpty.some1 (argument filePathReader (metavar "FILES..." <> help "Entry point(s)"))
+      excludeDirs <- many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)"))
-      pure $ runGraph renderer rootDir entryPoints
+      File{..} <- argument filePathReader (metavar "DIRECTORY:LANGUAGE")
+      pure $ runGraph renderer rootDir filePath (fromJust fileLanguage) excludeDirs
 
     filePathReader = eitherReader parseFilePath
     parseFilePath arg = case splitWhen (== ':') arg of
-        [a, b] | Just lang <- readMaybe a -> Right (File b (Just lang))
+        [a, b] | lang <- readMaybe b -> Right (File a lang)
-               | Just lang <- readMaybe b -> Right (File a (Just lang))
+               | lang <- readMaybe a -> Right (File b lang)
-        [path] -> Right (File path (languageForFilePath path))
+        [path] -> maybe (Left $ "Cannot identify language for path: " <> path) (Right . File path . Just) (languageForFilePath path)
-        _ -> Left ("cannot parse `" <> arg <> "`\nexpecting LANGUAGE:FILE or just FILE")
+        args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE")
 
     optionsReader options = eitherReader $ \ str -> maybe (Left ("expected one of: " <> intercalate ", " (fmap fst options))) (Right . snd) (find ((== str) . fst) options)
     options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options)))

src/Semantic/Graph.hs

@@ -23,7 +23,7 @@ import           Data.Output
 import           Parsing.Parser
 import           Prologue hiding (MonadError (..))
 import           Rendering.Renderer
-import           Semantic.IO (Files, NoLanguageForBlob (..))
+import           Semantic.IO (Files)
 import           Semantic.Task
 
 graph :: (Members '[Distribute WrappedTask, Files, Task, Exc SomeException, Telemetry] effs)
@@ -31,14 +31,12 @@ graph :: (Members '[Distribute WrappedTask, Files, Task, Exc SomeException, Tele
       -> Project
       -> Eff effs ByteString
 graph renderer project
-  | Just (SomeAnalysisParser parser prelude) <- someAnalysisParser
+  | SomeAnalysisParser parser prelude <- someAnalysisParser
-    (Proxy :: Proxy '[ Analysis.Evaluatable, Analysis.Declarations1, FreeVariables1, Functor, Eq1, Ord1, Show1 ]) <$> projectLanguage project = do
+    (Proxy :: Proxy '[ Analysis.Evaluatable, Analysis.Declarations1, FreeVariables1, Functor, Eq1, Ord1, Show1 ]) (projectLanguage project) = do
     parsePackage parser prelude project >>= graphImports >>= case renderer of
       JSONGraphRenderer -> pure . toOutput
       DOTGraphRenderer -> pure . Abstract.renderImportGraph
 
-  | otherwise = throwError (SomeException (NoLanguageForBlob (filePath (projectEntryPoint project))))
-
 -- | Parse a list of files into a 'Package'.
 parsePackage :: Members '[Distribute WrappedTask, Files, Task] effs
              => Parser term       -- ^ A parser.
@@ -47,14 +45,14 @@ parsePackage :: Members '[Distribute WrappedTask, Files, Task] effs
              -> Eff effs (Package term)
 parsePackage parser preludeFile project@Project{..} = do
   prelude <- traverse (parseModule parser Nothing) preludeFile
-  Package.fromModules n Nothing prelude <$> parseModules parser project
+  p <- parseModules parser project
+  trace ("project: " <> show p) $ pure (Package.fromModules n Nothing prelude (length projectEntryPoints) p)
   where
     n = name (projectName project)
 
     -- | Parse all files in a project into 'Module's.
     parseModules :: Members '[Distribute WrappedTask, Files, Task] effs => Parser term -> Project -> Eff effs [Module term]
-    parseModules parser project@Project{..} = distributeFor allFiles (WrapTask . parseModule parser (Just projectRootDir))
+    parseModules parser Project{..} = distributeFor (projectEntryPoints <> projectFiles) (WrapTask . parseModule parser (Just projectRootDir))
-      where allFiles = projectAllFiles project
 
     -- | Parse a file into a 'Module'.
     parseModule :: Members '[Files, Task] effs => Parser term -> Maybe FilePath -> File -> Eff effs (Module term)

src/Semantic/IO.hs

@@ -6,7 +6,9 @@ module Semantic.IO
 , readBlobPairsFromHandle
 , readBlobsFromHandle
 , readBlobsFromPaths
+, readProjectFromPaths
 , readBlobsFromDir
+, findFiles
 , languageForFilePath
 , NoLanguageForBlob(..)
 , readBlob
@@ -32,10 +34,11 @@ import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 import           Data.Language
 import           Data.Source
-import qualified Data.List.NonEmpty as NonEmpty
 import           Prelude hiding (readFile)
 import           Prologue hiding (MonadError (..), fail)
 import           System.Directory (doesDirectoryExist)
+import qualified System.Directory.Tree as Tree
+import           System.Directory.Tree (AnchoredDirTree(..))
 import           System.Exit
 import           System.FilePath
 import           System.FilePath.Glob
@@ -87,16 +90,42 @@ readBlobFromPath file = do
 readBlobsFromPaths :: MonadIO m => [File] -> m [Blob.Blob]
 readBlobsFromPaths files = catMaybes <$> traverse readFile files
 
-readProjectFromPaths :: MonadIO m => Maybe FilePath -> NonEmpty File -> m Project
+readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project
-readProjectFromPaths root files = do
+readProjectFromPaths maybeRoot path lang excludeDirs = do
-  paths <- liftIO $ filter (/= entryPointPath) <$> fmap fold (globDir (compile . mappend "**/*." <$> exts) rootDir)
+  isDir <- isDirectory path
-  pure $ Project files rootDir (toFile <$> paths)
+  let (filterFun, entryPoints, rootDir) = if isDir
+      then (id, [], fromMaybe path maybeRoot)
+      else (filter (/= path), [toFile path], fromMaybe (takeDirectory path) maybeRoot)
+
+  paths <- liftIO $ filterFun <$> findFiles rootDir exts excludeDirs
+  pure $ Project rootDir (toFile <$> paths) lang entryPoints
   where
-    toFile path = File path (languageForFilePath path)
+    toFile path = File path (Just lang)
-    exts = extensionsForLanguage (fileLanguage entryPoint)
+    exts = extensionsForLanguage lang
-    entryPoint = NonEmpty.head files
+
-    entryPointPath = filePath entryPoint
+-- Recursively find files in a directory.
-    rootDir = fromMaybe (takeDirectory entryPointPath) root
+findFiles :: forall m. MonadIO m => FilePath -> [String] -> [FilePath] -> m [FilePath]
+findFiles path exts excludeDirs = do
+  _:/dir <- liftIO $ Tree.build path
+  pure $ (onlyFiles . Tree.filterDir (withExtensions exts) . Tree.filterDir (notIn excludeDirs)) dir
+  where
+    -- Build a list of only FilePath's (remove directories and failures)
+    onlyFiles (Tree.Dir _ fs)   = concatMap onlyFiles fs
+    onlyFiles (Tree.Failed _ _) = []
+    onlyFiles (Tree.File _ f)   = [f]
+
+    -- Predicate for Files with one of the extensions in 'exts'.
+    withExtensions exts (Tree.File n _)
+      | takeExtension n `elem` exts = True
+      | otherwise                   = False
+    withExtensions _ _              = True
+
+    -- Predicate for contents NOT in a directory
+    notIn dirs (Tree.Dir n _)
+      | (x:_) <- n, x == '.' = False -- Don't include directories that start with '.'.
+      | n `elem` dirs = False
+      | otherwise = True
+    notIn _ _ = True
 
 readBlobsFromDir :: MonadIO m => FilePath -> m [Blob.Blob]
 readBlobsFromDir path = do
@@ -160,8 +189,8 @@ readBlobs = send . ReadBlobs
 readBlobPairs :: Member Files effs => Either Handle [Both File] -> Eff effs [Blob.BlobPair]
 readBlobPairs = send . ReadBlobPairs
 
-readProject :: Member Files effs => Maybe FilePath -> NonEmpty File -> Eff effs Project
+readProject :: Member Files effs => Maybe FilePath -> FilePath -> Language -> [FilePath] -> Eff effs Project
-readProject dir files = send (ReadProject dir files)
+readProject rootDir dir excludeDirs = send . ReadProject rootDir dir excludeDirs
 
 -- | A task which writes a 'B.ByteString' to a 'Handle' or a 'FilePath'.
 writeToOutput :: Member Files effs => Either Handle FilePath -> B.ByteString -> Eff effs ()
@@ -173,7 +202,7 @@ data Files out where
   ReadBlob      :: File -> Files Blob.Blob
   ReadBlobs     :: Either Handle [File] -> Files [Blob.Blob]
   ReadBlobPairs :: Either Handle [Both File] -> Files [Blob.BlobPair]
-  ReadProject   :: Maybe FilePath -> NonEmpty File -> Files Project
+  ReadProject   :: Maybe FilePath -> FilePath -> Language -> [FilePath] -> Files Project
   WriteToOutput :: Either Handle FilePath -> B.ByteString -> Files ()
 
 -- | Run a 'Files' effect in 'IO'.
@@ -181,10 +210,10 @@ runFiles :: Members '[Exc SomeException, IO] effs => Eff (Files ': effs) a -> Ef
 runFiles = interpret $ \ files -> case files of
   ReadBlob path -> rethrowing (readBlobFromPath path)
   ReadBlobs (Left handle) -> rethrowing (readBlobsFromHandle handle)
-  ReadBlobs (Right paths@[File path Nothing]) -> rethrowing (isDirectory path >>= bool (readBlobsFromPaths paths) (readBlobsFromDir path))
+  ReadBlobs (Right paths@[File path _]) -> rethrowing (isDirectory path >>= bool (readBlobsFromPaths paths) (readBlobsFromDir path))
   ReadBlobs (Right paths) -> rethrowing (readBlobsFromPaths paths)
   ReadBlobPairs source -> rethrowing (either readBlobPairsFromHandle (traverse (runBothWith readFilePair)) source)
-  ReadProject dir files -> rethrowing (readProjectFromPaths dir files)
+  ReadProject rootDir dir language excludeDirs -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs)
   WriteToOutput destination contents -> liftIO (either B.hPutStr B.writeFile destination contents)
 
 

src/Semantic/Util.hs

@@ -8,14 +8,17 @@ import           Analysis.Abstract.BadModuleResolutions
 import           Analysis.Abstract.BadSyntax
 import           Analysis.Abstract.BadValues
 import           Analysis.Abstract.BadVariables
+import           Analysis.Abstract.Caching
 import           Analysis.Abstract.Erroring
-import           Analysis.Abstract.Evaluating
+import           Analysis.Abstract.Evaluating as X
 import           Analysis.Abstract.ImportGraph
+import           Analysis.Abstract.TypeChecking
 import           Analysis.Declaration
 import           Control.Abstract.Analysis
 import           Data.Abstract.Address
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Located
+import           Data.Abstract.Type
 import           Data.Abstract.Value
 import           Data.Blob
 import           Data.Diff
@@ -52,25 +55,35 @@ type JustEvaluating term
   ( Evaluating (Located Precise term) term (Value (Located Precise term)))))))
 type EvaluatingWithHoles term = BadAddresses (BadModuleResolutions (BadVariables (BadValues (BadSyntax (Evaluating (Located Precise term) term (Value (Located Precise term)))))))
 type ImportGraphingWithHoles term = ImportGraphing (EvaluatingWithHoles term)
+-- The order is significant here: Caching has to come on the outside, or the RunEffect instance for NonDet
+-- will expect the TypeError exception type to have an Ord instance, which is wrong.
+type Checking term
+  = Caching
+  ( TypeChecking
+  ( Erroring (AddressError Monovariant Type)
+  ( Erroring (EvalError Type)
+  ( Erroring (ResolutionError Type)
+  ( Erroring (Unspecialized Type)
+  ( Evaluating Monovariant term Type))))))
 
-evalGoProject path = runAnalysis @(JustEvaluating Go.Term) <$> evaluateProject goParser Nothing path
+evalGoProject path = runAnalysis @(JustEvaluating Go.Term) <$> evaluateProject goParser Language.Go Nothing path
-evalRubyProject path = runAnalysis @(JustEvaluating Ruby.Term) <$> evaluateProject rubyParser rubyPrelude path
+evalRubyProject path = runAnalysis @(JustEvaluating Ruby.Term) <$> evaluateProject rubyParser Language.Ruby rubyPrelude path
-evalPHPProject path = runAnalysis @(JustEvaluating PHP.Term) <$> evaluateProject phpParser Nothing path
+evalPHPProject path = runAnalysis @(JustEvaluating PHP.Term) <$> evaluateProject phpParser Language.PHP Nothing path
-evalPythonProject path = runAnalysis @(JustEvaluating Python.Term) <$> evaluateProject pythonParser pythonPrelude path
+evalPythonProject path = runAnalysis @(JustEvaluating Python.Term) <$> evaluateProject pythonParser Language.Python pythonPrelude path
-evalTypeScriptProject path = runAnalysis @(EvaluatingWithHoles TypeScript.Term) <$> evaluateProject typescriptParser Nothing path
+evalTypeScriptProjectQuietly path = runAnalysis @(EvaluatingWithHoles TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path
+evalTypeScriptProject path = runAnalysis @(JustEvaluating TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path
+
+typecheckGoFile path = runAnalysis @(Checking Go.Term) <$> evaluateProject goParser Language.Go Nothing path
 
 rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) (Just Language.Ruby)
 pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) (Just Language.Python)
 
 -- Evaluate a project, starting at a single entrypoint.
-evaluateProject parser prelude path = evaluatePackage <$> runTask (readProject Nothing (file path :| []) >>= parsePackage parser prelude)
+evaluateProject parser lang prelude path = evaluatePackage <$> runTask (readProject Nothing path lang [] >>= parsePackage parser prelude)
 
-
--- Read and parse a file.
 parseFile :: Parser term -> FilePath -> IO term
 parseFile parser = runTask . (parse parser <=< readBlob . file)
 
--- Read a file from the filesystem into a Blob.
 blob :: FilePath -> IO Blob
 blob = runTask . readBlob . file
 

test/Analysis/Go/Spec.hs

@@ -3,6 +3,7 @@ module Analysis.Go.Spec (spec) where
 
 import Data.Abstract.Evaluatable (EvalError(..), runAnalysis)
 import qualified Language.Go.Assignment as Go
+import qualified Data.Language as Language
 
 import SpecHelpers
 
@@ -31,4 +32,4 @@ spec = parallel $ do
   where
     fixtures = "test/fixtures/go/analysis/"
     evaluate entry = evalGoProject (fixtures <> entry)
-    evalGoProject path = runAnalysis @(TestEvaluating Go.Term) <$> evaluateProject goParser Nothing path
+    evalGoProject path = runAnalysis @(TestEvaluating Go.Term) <$> evaluateProject goParser Language.Go Nothing path

test/Analysis/PHP/Spec.hs

@@ -3,6 +3,7 @@ module Analysis.PHP.Spec (spec) where
 
 import Data.Abstract.Evaluatable (EvalError(..), runAnalysis)
 import qualified Language.PHP.Assignment as PHP
+import qualified Data.Language as Language
 
 import SpecHelpers
 
@@ -35,4 +36,4 @@ spec = parallel $ do
   where
     fixtures = "test/fixtures/php/analysis/"
     evaluate entry = evalPHPProject (fixtures <> entry)
-    evalPHPProject path = runAnalysis @(TestEvaluating PHP.Term) <$> evaluateProject phpParser Nothing path
+    evalPHPProject path = runAnalysis @(TestEvaluating PHP.Term) <$> evaluateProject phpParser Language.PHP Nothing path

test/Analysis/Python/Spec.hs

@@ -5,6 +5,7 @@ import Data.Abstract.Evaluatable (EvalError(..), runAnalysis)
 import Data.Abstract.Value
 import Data.Map
 import qualified Language.Python.Assignment as Python
+import qualified Data.Language as Language
 
 import SpecHelpers
 
@@ -50,4 +51,4 @@ spec = parallel $ do
     addr = Address . Precise
     fixtures = "test/fixtures/python/analysis/"
     evaluate entry = evalPythonProject (fixtures <> entry)
-    evalPythonProject path = runAnalysis @(TestEvaluating Python.Term) <$> evaluateProject pythonParser pythonPrelude path
+    evalPythonProject path = runAnalysis @(TestEvaluating Python.Term) <$> evaluateProject pythonParser Language.Python pythonPrelude path

test/Analysis/Ruby/Spec.hs

@@ -10,6 +10,7 @@ import Data.List.NonEmpty (NonEmpty(..))
 import Data.Map
 import Data.Map.Monoidal as Map
 import qualified Language.Ruby.Assignment as Ruby
+import qualified Data.Language as Language
 
 import SpecHelpers
 
@@ -71,4 +72,4 @@ spec = parallel $ do
     addr = Address . Precise
     fixtures = "test/fixtures/ruby/analysis/"
     evaluate entry = evalRubyProject (fixtures <> entry)
-    evalRubyProject path = runAnalysis @(TestEvaluating Ruby.Term) <$> evaluateProject rubyParser rubyPrelude path
+    evalRubyProject path = runAnalysis @(TestEvaluating Ruby.Term) <$> evaluateProject rubyParser Language.Ruby rubyPrelude path

test/Analysis/TypeScript/Spec.hs

@@ -5,6 +5,7 @@ import Data.Abstract.Evaluatable
 import qualified Language.TypeScript.Assignment as TypeScript
 import Data.Abstract.Value as Value
 import Data.Abstract.Number as Number
+import qualified Data.Language as Language
 
 import SpecHelpers
 
@@ -42,4 +43,4 @@ spec = parallel $ do
   where
     fixtures = "test/fixtures/typescript/analysis/"
     evaluate entry = evalTypeScriptProject (fixtures <> entry)
-    evalTypeScriptProject path = runAnalysis @(TestEvaluating TypeScript.Term) <$> evaluateProject typescriptParser Nothing path
+    evalTypeScriptProject path = runAnalysis @(TestEvaluating TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path

test/fixtures/go/corpus/single-import-declarations.diffB-A.txt

@@ -5,10 +5,10 @@
   {+(Identifier)+})+}
 {+(Import
   {+(TextElement)+})+}
-{ (QualifiedImport
+{+(QualifiedImport
-  {-(Identifier)-})
+  {+(Identifier)+})+}
-->(QualifiedImport
+{-(QualifiedImport
-  {+(Identifier)+}) }
+  {-(Identifier)-})-}
 {-(Import
   {-(TextElement)-})-}
 {-(QualifiedImport