diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs index f8ea19a51..bfbf0b0d2 100644 --- a/src/Semantic/Api/Diffs.hs +++ b/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. diff --git a/src/Semantic/Api/TOCSummaries.hs b/src/Semantic/Api/TOCSummaries.hs index c23748534..11fd6b161 100644 --- a/src/Semantic/Api/TOCSummaries.hs +++ b/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) diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index c20573c5f..ea5a6ed37 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/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