github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 09:15:01 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #2103 from github/pass-precise-project-paths

Browse Source 
Pass precise project paths
This commit is contained in:
Josh Vera 2018-08-06 13:25:02 -04:00 committed by GitHub
commit dba1e3ba07
1 changed files with 62 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

98
src/Semantic/CLI.hs
View File

@ -6,8 +6,9 @@ module Semantic.CLI
, Parse.runParse , Parse.runParse
) where ) where
import Control.Monad.IO.Class
import Data.Language (ensureLanguage) import Data.Language (ensureLanguage)
import Data.List (intercalate) import Data.List (intercalate, uncons)
import Data.List.Split (splitWhen) import Data.List.Split (splitWhen)
import Data.Project import Data.Project
import Options.Applicative hiding (style) import Options.Applicative hiding (style)
@ -22,6 +23,7 @@ import qualified Semantic.Parse as Parse
import qualified Semantic.Task as Task import qualified Semantic.Task as Task
import qualified Semantic.Telemetry.Log as Log import qualified Semantic.Telemetry.Log as Log
import Semantic.Version import Semantic.Version
import System.FilePath
import Serializing.Format hiding (Options) import Serializing.Format hiding (Options)
import Text.Read import Text.Read
@ -38,19 +40,23 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
versionString = "semantic version " <> buildVersion <> " (" <> buildSHA <> ")" versionString = "semantic version " <> buildVersion <> " (" <> buildSHA <> ")"
description = fullDesc <> header "semantic -- Parse and diff semantically" description = fullDesc <> header "semantic -- Parse and diff semantically"
optionsParser = do optionsParser :: Parser Options
logLevel <- options [ ("error", Just Log.Error) , ("warning", Just Log.Warning) , ("info", Just Log.Info) , ("debug", Just Log.Debug) , ("none", Nothing)] optionsParser = do
(long "log-level" <> value (Just Log.Warning) <> help "Log messages at or above this level, or disable logging entirely.") logLevel <- options [ ("error", Just Log.Error) , ("warning", Just Log.Warning) , ("info", Just Log.Info) , ("debug", Just Log.Debug) , ("none", Nothing)]
requestId <- optional (strOption $ long "request-id" <> help "A string to use as the request identifier for any logged messages." <> metavar "id") (long "log-level" <> value (Just Log.Warning) <> help "Log messages at or above this level, or disable logging entirely.")
failOnWarning <- switch (long "fail-on-warning" <> help "Fail on assignment warnings.") requestId <- optional (strOption $ long "request-id" <> help "A string to use as the request identifier for any logged messages." <> metavar "id")
pure $ Options logLevel requestId failOnWarning failOnWarning <- switch (long "fail-on-warning" <> help "Fail on assignment warnings.")
pure $ Options logLevel requestId failOnWarning
argumentsParser = do argumentsParser :: Parser (Task.TaskEff ())
subparser <- hsubparser (diffCommand <> parseCommand <> tsParseCommand <> graphCommand) argumentsParser = do
output <- ToPath <$> strOption (long "output" <> short 'o' <> help "Output path, defaults to stdout") <|> pure (ToHandle stdout) subparser <- hsubparser (diffCommand <> parseCommand <> tsParseCommand <> graphCommand)
pure $ subparser >>= Task.write output output <- ToPath <$> strOption (long "output" <> short 'o' <> help "Output path, defaults to stdout") <|> pure (ToHandle stdout)
pure $ subparser >>= Task.write output
diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute changes between paths")) diffCommand :: Mod CommandFields (Task.TaskEff Builder)
diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute changes between paths"))
where
diffArgumentsParser = do diffArgumentsParser = do
renderer <- flag (Diff.runDiff SExpressionDiffRenderer) (Diff.runDiff SExpressionDiffRenderer) (long "sexpression" <> help "Output s-expression diff tree (default)") renderer <- flag (Diff.runDiff SExpressionDiffRenderer) (Diff.runDiff SExpressionDiffRenderer) (long "sexpression" <> help "Output s-expression diff tree (default)")
<|> flag' (Diff.runDiff JSONDiffRenderer) (long "json" <> help "Output JSON diff trees") <|> flag' (Diff.runDiff JSONDiffRenderer) (long "json" <> help "Output JSON diff trees")
@ -60,7 +66,9 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
filesOrStdin <- Right <$> some (both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin) filesOrStdin <- Right <$> some (both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin)
pure $ Task.readBlobPairs filesOrStdin >>= renderer pure $ Task.readBlobPairs filesOrStdin >>= renderer
parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)")) parseCommand :: Mod CommandFields (Task.TaskEff Builder)
parseCommand = command "parse" (info parseArgumentsParser (progDesc "Generate parse trees for path(s)"))
where
parseArgumentsParser = do parseArgumentsParser = do
renderer <- flag (Parse.runParse SExpressionTermRenderer) (Parse.runParse SExpressionTermRenderer) (long "sexpression" <> help "Output s-expression parse trees (default)") renderer <- flag (Parse.runParse SExpressionTermRenderer) (Parse.runParse SExpressionTermRenderer) (long "sexpression" <> help "Output s-expression parse trees (default)")
<|> flag' (Parse.runParse JSONTermRenderer) (long "json" <> help "Output JSON parse trees") <|> flag' (Parse.runParse JSONTermRenderer) (long "json" <> help "Output JSON parse trees")
@ -74,7 +82,12 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin) filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin)
pure $ Task.readBlobs filesOrStdin >>= renderer pure $ Task.readBlobs filesOrStdin >>= renderer
tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Print specialized tree-sitter ASTs for path(s)")) -- Example: semantic parse --symbols --fields=symbol,path,language,kind,line,span
symbolFieldsReader = eitherReader (Right . parseSymbolFields)
tsParseCommand :: Mod CommandFields (Task.TaskEff Builder)
tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Print specialized tree-sitter ASTs for path(s)"))
where
tsParseArgumentsParser = do tsParseArgumentsParser = do
format <- flag AST.SExpression AST.SExpression (long "sexpression" <> help "Output s-expression ASTs (default)") format <- flag AST.SExpression AST.SExpression (long "sexpression" <> help "Output s-expression ASTs (default)")
<|> flag' AST.JSON (long "json" <> help "Output JSON ASTs") <|> flag' AST.JSON (long "json" <> help "Output JSON ASTs")
@ -82,32 +95,45 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin) filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin)
pure $ Task.readBlobs filesOrStdin >>= AST.runASTParse format pure $ Task.readBlobs filesOrStdin >>= AST.runASTParse format
graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a graph for a directory or from a top-level entry point module")) graphCommand :: Mod CommandFields (Task.TaskEff Builder)
graphArgumentsParser = do graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a graph for a directory or from a top-level entry point module"))
graphType <- flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)") where
<|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph") graphArgumentsParser = makeGraphTask
let style = Graph.style <$> graphType
includePackages <- switch (long "packages" <> help "Include a vertex for the package, with edges from it to each module") <*> switch (long "packages" <> help "Include a vertex for the package, with edges from it to each module")
serializer <- flag (Task.serialize (DOT style)) (Task.serialize (DOT style)) (long "dot" <> help "Output in DOT graph format (default)") <*> serializer
<|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph") <*> (readProjectFromPaths <|> readProjectRecursively)
<|> flag' (Task.serialize Show) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") graphType = flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)")
rootDir <- rootDirectoryOption <|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph")
excludeDirs <- excludeDirsOption serializer = flag (Task.serialize (DOT Graph.style)) (Task.serialize (DOT Graph.style)) (long "dot" <> help "Output in DOT graph format (default)")
File{..} <- argument filePathReader (metavar "DIR:LANGUAGE | FILE") <|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph")
pure $ Task.readProject rootDir filePath fileLanguage excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer <|> flag' (Task.serialize Show) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)")
readProjectFromPaths = makeReadProjectFromPathsTask
<$> option auto (long "language" <> help "The language for the analysis.")
<*> ( Just <$> some (strArgument (metavar "FILES..."))
<|> flag' Nothing (long "stdin" <> help "Read a list of newline-separated paths to analyze from stdin."))
makeReadProjectFromPathsTask language maybePaths = do
paths <- maybeM (liftIO (many getLine)) maybePaths
blobs <- traverse IO.readBlob (flip File language <$> paths)
pure $! Project (takeDirectory (maybe "/" fst (uncons paths))) blobs language []
readProjectRecursively = makeReadProjectRecursivelyTask
<$> 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 filePathReader (metavar "DIR:LANGUAGE | FILE")
makeReadProjectRecursivelyTask rootDir excludeDirs File{..} = Task.readProject rootDir filePath fileLanguage excludeDirs
makeGraphTask graphType includePackages serializer projectTask = projectTask >>= Graph.runGraph graphType includePackages >>= serializer
rootDirectoryOption = optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR")) filePathReader :: ReadM File
excludeDirsOption = many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR")) filePathReader = eitherReader parseFilePath
filePathReader = eitherReader parseFilePath where
parseFilePath arg = case splitWhen (== ':') arg of parseFilePath arg = case splitWhen (== ':') arg of
[a, b] | (Just lang) <- readMaybe b >>= ensureLanguage -> Right (File a lang) [a, b] | Just lang <- readMaybe b >>= ensureLanguage -> Right (File a lang)
| (Just lang) <- readMaybe a >>= ensureLanguage -> Right (File b lang) | Just lang <- readMaybe a >>= ensureLanguage -> Right (File b lang)
[path] -> maybe (Left $ "Cannot identify language for path: " <> path) (Right . File path) (ensureLanguage (languageForFilePath path)) [path] -> maybe (Left $ "Cannot identify language for path: " <> path) (Right . File path) (ensureLanguage (languageForFilePath path))
args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE") args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE")
options :: Eq a => [(String, a)] -> Mod OptionFields a -> Parser a
options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options)))
where
optionsReader options = eitherReader $ \ str -> maybe (Left ("expected one of: " <> intercalate ", " (fmap fst options))) (Right . snd) (find ((== str) . fst) options) optionsReader options = eitherReader $ \ str -> maybe (Left ("expected one of: " <> intercalate ", " (fmap fst options))) (Right . snd) (find ((== str) . fst) options)
options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options)))
findOption options value = maybe "" fst (find ((== value) . snd) options) findOption options value = maybe "" fst (find ((== value) . snd) options)
-- Example: semantic parse --symbols --fields=symbol,path,language,kind,line,span
symbolFieldsReader = eitherReader (Right . parseSymbolFields)