github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-18 20:31:55 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #355 from github/pathtype-project-from-path

Browse Source 
Make readProjectFromPaths use typed paths.
This commit is contained in:
Patrick Thomson 2019-10-22 14:32:24 -04:00 committed by GitHub
commit 7e46bc38b0
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 22 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/Data/Project.hs
View File

@ -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

6
src/Semantic/CLI.hs
View File

@ -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

4
src/Semantic/Task/Files.hs
View File

@ -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]