From b76f950b06290e904ff2aafdd65c0769b3311d1f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 15:13:39 -0400 Subject: [PATCH 01/15] :fire: redundant parens. --- src/Semantic/CLI.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 767889606..abe92b353 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -100,8 +100,8 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar excludeDirsOption = many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR")) filePathReader = eitherReader parseFilePath parseFilePath arg = case splitWhen (== ':') arg of - [a, b] | (Just lang) <- readMaybe b >>= ensureLanguage -> Right (File a lang) - | (Just lang) <- readMaybe a >>= ensureLanguage -> Right (File b lang) + [a, b] | Just lang <- readMaybe b >>= ensureLanguage -> Right (File a 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)) args -> Left ("cannot parse `" <> join args <> "`\nexpecting FILE:LANGUAGE or just FILE") From c332244b01f4832377f38baa57de4679742e2785 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:23:43 -0400 Subject: [PATCH 02/15] Inline the root/exclude directory options. --- src/Semantic/CLI.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index abe92b353..1f7a7fb79 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -91,13 +91,11 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar serializer <- flag (Task.serialize (DOT style)) (Task.serialize (DOT style)) (long "dot" <> help "Output in DOT graph format (default)") <|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph") <|> flag' (Task.serialize Show) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") - rootDir <- rootDirectoryOption - excludeDirs <- excludeDirsOption + rootDir <- optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR")) + excludeDirs <- many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR")) File{..} <- argument filePathReader (metavar "DIR:LANGUAGE | FILE") pure $ Task.readProject rootDir filePath fileLanguage excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer - rootDirectoryOption = optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR")) - excludeDirsOption = many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR")) filePathReader = eitherReader parseFilePath parseFilePath arg = case splitWhen (== ':') arg of [a, b] | Just lang <- readMaybe b >>= ensureLanguage -> Right (File a lang) From 95b0302622bb2ff07149cc0f75a5576d8d6ec64c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:26:41 -0400 Subject: [PATCH 03/15] =?UTF-8?q?Move=20the=20symbolFieldsReader=20up=20wh?= =?UTF-8?q?ere=20it=E2=80=99s=20used.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Semantic/CLI.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 1f7a7fb79..4e2bf13f4 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -74,6 +74,9 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin) pure $ Task.readBlobs filesOrStdin >>= renderer + -- Example: semantic parse --symbols --fields=symbol,path,language,kind,line,span + symbolFieldsReader = eitherReader (Right . parseSymbolFields) + tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Print specialized tree-sitter ASTs for path(s)")) tsParseArgumentsParser = do format <- flag AST.SExpression AST.SExpression (long "sexpression" <> help "Output s-expression ASTs (default)") @@ -106,6 +109,3 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar 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) - - -- Example: semantic parse --symbols --fields=symbol,path,language,kind,line,span - symbolFieldsReader = eitherReader (Right . parseSymbolFields) From 679aee515c4ae1a780e5854602b39f000860f614 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:27:37 -0400 Subject: [PATCH 04/15] Extract options to the top level. --- src/Semantic/CLI.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 4e2bf13f4..16fbbd511 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -106,6 +106,8 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar [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") +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) - options options fields = option (optionsReader options) (fields <> showDefaultWith (findOption options) <> metavar (intercalate "|" (fmap fst options))) findOption options value = maybe "" fst (find ((== value) . snd) options) From 5d80308b27e99e8eca0f73e1f435df974323a594 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:28:09 -0400 Subject: [PATCH 05/15] Extract filePathReader to the top level. --- src/Semantic/CLI.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 16fbbd511..56f44531a 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -99,7 +99,9 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar File{..} <- argument filePathReader (metavar "DIR:LANGUAGE | FILE") pure $ Task.readProject rootDir filePath fileLanguage excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer - filePathReader = eitherReader parseFilePath +filePathReader :: ReadM File +filePathReader = eitherReader parseFilePath + where parseFilePath arg = case splitWhen (== ':') arg of [a, b] | Just lang <- readMaybe b >>= ensureLanguage -> Right (File a lang) | Just lang <- readMaybe a >>= ensureLanguage -> Right (File b lang) From 68c87a0b4d620a550b003a1481a5c531428408ee Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:28:45 -0400 Subject: [PATCH 06/15] Extract graphCommand to the top level. --- src/Semantic/CLI.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 56f44531a..b4a477025 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -85,7 +85,9 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar filesOrStdin <- Right <$> some (argument filePathReader (metavar "FILES...")) <|> pure (Left stdin) 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) +graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a graph for a directory or from a top-level entry point module")) + where graphArgumentsParser = do graphType <- flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)") <|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph") From d164e16dc55ab349abd01dc39ab03deeeba443ab Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:29:14 -0400 Subject: [PATCH 07/15] Extract tsParseCommand to the top level. --- src/Semantic/CLI.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index b4a477025..225cfa5d3 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -77,7 +77,9 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar -- Example: semantic parse --symbols --fields=symbol,path,language,kind,line,span symbolFieldsReader = eitherReader (Right . parseSymbolFields) - tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Print specialized tree-sitter ASTs for path(s)")) +tsParseCommand :: Mod CommandFields (Task.TaskEff Builder) +tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Print specialized tree-sitter ASTs for path(s)")) + where tsParseArgumentsParser = do format <- flag AST.SExpression AST.SExpression (long "sexpression" <> help "Output s-expression ASTs (default)") <|> flag' AST.JSON (long "json" <> help "Output JSON ASTs") From ab00268dc4ea086c52c29bf0e51b915d1a9c30b8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:29:42 -0400 Subject: [PATCH 08/15] Extract parseCommand to the top level. --- src/Semantic/CLI.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 225cfa5d3..dfaab8983 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -60,7 +60,9 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar filesOrStdin <- Right <$> some (both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin) 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 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") From 4e47a8eb538ea673c535ed9c3c14e3d4eb3d7895 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:30:00 -0400 Subject: [PATCH 09/15] Extract diffCommand to the top level. --- src/Semantic/CLI.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index dfaab8983..eac71573d 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -50,7 +50,9 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar 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 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") From 900ea9c63975108828bc7c0e7899aad62f26e044 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:30:31 -0400 Subject: [PATCH 10/15] Extract argumentsParser to the top level. --- src/Semantic/CLI.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index eac71573d..181bd514b 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -45,10 +45,11 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar failOnWarning <- switch (long "fail-on-warning" <> help "Fail on assignment warnings.") pure $ Options logLevel requestId failOnWarning - argumentsParser = do - subparser <- hsubparser (diffCommand <> parseCommand <> tsParseCommand <> graphCommand) - output <- ToPath <$> strOption (long "output" <> short 'o' <> help "Output path, defaults to stdout") <|> pure (ToHandle stdout) - pure $ subparser >>= Task.write output +argumentsParser :: Parser (Task.TaskEff ()) +argumentsParser = do + subparser <- hsubparser (diffCommand <> parseCommand <> tsParseCommand <> graphCommand) + output <- ToPath <$> strOption (long "output" <> short 'o' <> help "Output path, defaults to stdout") <|> pure (ToHandle stdout) + pure $ subparser >>= Task.write output diffCommand :: Mod CommandFields (Task.TaskEff Builder) diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute changes between paths")) From 31e4fe68a119caa01433fee908eb2d5240623164 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:30:51 -0400 Subject: [PATCH 11/15] Extract optionsParser to the top level. --- src/Semantic/CLI.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 181bd514b..8ba4561e6 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -38,12 +38,13 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar versionString = "semantic version " <> buildVersion <> " (" <> buildSHA <> ")" description = fullDesc <> header "semantic -- Parse and diff semantically" - optionsParser = do - logLevel <- options [ ("error", Just Log.Error) , ("warning", Just Log.Warning) , ("info", Just Log.Info) , ("debug", Just Log.Debug) , ("none", Nothing)] - (long "log-level" <> value (Just Log.Warning) <> help "Log messages at or above this level, or disable logging entirely.") - requestId <- optional (strOption $ long "request-id" <> help "A string to use as the request identifier for any logged messages." <> metavar "id") - failOnWarning <- switch (long "fail-on-warning" <> help "Fail on assignment warnings.") - pure $ Options logLevel requestId failOnWarning +optionsParser :: Parser Options +optionsParser = do + logLevel <- options [ ("error", Just Log.Error) , ("warning", Just Log.Warning) , ("info", Just Log.Info) , ("debug", Just Log.Debug) , ("none", Nothing)] + (long "log-level" <> value (Just Log.Warning) <> help "Log messages at or above this level, or disable logging entirely.") + requestId <- optional (strOption $ long "request-id" <> help "A string to use as the request identifier for any logged messages." <> metavar "id") + failOnWarning <- switch (long "fail-on-warning" <> help "Fail on assignment warnings.") + pure $ Options logLevel requestId failOnWarning argumentsParser :: Parser (Task.TaskEff ()) argumentsParser = do From 83ac305205b8e5a5b3a9e006d958e1698360c849 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:51:24 -0400 Subject: [PATCH 12/15] Define the graph parser with ordinary Applicative notation. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit ApplicativeDo can’t handle recursive bindings. --- src/Semantic/CLI.hs | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 8ba4561e6..4088e708f 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -96,18 +96,19 @@ tsParseCommand = command "ts-parse" (info tsParseArgumentsParser (progDesc "Prin graphCommand :: Mod CommandFields (Task.TaskEff Builder) graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a graph for a directory or from a top-level entry point module")) where - graphArgumentsParser = do - graphType <- flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)") - <|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph") - let style = Graph.style - includePackages <- 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)") - <|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph") - <|> flag' (Task.serialize Show) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") - rootDir <- optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file/directory." <> metavar "DIR")) - excludeDirs <- many (strOption (long "exclude-dir" <> help "Exclude a directory (e.g. vendor)" <> metavar "DIR")) - File{..} <- argument filePathReader (metavar "DIR:LANGUAGE | FILE") - pure $ Task.readProject rootDir filePath fileLanguage excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer + graphArgumentsParser = makeGraphTask + <$> graphType + <*> switch (long "packages" <> help "Include a vertex for the package, with edges from it to each module") + <*> serializer + <*> 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") + graphType = flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)") + <|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph") + serializer = flag (Task.serialize (DOT Graph.style)) (Task.serialize (DOT Graph.style)) (long "dot" <> help "Output in DOT graph format (default)") + <|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph") + <|> flag' (Task.serialize Show) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") + makeGraphTask graphType includePackages serializer rootDir excludeDirs File{..} = Task.readProject rootDir filePath fileLanguage excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer filePathReader :: ReadM File filePathReader = eitherReader parseFilePath From 5d848feebaa842650b6ae9be22a5101c5e807f4c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:53:19 -0400 Subject: [PATCH 13/15] Split out the recursive project task. --- src/Semantic/CLI.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 4088e708f..51a9e9376 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -100,15 +100,18 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g <$> graphType <*> switch (long "packages" <> help "Include a vertex for the package, with edges from it to each module") <*> serializer - <*> 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") + <*> recursiveProjectTask graphType = flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)") <|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph") serializer = flag (Task.serialize (DOT Graph.style)) (Task.serialize (DOT Graph.style)) (long "dot" <> help "Output in DOT graph format (default)") <|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph") <|> flag' (Task.serialize Show) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") - makeGraphTask graphType includePackages serializer rootDir excludeDirs File{..} = Task.readProject rootDir filePath fileLanguage excludeDirs >>= Graph.runGraph graphType includePackages >>= serializer + recursiveProjectTask = makeRecursiveProjectTask + <$> 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") + makeRecursiveProjectTask rootDir excludeDirs File{..} = Task.readProject rootDir filePath fileLanguage excludeDirs + makeGraphTask graphType includePackages serializer projectTask = projectTask >>= Graph.runGraph graphType includePackages >>= serializer filePathReader :: ReadM File filePathReader = eitherReader parseFilePath From 6ffa4efc0646a9a84e90b2ad8caf0f446841abd2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 16:59:02 -0400 Subject: [PATCH 14/15] Rename the parser for reading a project recursively. --- src/Semantic/CLI.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 51a9e9376..756ef4dee 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -100,17 +100,17 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g <$> graphType <*> switch (long "packages" <> help "Include a vertex for the package, with edges from it to each module") <*> serializer - <*> recursiveProjectTask + <*> readProjectRecursively graphType = flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)") <|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph") serializer = flag (Task.serialize (DOT Graph.style)) (Task.serialize (DOT Graph.style)) (long "dot" <> help "Output in DOT graph format (default)") <|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph") <|> flag' (Task.serialize Show) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") - recursiveProjectTask = makeRecursiveProjectTask + 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") - makeRecursiveProjectTask rootDir excludeDirs File{..} = Task.readProject rootDir filePath fileLanguage excludeDirs + makeReadProjectRecursivelyTask rootDir excludeDirs File{..} = Task.readProject rootDir filePath fileLanguage excludeDirs makeGraphTask graphType includePackages serializer projectTask = projectTask >>= Graph.runGraph graphType includePackages >>= serializer filePathReader :: ReadM File From 342ebbf5da20f7437e3639ad12c6cc436e898ecb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 30 Jul 2018 17:15:46 -0400 Subject: [PATCH 15/15] Add a CLI option to read a list of files. --- src/Semantic/CLI.hs | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 756ef4dee..91f682a83 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -6,8 +6,9 @@ module Semantic.CLI , Parse.runParse ) where +import Control.Monad.IO.Class import Data.Language (ensureLanguage) -import Data.List (intercalate) +import Data.List (intercalate, uncons) import Data.List.Split (splitWhen) import Data.Project import Options.Applicative hiding (style) @@ -22,6 +23,7 @@ import qualified Semantic.Parse as Parse import qualified Semantic.Task as Task import qualified Semantic.Telemetry.Log as Log import Semantic.Version +import System.FilePath import Serializing.Format hiding (Options) import Text.Read @@ -100,12 +102,20 @@ graphCommand = command "graph" (info graphArgumentsParser (progDesc "Compute a g <$> graphType <*> switch (long "packages" <> help "Include a vertex for the package, with edges from it to each module") <*> serializer - <*> readProjectRecursively + <*> (readProjectFromPaths <|> readProjectRecursively) graphType = flag Graph.ImportGraph Graph.ImportGraph (long "imports" <> help "Compute an import graph (default)") <|> flag' Graph.CallGraph (long "calls" <> help "Compute a call graph") serializer = flag (Task.serialize (DOT Graph.style)) (Task.serialize (DOT Graph.style)) (long "dot" <> help "Output in DOT graph format (default)") <|> flag' (Task.serialize JSON) (long "json" <> help "Output JSON graph") <|> 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"))