Add SourceSpans to customize ToJSON output for These SourceSpan SourceSpan

src/DiffSummary.hs

@@ -21,7 +21,7 @@ import Text.PrettyPrint.Leijen.Text ((<+>), squotes, space, string, Doc, punctua
 import qualified Text.PrettyPrint.Leijen.Text as P
 import SourceSpan
 import Source
-import Data.Aeson (ToJSON)
+import Data.Aeson as A
 
 data Annotatable a = Annotatable a | Unannotatable a
 
@@ -73,12 +73,15 @@ data DiffSummary a = DiffSummary {
 } deriving (Eq, Functor, Show, Generic)
 
 -- Returns a list of diff summary texts given two source blobs and a diff.
-diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range, HasField fields SourceSpan) => Both SourceBlob -> SyntaxDiff leaf fields -> [JSONSummary Text (These SourceSpan SourceSpan)]
+diffSummaries :: (HasCategory leaf, HasField fields Category, HasField fields Range, HasField fields SourceSpan) =>
+                  Both SourceBlob ->
+                  SyntaxDiff leaf fields ->
+                  [JSONSummary Text SourceSpans]
 diffSummaries blobs diff = summaryToTexts =<< diffToDiffSummaries (source <$> blobs) diff
 
 -- Takes a 'DiffSummary' and returns a list of summary texts representing the LeafInfos
 -- in that 'DiffSummary'.
-summaryToTexts :: DiffSummary DiffInfo -> [JSONSummary Text (These SourceSpan SourceSpan)]
+summaryToTexts :: DiffSummary DiffInfo -> [JSONSummary Text SourceSpans]
 summaryToTexts DiffSummary{..} = (\jsonSummary ->
   jsonSummary { summary = show $ summary jsonSummary <+> parentContexts parentAnnotation }) <$> summaries patch
 
@@ -100,25 +103,25 @@ diffToDiffSummaries sources = para $ \diff ->
     (beforeSource, afterSource) = runJoin sources
 
 -- Flattens a patch of diff infos into a list of docs, one for every 'LeafInfo' or `ErrorInfo` it contains.
-summaries :: Patch DiffInfo -> [JSONSummary Doc (These SourceSpan SourceSpan)]
+summaries :: Patch DiffInfo -> [JSONSummary Doc SourceSpans]
 summaries = \case
   p@(Replace i1 i2) -> zipWith (\a b ->
     JSONSummary
      {
       summary = summary (prefixWithPatch p This a) <+> "with" <+> determiner i1 <+> summary b
-    , span = These (span a) (span b)
+    , span = SourceSpans $ These (span a) (span b)
     }) (toLeafInfos i1) (toLeafInfos i2)
   p@(Insert info) -> prefixWithPatch p That <$> toLeafInfos info
   p@(Delete info) -> prefixWithPatch p This <$> toLeafInfos info
 
 -- Prefixes a given doc with the type of patch it represents.
-prefixWithPatch :: Patch DiffInfo -> (SourceSpan -> These SourceSpan SourceSpan) -> JSONSummary Doc SourceSpan -> JSONSummary Doc (These SourceSpan SourceSpan)
+prefixWithPatch :: Patch DiffInfo -> (SourceSpan -> These SourceSpan SourceSpan) -> JSONSummary Doc SourceSpan -> JSONSummary Doc SourceSpans
 prefixWithPatch patch constructor = prefixWithThe (patchToPrefix patch)
   where
     prefixWithThe prefix jsonSummary = jsonSummary
       {
         summary = prefix <+> determiner' patch <+> summary jsonSummary
-      , span = constructor (span jsonSummary)
+      , span = SourceSpans $ constructor (span jsonSummary)
       }
     patchToPrefix = \case
       (Replace _ _) -> "Replaced"

src/Info.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving #-}
-module Info (Range(..), characterRange, setCharacterRange, Category(..), category, setCategory, Cost(..), cost, setCost, SourceSpan(..), SourcePos(..)) where
+module Info (Range(..), characterRange, setCharacterRange, Category(..), category, setCategory, Cost(..), cost, setCost, SourceSpan(..), SourcePos(..), SourceSpans(..)) where
 
 import Data.Record
 import Prologue

src/Renderer/Summary.hs

@@ -10,7 +10,6 @@ import DiffSummary
 import Data.Map as Map hiding (null)
 import Source
 import SourceSpan
-import Data.These
 import Data.Aeson
 import Data.List as List
 
@@ -22,6 +21,6 @@ summary blobs diff = SummaryOutput $ Map.fromList [
   where
     changes = if null changes' then mempty else Map.singleton summaryKey (toJSON <$> changes')
     errors = if null errors' then mempty else Map.singleton summaryKey (toJSON <$> errors')
-    (errors' :: [JSONSummary Text (These SourceSpan SourceSpan)], changes' :: [JSONSummary Text (These SourceSpan SourceSpan)]) = List.partition isErrorSummary summaries
+    (errors', changes') = List.partition isErrorSummary summaries
     summaryKey = toSummaryKey (path <$> blobs)
     summaries = diffSummaries blobs diff

src/SourceSpan.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveAnyClass, GeneralizedNewtypeDeriving #-}
 -- |
 -- Source position and span information
 -- Mostly taken from purescript's SourcePos definition.
@@ -9,6 +9,7 @@ import Prologue
 import Data.Aeson ((.=), (.:))
 import qualified Data.Aeson as A
 import Test.QuickCheck
+import Data.These
 import Data.Text.Arbitrary()
 
 -- |
@@ -74,6 +75,20 @@ instance A.FromJSON SourceSpan where
       o .: "start" <*>
       o .: "end"
 
+
+newtype SourceSpans = SourceSpans { unSourceSpans :: These SourceSpan SourceSpan }
+  deriving (Eq, Show)
+
+instance A.ToJSON SourceSpans where
+  toJSON (SourceSpans spans) = case spans of
+    (This span) -> A.object ["this" .= span]
+    (That span) -> A.object ["that" .= span]
+    (These span1 span2) -> A.object ["these" .= (span1, span2)]
+  toEncoding (SourceSpans spans) = case spans of
+    (This span) -> A.pairs $ "this" .= span
+    (That span) -> A.pairs $ "that" .= span
+    (These span1 span2) -> A.pairs $ "these" .= (span1, span2)
+
 instance Arbitrary SourcePos where
   arbitrary = SourcePos <$> arbitrary <*> arbitrary
   shrink = genericShrink

test/DiffSummarySpec.hs

@@ -47,7 +47,7 @@ spec :: Spec
 spec = parallel $ do
   describe "diffSummaries" $ do
     it "outputs a diff summary" $ do
-      diffSummaries blobs testDiff `shouldBe` [ JSONSummary "Added the \"a\" string" (That $ sourceSpanBetween (1, 2) (1, 4)) ]
+      diffSummaries blobs testDiff `shouldBe` [ JSONSummary "Added the \"a\" string" (SourceSpans . That $ sourceSpanBetween (1, 2) (1, 4)) ]
 
     prop "equal terms produce identity diffs" $
       \ a -> let term = defaultFeatureVectorDecorator (category . headF) (toTerm (a :: ArbitraryTerm Text (Record '[Category, Range, SourceSpan]))) in