diff --git a/src/Data/Project.hs b/src/Data/Project.hs index 97c1fc30c..994049521 100644 --- a/src/Data/Project.hs +++ b/src/Data/Project.hs @@ -35,16 +35,26 @@ projectExtensions = extensionsForLanguage . projectLanguage projectFiles :: Project -> [File] projectFiles = fmap blobFile . projectBlobs -readProjectFromPaths :: MonadIO m => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project +readProjectFromPaths :: MonadIO m + => Maybe Path.AbsRelDir -- ^ An optional root directory for the project + -> Path.AbsRelFileDir -- ^ A file or directory to parse. Passing a file path loads all files in that file's parent directory. + -> Language + -> [Path.AbsRelDir] -- ^ Directories to exclude. + -> m Project readProjectFromPaths maybeRoot path lang excludeDirs = do - isDir <- isDirectory path - let rootDir = if isDir - then fromMaybe path maybeRoot - else fromMaybe (takeDirectory path) maybeRoot + let rootDir :: Path.AbsRelDir + rootDir = case maybeRoot >>= Path.fromAbsRel of + -- If we were provided a root directory, use that. + Just root -> root + Nothing -> case Path.fileFromFileDir path of + -- If we weren't and the path is a file, drop its file name. + Just fp -> Path.takeDirectory fp + -- Otherwise, load from the path. + Nothing -> Path.dirFromFileDir path - paths <- liftIO $ findFilesInDir (Path.absRel rootDir) exts (fmap Path.absRel excludeDirs) + paths <- liftIO $ findFilesInDir rootDir exts excludeDirs blobs <- liftIO $ traverse (readBlobFromFile' . toFile) paths - pure $ Project rootDir blobs lang excludeDirs + pure $ Project (Path.toString rootDir) blobs lang (fmap Path.toString excludeDirs) where toFile path = File (Path.toString path) lang exts = extensionsForLanguage lang diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index c6394e241..ba2bab166 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -160,9 +160,9 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g _ -> pure $! Project "/" mempty Language.Unknown mempty readProjectRecursively = makeReadProjectRecursivelyTask <$> option auto (long "language" <> help "The language for the analysis.") - <*> optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR")) - <*> many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR")) - <*> argument str (metavar "DIR") + <*> optional (pathOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR")) + <*> many (pathOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR")) + <*> argument path (metavar "PATH") makeReadProjectRecursivelyTask language rootDir excludeDirs dir = Task.readProject rootDir dir language excludeDirs makeGraphTask graphType includePackages serializer projectTask = projectTask >>= Graph.runGraph graphType includePackages >>= serializer diff --git a/src/Semantic/Task/Files.hs b/src/Semantic/Task/Files.hs index 2ced4d0c9..092c07011 100644 --- a/src/Semantic/Task/Files.hs +++ b/src/Semantic/Task/Files.hs @@ -44,7 +44,7 @@ data Destination = ToPath Path.AbsRelFile | ToHandle (Handle 'IO.WriteMode) -- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's. data Files (m :: * -> *) k = forall a . Read (Source a) (a -> m k) - | ReadProject (Maybe FilePath) FilePath Language [FilePath] (Project -> m k) + | ReadProject (Maybe Path.AbsRelDir) Path.AbsRelFileDir Language [Path.AbsRelDir] (Project -> m k) | FindFiles Path.AbsRelDir [String] [Path.AbsRelDir] ([Path.AbsRelFile] -> m k) | Write Destination B.Builder (m k) @@ -105,7 +105,7 @@ readBlobPairs :: (Member Files sig, Carrier sig m) => Either (Handle 'IO.ReadMod readBlobPairs (Left handle) = send (Read (FromPairHandle handle) pure) readBlobPairs (Right paths) = traverse (send . flip Read pure . uncurry FromPathPair) paths -readProject :: (Member Files sig, Carrier sig m) => Maybe FilePath -> FilePath -> Language -> [FilePath] -> m Project +readProject :: (Member Files sig, Carrier sig m) => Maybe Path.AbsRelDir -> Path.AbsRelFileDir -> Language -> [Path.AbsRelDir] -> m Project readProject rootDir dir lang excludeDirs = send (ReadProject rootDir dir lang excludeDirs pure) findFiles :: (Member Files sig, Carrier sig m) => Path.AbsRelDir -> [String] -> [Path.AbsRelDir] -> m [Path.AbsRelFile]