From 99683992cf98992877447677e32ecad2418cb718 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 1 Oct 2019 17:03:27 -0400 Subject: [PATCH 1/3] Remove Data.Project.readFile and :fire: error handling in Graph. Because `Data.Project.readFile` could throw an `FileNotFound` error when looking up `Blob` values in a project for a given `File`, the code that kicks off graphing required an error constraint. Turns out we don't even need it: if we have a project, we can access its blobs directly, since `Blob`s contain `File`s. This allows us to obviate `Project.readFile` in the first place, which allows us to entirely sidestep the need to handle errors. --- src/Data/Project.hs | 14 -------------- src/Semantic/Graph.hs | 36 +++++++++++++++--------------------- src/Semantic/Task/Files.hs | 2 +- src/Semantic/Util.hs | 2 +- 4 files changed, 17 insertions(+), 37 deletions(-) diff --git a/src/Data/Project.hs b/src/Data/Project.hs index d40033786..170cfb334 100644 --- a/src/Data/Project.hs +++ b/src/Data/Project.hs @@ -6,14 +6,12 @@ module Data.Project , projectExtensions , projectName , projectFiles - , readFile , readProjectFromPaths ) where import Prelude hiding (readFile) import Prologue -import Control.Effect.Error import Data.Blob import Data.Blob.IO import Data.Language @@ -43,18 +41,6 @@ newtype ProjectException = FileNotFound FilePath deriving (Show, Eq, Typeable, Exception) -readFile :: (Member (Error SomeException) sig, Carrier sig m) - => Project - -> File - -> m (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)) - readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project readProjectFromPaths maybeRoot path lang excludeDirs = do isDir <- isDirectory path diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 3a5915dff..dea492614 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -74,7 +74,6 @@ data GraphType = ImportGraph | CallGraph type AnalysisClasses = '[ Declarations1, Eq1, Evaluatable, FreeVariables1, AccessControls1, Foldable, Functor, Ord1, Show1 ] runGraph :: ( Member Distribute sig - , Member (Error SomeException) sig , Member Parse sig , Member Resolution sig , Member Trace sig @@ -231,7 +230,7 @@ runScopeGraph :: Ord address runScopeGraph = raiseHandler (runState lowerBound) -- | Parse a list of files into a 'Package'. -parsePackage :: (Member Distribute sig, Member (Error SomeException) sig, Member Resolution sig, Member Parse sig, Member Trace sig, Carrier sig m) +parsePackage :: (Member Distribute sig, Member Resolution sig, Member Parse sig, Member Trace sig, Carrier sig m) => Parser term -- ^ A parser. -> Project -- ^ Project to parse into a package. -> m (Package (Blob, term)) @@ -245,8 +244,8 @@ parsePackage parser project = do n = Data.Abstract.Evaluatable.name (projectName project) -- TODO: Confirm this is the right `name`. -- | Parse all files in a project into 'Module's. -parseModules :: (Member Distribute sig, Member (Error SomeException) sig, Member Parse sig, Carrier sig m) => Parser term -> Project -> m [Module (Blob, term)] -parseModules parser p@Project{..} = distributeFor (projectFiles p) (parseModule p parser) +parseModules :: (Member Distribute sig, Member Parse sig, Carrier sig m) => Parser term -> Project -> m [Module (Blob, term)] +parseModules parser p = distributeFor (projectBlobs p) (parseModule p parser) -- | Parse a list of packages from a python project. @@ -257,7 +256,6 @@ parsePythonPackage :: forall syntax sig m term. , AccessControls1 syntax , Functor syntax , term ~ Term syntax Loc - , Member (Error SomeException) sig , Member Distribute sig , Member Parse sig , Member Resolution sig @@ -290,7 +288,7 @@ parsePythonPackage parser project = do . raiseHandler (runState (lowerBound @(ScopeGraph (Hole (Maybe Name) Precise)))) . runAllocator - strat <- case find ((== (projectRootDir project "setup.py")) . filePath) (projectFiles project) of + strat <- case find (\b -> blobPath b == (projectRootDir project "setup.py")) (projectBlobs project) of Just setupFile -> do setupModule <- fmap snd <$> parseModule project parser setupFile fst <$> runAnalysis (evaluate (Proxy @'Language.Python) (runDomainEffects (runPythonPackaging . evalTerm id)) [ setupModule ]) @@ -301,36 +299,32 @@ parsePythonPackage parser project = do resMap <- Task.resolutionMap project pure (Package.fromModules (Data.Abstract.Evaluatable.name (projectName project)) modules resMap) -- TODO: Confirm this is the right `name`. PythonPackage.Packages dirs -> do - filteredBlobs <- for dirs $ \dir -> do - let packageDir = projectRootDir project unpack dir - let paths = filter ((packageDir `isPrefixOf`) . filePath) (projectFiles project) - traverse (readFile project) paths + let filteredBlobs = do + dir <- dirs + let packageDir = projectRootDir project unpack dir + filter ((packageDir `isPrefixOf`) . blobPath) (projectBlobs project) packageFromProject project filteredBlobs PythonPackage.FindPackages excludeDirs -> do trace "In Graph.FindPackages" let initFiles = filter (("__init__.py" `isSuffixOf`) . filePath) (projectFiles project) let packageDirs = filter (`notElem` ((projectRootDir project ) . unpack <$> excludeDirs)) (takeDirectory . filePath <$> initFiles) - filteredBlobs <- for packageDirs $ \dir -> do - let paths = filter ((dir `isPrefixOf`) . filePath) (projectFiles project) - traverse (readFile project) paths + let filteredBlobs = do + dir <- packageDirs + filter ((dir `isPrefixOf`) . blobPath) (projectBlobs project) packageFromProject project filteredBlobs where packageFromProject project filteredBlobs = do - let p = project { projectBlobs = catMaybes $ join filteredBlobs } + let p = project { projectBlobs = filteredBlobs } modules <- fmap (fmap snd) <$> parseModules parser p resMap <- Task.resolutionMap p pure (Package.fromModules (Data.Abstract.Evaluatable.name $ projectName p) modules resMap) -- TODO: Confirm this is the right `name`. -parseModule :: (Member (Error SomeException) sig, Member Parse sig, Carrier sig m) +parseModule :: (Member Parse sig, Carrier sig m) => Project -> Parser term - -> File + -> Blob -> m (Module (Blob, term)) -parseModule proj parser file = do - mBlob <- readFile proj file - case mBlob of - Just blob -> moduleForBlob (Just (projectRootDir proj)) blob . (,) blob <$> parse parser blob - Nothing -> throwError (SomeException (FileNotFound (filePath file))) +parseModule proj parser blob = moduleForBlob (Just (projectRootDir proj)) blob . (,) blob <$> parse parser blob withTermSpans :: ( Member (Reader Span) sig , Member (State Span) sig -- last evaluated child's span diff --git a/src/Semantic/Task/Files.hs b/src/Semantic/Task/Files.hs index 466263445..829983b70 100644 --- a/src/Semantic/Task/Files.hs +++ b/src/Semantic/Task/Files.hs @@ -25,7 +25,7 @@ import Data.Blob.IO import qualified Data.ByteString.Builder as B import Data.Handle import Data.Language -import Data.Project hiding (readFile) +import Data.Project import Prelude hiding (readFile) import Prologue hiding (catch) import qualified Semantic.Git as Git diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 7909918a3..3541d831c 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -35,7 +35,7 @@ import Data.Blob.IO import Data.Graph (topologicalSort) import qualified Data.Language as Language import Data.List (uncons) -import Data.Project hiding (readFile) +import Data.Project import Data.Quieterm (Quieterm, quieterm) import Data.Sum (weaken) import qualified Language.Go.Assignment From 79e47aaeaf492b458fb65bbae163eb41fbc2b516 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 2 Oct 2019 00:54:55 -0400 Subject: [PATCH 2/3] No need for ProjectException. --- src/Data/Project.hs | 7 ------- 1 file changed, 7 deletions(-) diff --git a/src/Data/Project.hs b/src/Data/Project.hs index 170cfb334..d96823b47 100644 --- a/src/Data/Project.hs +++ b/src/Data/Project.hs @@ -1,8 +1,5 @@ -{-# LANGUAGE DeriveAnyClass, MultiWayIf #-} - module Data.Project ( Project (..) - , ProjectException (..) , projectExtensions , projectName , projectFiles @@ -37,10 +34,6 @@ projectExtensions = extensionsForLanguage . projectLanguage projectFiles :: Project -> [File] projectFiles = fmap blobFile . projectBlobs -newtype ProjectException - = FileNotFound FilePath - deriving (Show, Eq, Typeable, Exception) - readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project readProjectFromPaths maybeRoot path lang excludeDirs = do isDir <- isDirectory path From ab2f30cf6e2c23eabadb5629fd623532c3b9f8d4 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 2 Oct 2019 10:57:29 -0400 Subject: [PATCH 3/3] List comprehensions are nicer here. --- src/Semantic/Graph.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index dea492614..5be45914a 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -298,20 +298,20 @@ parsePythonPackage parser project = do modules <- fmap (fmap snd) <$> parseModules parser project resMap <- Task.resolutionMap project pure (Package.fromModules (Data.Abstract.Evaluatable.name (projectName project)) modules resMap) -- TODO: Confirm this is the right `name`. - PythonPackage.Packages dirs -> do - let filteredBlobs = do - dir <- dirs - let packageDir = projectRootDir project unpack dir - filter ((packageDir `isPrefixOf`) . blobPath) (projectBlobs project) - packageFromProject project filteredBlobs + PythonPackage.Packages dirs -> + packageFromProject project [ blob | dir <- dirs + , blob <- projectBlobs project + , packageDir <- [projectRootDir project unpack dir] + , packageDir `isPrefixOf` blobPath blob + ] PythonPackage.FindPackages excludeDirs -> do trace "In Graph.FindPackages" let initFiles = filter (("__init__.py" `isSuffixOf`) . filePath) (projectFiles project) let packageDirs = filter (`notElem` ((projectRootDir project ) . unpack <$> excludeDirs)) (takeDirectory . filePath <$> initFiles) - let filteredBlobs = do - dir <- packageDirs - filter ((dir `isPrefixOf`) . blobPath) (projectBlobs project) - packageFromProject project filteredBlobs + packageFromProject project [ blob | dir <- packageDirs + , blob <- projectBlobs project + , dir `isPrefixOf` blobPath blob + ] where packageFromProject project filteredBlobs = do let p = project { projectBlobs = filteredBlobs }