Merge pull request #298 from github/remove-project-readfile

Remove Data.Project.readFile and unnecessary Error constraints.

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

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

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

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