Pass the blobs to diffTerms in These.

src/Semantic/Api/Diffs.hs

@@ -153,11 +153,11 @@ summarizeDiffParsers = aLaCarteParsers
 
 class SummarizeDiff term where
   decorateTerm :: Blob -> term Loc -> term (Maybe Declaration)
-  summarizeTerms :: (Member Telemetry sig, Carrier sig m, MonadIO m) => BlobPair -> These (term (Maybe Declaration)) (term (Maybe Declaration)) -> m [Either ErrorSummary TOCSummary]
+  summarizeTerms :: (Member Telemetry sig, Carrier sig m, MonadIO m) => These (Blob, term (Maybe Declaration)) (Blob, term (Maybe Declaration)) -> m [Either ErrorSummary TOCSummary]
 
 instance (Diffable syntax, Eq1 syntax, HasDeclaration syntax, Hashable1 syntax, Traversable syntax) => SummarizeDiff (Term syntax) where
   decorateTerm = decoratorWithAlgebra . declarationAlgebra
-  summarizeTerms blobs = fmap diffTOC . diffTerms blobs
+  summarizeTerms = fmap diffTOC . diffTerms
 
 
 -- | Parse a 'BlobPair' using one of the provided parsers, diff the resulting terms, and run an action on the abstracted diff.
@@ -169,11 +169,12 @@ diffWith
   -> (forall term . c term => DiffFor term Loc Loc -> m output) -- ^ A function to run on the computed diff. Note that the diff is abstract (it’s the diff type corresponding to an abstract term type), but the term type is constrained by @c@, allowing you to do anything @c@ allows, and requiring that all the input parsers produce terms supporting @c@.
   -> BlobPair                                                   -- ^ The blob pair to parse.
   -> m output
-diffWith parsers render blobPair = parsePairWith parsers (render <=< diffTerms blobPair . bimap snd snd) blobPair
+diffWith parsers render = parsePairWith parsers (render <=< diffTerms)
 
 diffTerms :: (DiffTerms term, Member Telemetry sig, Carrier sig m, MonadIO m)
-  => BlobPair -> These (term ann) (term ann) -> m (DiffFor term ann ann)
-diffTerms blobs terms = time "diff" languageTag $ do
-  let diff = diffTermPair terms
+  => These (Blob, term ann) (Blob, term ann) -> m (DiffFor term ann ann)
+diffTerms terms = time "diff" languageTag $ do
+  let diff = diffTermPair (bimap snd snd terms)
   diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag)
   where languageTag = languageTagForBlobPair blobs
+        blobs = BlobPair (bimap fst fst terms)

src/Semantic/Api/TOCSummaries.hs

@@ -35,7 +35,7 @@ legacyDiffSummary :: DiffEffects sig m => [BlobPair] -> m Summaries
 legacyDiffSummary = distributeFoldMap go
   where
     go :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig, Member Telemetry sig, MonadIO m) => BlobPair -> m Summaries
-    go blobPair = parsePairWith summarizeDiffParsers (fmap (uncurry (flip Summaries) . bimap toMap toMap . partitionEithers) . summarizeTerms blobPair . decorateTermsWith decorateTerm) blobPair
+    go blobPair = parsePairWith summarizeDiffParsers (fmap (uncurry (flip Summaries) . bimap toMap toMap . partitionEithers) . summarizeTerms . decorateTermsWith decorateTerm) blobPair
       `catchError` \(SomeException e) ->
         pure $ Summaries mempty (toMap [ErrorSummary (T.pack (show e)) lowerBound lang])
       where path = T.pack $ pathKeyForBlobPair blobPair
@@ -51,7 +51,7 @@ diffSummary blobs = do
   pure $ defMessage & P.files .~ diff
   where
     go :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig, Member Telemetry sig, MonadIO m) => BlobPair -> m TOCSummaryFile
-    go blobPair = parsePairWith summarizeDiffParsers (fmap (uncurry toFile . partitionEithers . map (bimap toError toChange)) . summarizeTerms blobPair . decorateTermsWith decorateTerm) blobPair
+    go blobPair = parsePairWith summarizeDiffParsers (fmap (uncurry toFile . partitionEithers . map (bimap toError toChange)) . summarizeTerms . decorateTermsWith decorateTerm) blobPair
       `catchError` \(SomeException e) ->
         pure $ toFile [defMessage & P.error .~ T.pack (show e) & P.maybe'span .~ Nothing] []
       where toFile errors changes = defMessage
@@ -60,8 +60,9 @@ diffSummary blobs = do
               & P.changes  .~ changes
               & P.errors   .~ errors
 
-decorateTermsWith :: (Blob -> term a -> term b) -> These (Blob, term a) (Blob, term a) -> These (term b) (term b)
-decorateTermsWith decorate = bimap (uncurry decorate) (uncurry decorate)
+decorateTermsWith :: (Blob -> term a -> term b) -> These (Blob, term a) (Blob, term a) -> These (Blob, term b) (Blob, term b)
+decorateTermsWith decorate = bimap dec dec where
+  dec (blob, term) = (blob, decorate blob term)
 
 toChangeType :: Change -> ChangeType
 toChangeType = \case

test/Rendering/TOC/Spec.hs

@@ -218,4 +218,4 @@ summarize
   :: DiffEffects sig m
   => BlobPair
   -> m [Either ErrorSummary TOCSummary]
-summarize blobPair = parsePairWith summarizeDiffParsers (summarizeTerms blobPair . decorateTermsWith decorateTerm) blobPair
+summarize = parsePairWith summarizeDiffParsers (summarizeTerms . decorateTermsWith decorateTerm)