diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 84878a1d5..6936f11bd 100644 --- a/semantic-diff.cabal +++ b/semantic-diff.cabal @@ -149,6 +149,7 @@ test-suite test , RangeSpec , Source.Spec , TermSpec + , TOCSpec , Test.Hspec.LeanCheck build-depends: array , base diff --git a/src/Renderer/TOC.hs b/src/Renderer/TOC.hs index 8e77e8a3f..2ee83a2e0 100644 --- a/src/Renderer/TOC.hs +++ b/src/Renderer/TOC.hs @@ -1,10 +1,11 @@ {-# LANGUAGE ScopedTypeVariables #-} -module Renderer.TOC (toc) where +module Renderer.TOC (toc, diffTOC, JSONSummary(..), Summarizable(..)) where import Category as C import Data.Aeson import Data.Functor.Both hiding (fst, snd) import qualified Data.Functor.Both as Both +import Data.Text (toLower) import Data.Record import Diff import Info @@ -17,7 +18,6 @@ import Source hiding (null) import Syntax as S import Term import Patch -import Unsafe (unsafeHead) data JSONSummary = JSONSummary { info :: Summarizable } | ErrorSummary { error :: Text, errorSpan :: SourceSpan } @@ -64,13 +64,24 @@ toc blobs diff = TOCOutput $ Map.fromList [ summaries = diffTOC blobs diff diffTOC :: (StringConv leaf Text, DefaultFields fields) => Both SourceBlob -> SyntaxDiff leaf fields -> [JSONSummary] -diffTOC blobs diff = do - noDupes <- removeDupes (diffToTOCSummaries (source <$> blobs) diff) - toJSONSummaries noDupes +diffTOC blobs diff = removeDupes (diffToTOCSummaries (source <$> blobs) diff) >>= toJSONSummaries where removeDupes :: [TOCSummary DiffInfo] -> [TOCSummary DiffInfo] - removeDupes [] = [] - removeDupes xs = (fmap unsafeHead . List.groupBy (\a b -> parentInfo a == parentInfo b)) xs + removeDupes = foldl' go [] + where + go xs x | (_, _ : _) <- find exactMatch x xs = xs + | (front, existingItem : back) <- find similarMatch x xs = + let + (Summarizable category name sourceSpan _) = parentInfo existingItem + replacement = x { parentInfo = Summarizable category name sourceSpan "modified" } + in + front <> (replacement : back) + | otherwise = xs <> [x] + find p x = List.break (p x) + exactMatch a b = parentInfo a == parentInfo b + similarMatch a b = case (parentInfo a, parentInfo b) of + (Summarizable catA nameA _ _, Summarizable catB nameB _ _) -> catA == catB && toLower nameA == toLower nameB + (_, _) -> False diffToTOCSummaries :: (StringConv leaf Text, DefaultFields fields) => Both Source -> SyntaxDiff leaf fields -> [TOCSummary DiffInfo] diffToTOCSummaries sources = para $ \diff -> @@ -155,10 +166,15 @@ toTermName :: forall leaf fields. DefaultFields fields => Int -> Source -> Synta toTermName parentOffset parentSource term = case unwrap term of S.Function identifier _ _ _ -> toTermName' identifier S.Method identifier Nothing _ _ _ -> toTermName' identifier - S.Method identifier (Just receiver) _ _ _ -> toTermName' receiver <> "." <> toTermName' identifier + S.Method identifier (Just receiver) _ _ _ -> case unwrap receiver of + S.Indexed [receiverParams] -> case unwrap receiverParams of + S.ParameterDecl (Just ty) _ -> "(" <> toTermName' ty <> ") " <> toTermName' identifier + _ -> toMethodNameWithReceiver receiver identifier + _ -> toMethodNameWithReceiver receiver identifier _ -> toText source where source = Source.slice (offsetRange (range term) (negate parentOffset)) parentSource + toMethodNameWithReceiver receiver name = toTermName' receiver <> "." <> toTermName' name offset = start (range term) toTermName' :: SyntaxTerm leaf fields -> Text toTermName' = toTermName offset source diff --git a/test/Spec.hs b/test/Spec.hs index 71480f5b5..66c1283f8 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -12,6 +12,7 @@ import qualified PatchOutputSpec import qualified RangeSpec import qualified Source.Spec import qualified TermSpec +import qualified TOCSpec import Test.Hspec main :: IO () @@ -27,3 +28,4 @@ main = hspec . parallel $ do describe "Range" RangeSpec.spec describe "Source" Source.Spec.spec describe "Term" TermSpec.spec + describe "TOC" TOCSpec.spec diff --git a/test/TOCSpec.hs b/test/TOCSpec.hs new file mode 100644 index 000000000..644b32d9d --- /dev/null +++ b/test/TOCSpec.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DataKinds #-} +module TOCSpec where + +import Category +import Data.Functor.Both +import Data.RandomWalkSimilarity +import Data.Record +import Data.These +import Diff +import Diffing +import Info +import Interpreter +import Parse +import Patch +import Prologue hiding (fst, snd) +import Renderer.TOC +import Source +import Syntax +import Test.Hspec (Spec, describe, it, parallel) +import Test.Hspec.Expectations.Pretty + +spec :: Spec +spec = parallel $ do + describe "tocSummaries" $ do + it "blank if there are no methods" $ + diffTOC blobs blankDiff `shouldBe` [ ] + + it "dedupes changes in same parent method" $ do + sourceBlobs <- blobsForPaths (both "test/corpus/toc/javascript/dupParent.A.js" "test/corpus/toc/javascript/dupParent.B.js") + diff <- testDiff sourceBlobs + diffTOC sourceBlobs diff `shouldBe` [ JSONSummary $ InSummarizable Category.Function "myFunction" (sourceSpanBetween (1, 1) (6, 2)) ] + + it "dedupes similar methods" $ do + sourceBlobs <- blobsForPaths (both "test/corpus/toc/javascript/erroneousDupMethod.A.js" "test/corpus/toc/javascript/erroneousDupMethod.B.js") + diff <- testDiff sourceBlobs + diffTOC sourceBlobs diff `shouldBe` [ JSONSummary $ Summarizable Category.Function "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" ] + +testDiff :: Both SourceBlob -> IO (Diff (Syntax Text) (Record '[Cost, Range, Category, SourceSpan])) +testDiff sourceBlobs = do + terms <- traverse (fmap (defaultFeatureVectorDecorator getLabel) . parser) sourceBlobs + pure $! stripDiff (diffTerms' terms sourceBlobs) + where + parser = parserWithCost (path . fst $ sourceBlobs) + diffTerms' terms blobs = case runBothWith areNullOids blobs of + (True, False) -> pure $ Insert (snd terms) + (False, True) -> pure $ Delete (fst terms) + (_, _) -> runBothWith (diffTerms construct compareCategoryEq diffCostWithCachedTermCosts) terms + areNullOids a b = (hasNullOid a, hasNullOid b) + hasNullOid blob = oid blob == nullOid || Source.null (source blob) + construct (info :< syntax) = free (Free ((setCost <$> info <*> sumCost syntax) :< syntax)) + sumCost = fmap getSum . foldMap (fmap Sum . getCost) + getCost diff = case runFree diff of + Free (info :< _) -> cost <$> info + Pure patch -> uncurry both (fromThese 0 0 (unPatch (cost . extract <$> patch))) + +blobsForPaths :: Both FilePath -> IO (Both SourceBlob) +blobsForPaths paths = do + sources <- sequence $ readAndTranscodeFile <$> paths + pure $ SourceBlob <$> sources <*> pure mempty <*> paths <*> pure (Just Source.defaultPlainBlob) + + +sourceSpanBetween :: (Int, Int) -> (Int, Int) -> SourceSpan +sourceSpanBetween (s1, e1) (s2, e2) = SourceSpan (SourcePos s1 e1) (SourcePos s2 e2) + +arrayInfo :: Record '[Category, Range, SourceSpan] +arrayInfo = ArrayLiteral :. Range 0 3 :. sourceSpanBetween (1, 1) (1, 5) :. Nil + +literalInfo :: Record '[Category, Range, SourceSpan] +literalInfo = StringLiteral :. Range 1 2 :. sourceSpanBetween (1, 2) (1, 4) :. Nil + +blankDiff :: Diff (Syntax Text) (Record '[Category, Range, SourceSpan]) +blankDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "\"a\"")) ]) + +blobs :: Both SourceBlob +blobs = both (SourceBlob (fromText "[]") nullOid "a.js" (Just defaultPlainBlob)) (SourceBlob (fromText "[a]") nullOid "b.js" (Just defaultPlainBlob)) diff --git a/test/corpus/toc/javascript/dupParent.A.js b/test/corpus/toc/javascript/dupParent.A.js new file mode 100644 index 000000000..1f3e01f84 --- /dev/null +++ b/test/corpus/toc/javascript/dupParent.A.js @@ -0,0 +1,3 @@ +function myFunction() { + return 0; +} diff --git a/test/corpus/toc/javascript/dupParent.B.js b/test/corpus/toc/javascript/dupParent.B.js new file mode 100644 index 000000000..3145f834f --- /dev/null +++ b/test/corpus/toc/javascript/dupParent.B.js @@ -0,0 +1,6 @@ +function myFunction() { + if (true) { + console.log(); + } + return 1; +} diff --git a/test/corpus/toc/javascript/erroneousDupMethod.A.js b/test/corpus/toc/javascript/erroneousDupMethod.A.js new file mode 100644 index 000000000..251e61ef0 --- /dev/null +++ b/test/corpus/toc/javascript/erroneousDupMethod.A.js @@ -0,0 +1,38 @@ +/* @flow */ + +import $ from '../jquery' +import cast from '../typecast' +import {on} from 'delegated-events' +import {submit} from '../form' + +let allowSubmit = false + +function performHealthcheck() { + const repoName = cast(document.getElementById('showcase_item_name_with_owner'), HTMLInputElement).value + const submitButton = cast(document.getElementById('submit'), HTMLButtonElement) + const hiddenForm = cast(document.getElementsByClassName('js-submit-health-check')[0], HTMLFormElement) + const targetRepoName = cast(document.getElementById('repo_name'), HTMLInputElement) + document.getElementById("js-health").innerHTML = "Performing health check..." + targetRepoName.value = repoName + submitButton.disabled = false + allowSubmit = true + submit(hiddenForm) +} + +on('submit', '#new_showcase_item', function(e) { + if (!allowSubmit) { e.preventDefault() } +}) + +$(document).on('ajaxSuccess', '.js-health', function(event, xhr, settings, data) { + this.innerHTML = data +}) + +on('focusout', '#showcase_item_name_with_owner', function() { + performHealthcheck() +}) + +on('focusin', '#showcase_item_body', function() { + if (cast(document.getElementById('showcase_item_name_with_owner'), HTMLInputElement).type === 'hidden') { + performHealthcheck() + } +}) diff --git a/test/corpus/toc/javascript/erroneousDupMethod.B.js b/test/corpus/toc/javascript/erroneousDupMethod.B.js new file mode 100644 index 000000000..b91cdd649 --- /dev/null +++ b/test/corpus/toc/javascript/erroneousDupMethod.B.js @@ -0,0 +1,45 @@ +/* @flow */ + +import cast from '../typecast' +import {changeValue} from '../form' +import {fetchSafeDocumentFragment} from '../fetch' +import {observe} from '../observe' + +function performHealthCheck(container, repoName) { + const formCheck = cast(document.querySelector('.js-repo-health-check'), HTMLFormElement) + const nameToCheck = cast(formCheck.querySelector('.js-repo-health-name'), HTMLInputElement) + nameToCheck.value = repoName + + const completedIndicator = cast(container.querySelector('.js-repo-health-check-completed'), HTMLInputElement) + changeValue(completedIndicator, '') + container.classList.remove('d-none') + container.classList.add('is-loading') + + return fetchSafeDocumentFragment(document, formCheck.action, { + method: 'POST', + body: new FormData(formCheck), + }).then(html => { + const results = cast(container.querySelector('.js-repo-health-results'), HTMLElement) + results.innerHTML = '' + results.appendChild(html) + + container.classList.remove('is-loading') + changeValue(completedIndicator, '1') + }) +} + +observe('.js-repo-health', function(container: HTMLElement) { + const form = cast(container.closest('form'), HTMLFormElement) + const repoInput = cast(form.querySelector('.js-repo-name'), HTMLInputElement) + + if (repoInput.type === 'hidden') { + const description = cast(form.querySelector('.js-comment-field'), HTMLTextAreaElement) + description.addEventListener('focus', () => { + performHealthCheck(container, repoInput.value) + }) + } else { + repoInput.addEventListener('change', () => { + performHealthCheck(container, repoInput.value) + }) + } +})