From 050734c40c6768c4cdbecca137cb7796e55319bd Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Fri, 27 Oct 2017 11:15:46 -0700 Subject: [PATCH] s/JSONSummary/TOCSummary --- src/Renderer/TOC.hs | 37 +++++++++++++++++++++---------------- test/TOCSpec.hs | 20 ++++++++++---------- 2 files changed, 31 insertions(+), 26 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 2c8d3ee87..406ece71b 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -5,7 +5,7 @@ module Renderer.TOC , renderToTags , diffTOC , Summaries(..) -, JSONSummary(..) +, TOCSummary(..) , isValidSummary , Declaration(..) , declaration @@ -82,8 +82,8 @@ instance ToJSON Tag where toJSON Tag{..} = object [ "symbol" .= tagSymbol, "path" .= tagPath, "language" .= tagLanguage, "kind" .= tagKind, "line" .= tagLine, "span" .= tagSpan ] -data JSONSummary - = JSONSummary +data TOCSummary + = TOCSummary { summaryCategoryName :: T.Text , summaryTermName :: T.Text , summaryTermText :: T.Text @@ -93,11 +93,11 @@ data JSONSummary | ErrorSummary { error :: T.Text, errorSpan :: Span, errorLanguage :: Maybe Language } deriving (Generic, Eq, Show) -instance ToJSON JSONSummary where - toJSON JSONSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySpan ] +instance ToJSON TOCSummary where + toJSON TOCSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySpan ] toJSON ErrorSummary{..} = object [ "error" .= error, "span" .= errorSpan, "language" .= errorLanguage ] -isValidSummary :: JSONSummary -> Bool +isValidSummary :: TOCSummary -> Bool isValidSummary ErrorSummary{} = False isValidSummary _ = True @@ -322,20 +322,25 @@ dedupe = let tuples = sortOn fst . Map.elems . snd . foldl' go (0, Map.empty) in dedupeKey entry = DedupeKey ((fmap toCategoryName . getDeclaration . entryPayload) entry, (fmap (toLower . declarationIdentifier) . getDeclaration . entryPayload) entry) exactMatch = (==) `on` (getDeclaration . entryPayload) --- | Construct a 'JSONSummary' from an 'Entry'. -entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Entry (Record fields) -> Maybe JSONSummary +-- | Construct a 'TOCSummary' from an 'Entry'. +entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Entry (Record fields) -> Maybe TOCSummary entrySummary entry = case entry of Changed a -> recordSummary a "modified" Deleted a -> recordSummary a "removed" Inserted a -> recordSummary a "added" Replaced a -> recordSummary a "modified" --- | Construct a 'JSONSummary' from a node annotation and a change type label. -recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Record fields -> T.Text -> Maybe JSONSummary -recordSummary record = case getDeclaration record of - Just (ErrorDeclaration text _ language) -> Just . const (ErrorSummary text (sourceSpan record) language) - Just declaration -> Just . JSONSummary (toCategoryName declaration) (formatIdentifier declaration) (declarationText declaration) (sourceSpan record) - Nothing -> const Nothing + Changed a -> recordSummary "modified" a + Deleted a -> recordSummary "removed" a + Inserted a -> recordSummary "added" a + Replaced a -> recordSummary "modified" a + +-- | Construct a 'TOCSummary' from a node annotation and a change type label. +recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => T.Text -> Record fields -> Maybe TOCSummary +recordSummary changeText record = case getDeclaration record of + Just (ErrorDeclaration text _ language) -> Just $ ErrorSummary text (sourceSpan record) language + Just declaration -> Just $ TOCSummary (toCategoryName declaration) (formatIdentifier declaration) (declarationText declaration) (sourceSpan record) changeText + Nothing -> Nothing where formatIdentifier (MethodDeclaration identifier _ (Just receiver)) = receiver <> "." <> identifier formatIdentifier declaration = declarationIdentifier declaration @@ -365,11 +370,11 @@ renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition renderToTags :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Blob -> Term f (Record fields) -> [Value] renderToTags Blob{..} = fmap toJSON . termToC' blobLanguage blobPath -diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Diff f (Record fields) (Record fields) -> [JSONSummary] +diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Diff f (Record fields) (Record fields) -> [TOCSummary] diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration -termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Term f (Record fields) -> [JSONSummary] termToC = mapMaybe (`recordSummary` "unchanged") . termTableOfContentsBy declaration +termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Term f (Record fields) -> [TOCSummary] termToC' :: (HasField fields (Maybe Declaration), HasField fields Span, Foldable f, Functor f) => Maybe Language -> FilePath -> Term f (Record fields) -> [Tag] termToC' lang path = mapMaybe (\r -> tagSummary r lang path "unchanged") . termTableOfContentsBy declaration diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index 9ecb20178..aa258645d 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -66,39 +66,39 @@ spec = parallel $ do sourceBlobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") diff <- runTask $ diffWithParser rubyParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Method" "self.foo" "def self.foo(a, *)" (sourceSpanBetween (1, 1) (2, 4)) "modified" - , JSONSummary "Method" "bar" "def bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" ] + [ TOCSummary "Method" "self.foo" "def self.foo(a, *)" (sourceSpanBetween (1, 1) (2, 4)) "modified" + , TOCSummary "Method" "bar" "def bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" ] it "dedupes changes in same parent method" $ do sourceBlobs <- blobsForPaths (both "javascript/duplicate-parent.A.js" "javascript/duplicate-parent.B.js") diff <- runTask $ diffWithParser typescriptParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Function" "myFunction" "function myFunction()" (sourceSpanBetween (1, 1) (6, 2)) "modified" ] + [ TOCSummary "Function" "myFunction" "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") diff <- runTask $ diffWithParser typescriptParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Function" "performHealthCheck" "function performHealthCheck(container, repoName)" (sourceSpanBetween (8, 1) (29, 2)) "modified" ] + [ TOCSummary "Function" "performHealthCheck" "function performHealthCheck(container, repoName)" (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") let Just goParser = syntaxParserForLanguage Go diff <- runTask $ distributeFor sourceBlobs (\ blob -> parse goParser blob >>= decorate (syntaxDeclarationAlgebra blob)) >>= runBothWith (diffTermPair sourceBlobs diffSyntaxTerms) diffTOC diff `shouldBe` - [ JSONSummary "Method" "(*apiClient) CheckAuth" mempty (sourceSpanBetween (3,1) (3,101)) "added" ] + [ TOCSummary "Method" "(*apiClient) CheckAuth" mempty (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") diff <- runTask $ diffWithParser rubyParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Method" "foo" "def foo" (sourceSpanBetween (1, 1) (4, 4)) "modified" ] + [ TOCSummary "Method" "foo" "def 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") diff <- runTask $ diffWithParser rubyParser sourceBlobs diffTOC diff `shouldBe` - [ JSONSummary "Method" "foo" "def foo(a, b, c)" (sourceSpanBetween (6, 1) (7, 4)) "added" ] + [ TOCSummary "Method" "foo" "def foo(a, b, c)" (sourceSpanBetween (6, 1) (7, 4)) "added" ] it "properly slices source blob that starts with a newline and has multi-byte chars" $ do sourceBlobs <- blobsForPaths (both "javascript/starts-with-newline.js" "javascript/starts-with-newline.js") @@ -134,13 +134,13 @@ spec = parallel $ do \a -> let term = defaultFeatureVectorDecorator (Info.category . termAnnotation) (a :: Term') in diffTOC (diffSyntaxTerms term term) `shouldBe` [] - describe "JSONSummary" $ do + describe "TOCSummary" $ do it "encodes modified summaries to JSON" $ do - let summary = JSONSummary "Method" "foo" mempty (sourceSpanBetween (1, 1) (4, 4)) "modified" + let summary = TOCSummary "Method" "foo" mempty (sourceSpanBetween (1, 1) (4, 4)) "modified" encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[4,4]},\"category\":\"Method\",\"term\":\"foo\",\"changeType\":\"modified\"}" it "encodes added summaries to JSON" $ do - let summary = JSONSummary "Method" "self.foo" mempty (sourceSpanBetween (1, 1) (2, 4)) "added" + let summary = TOCSummary "Method" "self.foo" mempty (sourceSpanBetween (1, 1) (2, 4)) "added" encode summary `shouldBe` "{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"category\":\"Method\",\"term\":\"self.foo\",\"changeType\":\"added\"}" describe "diff with ToCDiffRenderer'" $ do