mirror of
https://github.com/github/semantic.git
synced 2024-11-28 18:23:44 +03:00
106 lines
4.2 KiB
Haskell
106 lines
4.2 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
module DiffSummarySpec where
|
|
|
|
import Prologue
|
|
import Data.Record
|
|
import Test.Hspec
|
|
import Test.Hspec.QuickCheck
|
|
import Diff
|
|
import Syntax
|
|
import Term
|
|
import Patch
|
|
import Category
|
|
import DiffSummary
|
|
import Text.PrettyPrint.Leijen.Text (pretty)
|
|
import Test.Hspec.QuickCheck
|
|
import Diff.Arbitrary
|
|
import Data.List (partition)
|
|
import Term.Arbitrary
|
|
import Interpreter
|
|
import Info
|
|
|
|
arrayInfo :: Record '[Category]
|
|
arrayInfo = ArrayLiteral .: RNil
|
|
|
|
literalInfo :: Record '[Category]
|
|
literalInfo = StringLiteral .: RNil
|
|
|
|
testDiff :: Diff Text (Record '[Category])
|
|
testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "a")) ])
|
|
|
|
testSummary :: DiffSummary DiffInfo
|
|
testSummary = DiffSummary { patch = Insert (LeafInfo "string" "a"), parentAnnotations = [] }
|
|
|
|
replacementSummary :: DiffSummary DiffInfo
|
|
replacementSummary = DiffSummary { patch = Replace (LeafInfo "string" "a") (LeafInfo "symbol" "b"), parentAnnotations = [ ArrayLiteral ] }
|
|
|
|
spec :: Spec
|
|
spec = parallel $ do
|
|
describe "diffSummary" $ do
|
|
it "outputs a diff summary" $ do
|
|
diffSummary testDiff `shouldBe` [ DiffSummary { patch = Insert (LeafInfo "string" "a"), parentAnnotations = [ ArrayLiteral ] } ]
|
|
|
|
prop "equal terms produce identity diffs" $
|
|
\ a -> let term = toTerm (a :: ArbitraryTerm Text (Record '[Category])) in
|
|
diffSummary (diffTerms wrap (==) diffCost term term) `shouldBe` []
|
|
|
|
describe "annotatedSummaries" $ do
|
|
it "should print adds" $
|
|
annotatedSummaries testSummary `shouldBe` ["Added the 'a' string"]
|
|
it "prints a replacement" $ do
|
|
annotatedSummaries replacementSummary `shouldBe` ["Replaced the 'a' string with the 'b' symbol in the array context"]
|
|
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 (diffPatches >>= toList)
|
|
in
|
|
length listOfLeaves `shouldBe` length listOfDiffLeaves
|
|
|
|
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 a f -> Bool
|
|
isIndexedOrFixed' syntax = case syntax of
|
|
(Indexed _) -> True
|
|
(Fixed _) -> True
|
|
_ -> False
|
|
|
|
isBranchInfo :: DiffInfo -> Bool
|
|
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 |