diff --git a/src/Data/Project.hs b/src/Data/Project.hs index d40033786..d96823b47 100644 --- a/src/Data/Project.hs +++ b/src/Data/Project.hs @@ -1,19 +1,14 @@ -{-# LANGUAGE DeriveAnyClass, MultiWayIf #-} - module Data.Project ( Project (..) - , ProjectException (..) , 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 @@ -39,22 +34,6 @@ projectExtensions = extensionsForLanguage . projectLanguage projectFiles :: Project -> [File] projectFiles = fmap blobFile . projectBlobs -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..5be45914a 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 ]) @@ -300,37 +298,33 @@ 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 - filteredBlobs <- for dirs $ \dir -> do - let packageDir = projectRootDir project unpack dir - let paths = filter ((packageDir `isPrefixOf`) . filePath) (projectFiles project) - traverse (readFile project) paths - 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) - filteredBlobs <- for packageDirs $ \dir -> do - let paths = filter ((dir `isPrefixOf`) . filePath) (projectFiles project) - traverse (readFile project) paths - packageFromProject project filteredBlobs + packageFromProject project [ blob | dir <- packageDirs + , blob <- projectBlobs project + , dir `isPrefixOf` blobPath blob + ] 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