diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index d0e00b89f..1ee02322d 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -188,7 +188,7 @@ termToDiffInfo term = case unwrap term of -- to indicate where that value should be when constructing DiffInfos. S.Operator _ -> LeafInfo (toCategoryName term) "x" Commented cs leaf -> BranchInfo (termToDiffInfo <$> cs <> maybeToList leaf) (toCategoryName term) BCommented - S.Error children -> ErrorInfo (sourceSpan (extract term)) (toCategoryName term) + S.Error _ -> ErrorInfo (sourceSpan (extract term)) (toCategoryName term) _ -> LeafInfo (toCategoryName term) (toTermName term) prependSummary :: Category -> DiffSummary DiffInfo -> DiffSummary DiffInfo diff --git a/src/SourceSpan.hs b/src/SourceSpan.hs index ba68d0b22..a81c63a21 100644 --- a/src/SourceSpan.hs +++ b/src/SourceSpan.hs @@ -6,6 +6,8 @@ module SourceSpan where import Prologue import Data.Aeson ((.=), (.:)) import qualified Data.Aeson as A +import Test.QuickCheck +import Data.Text.Arbitrary() -- | -- Source position information @@ -19,7 +21,7 @@ data SourcePos = SourcePos -- Column number -- , column :: !Int - } deriving (Show, Read, Eq, Ord) + } deriving (Show, Read, Eq, Ord, Generic) displaySourcePos :: SourcePos -> Text displaySourcePos sp = @@ -46,7 +48,7 @@ data SourceSpan = SourceSpan -- End of the span -- , spanEnd :: !SourcePos - } deriving (Show, Read, Eq, Ord) + } deriving (Show, Read, Eq, Ord, Generic) displayStartEndPos :: SourceSpan -> Text displayStartEndPos sp = @@ -69,3 +71,11 @@ instance A.FromJSON SourceSpan where o .: "name" <*> o .: "start" <*> o .: "end" + +instance Arbitrary SourcePos where + arbitrary = SourcePos <$> arbitrary <*> arbitrary + shrink = genericShrink + +instance Arbitrary SourceSpan where + arbitrary = SourceSpan <$> arbitrary <*> arbitrary <*> arbitrary + shrink = genericShrink \ No newline at end of file diff --git a/test/CorpusSpec.hs b/test/CorpusSpec.hs index 67aaabd7e..02a76ebec 100644 --- a/test/CorpusSpec.hs +++ b/test/CorpusSpec.hs @@ -71,7 +71,7 @@ normalizeName path = addExtension (dropExtension $ dropExtension path) (takeExte -- | Given file paths for A, B, and, optionally, a diff, return whether diffing -- | the files will produce the diff. If no diff is provided, then the result -- | is true, but the diff will still be calculated. -testDiff :: Renderer (Record '[Range, Category, Cost]) -> Both FilePath -> Maybe FilePath -> (Verbatim -> Verbatim -> Expectation) -> Expectation +testDiff :: Renderer (Record '[Range, Category, Cost, SourceSpan]) -> Both FilePath -> Maybe FilePath -> (Verbatim -> Verbatim -> Expectation) -> Expectation testDiff renderer paths diff matcher = do sources <- sequence $ readAndTranscodeFile <$> paths actual <- Verbatim <$> diffFiles parser renderer (sourceBlobs sources) diff --git a/test/DiffSummarySpec.hs b/test/DiffSummarySpec.hs index de561d4be..f796e4143 100644 --- a/test/DiffSummarySpec.hs +++ b/test/DiffSummarySpec.hs @@ -18,14 +18,15 @@ import Data.List (partition) import Term.Arbitrary import Interpreter import Info +import SourceSpan -arrayInfo :: Record '[Category] -arrayInfo = ArrayLiteral .: RNil +arrayInfo :: Record '[Category, SourceSpan] +arrayInfo = ArrayLiteral .: SourceSpan "test.js" (SourcePos 0 0) (SourcePos 0 3) .: RNil -literalInfo :: Record '[Category] -literalInfo = StringLiteral .: RNil +literalInfo :: Record '[Category, SourceSpan] +literalInfo = StringLiteral .: SourceSpan "test.js" (SourcePos 0 0) (SourcePos 0 1) .: RNil -testDiff :: Diff Text (Record '[Category]) +testDiff :: Diff Text (Record '[Category, SourceSpan]) testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "a")) ]) testSummary :: DiffSummary DiffInfo @@ -41,7 +42,7 @@ spec = parallel $ 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 + \ a -> let term = toTerm (a :: ArbitraryTerm Text (Record '[Category, SourceSpan])) in diffSummary (diffTerms wrap (==) diffCost term term) `shouldBe` [] describe "annotatedSummaries" $ do @@ -52,7 +53,7 @@ spec = parallel $ do describe "DiffInfo" $ do prop "patches in summaries match the patches in diffs" $ \a -> let - diff = (toDiff (a :: ArbitraryDiff Text (Record '[Category, Cost]))) + diff = (toDiff (a :: ArbitraryDiff Text (Record '[Category, Cost, SourceSpan]))) summaries = diffSummary diff patches = toList diff in @@ -61,14 +62,14 @@ spec = parallel $ do (() <$ 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]))) + diff = (toDiff (a :: ArbitraryDiff Text (Record '[Category, SourceSpan]))) 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 Text (Record '[Category, SourceSpan]) -> [ Term Text (Record '[Category, SourceSpan]) ] extractDiffLeaves term = case unwrap term of (Indexed children) -> join $ extractDiffLeaves <$> children (Fixed children) -> join $ extractDiffLeaves <$> children