diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index 97e39ee47..81042ca37 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -133,7 +133,7 @@ instance P.Pretty (DiffSummary DiffInfo) where else space <> "in the" <+> (toDoc . intercalate "/" $ toCategoryName <$> annotations) <+> "context" toDoc = string . toS -diffSummary :: (HasCategory leaf, HasField fields Category, Hashable leaf, Show (Record fields), Show leaf, Ord (Record fields), Eq leaf, HasField fields Cost) => Diff leaf (Record fields) -> [DiffSummary DiffInfo] +diffSummary :: (HasCategory leaf, HasField fields Category) => Diff leaf (Record fields) -> [DiffSummary DiffInfo] diffSummary = cata $ \case -- Skip comments and leaves since they don't have any changes (Free (_ :< Leaf _)) -> [] diff --git a/test/DiffSummarySpec.hs b/test/DiffSummarySpec.hs index 402c50a98..add67b280 100644 --- a/test/DiffSummarySpec.hs +++ b/test/DiffSummarySpec.hs @@ -42,29 +42,59 @@ spec = parallel $ do show (pretty testSummary) `shouldBe` ("Added the 'a' string" :: Text) it "prints a replacement" $ do show (pretty replacementSummary) `shouldBe` ("Replaced the 'a' string with the 'b' symbol in the array context" :: Text) - prop "patches in summaries match the patches in diffs" $ - \a -> let - diff = (toDiff (a :: ArbitraryDiff Text (Record '[Category, Cost]))) - summaries = diffSummary diff - patches = toList diff - isIndexedOrFixed :: Patch (Term a annotation) -> Bool - isIndexedOrFixed patch = case unwrap <$> patch of - (Insert syntax) -> isIndexedOrFixed' syntax - (Delete syntax) -> isIndexedOrFixed' syntax - (Replace s1 s2) -> isIndexedOrFixed' s1 || isIndexedOrFixed' s2 - isIndexedOrFixed' syntax = case syntax of - (Indexed _) -> True - (Fixed _) -> True - _ -> False - isBranchInfo info = case info of - (BranchInfo _ _ _) -> True - (LeafInfo _ _) -> False - isBranchNode :: DiffSummary DiffInfo -> Bool - isBranchNode summary = (case patch summary of - (Insert diffInfo) -> isBranchInfo diffInfo - (Delete diffInfo) -> isBranchInfo diffInfo - (Replace i1 i2) -> isBranchInfo i1 || isBranchInfo i2) - in - case (partition isBranchNode summaries, partition isIndexedOrFixed patches) of - ((branchSummaries, otherSummaries), (branchPatches, otherPatches)) -> - ((() <$) . patch <$> branchSummaries, (() <$) . patch <$> otherSummaries) `shouldBe` ((() <$) <$> branchPatches, (() <$) <$> otherPatches) + describe "DiffInfo" $ do + prop "patches in summaries match the patches in diffs" $ + \a -> let + diff = (toDiff (a :: ArbitraryDiff Text (Record '[Category, Cost]))) + summaries = diffSummary diff + 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 + diff = (toDiff (a :: ArbitraryDiff Text (Record '[Category]))) + diffInfoPatches = patch <$> diffSummary diff + syntaxPatches = toList diff + extractLeaves :: DiffInfo -> [DiffInfo] + extractLeaves (BranchInfo children _ _) = join $ extractLeaves <$> children + extractLeaves leaf = [ leaf ] + + extractDiffLeaves :: Term Text (Record '[Category]) -> [ Term Text (Record '[Category]) ] + extractDiffLeaves term = case unwrap term of + (Indexed children) -> join $ extractDiffLeaves <$> children + (Fixed children) -> join $ extractDiffLeaves <$> children + Commented children leaf -> join $ extractDiffLeaves <$> children <> maybeToList leaf + _ -> [ term ] + in + case (partition isBranchNode diffInfoPatches, partition isIndexedOrFixed syntaxPatches) of + ((branchPatches, _), (diffPatches, _)) -> + let listOfLeaves = foldMap extractLeaves (join $ toList <$> branchPatches) + listOfDiffLeaves = foldMap extractDiffLeaves (join $ toList <$> diffPatches) + in + length listOfLeaves `shouldBe` length listOfDiffLeaves + + -- partitions arbitrary diff infos ([BranchInfo], [LeafInfo]) + -- partitions arbitrary patches ([Fixed/Indexed], [Other]) + -- Map [BranchInfo] -> [LeafInfo] + -- Map [Fixed/Indexed] -> [Children != Fixed/Indexed] + -- length [Children != Fixed/Indexed] == length [LeafInfo] + +isIndexedOrFixed :: Patch (Term a annotation) -> Bool +isIndexedOrFixed patch = case unwrap <$> patch of + (Insert syntax) -> isIndexedOrFixed' syntax + (Delete syntax) -> isIndexedOrFixed' syntax + (Replace s1 s2) -> isIndexedOrFixed' s1 || isIndexedOrFixed' s2 +isIndexedOrFixed' syntax = case syntax of + (Indexed _) -> True + (Fixed _) -> True + _ -> False +isBranchInfo info = case info of + (BranchInfo _ _ _) -> True + (LeafInfo _ _) -> False +isBranchNode :: Patch DiffInfo -> Bool +isBranchNode patch = case patch of + (Insert diffInfo) -> isBranchInfo diffInfo + (Delete diffInfo) -> isBranchInfo diffInfo + (Replace i1 i2) -> isBranchInfo i1 || isBranchInfo i2 \ No newline at end of file