Add SourceSpan to tests

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

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

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)

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