From 7fdc32b77cd8c25f011341bb40df56571b8c1a27 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 18 Jul 2017 15:52:18 -0700 Subject: [PATCH 1/8] Add Undetected Language constructor --- src/Language.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Language.hs b/src/Language.hs index f86897322..80f91cd7c 100644 --- a/src/Language.hs +++ b/src/Language.hs @@ -18,6 +18,7 @@ data Language = | Python | Ruby | TypeScript + | Undetected deriving (Show, Eq, Read, Generic, ToJSON) -- | Returns a Language based on the file extension (including the "."). From 9d2119ffc8b7acbf831feac708e0247ced2db1ab Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 18 Jul 2017 15:58:37 -0700 Subject: [PATCH 2/8] Add language field to JSONSummary --- src/Renderer/TOC.hs | 36 +++++++++++++++++++----------------- 1 file changed, 19 insertions(+), 17 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index fad5509c9..90a98c367 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -33,6 +33,7 @@ import Data.These import Data.Union import Diff import Info +import Language import Patch import Prologue import qualified Data.List as List @@ -62,14 +63,15 @@ data JSONSummary { summaryCategoryName :: Text , summaryTermName :: Text , summarySpan :: Span + , summaryLanguage :: Language , summaryChangeType :: Text } - | ErrorSummary { error :: Text, errorSpan :: Span } + | ErrorSummary { error :: Text, errorSpan :: Span, errorLanguage :: Language } deriving (Generic, Eq, Show) instance ToJSON JSONSummary where - toJSON JSONSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySpan ] - toJSON ErrorSummary{..} = object [ "error" .= error, "span" .= errorSpan ] + toJSON JSONSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySpan, "language" .= summaryLanguage ] + toJSON ErrorSummary{..} = object [ "error" .= error, "span" .= errorSpan, "language" .= errorLanguage ] isValidSummary :: JSONSummary -> Bool isValidSummary ErrorSummary{} = False @@ -171,19 +173,19 @@ dedupe = foldl' go [] similarDeclaration = (==) `on` fmap (toLower . declarationIdentifier) . getDeclaration -- | Construct a 'JSONSummary' from an 'Entry'. Returns 'Nothing' for 'Unchanged' patches. -entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Entry (Record fields) -> Maybe JSONSummary -entrySummary entry = case entry of +entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Language -> Entry (Record fields) -> Maybe JSONSummary +entrySummary language entry = case entry of Unchanged _ -> Nothing - Changed a -> recordSummary a "modified" - Deleted a -> recordSummary a "removed" - Inserted a -> recordSummary a "added" - Replaced a -> recordSummary a "modified" + Changed a -> recordSummary language a "modified" + Deleted a -> recordSummary language a "removed" + Inserted a -> recordSummary language a "added" + Replaced a -> recordSummary language a "modified" -- | Construct a 'JSONSummary' from a node annotation and a change type label. -recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Record fields -> Text -> Maybe JSONSummary -recordSummary record = case getDeclaration record of - Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record)) - Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) +recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Language -> Record fields -> Text -> Maybe JSONSummary +recordSummary language record = case getDeclaration record of + Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record) language) + Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) language Nothing -> const Nothing renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Both Blob -> Diff f (Record fields) -> Summaries @@ -201,11 +203,11 @@ renderToCTerm blob = uncurry Summaries . bimap toMap toMap . List.partition isVa where toMap [] = mempty toMap as = Map.singleton (toS (blobPath blob)) (toJSON <$> as) -diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Diff f (Record fields) -> [JSONSummary] -diffTOC = mapMaybe entrySummary . dedupe . tableOfContentsBy declaration +diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Language -> Diff f (Record fields) -> [JSONSummary] +diffTOC language = mapMaybe (entrySummary language) . dedupe . tableOfContentsBy declaration -termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Term f (Record fields) -> [JSONSummary] -termToC = mapMaybe (flip recordSummary "unchanged") . termTableOfContentsBy declaration +termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Language -> Term f (Record fields) -> [JSONSummary] +termToC language = mapMaybe (flip (recordSummary language) "unchanged") . termTableOfContentsBy declaration -- The user-facing category name toCategoryName :: Declaration -> Text From 565445039e8e2b1b2136b741ffd36caac8d33e95 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 18 Jul 2017 15:59:55 -0700 Subject: [PATCH 3/8] Add language to Summaries --- src/Renderer/TOC.hs | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 90a98c367..040184233 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -45,18 +45,18 @@ import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Markup as Markup import Term -data Summaries = Summaries { changes, errors :: !(Map Text [Value]) } +data Summaries = Summaries { changes, errors :: !(Map Text [Value]), language :: Language } deriving (Eq, Show) instance Monoid Summaries where - mempty = Summaries mempty mempty - mappend (Summaries c1 e1) (Summaries c2 e2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2) + mempty = Summaries mempty mempty Undetected + mappend (Summaries c1 e1 l1) (Summaries c2 e2 l2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2) l1 instance StringConv Summaries ByteString where strConv _ = toS . (<> "\n") . encode instance ToJSON Summaries where - toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors ] + toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors, "language" .= language ] data JSONSummary = JSONSummary @@ -189,9 +189,15 @@ recordSummary language record = case getDeclaration record of Nothing -> const Nothing renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Both Blob -> Diff f (Record fields) -> Summaries -renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC - where toMap [] = mempty +renderToCDiff blobs diff = Summaries (toMap changes) (toMap errors) languages + where (changes, errors) = List.partition isValidSummary $ diffTOC languages diff + toMap [] = mempty toMap as = Map.singleton summaryKey (toJSON <$> as) + languages = case runJoin (blobLanguage <$> blobs) of + (Nothing, Just after) -> after + (Just before, Nothing) -> before + (Nothing, Nothing) -> Undetected + (Just before, Just _) -> before summaryKey = toS $ case runJoin (blobPath <$> blobs) of (before, after) | null before -> after | null after -> before @@ -199,9 +205,11 @@ renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isV | otherwise -> before <> " -> " <> after renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Blob -> Term f (Record fields) -> Summaries -renderToCTerm blob = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC - where toMap [] = mempty - toMap as = Map.singleton (toS (blobPath blob)) (toJSON <$> as) +renderToCTerm Blob{..} term = Summaries (toMap changes) (toMap errors) language + where (changes, errors) = List.partition isValidSummary $ termToC language term + language = fromMaybe Undetected blobLanguage + toMap [] = mempty + toMap as = Map.singleton (toS blobPath) (toJSON <$> as) diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Language -> Diff f (Record fields) -> [JSONSummary] diffTOC language = mapMaybe (entrySummary language) . dedupe . tableOfContentsBy declaration From c7eb0dc4828f7b926836befd5771ce60320ec9bb Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 18 Jul 2017 16:49:39 -0700 Subject: [PATCH 4/8] :fire: language from Summaries; :fire: language from JSONSummary - We only care about the language when there's a parse error, so language is added to ErrorSummary only --- src/Renderer/TOC.hs | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 040184233..1d7839f1a 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -45,32 +45,31 @@ import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Markup as Markup import Term -data Summaries = Summaries { changes, errors :: !(Map Text [Value]), language :: Language } +data Summaries = Summaries { changes, errors :: !(Map Text [Value]) } deriving (Eq, Show) instance Monoid Summaries where - mempty = Summaries mempty mempty Undetected - mappend (Summaries c1 e1 l1) (Summaries c2 e2 l2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2) l1 + mempty = Summaries mempty mempty + mappend (Summaries c1 e1) (Summaries c2 e2) = Summaries (Map.unionWith (<>) c1 c2) (Map.unionWith (<>) e1 e2) instance StringConv Summaries ByteString where strConv _ = toS . (<> "\n") . encode instance ToJSON Summaries where - toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors, "language" .= language ] + toJSON Summaries{..} = object [ "changes" .= changes, "errors" .= errors ] data JSONSummary = JSONSummary { summaryCategoryName :: Text , summaryTermName :: Text , summarySpan :: Span - , summaryLanguage :: Language , summaryChangeType :: Text } | ErrorSummary { error :: Text, errorSpan :: Span, errorLanguage :: Language } deriving (Generic, Eq, Show) instance ToJSON JSONSummary where - toJSON JSONSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySpan, "language" .= summaryLanguage ] + toJSON JSONSummary{..} = object [ "changeType" .= summaryChangeType, "category" .= summaryCategoryName, "term" .= summaryTermName, "span" .= summarySpan ] toJSON ErrorSummary{..} = object [ "error" .= error, "span" .= errorSpan, "language" .= errorLanguage ] isValidSummary :: JSONSummary -> Bool @@ -185,11 +184,11 @@ entrySummary language entry = case entry of recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Language -> Record fields -> Text -> Maybe JSONSummary recordSummary language record = case getDeclaration record of Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record) language) - Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) language + Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) Nothing -> const Nothing renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Both Blob -> Diff f (Record fields) -> Summaries -renderToCDiff blobs diff = Summaries (toMap changes) (toMap errors) languages +renderToCDiff blobs diff = Summaries (toMap changes) (toMap errors) where (changes, errors) = List.partition isValidSummary $ diffTOC languages diff toMap [] = mempty toMap as = Map.singleton summaryKey (toJSON <$> as) @@ -205,7 +204,7 @@ renderToCDiff blobs diff = Summaries (toMap changes) (toMap errors) languages | otherwise -> before <> " -> " <> after renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Blob -> Term f (Record fields) -> Summaries -renderToCTerm Blob{..} term = Summaries (toMap changes) (toMap errors) language +renderToCTerm Blob{..} term = Summaries (toMap changes) (toMap errors) where (changes, errors) = List.partition isValidSummary $ termToC language term language = fromMaybe Undetected blobLanguage toMap [] = mempty From c92157b9888c93f26123f7147218e3405a392584 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 18 Jul 2017 17:17:33 -0700 Subject: [PATCH 5/8] :fire: Undetected constructor - Representing as Maybe Language is helpful for blobs that are null. --- src/Language.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Language.hs b/src/Language.hs index 80f91cd7c..f86897322 100644 --- a/src/Language.hs +++ b/src/Language.hs @@ -18,7 +18,6 @@ data Language = | Python | Ruby | TypeScript - | Undetected deriving (Show, Eq, Read, Generic, ToJSON) -- | Returns a Language based on the file extension (including the "."). From 9d1f4f19ca229f6de718e4f5c1be959d3224934d Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Tue, 18 Jul 2017 17:18:09 -0700 Subject: [PATCH 6/8] Update ErrorSummary to use MaybeLanguage --- src/Renderer/TOC.hs | 31 ++++++++++++++----------------- 1 file changed, 14 insertions(+), 17 deletions(-) diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 1d7839f1a..9c249cf04 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -65,7 +65,7 @@ data JSONSummary , summarySpan :: Span , summaryChangeType :: Text } - | ErrorSummary { error :: Text, errorSpan :: Span, errorLanguage :: Language } + | ErrorSummary { error :: Text, errorSpan :: Span, errorLanguage :: Maybe Language } deriving (Generic, Eq, Show) instance ToJSON JSONSummary where @@ -172,7 +172,7 @@ dedupe = foldl' go [] similarDeclaration = (==) `on` fmap (toLower . declarationIdentifier) . getDeclaration -- | Construct a 'JSONSummary' from an 'Entry'. Returns 'Nothing' for 'Unchanged' patches. -entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Language -> Entry (Record fields) -> Maybe JSONSummary +entrySummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Maybe Language -> Entry (Record fields) -> Maybe JSONSummary entrySummary language entry = case entry of Unchanged _ -> Nothing Changed a -> recordSummary language a "modified" @@ -181,22 +181,21 @@ entrySummary language entry = case entry of Replaced a -> recordSummary language a "modified" -- | Construct a 'JSONSummary' from a node annotation and a change type label. -recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Language -> Record fields -> Text -> Maybe JSONSummary +recordSummary :: (HasField fields (Maybe Declaration), HasField fields Span) => Maybe Language -> Record fields -> Text -> Maybe JSONSummary recordSummary language record = case getDeclaration record of Just (ErrorDeclaration text) -> Just . const (ErrorSummary text (sourceSpan record) language) Just declaration -> Just . JSONSummary (toCategoryName declaration) (declarationIdentifier declaration) (sourceSpan record) Nothing -> const Nothing renderToCDiff :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Both Blob -> Diff f (Record fields) -> Summaries -renderToCDiff blobs diff = Summaries (toMap changes) (toMap errors) - where (changes, errors) = List.partition isValidSummary $ diffTOC languages diff - toMap [] = mempty +renderToCDiff blobs = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . diffTOC language + where toMap [] = mempty toMap as = Map.singleton summaryKey (toJSON <$> as) - languages = case runJoin (blobLanguage <$> blobs) of - (Nothing, Just after) -> after - (Just before, Nothing) -> before - (Nothing, Nothing) -> Undetected - (Just before, Just _) -> before + language = case runJoin (blobLanguage <$> blobs) of + (Nothing, Just after) -> Just after + (Just before, Nothing) -> Just before + (Nothing, Nothing) -> Nothing + (Just before, Just _) -> Just before summaryKey = toS $ case runJoin (blobPath <$> blobs) of (before, after) | null before -> after | null after -> before @@ -204,16 +203,14 @@ renderToCDiff blobs diff = Summaries (toMap changes) (toMap errors) | otherwise -> before <> " -> " <> after renderToCTerm :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Blob -> Term f (Record fields) -> Summaries -renderToCTerm Blob{..} term = Summaries (toMap changes) (toMap errors) - where (changes, errors) = List.partition isValidSummary $ termToC language term - language = fromMaybe Undetected blobLanguage - toMap [] = mempty +renderToCTerm Blob{..} = uncurry Summaries . bimap toMap toMap . List.partition isValidSummary . termToC blobLanguage + where toMap [] = mempty toMap as = Map.singleton (toS blobPath) (toJSON <$> as) -diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Language -> Diff f (Record fields) -> [JSONSummary] +diffTOC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Maybe Language -> Diff f (Record fields) -> [JSONSummary] diffTOC language = mapMaybe (entrySummary language) . dedupe . tableOfContentsBy declaration -termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Language -> Term f (Record fields) -> [JSONSummary] +termToC :: (HasField fields (Maybe Declaration), HasField fields Span, Traversable f) => Maybe Language -> Term f (Record fields) -> [JSONSummary] termToC language = mapMaybe (flip (recordSummary language) "unchanged") . termTableOfContentsBy declaration -- The user-facing category name From 607392ded1a093797f926e5e78524bba8d3a35bd Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 19 Jul 2017 10:34:48 -0700 Subject: [PATCH 7/8] Add language to ToC spec tests --- test/TOCSpec.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index caecace4d..d82d4549d 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -55,12 +55,12 @@ spec = parallel $ do describe "diffTOC" $ do it "blank if there are no methods" $ - diffTOC blankDiff `shouldBe` [ ] + diffTOC Nothing blankDiff `shouldBe` [ ] it "summarizes changed methods" $ do sourceBlobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.B.rb") Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs) - diffTOC diff `shouldBe` + diffTOC (Just Ruby) diff `shouldBe` [ JSONSummary "Method" "self.foo" (sourceSpanBetween (1, 1) (2, 4)) "added" , JSONSummary "Method" "bar" (sourceSpanBetween (4, 1) (6, 4)) "modified" , JSONSummary "Method" "baz" (sourceSpanBetween (4, 1) (5, 4)) "removed" ] @@ -68,37 +68,37 @@ 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 (diffBlobPair IdentityDiffRenderer sourceBlobs) - diffTOC diff `shouldBe` + diffTOC Nothing diff `shouldBe` [ JSONSummary "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 (diffBlobPair IdentityDiffRenderer sourceBlobs) - diffTOC diff `shouldBe` + diffTOC (Just JavaScript) diff `shouldBe` [ JSONSummary "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 (diffBlobPair IdentityDiffRenderer sourceBlobs) - diffTOC diff `shouldBe` + diffTOC (Just Language.Go) diff `shouldBe` [ JSONSummary "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 (diffBlobPair IdentityDiffRenderer sourceBlobs) - diffTOC diff `shouldBe` + diffTOC (Just Ruby) diff `shouldBe` [ JSONSummary "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 (diffBlobPair IdentityDiffRenderer sourceBlobs) - diffTOC diff `shouldBe` + diffTOC (Just Ruby) diff `shouldBe` [ JSONSummary "Method" "foo" (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") Just diff <- runTask (diffBlobPair IdentityDiffRenderer sourceBlobs) - diffTOC diff `shouldBe` [] + diffTOC (Just JavaScript) diff `shouldBe` [] prop "inserts of methods and functions are summarized" $ \name body -> @@ -127,7 +127,7 @@ spec = parallel $ do prop "equal terms produce identity diffs" $ \a -> let term = defaultFeatureVectorDecorator (Info.category . headF) (unListableF a :: Term') in - diffTOC (diffTerms (pure term)) `shouldBe` [] + diffTOC Nothing (diffTerms (pure term)) `shouldBe` [] describe "JSONSummary" $ do it "encodes modified summaries to JSON" $ do @@ -159,7 +159,7 @@ type Diff' = SyntaxDiff Text (Maybe Declaration ': DefaultFields) type Term' = SyntaxTerm Text (Maybe Declaration ': DefaultFields) numTocSummaries :: Diff' -> Int -numTocSummaries diff = length $ filter isValidSummary (diffTOC diff) +numTocSummaries diff = length $ filter isValidSummary (diffTOC Nothing diff) -- Return a diff where body is inserted in the expressions of a function. The function is present in both sides of the diff. programWithChange :: Term' -> Diff' From 6fc07e18cea5ee6a4241d91320d5fefb97ae6522 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Wed, 19 Jul 2017 10:44:38 -0700 Subject: [PATCH 8/8] Add language field to errors test --- test/TOCSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs index d82d4549d..e270b948e 100644 --- a/test/TOCSpec.hs +++ b/test/TOCSpec.hs @@ -147,7 +147,7 @@ spec = parallel $ do it "produces JSON output if there are parse errors" $ do blobs <- blobsForPaths (both "ruby/methods.A.rb" "ruby/methods.X.rb") output <- runTask (diffBlobPair ToCDiffRenderer blobs) - toS output `shouldBe` ("{\"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) + toS output `shouldBe` ("{\"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\",\"language\":\"Ruby\"}]}}\n" :: ByteString) it "summarizes Markdown headings" $ do blobs <- blobsForPaths (both "markdown/headings.A.md" "markdown/headings.B.md")