Add diffWithParser for dedupe test in TOCSpec

src/Semantic/Util.hs

@@ -1,12 +1,51 @@
+{-# LANGUAGE TypeOperators, DataKinds #-}
 module Semantic.Util where
 
 import Data.Blob
 import Data.Text.Prettyprint.Doc
 import Data.Text.Prettyprint.Doc.Util
 import Files
+import Data.Record
+import Data.Functor.Classes
+import Algorithm
+import Data.Align.Generic
+import Interpreter
+import Parser
+import Decorators
+import Data.Functor.Both
+import Term
+import Diff
+import Semantic
+import Semantic.Task
+import Renderer.TOC
+import Data.Union
+import Data.Syntax.Declaration as Declaration
+import Data.Range
+import Data.Span
+import Data.Syntax
 
 pp :: Pretty a => a -> IO ()
 pp = putDocW 100 . (<> line) . pretty
 
 file :: FilePath -> IO Blob
 file path = Files.readFile path (languageForFilePath path)
+
+diffWithParser :: (HasField fields Data.Span.Span,
+                                     HasField fields Range,
+                                     Error :< fs,
+                                     Declaration.Method :< fs,
+                                     Declaration.Function :< fs,
+                                     Apply1 Eq1 fs, Apply1 Show1 fs,
+                                     Apply1 Traversable fs, Apply1 Functor fs,
+                                     Apply1 Foldable fs, Apply1 Diffable fs,
+                                     GAlign (Data.Union.Union fs)) =>
+                                    Parser (Term (Data.Union.Union fs) (Record fields))
+                                    -> Both Blob
+                                    -> Task (Diff (Union fs) (Record (Maybe Declaration ': fields)))
+diffWithParser parser = run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob))
+  where
+    run parse sourceBlobs = distributeFor sourceBlobs parse >>= diffTermPair sourceBlobs diffRecursively
+
+    diffRecursively :: (Eq1 f, GAlign f, Show1 f, Traversable f, Diffable f) => Both (Term f (Record fields)) -> Diff f (Record fields)
+    diffRecursively = decoratingWith constructorNameAndConstantFields (diffTermsWith algorithmForTerms comparableByConstructor)
+

test/TOCSpec.hs

@@ -32,6 +32,7 @@ import Renderer.TOC
 import RWS
 import Semantic
 import Semantic.Task
+import Semantic.Util
 import SpecHelpers
 import Syntax as S
 import Term
@@ -39,6 +40,7 @@ import Test.Hspec (Spec, describe, it, parallel)
 import Test.Hspec.Expectations.Pretty
 import Test.Hspec.LeanCheck
 import Test.LeanCheck
+import Parser
 
 spec :: Spec
 spec = parallel $ do
@@ -77,13 +79,13 @@ 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)
+      diff <- runTask $ diffWithParser typescriptParser sourceBlobs
       diffTOC 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)
+      diff <- runTask $ diffWithParser typescriptParser sourceBlobs
       diffTOC diff `shouldBe`
         [ JSONSummary "Function" "performHealthCheck" (sourceSpanBetween (8, 1) (29, 2)) "modified" ]