Move SummarizeDiff into TOCSummaries.

src/Semantic/Api/Diffs.hs

@@ -6,13 +6,10 @@ module Semantic.Api.Diffs
 
   , DiffEffects
 
-  , summarizeDiffParsers
-  , SummarizeDiff(..)
+  , diffTerms
   ) where
 
 import           Analysis.ConstructorName (ConstructorName)
-import           Analysis.Decorator (decoratorWithAlgebra)
-import           Analysis.TOCSummary (Declaration, HasDeclaration, declarationAlgebra)
 import           Control.Effect.Error
 import           Control.Effect.Parse
 import           Control.Effect.Reader
@@ -37,7 +34,6 @@ import           Proto.Semantic_JSON()
 import           Rendering.Graph
 import           Rendering.JSON hiding (JSON)
 import qualified Rendering.JSON
-import           Rendering.TOC
 import           Semantic.Api.Bridge
 import           Semantic.Config
 import           Semantic.Task as Task
@@ -148,18 +144,6 @@ instance (Diffable syntax, Eq1 syntax, Hashable1 syntax, Show1 syntax, Traversab
   showDiff = serialize Show
 
 
-summarizeDiffParsers :: Map Language (SomeParser SummarizeDiff Loc)
-summarizeDiffParsers = aLaCarteParsers
-
-class SummarizeDiff term where
-  summarizeTerms :: (Member Telemetry sig, Carrier sig m, MonadIO m) => These (Blob, term Loc) (Blob, term Loc) -> m [Either ErrorSummary TOCSummary]
-
-instance (Diffable syntax, Eq1 syntax, HasDeclaration syntax, Hashable1 syntax, Traversable syntax) => SummarizeDiff (Term syntax) where
-  summarizeTerms = fmap diffTOC . diffTerms . bimap decorateTerm decorateTerm where
-    decorateTerm :: (Foldable syntax, Functor syntax, HasDeclaration syntax) => (Blob, Term syntax Loc) -> (Blob, Term syntax (Maybe Declaration))
-    decorateTerm (blob, term) = (blob, decoratorWithAlgebra (declarationAlgebra blob) term)
-
-
 -- | Parse a 'BlobPair' using one of the provided parsers, diff the resulting terms, and run an action on the abstracted diff.
 --
 -- This allows us to define features using an abstract interface, and use them with diffs for any parser whose terms support that interface.

src/Semantic/Api/TOCSummaries.hs

@@ -1,11 +1,12 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase, MonoLocalBinds #-}
 module Semantic.Api.TOCSummaries
 ( diffSummary
 , legacyDiffSummary
 , diffSummaryBuilder
 ) where
 
-import           Analysis.TOCSummary (formatKind)
+import           Analysis.Decorator (decoratorWithAlgebra)
+import           Analysis.TOCSummary (Declaration, HasDeclaration, declarationAlgebra, formatKind)
 import           Control.Effect.Error
 import           Control.Effect.Parse
 import           Control.Lens
@@ -14,10 +15,18 @@ import           Data.Aeson
 import           Data.Blob
 import           Data.ByteString.Builder
 import           Data.Either (partitionEithers)
+import           Data.Functor.Classes
+import           Data.Hashable.Lifted
+import           Data.Language (Language)
+import           Data.Map (Map)
 import qualified Data.Map.Monoidal as Map
 import           Data.ProtoLens (defMessage)
 import           Data.Semilattice.Lower
+import           Data.Term (Term)
 import qualified Data.Text as T
+import           Data.These (These)
+import           Diffing.Algorithm (Diffable)
+import           Parsing.Parser (SomeParser, aLaCarteParsers)
 import           Proto.Semantic as P hiding (Blob, BlobPair)
 import           Proto.Semantic_Fields as P
 import           Rendering.TOC
@@ -25,6 +34,7 @@ import           Semantic.Api.Bridge
 import           Semantic.Api.Diffs
 import           Semantic.Task as Task
 import           Serializing.Format
+import           Source.Loc
 
 diffSummaryBuilder :: DiffEffects sig m => Format DiffTreeTOCResponse -> [BlobPair] -> m Builder
 diffSummaryBuilder format blobs = diffSummary blobs >>= serialize format
@@ -39,6 +49,7 @@ legacyDiffSummary = distributeFoldMap go
       where path = T.pack $ pathKeyForBlobPair blobPair
             lang = languageForBlobPair blobPair
 
+            toMap :: ToJSON a => [a] -> Map.Map T.Text [Value]
             toMap [] = mempty
             toMap as = Map.singleton path (toJSON <$> as)
 
@@ -76,3 +87,15 @@ toError :: ErrorSummary -> TOCSummaryError
 toError ErrorSummary{..} = defMessage
   & P.error      .~ message
   & P.maybe'span .~ converting #? span
+
+
+summarizeDiffParsers :: Map Language (SomeParser SummarizeDiff Loc)
+summarizeDiffParsers = aLaCarteParsers
+
+class SummarizeDiff term where
+  summarizeTerms :: (Member Telemetry sig, Carrier sig m, MonadIO m) => These (Blob, term Loc) (Blob, term Loc) -> m [Either ErrorSummary TOCSummary]
+
+instance (Diffable syntax, Eq1 syntax, HasDeclaration syntax, Hashable1 syntax, Traversable syntax) => SummarizeDiff (Term syntax) where
+  summarizeTerms = fmap diffTOC . diffTerms . bimap decorateTerm decorateTerm where
+    decorateTerm :: (Foldable syntax, Functor syntax, HasDeclaration syntax) => (Blob, Term syntax Loc) -> (Blob, Term syntax (Maybe Declaration))
+    decorateTerm (blob, term) = (blob, decoratorWithAlgebra (declarationAlgebra blob) term)

test/Rendering/TOC/Spec.hs

@@ -16,7 +16,7 @@ import Prelude
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Declaration as Declaration
 import Rendering.TOC
-import Semantic.Api (DiffEffects, decorateTerm, decorateTermsWith, diffSummaryBuilder, summarizeDiff, summarizeDiffParsers)
+import Semantic.Api (DiffEffects, decorateTerm, diffSummaryBuilder, summarizeDiff, summarizeDiffParsers)
 import Serializing.Format as Format
 import Source.Loc
 import Source.Span