From 15643e1d4fc388beaca3a465d04f915f81328640 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 17 Jan 2019 15:58:49 -0800 Subject: [PATCH] Switch over ToCDiffRenderer (will fix the tests next) --- src/Rendering/Renderer.hs | 2 -- src/Semantic/API/TOCSummaries.hs | 7 ++++++- src/Semantic/CLI.hs | 4 ++-- src/Semantic/Diff.hs | 1 - src/Serializing/Format.hs | 1 + test/Rendering/TOC/Spec.hs | 10 ++++++---- test/Semantic/CLI/Spec.hs | 4 ++-- 7 files changed, 17 insertions(+), 12 deletions(-) diff --git a/src/Rendering/Renderer.hs b/src/Rendering/Renderer.hs index 07b85f293..c3baf7481 100644 --- a/src/Rendering/Renderer.hs +++ b/src/Rendering/Renderer.hs @@ -29,8 +29,6 @@ import Rendering.TOC as R -- | Specification of renderers for diffs, producing output in the parameter type. data DiffRenderer output where - -- | Compute a table of contents for the diff & encode it as JSON. - ToCDiffRenderer :: DiffRenderer Summaries -- | Render to JSON with the format documented in docs/json-format.md JSONDiffRenderer :: DiffRenderer (JSON "diffs" SomeJSON) -- | Render to JSON as an adjacency list. diff --git a/src/Semantic/API/TOCSummaries.hs b/src/Semantic/API/TOCSummaries.hs index cfb911d56..060ad5041 100644 --- a/src/Semantic/API/TOCSummaries.hs +++ b/src/Semantic/API/TOCSummaries.hs @@ -1,14 +1,19 @@ {-# LANGUAGE GADTs, TypeOperators, DerivingStrategies #-} -module Semantic.API.TOCSummaries (diffSummary) where +module Semantic.API.TOCSummaries (diffSummary, diffSummaryBuilder) where import Analysis.TOCSummary (Declaration, declarationAlgebra) import Data.Blob +import Data.ByteString.Builder import Data.Diff import Rendering.TOC import Semantic.API.Converters import Semantic.API.Diff import Semantic.API.Types import Semantic.Task as Task +import Serializing.Format + +diffSummaryBuilder :: (DiffEffects sig m) => Format DiffTreeTOCResponse -> [BlobPair] -> m Builder +diffSummaryBuilder format blobs = runSerialize Plain format <$> diffSummary blobs diffSummary :: (DiffEffects sig m) => [BlobPair] -> m DiffTreeTOCResponse diffSummary = distributeFoldMap go diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 29574306d..30769cc88 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -16,7 +16,7 @@ import Data.Project import Options.Applicative hiding (style) import Prologue import Rendering.Renderer -import Semantic.API (parseSymbolsBuilder) +import Semantic.API (parseSymbolsBuilder, diffSummaryBuilder) import qualified Semantic.AST as AST import Semantic.Config import qualified Semantic.Diff as Diff @@ -70,7 +70,7 @@ diffCommand = command "diff" (info diffArgumentsParser (progDesc "Compute change 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 JSONGraphDiffRenderer) (long "json-graph" <> help "Output JSON diff trees") - <|> flag' (Diff.runDiff ToCDiffRenderer) (long "toc" <> help "Output JSON table of contents diff summary") + <|> flag' (diffSummaryBuilder JSON) (long "toc" <> help "Output JSON table of contents diff summary") <|> flag' (Diff.runDiff DOTDiffRenderer) (long "dot" <> help "Output the diff as a DOT graph") <|> flag' (Diff.runDiff ShowDiffRenderer) (long "show" <> help "Output using the Show instance (debug only, format subject to change without notice)") filesOrStdin <- Right <$> some (Both <$> argument filePathReader (metavar "FILE_A") <*> argument filePathReader (metavar "FILE_B")) <|> pure (Left stdin) diff --git a/src/Semantic/Diff.hs b/src/Semantic/Diff.hs index 276bee2da..45fb1ce46 100644 --- a/src/Semantic/Diff.hs +++ b/src/Semantic/Diff.hs @@ -28,7 +28,6 @@ import Serializing.Format -- | Using the specified renderer, diff a list of 'BlobPair's to produce a 'Builder' output. runDiff :: (Member Distribute sig, Member (Error SomeException) sig, Member Task sig, Member Telemetry sig, MonadIO m, Carrier sig m) => DiffRenderer output -> [BlobPair] -> m Builder -runDiff ToCDiffRenderer = withParsedBlobPairs' renderJSONSummaryError (decorate . declarationAlgebra) (render . renderToCDiff) >=> serialize JSON runDiff JSONDiffRenderer = withParsedBlobPairs' renderJSONDiffError (const pure) (render . renderJSONDiff) >=> serialize JSON runDiff JSONGraphDiffRenderer = withParsedBlobPairs' renderJSONDiffError (const pure) (render . renderAdjGraph) >=> serialize JSON where renderAdjGraph :: (Recursive t, ToTreeGraph DiffVertex (Base t)) => BlobPair -> t -> JSON.JSON "diffs" SomeJSON diff --git a/src/Serializing/Format.hs b/src/Serializing/Format.hs index 8cbaa2157..eb350d02e 100644 --- a/src/Serializing/Format.hs +++ b/src/Serializing/Format.hs @@ -25,6 +25,7 @@ data Format input where Show :: Show input => Format input Proto :: Message input => Format input +-- TODO: move this ^. data FormatStyle = Colourful | Plain runSerialize :: FormatStyle -> Format input -> input -> Builder diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index 23bf9a4cd..40a7200c3 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -24,6 +24,8 @@ import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration import Rendering.TOC import Semantic.Config +import Semantic.API (diffSummaryBuilder) +import Serializing.Format as Format import SpecHelpers @@ -146,22 +148,22 @@ spec = parallel $ do describe "diff with ToCDiffRenderer'" $ do it "produces JSON output" $ do blobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.B.rb") - output <- runTask (runDiff ToCDiffRenderer [blobs]) + output <- runTask (diffSummaryBuilder Format.JSON [blobs]) runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"added\"},{\"span\":{\"start\":[4,1],\"end\":[6,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{}}\n" :: ByteString) it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (Both "ruby/toc/methods.A.rb" "ruby/toc/methods.X.rb") - output <- runTaskWithOptions (defaultOptions { optionsLogLevel = Nothing }) (runDiff ToCDiffRenderer [blobs]) + output <- runTaskWithOptions (defaultOptions { optionsLogLevel = Nothing }) (diffSummaryBuilder Format.JSON [blobs]) runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"removed\"},{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/ruby/toc/methods.A.rb -> test/fixtures/ruby/toc/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[2,3]},\"error\":\"expected end of input nodes, but got ParseError\",\"language\":\"Ruby\"}]}}\n" :: ByteString) it "ignores anonymous functions" $ do blobs <- blobsForPaths (Both "ruby/toc/lambda.A.rb" "ruby/toc/lambda.B.rb") - output <- runTask (runDiff ToCDiffRenderer [blobs]) + output <- runTask (diffSummaryBuilder Format.JSON [blobs]) runBuilder output `shouldBe` ("{\"changes\":{},\"errors\":{}}\n" :: ByteString) it "summarizes Markdown headings" $ do blobs <- blobsForPaths (Both "markdown/toc/headings.A.md" "markdown/toc/headings.B.md") - output <- runTask (runDiff ToCDiffRenderer [blobs]) + output <- runTask (diffSummaryBuilder Format.JSON [blobs]) runBuilder output `shouldBe` ("{\"changes\":{\"test/fixtures/markdown/toc/headings.A.md -> test/fixtures/markdown/toc/headings.B.md\":[{\"span\":{\"start\":[1,1],\"end\":[3,16]},\"category\":\"Heading 1\",\"term\":\"Introduction\",\"changeType\":\"removed\"},{\"span\":{\"start\":[5,1],\"end\":[7,4]},\"category\":\"Heading 2\",\"term\":\"Two\",\"changeType\":\"modified\"},{\"span\":{\"start\":[9,1],\"end\":[11,10]},\"category\":\"Heading 3\",\"term\":\"This heading is new\",\"changeType\":\"added\"},{\"span\":{\"start\":[13,1],\"end\":[14,4]},\"category\":\"Heading 1\",\"term\":\"Final\",\"changeType\":\"added\"}]},\"errors\":{}}\n" :: ByteString) diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index 4dac75239..d9cf68348 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -4,7 +4,7 @@ import Control.Monad (when) import qualified Data.ByteString as B import Data.ByteString.Builder import Data.Foldable (for_) -import Semantic.API (parseSymbolsBuilder) +import Semantic.API (parseSymbolsBuilder, diffSummaryBuilder) import Semantic.CLI import Semantic.IO import Semantic.Task @@ -49,7 +49,7 @@ diffFixtures :: [(String, [BlobPair] -> TaskEff Builder, [Both File], FilePath)] diffFixtures = [ (show JSONDiffRenderer, runDiff JSONDiffRenderer, pathMode, prefix "diff-tree.json") , (show SExpressionDiffRenderer, runDiff SExpressionDiffRenderer, pathMode, "test/fixtures/ruby/corpus/method-declaration.diffA-B.txt") - , (show ToCDiffRenderer, runDiff ToCDiffRenderer, pathMode, prefix "diff-tree.toc.json") + , ("toc summaries", diffSummaryBuilder Serializing.Format.JSON, pathMode, prefix "diff-tree.toc.json") ] where pathMode = [Both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" Ruby) (File "test/fixtures/ruby/corpus/method-declaration.B.rb" Ruby)] prefix = "test/fixtures/cli"