github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2025-01-02 20:41:38 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into remove-boring-instances

Browse Source
This commit is contained in:
Patrick Thomson 2019-05-13 13:29:31 -04:00 committed by GitHub
commit 877e440800
3 changed files with 25 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Data/Handle.hs
View File

@ -7,6 +7,7 @@ module Data.Handle
, stdout
, stderr
, readBlobsFromHandle
, readPathsFromHandle
, readBlobPairsFromHandle
, readFromHandle
, openFileForReading
@ -16,6 +17,7 @@ import Prologue
import Data.Aeson
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import System.Exit
import qualified System.IO as IO
@ -48,6 +50,10 @@ openFileForReading path = ReadHandle <$> IO.openFile path IO.ReadMode
readBlobsFromHandle :: MonadIO m => Handle 'IO.ReadMode -> m [Blob]
readBlobsFromHandle = fmap blobs <$> readFromHandle
-- | Read line delimited paths from a handle
readPathsFromHandle :: MonadIO m => Handle 'IO.ReadMode -> m [FilePath]
readPathsFromHandle (ReadHandle h) = liftIO $ fmap BLC.unpack . BLC.lines <$> BL.hGetContents h
-- | Read JSON encoded blob pairs from a handle.
readBlobPairsFromHandle :: MonadIO m => Handle 'IO.ReadMode -> m [BlobPair]
readBlobPairsFromHandle = fmap blobs <$> readFromHandle

6
src/Semantic/CLI.hs
View File

@ -87,7 +87,8 @@ parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate pa
filesOrStdin <- FilesFromGitRepo
<$> option str (long "gitDir" <> help "A .git directory to read from")
<*> option shaReader (long "sha" <> help "The commit SHA1 to read from")
<*> many (option str (long "exclude" <> short 'x' <> help "Paths to exclude"))
<*> ( ExcludePaths <$> many (option str (long "exclude" <> short 'x' <> help "Paths to exclude"))
<|> ExcludeFromHandle <$> flag' stdin (long "exclude-stdin" <> help "Exclude paths given to stdin"))
<|> FilesFromPaths <$> some (argument filePathReader (metavar "FILES..."))
<|> pure (FilesFromHandle stdin)
pure $ Task.readBlobs filesOrStdin >>= renderer
@ -103,7 +104,8 @@ tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Gene
filesOrStdin <- FilesFromGitRepo
<$> option str (long "gitDir" <> help "A .git directory to read from")
<*> option shaReader (long "sha" <> help "The commit SHA1 to read from")
<*> many (option str (long "exclude" <> short 'x' <> help "Paths to exclude"))
<*> ( ExcludePaths <$> many (option str (long "exclude" <> short 'x' <> help "Paths to exclude"))
<|> ExcludeFromHandle <$> flag' stdin (long "exclude-stdin" <> help "Exclude paths given to stdin"))
<|> FilesFromPaths <$> some (argument filePathReader (metavar "FILES..."))
<|> pure (FilesFromHandle stdin)
pure $ Task.readBlobs filesOrStdin >>= AST.runASTParse format

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

@ -14,6 +14,7 @@ module Semantic.Task.Files
, Handle (..)
, FilesC(..)
, FilesArg(..)
, Excludes(..)
) where
import Control.Effect
@ -35,15 +36,19 @@ import Semantic.Telemetry
import qualified System.IO as IO
data Source blob where
FromPath :: File -> Source Blob
FromHandle :: Handle 'IO.ReadMode -> Source [Blob]
FromDir :: FilePath -> Source [Blob]
FromGitRepo :: FilePath -> Git.OID -> [FilePath] -> Source [Blob]
FromPathPair :: Both File -> Source BlobPair
FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair]
FromPath :: File -> Source Blob
FromHandle :: Handle 'IO.ReadMode -> Source [Blob]
FromDir :: FilePath -> Source [Blob]
FromGitRepo :: FilePath -> Git.OID -> Excludes -> Source [Blob]
FromPathPair :: Both File -> Source BlobPair
FromPairHandle :: Handle 'IO.ReadMode -> Source [BlobPair]
data Destination = ToPath FilePath | ToHandle (Handle 'IO.WriteMode)
data Excludes
= ExcludePaths [FilePath]
| ExcludeFromHandle (Handle 'IO.ReadMode)
-- | An effect to read/write 'Blob's from 'Handle's or 'FilePath's.
data Files (m :: * -> *) k
= forall a . Read (Source a) (a -> k)
@ -67,7 +72,8 @@ instance (Member (Error SomeException) sig, Member Telemetry sig, MonadIO m, Car
Read (FromPath path) k -> (readBlobFromFile' path `catchIO` (throwError . toException @SomeException)) >>= k
Read (FromHandle handle) k -> (readBlobsFromHandle handle `catchIO` (throwError . toException @SomeException)) >>= k
Read (FromDir dir) k -> (readBlobsFromDir dir `catchIO` (throwError . toException @SomeException)) >>= k
Read (FromGitRepo path sha excludePaths) k -> time "task.read_git_repo" mempty (readBlobsFromGitRepo path sha excludePaths `catchIO` (throwError . toException @SomeException)) >>= k
Read (FromGitRepo path sha (ExcludePaths excludePaths)) k -> (readBlobsFromGitRepo path sha excludePaths `catchIO` (throwError . toException @SomeException)) >>= k
Read (FromGitRepo path sha (ExcludeFromHandle handle)) k -> (readPathsFromHandle handle >>= readBlobsFromGitRepo path sha) `catchIO` (throwError . toException @SomeException) >>= k
Read (FromPathPair paths) k -> (runBothWith readFilePair paths `catchIO` (throwError . toException @SomeException)) >>= k
Read (FromPairHandle handle) k -> (readBlobPairsFromHandle handle `catchIO` (throwError . toException @SomeException)) >>= k
ReadProject rootDir dir language excludeDirs k -> (readProjectFromPaths rootDir dir language excludeDirs `catchIO` (throwError . toException @SomeException)) >>= k
@ -83,7 +89,7 @@ readBlob file = send (Read (FromPath file) pure)
data FilesArg
= FilesFromHandle (Handle 'IO.ReadMode)
| FilesFromPaths [File]
| FilesFromGitRepo FilePath Git.OID [FilePath]
| FilesFromGitRepo FilePath Git.OID Excludes
-- | A task which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
readBlobs :: (Member Files sig, Carrier sig m, MonadIO m) => FilesArg -> m [Blob]
@ -94,7 +100,7 @@ readBlobs (FilesFromPaths [path]) = do
then send (Read (FromDir (filePath path)) pure)
else pure <$> send (Read (FromPath path) pure)
readBlobs (FilesFromPaths paths) = traverse (send . flip Read pure . FromPath) paths
readBlobs (FilesFromGitRepo path sha excludePaths) = send (Read (FromGitRepo path sha excludePaths) pure)
readBlobs (FilesFromGitRepo path sha excludes) = send (Read (FromGitRepo path sha excludes) pure)
-- | A task which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
readBlobPairs :: (Member Files sig, Carrier sig m) => Either (Handle 'IO.ReadMode) [Both File] -> m [BlobPair]