github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-29 02:44:36 +03:00
Code Issues Projects Releases Wiki Activity

Make readBlobsFromDir use a typed path.

Browse Source
This commit is contained in:
Patrick Thomson 2019-09-24 17:03:22 -04:00
parent 71e47b7677
commit 9a6185e095
2 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Data/Blob/IO.hs
View File

@ -37,9 +37,9 @@ readBlobFromFile' file = do
maybeM (Prelude.fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
-- | Read all blobs in the directory with Language.supportedExts.
readBlobsFromDir :: MonadIO m => FilePath -> m [Blob]
readBlobsFromDir :: MonadIO m => Path.AbsRelDir -> m [Blob]
readBlobsFromDir path = liftIO . fmap catMaybes $
findFilesInDir path supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . fileForPath)
findFilesInDir (Path.toString path) supportedExts mempty >>= Async.mapConcurrently (readBlobFromFile . fileForPath)
readBlobsFromGitRepoPath :: (Part.AbsRel ar, MonadIO m) => Path.Dir ar -> Git.OID -> [Path.RelFile] -> [Path.RelFile] -> m [Blob]
readBlobsFromGitRepoPath path oid excludePaths includePaths

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

@ -31,11 +31,12 @@ import Prologue hiding (catch)
import qualified Semantic.Git as Git
import Semantic.IO
import qualified System.IO as IO
import qualified System.Path as Path
data Source blob where
FromPath :: File -> Source Blob
FromHandle :: Handle 'IO.ReadMode -> Source [Blob]
FromDir :: FilePath -> Source [Blob]
FromDir :: Path.AbsRelDir -> Source [Blob]
FromGitRepo :: FilePath -> Git.OID -> PathFilter -> Source [Blob]
FromPathPair :: Both File -> Source BlobPair
FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair]
@ -81,7 +82,7 @@ instance (Member (Error SomeException) sig, Member Catch sig, MonadIO m, Carrier
eff (L op) = case op of
Read (FromPath path) k -> rethrowing (readBlobFromFile' path) >>= k
Read (FromHandle handle) k -> rethrowing (readBlobsFromHandle handle) >>= k
Read (FromDir dir) k -> rethrowing (readBlobsFromDir dir) >>= k
Read (FromDir dir) k -> rethrowing (readBlobsFromDir (Path.toString dir)) >>= k
Read (FromGitRepo path sha (ExcludePaths excludePaths)) k -> rethrowing (readBlobsFromGitRepo path sha excludePaths mempty) >>= k
Read (FromGitRepo path sha (ExcludeFromHandle handle)) k -> rethrowing (readPathsFromHandle handle >>= (\x -> readBlobsFromGitRepo path sha x mempty)) >>= k
Read (FromGitRepo path sha (IncludePaths includePaths)) k -> rethrowing (readBlobsFromGitRepo path sha mempty includePaths) >>= k
@ -108,7 +109,7 @@ readBlobs (FilesFromHandle handle) = send (Read (FromHandle handle) pure)
readBlobs (FilesFromPaths [path]) = do
isDir <- isDirectory (filePath path)
if isDir
then send (Read (FromDir (filePath path)) pure)
then send (Read (FromDir (Path.path (filePath path))) pure)
else pure <$> send (Read (FromPath path) pure)
readBlobs (FilesFromPaths paths) = traverse (send . flip Read pure . FromPath) paths
readBlobs (FilesFromGitRepo path sha filter) = send (Read (FromGitRepo path sha filter) pure)