From 190dca165dc15131137447d9680342b28219431f Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 21 Apr 2017 17:46:59 -0700 Subject: [PATCH] Turn on debug flag to send sourceText output for parse again --- src/Arguments.hs | 14 ++++++-------- src/Command/Git.hs | 1 - src/Renderer.hs | 12 ++++++------ src/SemanticCmdLine.hs | 5 ++--- 4 files changed, 14 insertions(+), 18 deletions(-) diff --git a/src/Arguments.hs b/src/Arguments.hs index a887d54e6..dac521614 100644 --- a/src/Arguments.hs +++ b/src/Arguments.hs @@ -47,19 +47,18 @@ data ParseArguments where ParseArguments :: (Monoid output, StringConv output ByteString) => { parseTreeRenderer :: ParseTreeRenderer DefaultFields output , parseMode :: ParseMode - , debug :: Bool , gitDir :: FilePath , alternateObjectDirs :: [FilePath] } -> ParseArguments -sExpressionParseTree :: ParseMode -> Bool -> FilePath -> [FilePath] -> ParseArguments +sExpressionParseTree :: ParseMode -> FilePath -> [FilePath] -> ParseArguments sExpressionParseTree = ParseArguments (SExpressionParseTreeRenderer TreeOnly) -jsonParseTree :: ParseMode -> Bool -> FilePath -> [FilePath] -> ParseArguments -jsonParseTree = ParseArguments JSONParseTreeRenderer +jsonParseTree :: Bool -> ParseMode -> FilePath -> [FilePath] -> ParseArguments +jsonParseTree = ParseArguments . JSONParseTreeRenderer -jsonIndexParseTree :: ParseMode -> Bool -> FilePath -> [FilePath] -> ParseArguments -jsonIndexParseTree = ParseArguments JSONIndexParseTreeRenderer +jsonIndexParseTree :: Bool -> ParseMode -> FilePath -> [FilePath] -> ParseArguments +jsonIndexParseTree = ParseArguments . JSONIndexParseTreeRenderer data ProgramMode = Parse ParseArguments | Diff DiffArguments deriving Show @@ -78,9 +77,8 @@ instance Show DiffArguments where . showString "alternateObjectDirs = " . shows alternateObjectDirs instance Show ParseArguments where - showsPrec d (ParseArguments renderer mode debug gitDir alternateObjectDirs) = showParen (d >= 10) $ showString "ParseArguments " + showsPrec d (ParseArguments renderer mode gitDir alternateObjectDirs) = showParen (d >= 10) $ showString "ParseArguments " . showString "parseTreeRenderer = " . shows renderer . showString ", " . showString "parseMode = " . shows mode . showString ", " - . showString "debug = " . shows debug . showString ", " . showString "gitDir = " . shows gitDir . showString ", " . showString "alternateObjectDirs = " . shows alternateObjectDirs diff --git a/src/Command/Git.hs b/src/Command/Git.hs index 20c91bf99..adaa1b355 100644 --- a/src/Command/Git.hs +++ b/src/Command/Git.hs @@ -44,7 +44,6 @@ readFilesAtSHAs gitDir alternates paths shas = do trees <- traverse treeForSha shas traverse (blobForPathInTree path) trees - runGit :: FilePath -> [FilePath] -> ReaderT LgRepo IO a -> IO a runGit gitDir alternates action = withRepository lgFactory gitDir $ do repo <- getRepository diff --git a/src/Renderer.hs b/src/Renderer.hs index 4dd22f98e..5f9ba1927 100644 --- a/src/Renderer.hs +++ b/src/Renderer.hs @@ -53,14 +53,14 @@ runDiffRenderer = foldMap . uncurry . resolveDiffRenderer data ParseTreeRenderer fields output where SExpressionParseTreeRenderer :: (HasField fields Category, HasField fields SourceSpan) => SExpressionFormat -> ParseTreeRenderer fields ByteString - JSONParseTreeRenderer :: HasDefaultFields fields => ParseTreeRenderer fields Value - JSONIndexParseTreeRenderer :: HasDefaultFields fields => ParseTreeRenderer fields Value + JSONParseTreeRenderer :: HasDefaultFields fields => Bool -> ParseTreeRenderer fields Value + JSONIndexParseTreeRenderer :: HasDefaultFields fields => Bool -> ParseTreeRenderer fields Value resolveParseTreeRenderer :: (Monoid output, StringConv output ByteString) => ParseTreeRenderer fields output -> (SourceBlob -> Term (Syntax Text) (Record fields) -> output) resolveParseTreeRenderer renderer = case renderer of SExpressionParseTreeRenderer format -> R.sExpressionParseTree format - JSONParseTreeRenderer -> R.jsonParseTree False - JSONIndexParseTreeRenderer -> R.jsonIndexParseTree False + JSONParseTreeRenderer debug -> R.jsonParseTree debug + JSONIndexParseTreeRenderer debug -> R.jsonIndexParseTree debug runParseTreeRenderer :: (Monoid output, StringConv output ByteString) => ParseTreeRenderer fields output -> [(SourceBlob, Term (Syntax Text) (Record fields))] -> output runParseTreeRenderer = foldMap . uncurry . resolveParseTreeRenderer @@ -82,8 +82,8 @@ instance Show (DiffRenderer fields output) where instance Show (ParseTreeRenderer fields output) where showsPrec d (SExpressionParseTreeRenderer format) = showsUnaryWith showsPrec "SExpressionParseTreeRenderer" d format - showsPrec _ JSONParseTreeRenderer = showString "JSONParseTreeRenderer" - showsPrec _ JSONIndexParseTreeRenderer = showString "JSONIndexParseTreeRenderer" + showsPrec d (JSONParseTreeRenderer debug) = showsUnaryWith showsPrec "JSONParseTreeRenderer" d debug + showsPrec d (JSONIndexParseTreeRenderer debug) = showsUnaryWith showsPrec "JSONIndexParseTreeRenderer" d debug instance Monoid File where mempty = File mempty diff --git a/src/SemanticCmdLine.hs b/src/SemanticCmdLine.hs index 2453ffa65..6a27fcdbb 100644 --- a/src/SemanticCmdLine.hs +++ b/src/SemanticCmdLine.hs @@ -96,14 +96,13 @@ arguments gitDir alternates = info (version <*> helper <*> argumentsParser) desc parseCommand = command "parse" (info parseArgumentsParser (progDesc "Print parse trees for a commit or paths")) parseArgumentsParser = Parse <$> ( ( flag sExpressionParseTree sExpressionParseTree (long "sexpression" <> help "Output s-expression parse trees (default)") - <|> flag' jsonParseTree (long "json" <> help "Output JSON parse trees") - <|> flag' jsonIndexParseTree (long "index" <> help "Output JSON parse trees in index format") ) + <|> (flag' jsonParseTree (long "json" <> help "Output JSON parse trees") <*> switch (long "debug")) + <|> (flag' jsonIndexParseTree (long "index" <> help "Output JSON parse trees in index format") <*> switch (long "debug")) ) <*> ( ParsePaths <$> some (argument str (metavar "FILES...")) <|> ParseCommit <$> option (eitherReader parseSha) (long "sha" <> metavar "SHA" <> help "Commit SHA") <*> some (argument str (metavar "FILES...")) ) - <*> switch (long "debug") <*> pure gitDir <*> pure alternates )