From 4b5ad434e81dbe4b333422b0ab5f1891782f7455 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 31 May 2017 12:27:21 -0400 Subject: [PATCH] Rename parseDiffAndRenderBlobPair to diffBlobPair. --- src/Semantic.hs | 6 +++--- src/SemanticCmdLine.hs | 4 ++-- test/CommandSpec.hs | 2 +- test/SpecHelpers.hs | 2 +- test/TOCSpec.hs | 16 ++++++++-------- 5 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/Semantic.hs b/src/Semantic.hs index 409bafd13..8de4f39d5 100644 --- a/src/Semantic.hs +++ b/src/Semantic.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GADTs #-} module Semantic ( parseBlob -, parseDiffAndRenderBlobPair +, diffBlobPair , diffAndRenderTermPair ) where @@ -43,8 +43,8 @@ parseBlob renderer blob@SourceBlob{..} = case renderer of -- | A task to parse a pair of 'SourceBlob's, diff them, and render the 'Diff'. -parseDiffAndRenderBlobPair :: DiffRenderer output -> Both SourceBlob -> Task (Maybe output) -parseDiffAndRenderBlobPair renderer blobs = case renderer of +diffBlobPair :: DiffRenderer output -> Both SourceBlob -> Task (Maybe output) +diffBlobPair renderer blobs = case renderer of ToCDiffRenderer -> do terms <- distributeFor blobs $ \ blob -> do term <- parseSource blob diff --git a/src/SemanticCmdLine.hs b/src/SemanticCmdLine.hs index c35297fe7..733e5b8fa 100644 --- a/src/SemanticCmdLine.hs +++ b/src/SemanticCmdLine.hs @@ -21,7 +21,7 @@ import System.FilePath.Posix (takeFileName, (-<.>)) import System.IO.Error (IOError) import System.IO (stdin) import Text.Regex -import qualified Semantic (parseBlob, parseDiffAndRenderBlobPair) +import qualified Semantic (parseBlob, diffBlobPair) main :: IO () main = do @@ -54,7 +54,7 @@ runDiff DiffArguments{..} = do DiffPaths a b -> pure <$> traverse (uncurry readFile) (both a b) DiffCommits sha1 sha2 paths -> readFilesAtSHAs gitDir alternateObjectDirs paths (both sha1 sha2) DiffStdin -> readBlobPairsFromHandle stdin - Task.runTask . fmap toS $ Task.distributeFoldMap (fmap (fromMaybe mempty) . Semantic.parseDiffAndRenderBlobPair diffRenderer) blobs + Task.runTask . fmap toS $ Task.distributeFoldMap (fmap (fromMaybe mempty) . Semantic.diffBlobPair diffRenderer) blobs runParse :: ParseArguments -> IO ByteString runParse ParseArguments{..} = do diff --git a/test/CommandSpec.hs b/test/CommandSpec.hs index 0a32f5cb9..295f5f9b1 100644 --- a/test/CommandSpec.hs +++ b/test/CommandSpec.hs @@ -138,4 +138,4 @@ data Fixture = Fixture { shas :: Both String, expectedBlobs :: [Both SourceBlob] fetchDiffsOutput :: FilePath -> String -> String -> [(FilePath, Maybe Language)] -> IO Summaries fetchDiffsOutput gitDir sha1 sha2 filePaths = do blobPairs <- runCommand $ readFilesAtSHAs gitDir [] filePaths (both sha1 sha2) - fromMaybe mempty <$> runTask (distributeFoldMap (Semantic.parseDiffAndRenderBlobPair Renderer.ToCDiffRenderer) blobPairs) + fromMaybe mempty <$> runTask (distributeFoldMap (Semantic.diffBlobPair Renderer.ToCDiffRenderer) blobPairs) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index c7ef0dc80..5a02bcab5 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -27,7 +27,7 @@ import Term diffFilePaths :: Both FilePath -> IO ByteString diffFilePaths paths = do blobs <- traverse readFile paths - fromMaybe mempty <$> runTask (parseDiffAndRenderBlobPair SExpressionDiffRenderer blobs) + fromMaybe mempty <$> runTask (diffBlobPair SExpressionDiffRenderer blobs) -- | Returns an s-expression parse tree for the specified FilePath. parseFilePath :: FilePath -> IO ByteString diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index 8b14d3aab..0e759d2f2 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -58,7 +58,7 @@ spec = parallel $ do it "summarizes changed methods" $ do sourceBlobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") - Just diff <- runTask (parseDiffAndRenderBlobPair IdentityDiffRenderer sourceBlobs) + Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs) diffTOC diff `shouldBe` [ JSONSummary $ Summarizable C.SingletonMethod "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added" , JSONSummary $ Summarizable C.Method "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" @@ -66,31 +66,31 @@ spec = parallel $ do it "dedupes changes in same parent method" $ do sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js") - Just diff <- runTask (parseDiffAndRenderBlobPair IdentityDiffRenderer sourceBlobs) + Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs) diffTOC diff `shouldBe` [ JSONSummary $ Summarizable C.Function "myFunction" (sourceSpanBetween (1, 1) (6, 2)) "modified" ] it "dedupes similar methods" $ do sourceBlobs <- blobsForPaths (both "javascript/erroneous-duplicate-method.A.js" "javascript/erroneous-duplicate-method.B.js") - Just diff <- runTask (parseDiffAndRenderBlobPair IdentityDiffRenderer sourceBlobs) + Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs) diffTOC diff `shouldBe` [ JSONSummary $ Summarizable C.Function "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" ] it "summarizes Go methods with receivers with special formatting" $ do sourceBlobs <- blobsForPaths (both "go/method-with-receiver.A.go" "go/method-with-receiver.B.go") - Just diff <- runTask (parseDiffAndRenderBlobPair IdentityDiffRenderer sourceBlobs) + Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs) diffTOC diff `shouldBe` [ JSONSummary $ Summarizable C.Method "(*apiClient) CheckAuth" (sourceSpanBetween (3,1) (3,101)) "added" ] it "summarizes Ruby methods that start with two identifiers" $ do sourceBlobs <- blobsForPaths (both "ruby/method-starts-with-two-identifiers.A.rb" "ruby/method-starts-with-two-identifiers.B.rb") - Just diff <- runTask (parseDiffAndRenderBlobPair IdentityDiffRenderer sourceBlobs) + Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs) diffTOC diff `shouldBe` [ JSONSummary $ Summarizable C.Method "foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" ] it "handles unicode characters in file" $ do sourceBlobs <- blobsForPaths (both "ruby/unicode.A.rb" "ruby/unicode.B.rb") - Just diff <- runTask (parseDiffAndRenderBlobPair IdentityDiffRenderer sourceBlobs) + Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs) diffTOC diff `shouldBe` [ JSONSummary $ Summarizable C.Method "foo" (sourceSpanBetween (6, 1) (7, 4)) "added" ] @@ -135,12 +135,12 @@ spec = parallel $ do describe "diff with ToCDiffRenderer" $ do it "produces JSON output" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") - output <- runTask (parseDiffAndRenderBlobPair ToCDiffRenderer blobs) + output <- runTask (diffBlobPair ToCDiffRenderer blobs) fmap toS output `shouldBe` Just ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/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/methods.A.rb" "ruby/methods.X.rb") - output <- runTask (parseDiffAndRenderBlobPair ToCDiffRenderer blobs) + output <- runTask (diffBlobPair ToCDiffRenderer blobs) fmap toS output `shouldBe` Just ("{\"changes\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[4,1],\"end\":[5,4]},\"category\":\"Method\",\"term\":\"baz\",\"changeType\":\"removed\"}]},\"errors\":{\"test/fixtures/toc/ruby/methods.A.rb -> test/fixtures/toc/ruby/methods.X.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,1]},\"error\":\"def bar\\nen\\n\"}]}}\n" :: ByteString) type Diff' = SyntaxDiff Text (Maybe Declaration ': DefaultFields)