2016-07-13 21:32:53 +03:00
|
|
|
{-# LANGUAGE DataKinds #-}
|
2016-05-17 20:09:14 +03:00
|
|
|
module DiffSummarySpec where
|
2016-05-16 21:43:53 +03:00
|
|
|
|
2016-08-10 16:30:03 +03:00
|
|
|
import Category
|
|
|
|
import Data.Functor.Both
|
2017-01-09 22:29:49 +03:00
|
|
|
import Data.Functor.Listable
|
2016-08-10 16:30:03 +03:00
|
|
|
import Data.List (partition)
|
|
|
|
import Data.RandomWalkSimilarity
|
2016-06-17 20:33:50 +03:00
|
|
|
import Data.Record
|
2017-01-09 22:29:49 +03:00
|
|
|
import Data.String
|
2016-05-17 22:59:07 +03:00
|
|
|
import Diff
|
2016-08-10 16:30:03 +03:00
|
|
|
import DiffSummary
|
2016-07-22 21:51:08 +03:00
|
|
|
import Info
|
2016-08-10 16:30:03 +03:00
|
|
|
import Interpreter
|
|
|
|
import Patch
|
|
|
|
import Prologue
|
2016-07-29 21:31:02 +03:00
|
|
|
import Source
|
2016-08-10 16:30:03 +03:00
|
|
|
import Syntax
|
|
|
|
import Term
|
2016-09-15 00:45:23 +03:00
|
|
|
import Test.Hspec (Spec, describe, it, parallel)
|
|
|
|
import Test.Hspec.Expectations.Pretty
|
2017-01-09 22:29:49 +03:00
|
|
|
import Test.Hspec.LeanCheck
|
2016-10-06 22:12:14 +03:00
|
|
|
import Data.These
|
2016-05-17 20:09:14 +03:00
|
|
|
|
2016-10-06 21:20:58 +03:00
|
|
|
sourceSpanBetween :: (Int, Int) -> (Int, Int) -> SourceSpan
|
2016-10-11 22:12:48 +03:00
|
|
|
sourceSpanBetween (s1, e1) (s2, e2) = SourceSpan (SourcePos s1 e1) (SourcePos s2 e2)
|
2016-10-06 21:20:58 +03:00
|
|
|
|
2016-10-06 00:41:00 +03:00
|
|
|
arrayInfo :: Record '[Category, Range, SourceSpan]
|
2017-01-19 23:46:28 +03:00
|
|
|
arrayInfo = ArrayLiteral :. Range 0 3 :. sourceSpanBetween (1, 1) (1, 5) :. Nil
|
2016-05-17 22:59:07 +03:00
|
|
|
|
2016-10-06 00:41:00 +03:00
|
|
|
literalInfo :: Record '[Category, Range, SourceSpan]
|
2017-01-19 23:46:28 +03:00
|
|
|
literalInfo = StringLiteral :. Range 1 2 :. sourceSpanBetween (1, 2) (1, 4) :. Nil
|
2016-05-17 22:59:07 +03:00
|
|
|
|
2016-10-06 00:41:00 +03:00
|
|
|
testDiff :: Diff (Syntax Text) (Record '[Category, Range, SourceSpan])
|
2016-10-01 00:15:02 +03:00
|
|
|
testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "\"a\"")) ])
|
2016-05-17 22:59:07 +03:00
|
|
|
|
2016-05-31 23:15:40 +03:00
|
|
|
testSummary :: DiffSummary DiffInfo
|
2016-12-13 19:38:18 +03:00
|
|
|
testSummary = DiffSummary { patch = Insert (LeafInfo StringLiteral "a" $ sourceSpanBetween (1,1) (1, 2)), parentAnnotation = [] }
|
2016-05-17 20:09:14 +03:00
|
|
|
|
2016-05-31 23:15:40 +03:00
|
|
|
replacementSummary :: DiffSummary DiffInfo
|
2016-12-13 19:38:18 +03:00
|
|
|
replacementSummary = DiffSummary { patch = Replace (LeafInfo StringLiteral "a" $ sourceSpanBetween (1, 2) (1, 4)) (LeafInfo SymbolLiteral "b" $ sourceSpanBetween (1,1) (1, 2)), parentAnnotation = [Left (Info.FunctionCall, "foo")] }
|
2016-05-18 17:24:08 +03:00
|
|
|
|
2016-08-22 17:33:26 +03:00
|
|
|
blobs :: Both SourceBlob
|
|
|
|
blobs = both (SourceBlob (fromText "[]") nullOid "a.js" (Just defaultPlainBlob)) (SourceBlob (fromText "[a]") nullOid "b.js" (Just defaultPlainBlob))
|
2016-07-29 21:31:02 +03:00
|
|
|
|
2016-05-17 20:09:14 +03:00
|
|
|
spec :: Spec
|
|
|
|
spec = parallel $ do
|
2016-07-30 01:37:41 +03:00
|
|
|
describe "diffSummaries" $ do
|
2017-02-08 19:15:37 +03:00
|
|
|
it "outputs a diff summary" $
|
2016-10-07 00:55:54 +03:00
|
|
|
diffSummaries blobs testDiff `shouldBe` [ JSONSummary "Added the \"a\" string" (SourceSpans . That $ sourceSpanBetween (1, 2) (1, 4)) ]
|
2016-07-14 22:21:14 +03:00
|
|
|
|
|
|
|
prop "equal terms produce identity diffs" $
|
2017-01-09 22:29:49 +03:00
|
|
|
\ a -> let term = defaultFeatureVectorDecorator (category . headF) (unListableF a :: SyntaxTerm String '[Category, Range, SourceSpan]) in
|
2017-02-21 23:23:30 +03:00
|
|
|
diffSummaries blobs (diffTerms term term) `shouldBe` []
|
2016-07-14 22:21:14 +03:00
|
|
|
|
2016-07-15 21:10:31 +03:00
|
|
|
describe "DiffInfo" $ do
|
|
|
|
prop "patches in summaries match the patches in diffs" $
|
|
|
|
\a -> let
|
2017-02-21 22:58:39 +03:00
|
|
|
diff = unListableDiff a :: SyntaxDiff String '[Category, Range, SourceSpan]
|
2016-08-25 19:22:58 +03:00
|
|
|
summaries = diffToDiffSummaries (source <$> blobs) diff
|
2016-07-15 21:10:31 +03:00
|
|
|
patches = toList diff
|
|
|
|
in
|
|
|
|
case (partition isBranchNode (patch <$> summaries), partition isIndexedOrFixed patches) of
|
|
|
|
((branchPatches, otherPatches), (branchDiffPatches, otherDiffPatches)) ->
|
|
|
|
(() <$ branchPatches, () <$ otherPatches) `shouldBe` (() <$ branchDiffPatches, () <$ otherDiffPatches)
|
|
|
|
prop "generates one LeafInfo for each child in an arbitrary branch patch" $
|
|
|
|
\a -> let
|
2017-01-09 22:29:49 +03:00
|
|
|
diff = unListableDiff a :: SyntaxDiff String '[Category, Range, SourceSpan]
|
2016-08-25 19:22:58 +03:00
|
|
|
diffInfoPatches = patch <$> diffToDiffSummaries (source <$> blobs) diff
|
2016-07-15 21:10:31 +03:00
|
|
|
syntaxPatches = toList diff
|
|
|
|
extractLeaves :: DiffInfo -> [DiffInfo]
|
|
|
|
extractLeaves (BranchInfo children _ _) = join $ extractLeaves <$> children
|
|
|
|
extractLeaves leaf = [ leaf ]
|
|
|
|
|
2017-01-09 22:29:49 +03:00
|
|
|
extractDiffLeaves :: SyntaxTerm String '[Category, Range, SourceSpan] -> [ SyntaxTerm String '[Category, Range, SourceSpan] ]
|
2016-07-15 21:10:31 +03:00
|
|
|
extractDiffLeaves term = case unwrap term of
|
|
|
|
(Indexed children) -> join $ extractDiffLeaves <$> children
|
|
|
|
(Fixed children) -> join $ extractDiffLeaves <$> children
|
2016-07-26 20:45:50 +03:00
|
|
|
Commented children leaf -> children <> maybeToList leaf >>= extractDiffLeaves
|
2016-07-15 21:10:31 +03:00
|
|
|
_ -> [ term ]
|
|
|
|
in
|
|
|
|
case (partition isBranchNode diffInfoPatches, partition isIndexedOrFixed syntaxPatches) of
|
|
|
|
((branchPatches, _), (diffPatches, _)) ->
|
|
|
|
let listOfLeaves = foldMap extractLeaves (join $ toList <$> branchPatches)
|
2016-07-26 20:44:12 +03:00
|
|
|
listOfDiffLeaves = foldMap extractDiffLeaves (diffPatches >>= toList)
|
2016-07-15 21:10:31 +03:00
|
|
|
in
|
2017-02-10 01:10:16 +03:00
|
|
|
Prologue.length listOfLeaves `shouldBe` Prologue.length listOfDiffLeaves
|
2016-07-15 21:10:31 +03:00
|
|
|
|
2016-09-09 21:46:50 +03:00
|
|
|
isIndexedOrFixed :: Patch (Term (Syntax a) annotation) -> Bool
|
2016-07-26 23:44:33 +03:00
|
|
|
isIndexedOrFixed = any (isIndexedOrFixed' . unwrap)
|
2016-07-16 03:32:48 +03:00
|
|
|
|
|
|
|
isIndexedOrFixed' :: Syntax a f -> Bool
|
2016-07-15 21:10:31 +03:00
|
|
|
isIndexedOrFixed' syntax = case syntax of
|
|
|
|
(Indexed _) -> True
|
|
|
|
(Fixed _) -> True
|
2017-02-15 21:16:53 +03:00
|
|
|
(Commented _ _) -> True
|
2016-07-15 21:10:31 +03:00
|
|
|
_ -> False
|
2016-07-16 03:32:48 +03:00
|
|
|
|
2016-07-15 21:10:31 +03:00
|
|
|
isBranchNode :: Patch DiffInfo -> Bool
|
2016-07-26 21:04:15 +03:00
|
|
|
isBranchNode = any isBranchInfo
|
2017-01-09 22:29:49 +03:00
|
|
|
|
|
|
|
unListableDiff :: Functor f => ListableF (Free (TermF f (ListableF (Join (,)) annotation))) (Patch (ListableF (Term f) annotation)) -> Diff f annotation
|
2017-02-14 01:30:55 +03:00
|
|
|
unListableDiff diff = hoistFree (first unListableF) $ fmap unListableF <$> unListableF diff
|