diff --git a/share-api.cabal b/share-api.cabal index f9eb85a9..4ecdde11 100644 --- a/share-api.cabal +++ b/share-api.cabal @@ -28,6 +28,8 @@ library Share.App Share.Backend Share.BackgroundJobs + Share.BackgroundJobs.Diffs.ContributionDiffs + Share.BackgroundJobs.Diffs.Queries Share.BackgroundJobs.Errors Share.BackgroundJobs.Monad Share.BackgroundJobs.Search.DefinitionSync diff --git a/share-utils/package.yaml b/share-utils/package.yaml index 519184ef..d7be7067 100644 --- a/share-utils/package.yaml +++ b/share-utils/package.yaml @@ -42,6 +42,7 @@ default-extensions: - FlexibleContexts - FlexibleInstances - GeneralizedNewtypeDeriving + - InstanceSigs - LambdaCase - MultiParamTypeClasses - NamedFieldPuns diff --git a/share-utils/share-utils.cabal b/share-utils/share-utils.cabal index b064344c..bc846403 100644 --- a/share-utils/share-utils.cabal +++ b/share-utils/share-utils.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack @@ -25,6 +25,7 @@ source-repository head library exposed-modules: Share.Debug + Share.Utils.Aeson Share.Utils.Binary Share.Utils.Deployment Share.Utils.IDs @@ -50,6 +51,7 @@ library FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving + InstanceSigs LambdaCase MultiParamTypeClasses NamedFieldPuns diff --git a/share-utils/src/Share/Utils/Aeson.hs b/share-utils/src/Share/Utils/Aeson.hs new file mode 100644 index 00000000..3083b166 --- /dev/null +++ b/share-utils/src/Share/Utils/Aeson.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE InstanceSigs #-} + +module Share.Utils.Aeson (MaybeEncoded (..), PreEncoded (..)) where + +import Data.Aeson (ToJSON (..)) +import Data.Aeson qualified as Aeson +import Data.Aeson.Encoding qualified as Encoding +import Data.Binary.Builder qualified as Builder +import Data.ByteString.Lazy.Char8 qualified as BL +import Data.Maybe (fromMaybe) +import Data.Proxy (Proxy (..)) +import Data.Typeable (Typeable, typeRep) +import GHC.Stack (HasCallStack) + +data MaybeEncoded a + = IsEncoded BL.ByteString + | NotEncoded a + deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable) + +instance (Typeable a, ToJSON a) => ToJSON (MaybeEncoded a) where + toJSON :: (HasCallStack) => MaybeEncoded a -> Aeson.Value + toJSON (IsEncoded txt) = Aeson.toJSON (PreEncoded @a txt) + toJSON (NotEncoded a) = Aeson.toJSON a + + toEncoding :: (HasCallStack) => MaybeEncoded a -> Aeson.Encoding + toEncoding (IsEncoded txt) = Aeson.toEncoding (PreEncoded @a txt) + toEncoding (NotEncoded a) = Aeson.toEncoding a + +newtype PreEncoded a = PreEncoded BL.ByteString + deriving stock (Show, Eq, Ord) + +instance (Typeable a) => ToJSON (PreEncoded a) where + toJSON :: (HasCallStack) => PreEncoded a -> Aeson.Value + toJSON (PreEncoded txt) = + -- It's regrettable we have to do this, but seemingly it's required when building values + -- with @@object [key .= val]@@ syntax. + fromMaybe (error $ "Invalid PreEncoded JSON for type: " <> show (typeRep (Proxy @a))) $ Aeson.decode txt + + toEncoding :: (HasCallStack) => PreEncoded a -> Aeson.Encoding + toEncoding (PreEncoded txt) = Encoding.unsafeToEncoding . Builder.fromLazyByteString $ txt diff --git a/share-utils/src/Share/Utils/URI.hs b/share-utils/src/Share/Utils/URI.hs index 8ee3da00..3a07aff7 100644 --- a/share-utils/src/Share/Utils/URI.hs +++ b/share-utils/src/Share/Utils/URI.hs @@ -22,12 +22,12 @@ import Data.Map qualified as Map import Data.Text (Text) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text -import Share.Utils.Show (tShow) import Hasql.Decoders qualified as Decoders import Hasql.Interpolate qualified as Hasql import Network.HTTP.Types (parseQuery, renderQuery) import Network.URI qualified as URI import Servant +import Share.Utils.Show (tShow) -- | Helper type to provide additional instances for URIs. newtype URIParam = URIParam {unpackURI :: URI} diff --git a/sql/2024-11-19-00-00_namespace_diffs.sql b/sql/2024-11-19-00-00_namespace_diffs.sql new file mode 100644 index 00000000..c4b63844 --- /dev/null +++ b/sql/2024-11-19-00-00_namespace_diffs.sql @@ -0,0 +1,23 @@ +-- Adds tables for storing pre-computed namespace diffs + +CREATE TABLE namespace_diffs ( + left_namespace_id INTEGER NOT NULL REFERENCES branch_hashes(id) ON DELETE CASCADE, + right_namespace_id INTEGER NOT NULL REFERENCES branch_hashes(id) ON DELETE CASCADE, + + -- Since different codebases can have different variable names and such we also need to sandbox diffs by codebase owner + left_codebase_owner_user_id UUID NOT NULL REFERENCES users(id) ON DELETE CASCADE, + right_codebase_owner_user_id UUID NOT NULL REFERENCES users(id) ON DELETE CASCADE, + + diff JSONB NOT NULL, + + PRIMARY KEY (left_namespace_id, right_namespace_id, left_codebase_owner_user_id, right_codebase_owner_user_id) +); + + +-- New table for coordinating background job for pre-computing diffs + +-- Table of all contributions which have been updated and may need their diffs re-computed +CREATE TABLE contribution_diff_queue ( + contribution_id UUID PRIMARY KEY REFERENCES contributions(id) ON DELETE CASCADE, + created_at TIMESTAMPTZ NOT NULL DEFAULT NOW() +); diff --git a/src/Share/BackgroundJobs.hs b/src/Share/BackgroundJobs.hs index 06b79d9a..72e7ee3d 100644 --- a/src/Share/BackgroundJobs.hs +++ b/src/Share/BackgroundJobs.hs @@ -1,6 +1,7 @@ module Share.BackgroundJobs (startWorkers) where import Ki.Unlifted qualified as Ki +import Share.BackgroundJobs.Diffs.ContributionDiffs qualified as ContributionDiffs import Share.BackgroundJobs.Monad (Background) import Share.BackgroundJobs.Search.DefinitionSync qualified as DefnSearch @@ -8,3 +9,4 @@ import Share.BackgroundJobs.Search.DefinitionSync qualified as DefnSearch startWorkers :: Ki.Scope -> Background () startWorkers scope = do DefnSearch.worker scope + ContributionDiffs.worker scope diff --git a/src/Share/BackgroundJobs/Diffs/ContributionDiffs.hs b/src/Share/BackgroundJobs/Diffs/ContributionDiffs.hs new file mode 100644 index 00000000..f6805850 --- /dev/null +++ b/src/Share/BackgroundJobs/Diffs/ContributionDiffs.hs @@ -0,0 +1,71 @@ +module Share.BackgroundJobs.Diffs.ContributionDiffs (worker) where + +import Control.Lens +import Control.Monad.Except (ExceptT (..), runExceptT) +import Ki.Unlifted qualified as Ki +import Share.BackgroundJobs.Diffs.Queries qualified as DQ +import Share.BackgroundJobs.Errors (reportError) +import Share.BackgroundJobs.Monad (Background) +import Share.BackgroundJobs.Workers (newWorker) +import Share.Branch (Branch (..)) +import Share.Codebase qualified as Codebase +import Share.Contribution (Contribution (..)) +import Share.IDs +import Share.Metrics qualified as Metrics +import Share.NamespaceDiffs (NamespaceDiffError (MissingEntityError)) +import Share.Postgres qualified as PG +import Share.Postgres.Contributions.Queries qualified as ContributionsQ +import Share.Postgres.Queries qualified as Q +import Share.Prelude +import Share.Utils.Logging qualified as Logging +import Share.Web.Authorization qualified as AuthZ +import Share.Web.Errors (EntityMissing (..), ErrorID (..)) +import Share.Web.Share.Diffs.Impl qualified as Diffs +import Unison.Debug qualified as Debug +import UnliftIO.Concurrent qualified as UnliftIO + +pollingIntervalSeconds :: Int +pollingIntervalSeconds = 10 + +worker :: Ki.Scope -> Background () +worker scope = do + authZReceipt <- AuthZ.backgroundJobAuthZ + newWorker scope "diffs:contributions" $ forever do + processDiffs authZReceipt >>= \case + Left e -> reportError e + Right _ -> pure () + liftIO $ UnliftIO.threadDelay $ pollingIntervalSeconds * 1000000 + +processDiffs :: AuthZ.AuthZReceipt -> Background (Either NamespaceDiffError ()) +processDiffs authZReceipt = Metrics.recordContributionDiffDuration . runExceptT $ do + Debug.debugLogM Debug.Temp "Background: Getting contributions to be diffed" + mayContributionId <- PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do + DQ.claimContributionToDiff + Debug.debugM Debug.Temp "Background: contribution to be diffed: " mayContributionId + for_ mayContributionId (diffContribution authZReceipt) + case mayContributionId of + Just contributionId -> do + Logging.textLog ("Recomputed contribution diff: " <> tShow contributionId) + & Logging.withTag ("contribution-id", tShow contributionId) + & Logging.withSeverity Logging.Info + & Logging.logMsg + -- Keep processing releases until we run out of them. + either throwError pure =<< lift (processDiffs authZReceipt) + Nothing -> pure () + +diffContribution :: AuthZ.AuthZReceipt -> ContributionId -> ExceptT NamespaceDiffError Background () +diffContribution authZReceipt contributionId = do + ( project, + newBranch@Branch {causal = newBranchCausalId}, + oldBranch@Branch {causal = oldBranchCausalId} + ) <- ExceptT $ PG.tryRunTransaction $ do + Contribution {sourceBranchId = newBranchId, targetBranchId = oldBranchId, projectId} <- ContributionsQ.contributionById contributionId `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "contribution:missing") "Contribution not found") + project <- Q.projectById projectId `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "project:missing") "Project not found") + newBranch <- Q.branchById newBranchId `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "branch:missing") "Source branch not found") + oldBranch <- Q.branchById oldBranchId `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "branch:missing") "Target branch not found") + pure (project, newBranch, oldBranch) + let oldCodebase = Codebase.codebaseForProjectBranch authZReceipt project oldBranch + let newCodebase = Codebase.codebaseForProjectBranch authZReceipt project newBranch + -- This method saves the diff so it'll be there when we need it, so we don't need to do anything with it. + _ <- Diffs.diffCausals authZReceipt (oldCodebase, oldBranchCausalId) (newCodebase, newBranchCausalId) + pure () diff --git a/src/Share/BackgroundJobs/Diffs/Queries.hs b/src/Share/BackgroundJobs/Diffs/Queries.hs new file mode 100644 index 00000000..f7bbd77d --- /dev/null +++ b/src/Share/BackgroundJobs/Diffs/Queries.hs @@ -0,0 +1,43 @@ +module Share.BackgroundJobs.Diffs.Queries + ( submitContributionsToBeDiffed, + claimContributionToDiff, + ) +where + +import Data.Foldable (toList) +import Data.Set (Set) +import Share.IDs +import Share.Postgres +import Unison.Debug qualified as Debug + +submitContributionsToBeDiffed :: (QueryM m) => Set ContributionId -> m () +submitContributionsToBeDiffed contributions = do + Debug.debugM Debug.Temp "Submitting contributions to be diffed: " contributions + execute_ + [sql| + WITH new_contributions(contribution_id) AS ( + SELECT * FROM ^{singleColumnTable (toList contributions)} + ) + INSERT INTO contribution_diff_queue (contribution_id) + SELECT nc.contribution_id FROM new_contributions nc + ON CONFLICT DO NOTHING + |] + +-- | Claim the oldest contribution in the queue to be diffed. +claimContributionToDiff :: Transaction e (Maybe ContributionId) +claimContributionToDiff = do + query1Col + [sql| + WITH chosen_contribution(contribution_id) AS ( + SELECT q.contribution_id + FROM contribution_diff_queue q + ORDER BY q.created_at ASC + LIMIT 1 + -- Skip any that are being synced by other workers. + FOR UPDATE SKIP LOCKED + ) + DELETE FROM contribution_diff_queue + USING chosen_contribution + WHERE contribution_diff_queue.contribution_id = chosen_contribution.contribution_id + RETURNING chosen_contribution.contribution_id + |] diff --git a/src/Share/Metrics.hs b/src/Share/Metrics.hs index a93082e5..a1d70561 100644 --- a/src/Share/Metrics.hs +++ b/src/Share/Metrics.hs @@ -10,6 +10,7 @@ module Share.Metrics tickUserSignup, recordBackgroundImportDuration, recordDefinitionSearchIndexDuration, + recordContributionDiffDuration, ) where @@ -398,6 +399,18 @@ definitionSearchIndexDurationSeconds = "definition_search_indexing_duration_seconds" "The time it took to index a release for definition search" +{-# NOINLINE contributionDiffDurationSeconds #-} +contributionDiffDurationSeconds :: Prom.Vector Prom.Label2 Prom.Histogram +contributionDiffDurationSeconds = + Prom.unsafeRegister $ + Prom.vector ("deployment", "service") $ + Prom.histogram info Prom.defaultBuckets + where + info = + Prom.Info + "contribution_diff_duration_seconds" + "The time it took to compute a contribution diff" + timeActionIntoHistogram :: (Prom.Label l, MonadUnliftIO m) => (Prom.Vector l Prom.Histogram) -> l -> m c -> m c timeActionIntoHistogram histogram l m = do UnliftIO.bracket start end \_ -> m @@ -416,3 +429,6 @@ recordBackgroundImportDuration = timeActionIntoHistogram backgroundImportDuratio -- | Record the duration of a background import. recordDefinitionSearchIndexDuration :: (MonadUnliftIO m) => m r -> m r recordDefinitionSearchIndexDuration = timeActionIntoHistogram definitionSearchIndexDurationSeconds (deployment, service) + +recordContributionDiffDuration :: (MonadUnliftIO m) => m r -> m r +recordContributionDiffDuration = timeActionIntoHistogram contributionDiffDurationSeconds (deployment, service) diff --git a/src/Share/NamespaceDiffs.hs b/src/Share/NamespaceDiffs.hs index 3f3e29d7..904b2081 100644 --- a/src/Share/NamespaceDiffs.hs +++ b/src/Share/NamespaceDiffs.hs @@ -11,6 +11,18 @@ module Share.NamespaceDiffs diffTreeNamespaces, namespaceTreeDiffReferences_, namespaceTreeDiffReferents_, + namespaceTreeDiffTermDiffs_, + namespaceTreeDiffTypeDiffs_, + namespaceTreeDiffRenderedTerms_, + namespaceTreeDiffRenderedTypes_, + namespaceTreeTermDiffKinds_, + namespaceTreeTypeDiffKinds_, + definitionDiffRendered_, + definitionDiffRefs_, + definitionDiffDiffs_, + definitionDiffKindRefs_, + definitionDiffKindDiffs_, + definitionDiffKindRendered_, ) where @@ -25,13 +37,14 @@ import Data.Map qualified as Map import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as NESet -import Servant (err500) +import Servant (err404, err500) import Share.Postgres qualified as PG import Share.Postgres.IDs (BranchHashId) import Share.Postgres.NameLookups.Conversions qualified as Cv import Share.Postgres.NameLookups.Types (NameLookupReceipt) import Share.Postgres.NamespaceDiffs qualified as ND import Share.Prelude +import Share.Utils.Logging (Loggable (..)) import Share.Utils.Logging qualified as Logging import Share.Web.Errors import U.Codebase.Reference qualified as V2 @@ -65,24 +78,66 @@ data DefinitionDiffs name r = DefinitionDiffs } deriving stock (Eq, Show) -data DefinitionDiff r = DefinitionDiff - { kind :: DefinitionDiffKind r, +data DefinitionDiff r rendered diff = DefinitionDiff + { kind :: DefinitionDiffKind r rendered diff, -- The fully qualified name of the definition we're concerned with. fqn :: Name } - deriving stock (Eq, Show, Ord, Functor, Foldable, Traversable) + deriving stock (Eq, Show, Ord) + +definitionDiffKind_ :: Lens (DefinitionDiff r rendered diff) (DefinitionDiff r' rendered' diff') (DefinitionDiffKind r rendered diff) (DefinitionDiffKind r' rendered' diff') +definitionDiffKind_ = lens getter setter + where + getter (DefinitionDiff k _) = k + setter (DefinitionDiff _ n) k = DefinitionDiff k n + +definitionDiffRefs_ :: Traversal (DefinitionDiff r rendered diff) (DefinitionDiff r' rendered diff) r r' +definitionDiffRefs_ f (DefinitionDiff k n) = DefinitionDiff <$> definitionDiffKindRefs_ f k <*> pure n + +definitionDiffDiffs_ :: Traversal (DefinitionDiff r rendered diff) (DefinitionDiff r rendered diff') diff diff' +definitionDiffDiffs_ f (DefinitionDiff k n) = DefinitionDiff <$> definitionDiffKindDiffs_ f k <*> pure n + +definitionDiffRendered_ :: Traversal (DefinitionDiff r rendered diff) (DefinitionDiff r rendered' diff) rendered rendered' +definitionDiffRendered_ f (DefinitionDiff k n) = DefinitionDiff <$> definitionDiffKindRendered_ f k <*> pure n -- | Information about a single definition which is different. -data DefinitionDiffKind r - = Added r - | NewAlias r (NESet Name {- existing names -}) - | Removed r - | Updated r {- old -} r {- new -} +data DefinitionDiffKind r rendered diff + = Added r rendered + | NewAlias r (NESet Name {- existing names -}) rendered + | Removed r rendered + | Updated r {- old -} r {- new -} diff | -- This definition was removed away from this location and added at the provided names. - RenamedTo r (NESet Name) + RenamedTo r (NESet Name) rendered | -- This definition was added at this location and removed from the provided names. - RenamedFrom r (NESet Name) - deriving stock (Eq, Show, Ord, Functor, Foldable, Traversable) + RenamedFrom r (NESet Name) rendered + deriving stock (Eq, Show, Ord) + +definitionDiffKindRefs_ :: Traversal (DefinitionDiffKind r rendered diff) (DefinitionDiffKind r' rendered diff) r r' +definitionDiffKindRefs_ f = \case + Added r rendered -> Added <$> f r <*> pure rendered + NewAlias r ns rendered -> NewAlias <$> f r <*> pure ns <*> pure rendered + Removed r rendered -> Removed <$> f r <*> pure rendered + Updated old new diff -> Updated <$> f old <*> f new <*> pure diff + RenamedTo r old rendered -> RenamedTo <$> f r <*> pure old <*> pure rendered + RenamedFrom r old rendered -> RenamedFrom <$> f r <*> pure old <*> pure rendered + +definitionDiffKindDiffs_ :: Traversal (DefinitionDiffKind r rendered diff) (DefinitionDiffKind r rendered diff') diff diff' +definitionDiffKindDiffs_ f = \case + Added r rendered -> Added r <$> pure rendered + NewAlias r ns rendered -> NewAlias r ns <$> pure rendered + Removed r rendered -> Removed r <$> pure rendered + Updated old new diff -> Updated old new <$> f diff + RenamedTo r old rendered -> RenamedTo r old <$> pure rendered + RenamedFrom r old rendered -> RenamedFrom r old <$> pure rendered + +definitionDiffKindRendered_ :: Traversal (DefinitionDiffKind r rendered diff) (DefinitionDiffKind r rendered' diff) rendered rendered' +definitionDiffKindRendered_ f = \case + Added r rendered -> Added r <$> f rendered + NewAlias r ns rendered -> NewAlias r ns <$> f rendered + Removed r rendered -> Removed r <$> f rendered + Updated old new diff -> Updated old new <$> pure diff + RenamedTo r old rendered -> RenamedTo r old <$> f rendered + RenamedFrom r old rendered -> RenamedFrom r old <$> f rendered instance (Ord r) => Semigroup (DefinitionDiffs Name r) where d1 <> d2 = @@ -125,52 +180,114 @@ instance (Ord r) => Monoid (DefinitionDiffs Name r) where -- ├── c = DiffAtPath -- └── x = DiffAtPath -- @@ -type NamespaceTreeDiff referent reference = Cofree (Map Path) (Map NameSegment (DiffAtPath referent reference)) +type NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff = Cofree (Map Path) (Map NameSegment (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff)) -- | The differences at a specific path in the namespace tree. -data DiffAtPath referent reference = DiffAtPath - { termDiffsAtPath :: Set (DefinitionDiff referent), - typeDiffsAtPath :: Set (DefinitionDiff reference) +data DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff = DiffAtPath + { termDiffsAtPath :: Set (DefinitionDiff referent renderedTerm termDiff), + typeDiffsAtPath :: Set (DefinitionDiff reference renderedType typeDiff) } deriving stock (Eq, Show) -- | A traversal over all the referents in a `DiffAtPath`. -diffAtPathReferents_ :: (Ord referent') => Traversal (DiffAtPath referent reference) (DiffAtPath referent' reference) referent referent' +diffAtPathReferents_ :: (Ord referent', Ord termDiff, Ord renderedTerm) => Traversal (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff) (DiffAtPath referent' reference renderedTerm renderedType termDiff typeDiff) referent referent' diffAtPathReferents_ f (DiffAtPath {termDiffsAtPath, typeDiffsAtPath}) = termDiffsAtPath - & (Set.traverse . traverse) %%~ f + & (Set.traverse . definitionDiffRefs_) %%~ f & fmap \termDiffsAtPath -> DiffAtPath {typeDiffsAtPath, termDiffsAtPath} -- | A traversal over all the references in a `DiffAtPath`. -diffAtPathReferences_ :: (Ord reference') => Traversal (DiffAtPath referent reference) (DiffAtPath referent reference') reference reference' +diffAtPathReferences_ :: (Ord reference', Ord typeDiff, Ord renderedType) => Traversal (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff) (DiffAtPath referent reference' renderedTerm renderedType termDiff typeDiff) reference reference' diffAtPathReferences_ f (DiffAtPath {termDiffsAtPath, typeDiffsAtPath}) = typeDiffsAtPath - & (Set.traverse . traverse) %%~ f + & (Set.traverse . definitionDiffRefs_) %%~ f & fmap \typeDiffsAtPath -> DiffAtPath {typeDiffsAtPath, termDiffsAtPath} +-- | A traversal over all the term diffs in a `DiffAtPath`. +diffAtPathTermDiffs_ :: (Ord termDiff', Ord referent, Ord renderedTerm) => Traversal (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff) (DiffAtPath referent reference renderedTerm renderedType termDiff' typeDiff) termDiff termDiff' +diffAtPathTermDiffs_ f (DiffAtPath {termDiffsAtPath, typeDiffsAtPath}) = + termDiffsAtPath + & (Set.traverse . definitionDiffDiffs_) %%~ f + <&> \termDiffsAtPath -> DiffAtPath {typeDiffsAtPath, termDiffsAtPath} + +-- | A traversal over all the type diffs in a `DiffAtPath`. +diffAtPathTypeDiffs_ :: (Ord typeDiff', Ord reference, Ord renderedType) => Traversal (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff) (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff') typeDiff typeDiff' +diffAtPathTypeDiffs_ f (DiffAtPath {termDiffsAtPath, typeDiffsAtPath}) = + typeDiffsAtPath + & (Set.traverse . definitionDiffDiffs_) %%~ f + <&> \typeDiffsAtPath -> DiffAtPath {typeDiffsAtPath, termDiffsAtPath} + +diffAtPathTermDiffKinds_ :: (Ord renderedTerm', Ord termDiff', Ord referent') => Traversal (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff) (DiffAtPath referent' reference renderedTerm' renderedType termDiff' typeDiff) (DefinitionDiffKind referent renderedTerm termDiff) (DefinitionDiffKind referent' renderedTerm' termDiff') +diffAtPathTermDiffKinds_ f (DiffAtPath terms types) = do + newTerms <- terms & Set.traverse . definitionDiffKind_ %%~ f + pure $ DiffAtPath newTerms types + +diffAtPathTypeDiffKinds_ :: (Ord renderedType', Ord typeDiff', Ord reference') => Traversal (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff) (DiffAtPath referent reference' renderedTerm renderedType' termDiff typeDiff') (DefinitionDiffKind reference renderedType typeDiff) (DefinitionDiffKind reference' renderedType' typeDiff') +diffAtPathTypeDiffKinds_ f (DiffAtPath terms types) = do + newTypes <- types & Set.traverse . definitionDiffKind_ %%~ f + pure $ DiffAtPath terms newTypes + +-- | A traversal over all the rendered terms in a `DiffAtPath`. +diffAtPathRenderedTerms_ :: (Ord termDiff, Ord referent, Ord renderedTerm') => Traversal (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff) (DiffAtPath referent reference renderedTerm' renderedType termDiff typeDiff) renderedTerm renderedTerm' +diffAtPathRenderedTerms_ f (DiffAtPath {termDiffsAtPath, typeDiffsAtPath}) = + termDiffsAtPath + & (Set.traverse . definitionDiffRendered_) %%~ f + <&> \termDiffsAtPath -> DiffAtPath {typeDiffsAtPath, termDiffsAtPath} + +-- | A traversal over all the rendered types in a `DiffAtPath`. +diffAtPathRenderedTypes_ :: (Ord typeDiff, Ord reference, Ord renderedType') => Traversal (DiffAtPath referent reference renderedTerm renderedType termDiff typeDiff) (DiffAtPath referent reference renderedTerm renderedType' termDiff typeDiff) renderedType renderedType' +diffAtPathRenderedTypes_ f (DiffAtPath {termDiffsAtPath, typeDiffsAtPath}) = + typeDiffsAtPath + & (Set.traverse . definitionDiffRendered_) %%~ f + <&> \typeDiffsAtPath -> DiffAtPath {typeDiffsAtPath, termDiffsAtPath} + -- | Traversal over all the referents in a `NamespaceTreeDiff`. -namespaceTreeDiffReferents_ :: (Ord referent') => Traversal (NamespaceTreeDiff referent reference) (NamespaceTreeDiff referent' reference) referent referent' +namespaceTreeDiffReferents_ :: (Ord referent', Ord termDiff, Ord renderedTerm) => Traversal (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff) (NamespaceTreeDiff referent' reference renderedTerm renderedType termDiff typeDiff) referent referent' namespaceTreeDiffReferents_ = traversed . traversed . diffAtPathReferents_ -- | Traversal over all the references in a `NamespaceTreeDiff`. -namespaceTreeDiffReferences_ :: (Ord reference') => Traversal (NamespaceTreeDiff referent reference) (NamespaceTreeDiff referent reference') reference reference' +namespaceTreeDiffReferences_ :: (Ord reference', Ord typeDiff, Ord renderedType) => Traversal (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff) (NamespaceTreeDiff referent reference' renderedTerm renderedType termDiff typeDiff) reference reference' namespaceTreeDiffReferences_ = traversed . traversed . diffAtPathReferences_ -data NamespaceDiffError = ImpossibleError Text +namespaceTreeDiffTermDiffs_ :: (Ord termDiff', Ord referent, Ord renderedTerm) => Traversal (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff) (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff' typeDiff) termDiff termDiff' +namespaceTreeDiffTermDiffs_ = traversed . traversed . diffAtPathTermDiffs_ + +namespaceTreeDiffTypeDiffs_ :: (Ord typeDiff', Ord reference, Ord renderedType) => Traversal (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff) (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff') typeDiff typeDiff' +namespaceTreeDiffTypeDiffs_ = traversed . traversed . diffAtPathTypeDiffs_ + +namespaceTreeTermDiffKinds_ :: (Ord renderedTerm', Ord termDiff', Ord referent') => Traversal (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff) (NamespaceTreeDiff referent' reference renderedTerm' renderedType termDiff' typeDiff) (DefinitionDiffKind referent renderedTerm termDiff) (DefinitionDiffKind referent' renderedTerm' termDiff') +namespaceTreeTermDiffKinds_ = traversed . traversed . diffAtPathTermDiffKinds_ + +namespaceTreeTypeDiffKinds_ :: (Ord renderedType', Ord typeDiff', Ord reference') => Traversal (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff) (NamespaceTreeDiff referent reference' renderedTerm renderedType' termDiff typeDiff') (DefinitionDiffKind reference renderedType typeDiff) (DefinitionDiffKind reference' renderedType' typeDiff') +namespaceTreeTypeDiffKinds_ = traversed . traversed . diffAtPathTypeDiffKinds_ + +namespaceTreeDiffRenderedTerms_ :: (Ord termDiff, Ord referent, Ord renderedTerm') => Traversal (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff) (NamespaceTreeDiff referent reference renderedTerm' renderedType termDiff typeDiff) renderedTerm renderedTerm' +namespaceTreeDiffRenderedTerms_ = traversed . traversed . diffAtPathRenderedTerms_ + +namespaceTreeDiffRenderedTypes_ :: (Ord typeDiff, Ord reference, Ord renderedType') => Traversal (NamespaceTreeDiff referent reference renderedTerm renderedType termDiff typeDiff) (NamespaceTreeDiff referent reference renderedTerm renderedType' termDiff typeDiff) renderedType renderedType' +namespaceTreeDiffRenderedTypes_ = traversed . traversed . diffAtPathRenderedTypes_ + +data NamespaceDiffError + = ImpossibleError Text + | MissingEntityError EntityMissing deriving stock (Eq, Show) instance ToServerError NamespaceDiffError where - toServerError ImpossibleError {} = (ErrorID "namespace-diff:impossible-error", err500) + toServerError = \case + ImpossibleError {} -> (ErrorID "namespace-diff:impossible-error", err500) + MissingEntityError (EntityMissing eId _msg) -> (eId, err404) instance Logging.Loggable NamespaceDiffError where - toLog (ImpossibleError t) = - Logging.textLog t - & Logging.withSeverity Logging.Error + toLog = \case + (ImpossibleError t) -> + Logging.textLog t + & Logging.withSeverity Logging.Error + (MissingEntityError e) -> Logging.toLog e -- | Compute the tree of differences between two namespace hashes. -- Note: This ignores all dependencies in the lib namespace. -diffTreeNamespaces :: (BranchHashId, NameLookupReceipt) -> (BranchHashId, NameLookupReceipt) -> (PG.Transaction e (Either NamespaceDiffError (NamespaceTreeDiff V2.Referent V2.Reference))) +diffTreeNamespaces :: (BranchHashId, NameLookupReceipt) -> (BranchHashId, NameLookupReceipt) -> (PG.Transaction e (Either NamespaceDiffError (NamespaceTreeDiff V2.Referent V2.Reference Name Name Name Name))) diffTreeNamespaces (oldBHId, oldNLReceipt) (newBHId, newNLReceipt) = do ((oldTerms, newTerms), (oldTypes, newTypes)) <- PG.pipelined do terms <- ND.getRelevantTermsForDiff oldNLReceipt oldBHId newBHId @@ -191,7 +308,7 @@ diffTreeNamespacesHelper :: (Ord referent, Ord reference) => (Relation Name referent, Relation Name referent) -> (Relation Name reference, Relation Name reference) -> - Either NamespaceDiffError (NamespaceTreeDiff referent reference) + Either NamespaceDiffError (NamespaceTreeDiff referent reference Name Name Name Name) diffTreeNamespacesHelper (oldTerms, newTerms) (oldTypes, newTypes) = do termTree <- computeDefinitionDiff oldTerms newTerms <&> definitionDiffsToTree typeTree <- computeDefinitionDiff oldTypes newTypes <&> definitionDiffsToTree @@ -200,12 +317,12 @@ diffTreeNamespacesHelper (oldTerms, newTerms) (oldTypes, newTypes) = do & compressNameTree pure compressed where - combineTermsAndTypes :: These (Map NameSegment (Set (DefinitionDiff referent))) (Map NameSegment (Set (DefinitionDiff reference))) -> Map NameSegment (DiffAtPath referent reference) + combineTermsAndTypes :: These (Map NameSegment (Set (DefinitionDiff referent Name Name))) (Map NameSegment (Set (DefinitionDiff reference Name Name))) -> Map NameSegment (DiffAtPath referent reference Name Name Name Name) combineTermsAndTypes = \case This termsMap -> termsMap <&> \termDiffsAtPath -> DiffAtPath {termDiffsAtPath, typeDiffsAtPath = mempty} That typesMap -> typesMap <&> \typeDiffsAtPath -> DiffAtPath {typeDiffsAtPath, termDiffsAtPath = mempty} These trms typs -> alignWith combineNode trms typs - combineNode :: These (Set (DefinitionDiff referent)) (Set (DefinitionDiff reference)) -> DiffAtPath referent reference + combineNode :: These (Set (DefinitionDiff referent Name Name)) (Set (DefinitionDiff reference Name Name)) -> DiffAtPath referent reference Name Name Name Name combineNode = \case This termDiffsAtPath -> DiffAtPath {termDiffsAtPath, typeDiffsAtPath = mempty} That typeDiffsAtPath -> DiffAtPath {typeDiffsAtPath, termDiffsAtPath = mempty} @@ -330,21 +447,21 @@ computeDefinitionDiff old new = ) -- | Convert a `DefinitionDiffs` into a tree of differences. -definitionDiffsToTree :: forall ref. (Ord ref) => DefinitionDiffs Name ref -> Cofree (Map NameSegment) (Map NameSegment (Set (DefinitionDiff ref))) +definitionDiffsToTree :: forall ref. (Ord ref) => DefinitionDiffs Name ref -> Cofree (Map NameSegment) (Map NameSegment (Set (DefinitionDiff ref Name Name))) definitionDiffsToTree dd = let DefinitionDiffs {added, removed, updated, renamed, newAliases} = dd - expandedAliases :: Map Name (Set (DefinitionDiffKind ref)) + expandedAliases :: Map Name (Set (DefinitionDiffKind ref Name Name)) expandedAliases = newAliases & Map.toList & foldMap ( \(r, (existingNames, newNames)) -> ( Foldable.toList newNames - <&> \newName -> Map.singleton newName (Set.singleton (NewAlias r existingNames)) + <&> \newName -> Map.singleton newName (Set.singleton (NewAlias r existingNames newName)) ) ) & Map.unionsWith (<>) - expandedRenames :: Map Name (Set (DefinitionDiffKind ref)) + expandedRenames :: Map Name (Set (DefinitionDiffKind ref Name Name)) expandedRenames = renamed & Map.toList @@ -356,21 +473,21 @@ definitionDiffsToTree dd = -- ) -- <> ( Foldable.toList newNames - <&> \newName -> Map.singleton newName (Set.singleton (RenamedFrom r oldNames)) + <&> \newName -> Map.singleton newName (Set.singleton (RenamedFrom r oldNames newName)) ) ) & Map.unionsWith (<>) - diffTree :: Map Name (Set (DefinitionDiffKind ref)) + diffTree :: Map Name (Set (DefinitionDiffKind ref Name Name)) diffTree = Map.unionsWith (<>) - [ (added <&> Set.singleton . Added), + [ (added & Map.mapWithKey \n r -> Set.singleton $ Added r n), expandedAliases, - (removed <&> Set.singleton . Removed), - (updated <&> \(oldR, newR) -> Set.singleton $ Updated oldR newR), + (removed & Map.mapWithKey \n r -> Set.singleton $ Removed r n), + (updated & Map.mapWithKey \name (oldR, newR) -> Set.singleton $ Updated oldR newR name), expandedRenames ] - includeFQNs :: Map Name (Set (DefinitionDiffKind ref)) -> Map Name (Set (DefinitionDiff ref)) + includeFQNs :: Map Name (Set (DefinitionDiffKind ref Name Name)) -> Map Name (Set (DefinitionDiff ref Name Name)) includeFQNs m = m & imap \n ds -> (ds & Set.map \d -> DefinitionDiff {kind = d, fqn = n}) in diffTree & includeFQNs diff --git a/src/Share/Postgres/Contributions/Queries.hs b/src/Share/Postgres/Contributions/Queries.hs index e5d30a9f..c8b2c7cd 100644 --- a/src/Share/Postgres/Contributions/Queries.hs +++ b/src/Share/Postgres/Contributions/Queries.hs @@ -17,6 +17,9 @@ module Share.Postgres.Contributions.Queries performMergesAndBCAUpdatesFromBranchPush, rebaseContributionsFromMergedBranches, contributionStateTokenById, + getPrecomputedNamespaceDiff, + savePrecomputedNamespaceDiff, + contributionsRelatedToBranches, ) where @@ -26,6 +29,7 @@ import Data.Map qualified as Map import Data.Set qualified as Set import Data.Time (UTCTime) import Safe (lastMay) +import Share.Codebase.Types (CodebaseEnv (..)) import Share.Contribution (Contribution (..), ContributionStatus (..)) import Share.IDs import Share.Postgres qualified as PG @@ -508,3 +512,48 @@ contributionStateTokenById contributionId = do JOIN causals target_causal ON target_causal.id = target_branch.causal_id WHERE contribution.id = #{contributionId} |] + +getPrecomputedNamespaceDiff :: + (CodebaseEnv, BranchHashId) -> + (CodebaseEnv, BranchHashId) -> + PG.Transaction e (Maybe Text) +getPrecomputedNamespaceDiff + (CodebaseEnv {codebaseOwner = leftCodebaseUser}, leftBHId) + (CodebaseEnv {codebaseOwner = rightCodebaseUser}, rightBHId) = do + PG.query1Col @Text + [PG.sql| + SELECT (diff :: text) + FROM namespace_diffs nd + WHERE nd.left_namespace_id = #{leftBHId} + AND nd.right_namespace_id = #{rightBHId} + AND nd.left_codebase_owner_user_id = #{leftCodebaseUser} + AND nd.right_codebase_owner_user_id = #{rightCodebaseUser} + |] + +savePrecomputedNamespaceDiff :: + (CodebaseEnv, BranchHashId) -> + (CodebaseEnv, BranchHashId) -> + Text -> + PG.Transaction e () +savePrecomputedNamespaceDiff (CodebaseEnv {codebaseOwner = leftCodebaseUser}, leftBHId) (CodebaseEnv {codebaseOwner = rightCodebaseUser}, rightBHId) diff = do + PG.execute_ + [PG.sql| + INSERT INTO namespace_diffs (left_namespace_id, right_namespace_id, left_codebase_owner_user_id, right_codebase_owner_user_id, diff) + VALUES (#{leftBHId}, #{rightBHId}, #{leftCodebaseUser}, #{rightCodebaseUser}, #{diff}::jsonb) + ON CONFLICT DO NOTHING + |] + +-- | Get all contribution IDs for contributions which have a source or target branch in the +-- provided set. +contributionsRelatedToBranches :: Set BranchId -> PG.Transaction e [ContributionId] +contributionsRelatedToBranches branchIds = do + PG.queryListCol @ContributionId + [PG.sql| + WITH related_branches(branch_id) AS ( + SELECT * FROM ^{PG.singleColumnTable $ Set.toList branchIds} + ) + SELECT contr.id FROM contributions contr + WHERE + contr.source_branch IN (SELECT branch_id FROM related_branches) + OR contr.target_branch IN (SELECT branch_id FROM related_branches) + |] diff --git a/src/Share/Postgres/NamespaceDiffs.hs b/src/Share/Postgres/NamespaceDiffs.hs index 4074f594..8bf74144 100644 --- a/src/Share/Postgres/NamespaceDiffs.hs +++ b/src/Share/Postgres/NamespaceDiffs.hs @@ -13,6 +13,7 @@ import Share.Postgres.IDs (BranchHashId) import Share.Postgres.NameLookups.Types (NameLookupReceipt, NamedRef (..), ReversedName) import Share.Postgres.Refs.Types (PGReference, PGReferent) import Share.Prelude +import U.Codebase.Referent qualified as V2 import Unison.Name (Name) import Unison.Util.Relation (Relation) import Unison.Util.Relation qualified as Rel @@ -106,6 +107,21 @@ getRelevantTermsForDiff !_nameLookupReceipt oldBranchHashId newBranchHashId = do SELECT new.reversed_name, new.referent_builtin, new.referent_component_hash_id, new.referent_component_index, new.referent_constructor_index, true FROM relevant_terms_in_new new |] + -- NOTE: For now we filter out all diffs on constructors. + -- This is because: + -- 1. We don't have a good way to construct a reasonable looking diff if a constructor + -- is updated into a term + -- 2. It's silly to render a change in a type in both the type itself AND all of its + -- constructors + -- + -- The downside is that this means if a constructor is only _renamed_ but not otherwise + -- changed, it won't show up in the diff at all :'( , but we plan to fix this with the new + -- synhash based diffing system. + <&> filter + ( \(NamedRef {ref} PG.:. _) -> case ref of + V2.Ref {} -> True + V2.Con {} -> False + ) <&> ( fmap \(NamedRef {reversedSegments, ref} PG.:. PG.Only inNew) -> if inNew then Right (from @ReversedName @Name reversedSegments, ref) diff --git a/src/Share/Postgres/Projects/Queries.hs b/src/Share/Postgres/Projects/Queries.hs index 403be808..46283a15 100644 --- a/src/Share/Postgres/Projects/Queries.hs +++ b/src/Share/Postgres/Projects/Queries.hs @@ -10,7 +10,7 @@ module Share.Postgres.Projects.Queries where import Control.Lens -import Control.Monad.Except (MonadError (..), runExceptT) +import Control.Monad.Except (runExceptT) import Share.IDs import Share.Postgres import Share.Prelude diff --git a/src/Share/Prelude.hs b/src/Share/Prelude.hs index 01e7a702..9af3cbd1 100644 --- a/src/Share/Prelude.hs +++ b/src/Share/Prelude.hs @@ -46,6 +46,8 @@ module Share.Prelude Exception (..), MaybeT (..), hoistMaybe, + traverseFirst, + throwError, ) where @@ -53,6 +55,7 @@ import Control.Applicative as X import Control.Arrow ((&&&)) import Control.Category hiding (id, (.)) import Control.Monad as X +import Control.Monad.Except (throwError) import Control.Monad.Reader as X import Control.Monad.State as X import Control.Monad.Trans.Maybe @@ -209,3 +212,6 @@ partitionMap f xs = unifyEither :: Either a a -> a unifyEither = either id id + +traverseFirst :: (Bitraversable t, Applicative f) => (a -> f b) -> t a x -> f (t b x) +traverseFirst f = bitraverse f pure diff --git a/src/Share/Utils/Caching.hs b/src/Share/Utils/Caching.hs index 0c478918..f9521843 100644 --- a/src/Share/Utils/Caching.hs +++ b/src/Share/Utils/Caching.hs @@ -12,6 +12,10 @@ module Share.Utils.Caching ) where +import Data.Aeson (FromJSON, ToJSON (..)) +import Data.Aeson qualified as Aeson +import Data.Aeson.Encoding qualified as Aeson +import Data.Binary.Builder qualified as Builder import Data.ByteString qualified as BS import Data.ByteString.Lazy.Char8 qualified as BL import Data.Text.Encoding qualified as Text @@ -31,6 +35,11 @@ instance MimeRender JSON (Cached JSON a) where mimeRender _proxy = \case Cached bs -> BL.fromStrict bs +instance (FromJSON a, ToJSON a) => ToJSON (Cached JSON a) where + toJSON (Cached bs) = toJSON $ Aeson.decode @a $ BL.fromStrict bs + + toEncoding (Cached bs) = Aeson.unsafeToEncoding $ Builder.fromLazyByteString $ BL.fromStrict bs + -- | Wrap a response in caching. -- This combinator knows whether a given access is privileged or not and will _not_ cache -- private content. diff --git a/src/Share/Utils/Logging.hs b/src/Share/Utils/Logging.hs index b2c7ec71..a853d608 100644 --- a/src/Share/Utils/Logging.hs +++ b/src/Share/Utils/Logging.hs @@ -37,6 +37,7 @@ module Share.Utils.Logging ) where +import Control.Monad.Except (ExceptT) import Control.Monad.Reader import Data.Char qualified as Char import Data.Map qualified as Map @@ -117,6 +118,12 @@ class (Monad m) => MonadLogger m where instance (MonadLogger m) => MonadLogger (ReaderT r m) where logMsg = lift . logMsg +instance (MonadLogger m) => MonadLogger (ExceptT e m) where + logMsg = lift . logMsg + +instance (MonadLogger m) => MonadLogger (MaybeT m) where + logMsg = lift . logMsg + textLog :: Text -> LogMsg textLog msg = LogMsg diff --git a/src/Share/Web/Errors.hs b/src/Share/Web/Errors.hs index f1ee3d59..2d97d7ce 100644 --- a/src/Share/Web/Errors.hs +++ b/src/Share/Web/Errors.hs @@ -7,6 +7,7 @@ module Share.Web.Errors ( respondError, + respondExceptT, reportError, ToServerError (..), SimpleServerError (..), @@ -68,7 +69,7 @@ import Unison.Sync.Types qualified as Sync import UnliftIO qualified newtype ErrorID = ErrorID Text - deriving stock (Show) + deriving stock (Show, Eq, Ord) deriving (IsString) via Text class ToServerError e where @@ -166,6 +167,9 @@ respondError e = do reportError e UnliftIO.throwIO serverErr +respondExceptT :: (HasCallStack, ToServerError e, Loggable e) => ExceptT e WebApp a -> WebApp a +respondExceptT m = runExceptT m >>= either respondError pure + -- | Logs the error with a call stack, but doesn't abort the request or render an error to the client. reportError :: (HasCallStack, ToServerError e, Loggable e) => e -> WebApp () reportError e = do @@ -208,7 +212,7 @@ instance ToServerError (InternalServerError a) where toServerError InternalServerError {errorId} = (ErrorID errorId, internalServerError) data EntityMissing = EntityMissing {entityMissingErrorID :: ErrorID, errorMsg :: Text} - deriving stock (Show) + deriving stock (Show, Eq, Ord) instance Loggable EntityMissing where toLog EntityMissing {errorMsg} = withSeverity UserFault $ textLog errorMsg diff --git a/src/Share/Web/Share/Comments/Impl.hs b/src/Share/Web/Share/Comments/Impl.hs index 79e3131c..d6232909 100644 --- a/src/Share/Web/Share/Comments/Impl.hs +++ b/src/Share/Web/Share/Comments/Impl.hs @@ -21,7 +21,6 @@ import Share.Web.Errors import Share.Web.Share.Comments import Share.Web.Share.Comments.Types import Share.Web.Share.Types -import Servant createCommentEndpoint :: Maybe Session -> diff --git a/src/Share/Web/Share/Contributions/Impl.hs b/src/Share/Web/Share/Contributions/Impl.hs index 95fe0cd8..eb940a18 100644 --- a/src/Share/Web/Share/Contributions/Impl.hs +++ b/src/Share/Web/Share/Contributions/Impl.hs @@ -13,9 +13,11 @@ module Share.Web.Share.Contributions.Impl ) where -import Control.Lens +import Control.Lens hiding ((.=)) +import Data.Set qualified as Set import Servant import Servant.Server.Generic (AsServerT) +import Share.BackgroundJobs.Diffs.Queries qualified as DiffsQ import Share.Branch (Branch (..)) import Share.Branch qualified as Branch import Share.Codebase qualified as Codebase @@ -52,6 +54,7 @@ import Share.Web.Share.Diffs.Impl qualified as Diffs import Share.Web.Share.Diffs.Types (ShareNamespaceDiffResponse (..), ShareTermDiffResponse (..), ShareTypeDiffResponse (..)) import Share.Web.Share.Types (UserDisplayInfo) import Unison.Name (Name) +import Unison.Server.Types import Unison.Syntax.Name qualified as Name contributionsByProjectServer :: Maybe Session -> UserHandle -> ProjectSlug -> API.ContributionsByProjectRoutes (AsServerT WebApp) @@ -156,7 +159,8 @@ createContributionEndpoint session userHandle projectSlug (CreateContributionReq pure (project, sourceBranch, targetBranch) _authReceipt <- AuthZ.permissionGuard $ AuthZ.checkContributionCreate callerUserId project PG.runTransactionOrRespondError $ do - (_, contributionNumber) <- ContributionsQ.createContribution callerUserId projectId title description status sourceBranchId targetBranchId + (contributionId, contributionNumber) <- ContributionsQ.createContribution callerUserId projectId title description status sourceBranchId targetBranchId + DiffsQ.submitContributionsToBeDiffed $ Set.singleton contributionId ContributionsQ.shareContributionByProjectIdAndNumber projectId contributionNumber `whenNothingM` throwError (InternalServerError "create-contribution-error" internalServerError) >>= UsersQ.userDisplayInfoOf traversed where @@ -201,6 +205,7 @@ updateContributionByNumberEndpoint session handle projectSlug contributionNumber _authReceipt <- AuthZ.permissionGuard $ AuthZ.checkContributionUpdate callerUserId contribution updateRequest PG.runTransactionOrRespondError $ do _ <- ContributionsQ.updateContribution callerUserId contributionId title description status (branchId <$> maySourceBranch) (branchId <$> mayTargetBranch) + DiffsQ.submitContributionsToBeDiffed $ Set.singleton contributionId ContributionsQ.shareContributionByProjectIdAndNumber projectId contributionNumber `whenNothingM` throwError (EntityMissing (ErrorID "contribution:missing") "Contribution not found") >>= UsersQ.userDisplayInfoOf traversed where @@ -275,7 +280,7 @@ contributionDiffEndpoint (AuthN.MaybeAuthedUserID mayCallerUserId) userHandle pr let oldCausalId = fromMaybe oldBranchCausalId bestCommonAncestorCausalId let cacheKeys = [IDs.toText contributionId, IDs.toText newPBSH, IDs.toText oldPBSH, Caching.causalIdCacheKey newBranchCausalId, Caching.causalIdCacheKey oldCausalId] Caching.cachedResponse authZReceipt "contribution-diff" cacheKeys do - namespaceDiff <- Diffs.diffCausals authZReceipt oldCausalId newBranchCausalId + namespaceDiff <- respondExceptT (Diffs.diffCausals authZReceipt (oldCodebase, oldCausalId) (newCodebase, newBranchCausalId)) (newBranchCausalHash, oldCausalHash) <- PG.runTransaction $ do newBranchCausalHash <- CausalQ.expectCausalHashesByIdsOf id newBranchCausalId oldCausalHash <- CausalQ.expectCausalHashesByIdsOf id oldCausalId @@ -323,15 +328,15 @@ contributionDiffTermsEndpoint (AuthN.MaybeAuthedUserID mayCallerUserId) userHand let cacheKeys = [IDs.toText contributionId, IDs.toText newPBSH, IDs.toText oldPBSH, Caching.causalIdCacheKey newBranchCausalId, Caching.causalIdCacheKey oldCausalId, Name.toText oldTermName, Name.toText newTermName] Caching.cachedResponse authZReceipt "contribution-diff-terms" cacheKeys do (oldBranchHashId, newBranchHashId) <- PG.runTransaction $ CausalQ.expectNamespaceIdsByCausalIdsOf both (oldCausalId, newBranchCausalId) - (oldTerm, newTerm, displayObjDiff) <- Diffs.diffTerms authZReceipt (oldCodebase, oldBranchHashId, oldTermName) (newCodebase, newBranchHashId, newTermName) + termDiff <- respondExceptT (Diffs.diffTerms authZReceipt (oldCodebase, oldBranchHashId, oldTermName) (newCodebase, newBranchHashId, newTermName)) pure $ ShareTermDiffResponse { project = projectShorthand, oldBranch = IDs.IsBranchShortHand $ IDs.projectBranchShortHandToBranchShortHand oldPBSH, newBranch = IDs.IsBranchShortHand $ IDs.projectBranchShortHandToBranchShortHand newPBSH, - oldTerm = oldTerm, - newTerm = newTerm, - diff = displayObjDiff + oldTerm = termDiff.left, + newTerm = termDiff.right, + diff = termDiff.diff } where projectShorthand :: IDs.ProjectShortHand @@ -368,15 +373,15 @@ contributionDiffTypesEndpoint (AuthN.MaybeAuthedUserID mayCallerUserId) userHand let cacheKeys = [IDs.toText contributionId, IDs.toText newPBSH, IDs.toText oldPBSH, Caching.causalIdCacheKey newBranchCausalId, Caching.causalIdCacheKey oldCausalId, Name.toText oldTypeName, Name.toText newTypeName] Caching.cachedResponse authZReceipt "contribution-diff-types" cacheKeys do (oldBranchHashId, newBranchHashId) <- PG.runTransaction $ CausalQ.expectNamespaceIdsByCausalIdsOf both (oldCausalId, newBranchCausalId) - (oldType, newType, displayObjDiff) <- Diffs.diffTypes authZReceipt (oldCodebase, oldBranchHashId, oldTypeName) (newCodebase, newBranchHashId, newTypeName) + typeDiff <- respondExceptT (Diffs.diffTypes authZReceipt (oldCodebase, oldBranchHashId, oldTypeName) (newCodebase, newBranchHashId, newTypeName)) pure $ ShareTypeDiffResponse { project = projectShorthand, oldBranch = IDs.IsBranchShortHand $ IDs.projectBranchShortHandToBranchShortHand oldPBSH, newBranch = IDs.IsBranchShortHand $ IDs.projectBranchShortHandToBranchShortHand newPBSH, - oldType = oldType, - newType = newType, - diff = displayObjDiff + oldType = typeDiff.left, + newType = typeDiff.right, + diff = typeDiff.diff } where projectShorthand :: IDs.ProjectShortHand diff --git a/src/Share/Web/Share/Contributions/MergeDetection.hs b/src/Share/Web/Share/Contributions/MergeDetection.hs index cdf1cddc..6e707621 100644 --- a/src/Share/Web/Share/Contributions/MergeDetection.hs +++ b/src/Share/Web/Share/Contributions/MergeDetection.hs @@ -3,6 +3,8 @@ module Share.Web.Share.Contributions.MergeDetection ) where +import Data.Set qualified as Set +import Share.BackgroundJobs.Diffs.Queries qualified as DiffsQ import Share.IDs import Share.Postgres qualified as PG import Share.Postgres.Contributions.Queries qualified as ContributionQ @@ -11,6 +13,8 @@ import Share.Postgres.Contributions.Queries qualified as ContributionQ -- best common ancestors. updateContributionsFromBranchUpdate :: UserId -> BranchId -> PG.Transaction e () updateContributionsFromBranchUpdate callerUserId branchId = do - updatedContributions <- ContributionQ.performMergesAndBCAUpdatesFromBranchPush callerUserId branchId - _rebasedContributions <- ContributionQ.rebaseContributionsFromMergedBranches updatedContributions + contributionsWithUpdatedBCAs <- ContributionQ.performMergesAndBCAUpdatesFromBranchPush callerUserId branchId + _rebasedContributions <- ContributionQ.rebaseContributionsFromMergedBranches contributionsWithUpdatedBCAs + affectedContributions <- ContributionQ.contributionsRelatedToBranches (Set.singleton branchId) + DiffsQ.submitContributionsToBeDiffed (Set.fromList affectedContributions) pure () diff --git a/src/Share/Web/Share/Diffs/Impl.hs b/src/Share/Web/Share/Diffs/Impl.hs index aef5cb02..f01431b0 100644 --- a/src/Share/Web/Share/Diffs/Impl.hs +++ b/src/Share/Web/Share/Diffs/Impl.hs @@ -6,30 +6,43 @@ module Share.Web.Share.Diffs.Impl ) where -import Control.Lens +import Control.Comonad.Cofree qualified as Cofree +import Control.Lens hiding ((.=)) import Control.Monad.Except +import Control.Monad.Trans.Except (except) +import Data.Aeson (ToJSON (..), Value, (.=)) +import Data.Aeson qualified as Aeson +import Data.Aeson.Types (object) +import Data.Foldable qualified as Foldable +import Data.Map qualified as Map +import Data.Text.Lazy qualified as TL +import Data.Text.Lazy.Encoding qualified as TL +import Share.App (AppM) import Share.Codebase qualified as Codebase +import Share.NamespaceDiffs (DefinitionDiff (..), DefinitionDiffKind (..), DiffAtPath (..), NamespaceDiffError (..), NamespaceTreeDiff) import Share.NamespaceDiffs qualified as NamespaceDiffs import Share.Postgres qualified as PG import Share.Postgres.Causal.Queries qualified as CausalQ +import Share.Postgres.Contributions.Queries qualified as ContributionQ import Share.Postgres.IDs (BranchHashId, CausalId) import Share.Postgres.NameLookups.Ops qualified as NLOps import Share.Postgres.NameLookups.Ops qualified as NameLookupOps import Share.Postgres.NameLookups.Types (NameLookupReceipt) import Share.Prelude -import Share.Web.App +import Share.Utils.Aeson (PreEncoded (PreEncoded)) import Share.Web.Authorization (AuthZReceipt) -import Share.Web.Errors (EntityMissing (..), ErrorID (..), respondError) +import Share.Web.Errors import U.Codebase.Reference qualified as V2Reference import U.Codebase.Referent qualified as V2Referent import Unison.Codebase.Path qualified as Path import Unison.Name (Name) +import Unison.NameSegment (NameSegment) import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.PrettyPrintEnvDecl.Postgres qualified as PPEPostgres import Unison.Server.Backend.DefinitionDiff qualified as DefinitionDiff import Unison.Server.NameSearch.Postgres qualified as PGNameSearch import Unison.Server.Share.Definitions qualified as Definitions -import Unison.Server.Types (DisplayObjectDiff, TermDefinition (..), TermTag, TypeDefinition (..), TypeTag) +import Unison.Server.Types import Unison.ShortHash (ShortHash) import Unison.Syntax.Name qualified as Name import Unison.Util.Pretty (Width) @@ -39,9 +52,9 @@ diffNamespaces :: AuthZReceipt -> (BranchHashId, NameLookupReceipt) -> (BranchHashId, NameLookupReceipt) -> - WebApp (NamespaceDiffs.NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash)) + AppM r (Either NamespaceDiffs.NamespaceDiffError (NamespaceDiffs.NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash) Name Name Name Name)) diffNamespaces !_authZReceipt oldNamespacePair newNamespacePair = do - PG.runTransactionOrRespondError $ do + PG.tryRunTransaction $ do diff <- NamespaceDiffs.diffTreeNamespaces oldNamespacePair newNamespacePair `whenLeftM` throwError withTermTags <- ( diff @@ -61,10 +74,10 @@ diffNamespaces !_authZReceipt oldNamespacePair newNamespacePair = do -- | Find the common ancestor between two causals, then diff diffCausals :: AuthZReceipt -> - CausalId -> - CausalId -> - WebApp (NamespaceDiffs.NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash)) -diffCausals !_authZReceipt oldCausalId newCausalId = do + (Codebase.CodebaseEnv, CausalId) -> + (Codebase.CodebaseEnv, CausalId) -> + ExceptT NamespaceDiffs.NamespaceDiffError (AppM r) (PreEncoded (NamespaceDiffs.NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash) TermDefinition TypeDefinition TermDefinitionDiff TypeDefinitionDiff)) +diffCausals !authZReceipt (oldCodebase, oldCausalId) (newCodebase, newCausalId) = do -- Ensure name lookups for each thing we're diffing. -- We do this in two separate transactions to ensure we can still make progress even if we need to build name lookups. let getOldBranch = PG.runTransaction $ do @@ -76,74 +89,191 @@ diffCausals !_authZReceipt oldCausalId newCausalId = do newBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id newCausalId newNLReceipt <- NLOps.ensureNameLookupForBranchId newBranchHashId pure (newBranchHashId, newNLReceipt) - ((oldBranchHashId, oldBranchNLReceipt), (newBranchHashId, newNLReceipt)) <- getOldBranch `UnliftIO.concurrently` getNewBranch - PG.runTransactionOrRespondError $ do - diff <- NamespaceDiffs.diffTreeNamespaces (oldBranchHashId, oldBranchNLReceipt) (newBranchHashId, newNLReceipt) `whenLeftM` throwError - withTermTags <- - ( diff - & unsafePartsOf NamespaceDiffs.namespaceTreeDiffReferents_ - %%~ ( \refs -> do - termTags <- Codebase.termTagsByReferentsOf traversed refs - pure $ zip termTags (refs <&> V2Referent.toShortHash) - ) - ) - diffWithTags <- - withTermTags - & unsafePartsOf NamespaceDiffs.namespaceTreeDiffReferences_ - %%~ ( \refs -> do - typeTags <- Codebase.typeTagsByReferencesOf traversed refs - pure $ zip typeTags (refs <&> V2Reference.toShortHash) + ((oldBranchHashId, oldBranchNLReceipt), (newBranchHashId, newNLReceipt)) <- getOldBranch `concurrentExceptT` getNewBranch + (PG.runTransaction $ ContributionQ.getPrecomputedNamespaceDiff (oldCodebase, oldBranchHashId) (newCodebase, newBranchHashId)) + >>= \case + Just diff -> pure $ PreEncoded $ TL.encodeUtf8 $ TL.fromStrict diff + Nothing -> do + diffWithTags <- ExceptT $ PG.tryRunTransaction $ do + diff <- NamespaceDiffs.diffTreeNamespaces (oldBranchHashId, oldBranchNLReceipt) (newBranchHashId, newNLReceipt) `whenLeftM` throwError + withTermTags <- + ( diff + & unsafePartsOf NamespaceDiffs.namespaceTreeDiffReferents_ + %%~ ( \refs -> do + termTags <- Codebase.termTagsByReferentsOf traversed refs + pure $ zip termTags (refs <&> V2Referent.toShortHash) + ) ) - pure diffWithTags + withTermTags + & unsafePartsOf NamespaceDiffs.namespaceTreeDiffReferences_ + %%~ ( \refs -> do + typeTags <- Codebase.typeTagsByReferencesOf traversed refs + pure $ zip typeTags (refs <&> V2Reference.toShortHash) + ) + diff <- computeUpdatedDefinitionDiffs authZReceipt (oldCodebase, oldBranchHashId) (newCodebase, newBranchHashId) diffWithTags + let encoded = Aeson.encode . RenderedNamespaceDiff $ diff + PG.runTransaction $ ContributionQ.savePrecomputedNamespaceDiff (oldCodebase, oldBranchHashId) (newCodebase, newBranchHashId) (TL.toStrict $ TL.decodeUtf8 encoded) + pure $ PreEncoded encoded + +computeUpdatedDefinitionDiffs :: + (Ord a, Ord b) => + AuthZReceipt -> + (Codebase.CodebaseEnv, BranchHashId) -> + (Codebase.CodebaseEnv, BranchHashId) -> + (NamespaceDiffs.NamespaceTreeDiff a b Name Name Name Name) -> + ExceptT NamespaceDiffError (AppM r) (NamespaceDiffs.NamespaceTreeDiff a b TermDefinition TypeDefinition TermDefinitionDiff TypeDefinitionDiff) +computeUpdatedDefinitionDiffs !authZReceipt (fromCodebase, fromBHId) (toCodebase, toBHId) diff = do + withTermDiffs <- + diff + & NamespaceDiffs.namespaceTreeDiffTermDiffs_ + %%~ ( \name -> + diffTerms authZReceipt (fromCodebase, fromBHId, name) (toCodebase, toBHId, name) + ) + >>= NamespaceDiffs.namespaceTreeTermDiffKinds_ %%~ renderDiffKind getTermDefinition + withTermDiffs + & NamespaceDiffs.namespaceTreeDiffTypeDiffs_ + %%~ ( \name -> + diffTypes authZReceipt (fromCodebase, fromBHId, name) (toCodebase, toBHId, name) + ) + >>= NamespaceDiffs.namespaceTreeTypeDiffKinds_ %%~ renderDiffKind getTypeDefinition + where + notFound name t = MissingEntityError $ EntityMissing (ErrorID "definition-not-found") (t <> ": Definition not found: " <> Name.toText name) + renderDiffKind getter = \case + Added r name -> Added r <$> (lift (getter (toCodebase, toBHId, name)) `whenNothingM` throwError (notFound name "Added")) + NewAlias r existingNames name -> NewAlias r existingNames <$> (lift (getter (toCodebase, toBHId, name)) `whenNothingM` throwError (notFound name "NewAlias")) + Removed r name -> Removed r <$> (lift (getter (fromCodebase, fromBHId, name)) `whenNothingM` throwError (notFound name "Removed")) + Updated oldRef newRef diff -> pure $ Updated oldRef newRef diff + RenamedTo r names name -> RenamedTo r names <$> (lift (getter (fromCodebase, fromBHId, name)) `whenNothingM` throwError (notFound name "RenamedTo")) + RenamedFrom r names name -> RenamedFrom r names <$> (lift (getter (toCodebase, toBHId, name)) `whenNothingM` throwError (notFound name "RenamedFrom")) diffTerms :: AuthZReceipt -> (Codebase.CodebaseEnv, BranchHashId, Name) -> (Codebase.CodebaseEnv, BranchHashId, Name) -> - WebApp (TermDefinition, TermDefinition, DisplayObjectDiff) + ExceptT NamespaceDiffError (AppM r) TermDefinitionDiff diffTerms !_authZReceipt old@(_, _, oldName) new@(_, _, newName) = do - let getOldTerm = getTermDefinition old `whenNothingM` respondError (EntityMissing (ErrorID "term-not-found") ("'From' term not found: " <> Name.toText oldName)) - let getNewTerm = getTermDefinition new `whenNothingM` respondError (EntityMissing (ErrorID "term-not-found") ("'To' term not found: " <> Name.toText newName)) - (oldTerm, newTerm) <- getOldTerm `UnliftIO.concurrently` getNewTerm + let getOldTerm = lift (getTermDefinition old) `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "term-not-found") ("'From' term not found: " <> Name.toText oldName)) + let getNewTerm = lift (getTermDefinition new) `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "term-not-found") ("'To' term not found: " <> Name.toText newName)) + (oldTerm, newTerm) <- getOldTerm `concurrentExceptT` getNewTerm let termDiffDisplayObject = DefinitionDiff.diffDisplayObjects (termDefinition oldTerm) (termDefinition newTerm) - pure $ (oldTerm, newTerm, termDiffDisplayObject) + pure $ TermDefinitionDiff {left = oldTerm, right = newTerm, diff = termDiffDisplayObject} + +getTermDefinition :: (Codebase.CodebaseEnv, BranchHashId, Name) -> AppM r (Maybe TermDefinition) +getTermDefinition (codebase, bhId, name) = do + let perspective = Path.empty + (namesPerspective, Identity relocatedName) <- PG.runTransactionMode PG.ReadCommitted PG.Read $ NameLookupOps.relocateToNameRoot perspective (Identity name) bhId + let ppedBuilder deps = (PPED.biasTo [name]) <$> lift (PPEPostgres.ppedForReferences namesPerspective deps) + let nameSearch = PGNameSearch.nameSearchForPerspective namesPerspective + rt <- Codebase.codebaseRuntime codebase + Codebase.runCodebaseTransactionMode PG.ReadCommitted codebase do + Definitions.termDefinitionByName ppedBuilder nameSearch renderWidth rt relocatedName where renderWidth :: Width renderWidth = 80 - getTermDefinition :: (Codebase.CodebaseEnv, BranchHashId, Name) -> WebApp (Maybe TermDefinition) - getTermDefinition (codebase, bhId, name) = do - let perspective = Path.empty - (namesPerspective, Identity relocatedName) <- PG.runTransaction $ NameLookupOps.relocateToNameRoot perspective (Identity name) bhId - let ppedBuilder deps = (PPED.biasTo [name]) <$> lift (PPEPostgres.ppedForReferences namesPerspective deps) - let nameSearch = PGNameSearch.nameSearchForPerspective namesPerspective - rt <- Codebase.codebaseRuntime codebase - Codebase.runCodebaseTransaction codebase do - Definitions.termDefinitionByName ppedBuilder nameSearch renderWidth rt relocatedName diffTypes :: AuthZReceipt -> (Codebase.CodebaseEnv, BranchHashId, Name) -> (Codebase.CodebaseEnv, BranchHashId, Name) -> - WebApp (TypeDefinition, TypeDefinition, DisplayObjectDiff) + ExceptT NamespaceDiffError (AppM r) TypeDefinitionDiff diffTypes !_authZReceipt old@(_, _, oldTypeName) new@(_, _, newTypeName) = do let getOldType = - getTypeDefinition old - `whenNothingM` respondError (EntityMissing (ErrorID "type-not-found") ("'From' Type not found: " <> Name.toText oldTypeName)) + lift (getTypeDefinition old) + `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "type-not-found") ("'From' Type not found: " <> Name.toText oldTypeName)) let getNewType = - getTypeDefinition new - `whenNothingM` respondError (EntityMissing (ErrorID "type-not-found") ("'To' Type not found: " <> Name.toText newTypeName)) - (sourceType, newType) <- getOldType `UnliftIO.concurrently` getNewType + lift (getTypeDefinition new) + `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "type-not-found") ("'To' Type not found: " <> Name.toText newTypeName)) + (sourceType, newType) <- getOldType `concurrentExceptT` getNewType let typeDiffDisplayObject = DefinitionDiff.diffDisplayObjects (typeDefinition sourceType) (typeDefinition newType) - pure $ (sourceType, newType, typeDiffDisplayObject) + pure $ TypeDefinitionDiff {left = sourceType, right = newType, diff = typeDiffDisplayObject} + +getTypeDefinition :: (Codebase.CodebaseEnv, BranchHashId, Name) -> AppM r (Maybe TypeDefinition) +getTypeDefinition (codebase, bhId, name) = do + let perspective = Path.empty + (namesPerspective, Identity relocatedName) <- PG.runTransactionMode PG.ReadCommitted PG.Read $ NameLookupOps.relocateToNameRoot perspective (Identity name) bhId + let ppedBuilder deps = (PPED.biasTo [name]) <$> lift (PPEPostgres.ppedForReferences namesPerspective deps) + let nameSearch = PGNameSearch.nameSearchForPerspective namesPerspective + rt <- Codebase.codebaseRuntime codebase + Codebase.runCodebaseTransactionMode PG.ReadCommitted codebase do + Definitions.typeDefinitionByName ppedBuilder nameSearch renderWidth rt relocatedName where renderWidth :: Width renderWidth = 80 - getTypeDefinition :: (Codebase.CodebaseEnv, BranchHashId, Name) -> WebApp (Maybe TypeDefinition) - getTypeDefinition (codebase, bhId, name) = do - let perspective = Path.empty - (namesPerspective, Identity relocatedName) <- PG.runTransaction $ NameLookupOps.relocateToNameRoot perspective (Identity name) bhId - let ppedBuilder deps = (PPED.biasTo [name]) <$> lift (PPEPostgres.ppedForReferences namesPerspective deps) - let nameSearch = PGNameSearch.nameSearchForPerspective namesPerspective - rt <- Codebase.codebaseRuntime codebase - Codebase.runCodebaseTransaction codebase do - Definitions.typeDefinitionByName ppedBuilder nameSearch renderWidth rt relocatedName + +newtype RenderedNamespaceDiff = RenderedNamespaceDiff (NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash) TermDefinition TypeDefinition TermDefinitionDiff TypeDefinitionDiff) + +instance ToJSON RenderedNamespaceDiff where + toJSON (RenderedNamespaceDiff diffs) = namespaceTreeDiffJSON diffs + where + text :: Text -> Text + text t = t + hqNameJSON :: Name -> NameSegment -> ShortHash -> Value -> Value + hqNameJSON fqn name sh rendered = object ["hash" .= sh, "shortName" .= name, "fullName" .= fqn, "rendered" .= rendered] + -- The preferred frontend format is a bit clunky to calculate here: + diffDataJSON :: (ToJSON tag) => NameSegment -> DefinitionDiff (tag, ShortHash) Value Value -> (tag, Value) + diffDataJSON shortName (DefinitionDiff {fqn, kind}) = case kind of + Added (defnTag, r) rendered -> (defnTag, object ["tag" .= text "Added", "contents" .= hqNameJSON fqn shortName r rendered]) + NewAlias (defnTag, r) existingNames rendered -> + let contents = object ["hash" .= r, "aliasShortName" .= shortName, "aliasFullName" .= fqn, "otherNames" .= toList existingNames, "rendered" .= rendered] + in (defnTag, object ["tag" .= text "Aliased", "contents" .= contents]) + Removed (defnTag, r) rendered -> (defnTag, object ["tag" .= text "Removed", "contents" .= hqNameJSON fqn shortName r rendered]) + Updated (oldTag, oldRef) (newTag, newRef) diffVal -> + let contents = object ["oldHash" .= oldRef, "newHash" .= newRef, "shortName" .= shortName, "fullName" .= fqn, "oldTag" .= oldTag, "newTag" .= newTag, "diff" .= diffVal] + in (newTag, object ["tag" .= text "Updated", "contents" .= contents]) + RenamedTo (defnTag, r) newNames rendered -> + let contents = object ["oldShortName" .= shortName, "oldFullName" .= fqn, "newNames" .= newNames, "hash" .= r, "rendered" .= rendered] + in (defnTag, object ["tag" .= text "RenamedTo", "contents" .= contents]) + RenamedFrom (defnTag, r) oldNames rendered -> + let contents = object ["oldNames" .= oldNames, "newShortName" .= shortName, "newFullName" .= fqn, "hash" .= r, "rendered" .= rendered] + in (defnTag, object ["tag" .= text "RenamedFrom", "contents" .= contents]) + displayObjectDiffToJSON :: DisplayObjectDiff -> Value + displayObjectDiffToJSON = \case + DisplayObjectDiff dispDiff -> + object ["diff" .= dispDiff, "diffKind" .= ("diff" :: Text)] + MismatchedDisplayObjects {} -> + object ["diffKind" .= ("mismatched" :: Text)] + + termDefinitionDiffToJSON :: TermDefinitionDiff -> Value + termDefinitionDiffToJSON (TermDefinitionDiff {left, right, diff}) = object ["left" .= left, "right" .= right, "diff" .= displayObjectDiffToJSON diff] + + typeDefinitionDiffToJSON :: TypeDefinitionDiff -> Value + typeDefinitionDiffToJSON (TypeDefinitionDiff {left, right, diff}) = object ["left" .= left, "right" .= right, "diff" .= displayObjectDiffToJSON diff] + namespaceTreeDiffJSON :: NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash) TermDefinition TypeDefinition TermDefinitionDiff TypeDefinitionDiff -> Value + namespaceTreeDiffJSON (diffs Cofree.:< children) = + let changesJSON = + diffs + & Map.toList + & foldMap + ( \(name, DiffAtPath {termDiffsAtPath, typeDiffsAtPath}) -> + ( Foldable.toList termDiffsAtPath + <&> over NamespaceDiffs.definitionDiffDiffs_ termDefinitionDiffToJSON + <&> over NamespaceDiffs.definitionDiffRendered_ toJSON + & fmap (diffDataJSON name) + & fmap (\(tag, dJSON) -> object ["tag" .= tag, "contents" .= dJSON]) + ) + <> ( Foldable.toList typeDiffsAtPath + <&> over NamespaceDiffs.definitionDiffDiffs_ typeDefinitionDiffToJSON + <&> over NamespaceDiffs.definitionDiffRendered_ toJSON + & fmap (diffDataJSON name) + & fmap (\(tag, dJSON) -> object ["tag" .= tag, "contents" .= dJSON]) + ) + ) + & toJSON @([Value]) + childrenJSON = + children + & Map.toList + & fmap + ( \(path, childNode) -> + object ["path" .= path, "contents" .= namespaceTreeDiffJSON childNode] + ) + in object + [ "changes" .= changesJSON, + "children" .= childrenJSON + ] + +concurrentExceptT :: (MonadUnliftIO m) => ExceptT e m a -> ExceptT e m b -> ExceptT e m (a, b) +concurrentExceptT a b = do + (ea, eb) <- lift $ UnliftIO.concurrently (runExceptT a) (runExceptT b) + ra <- except ea + rb <- except eb + pure (ra, rb) diff --git a/src/Share/Web/Share/Diffs/Types.hs b/src/Share/Web/Share/Diffs/Types.hs index 45f04ef1..c2e83f7c 100644 --- a/src/Share/Web/Share/Diffs/Types.hs +++ b/src/Share/Web/Share/Diffs/Types.hs @@ -2,20 +2,16 @@ module Share.Web.Share.Diffs.Types where -import Control.Comonad.Cofree qualified as Cofree import Data.Aeson -import Data.Foldable qualified as Foldable -import Data.Map qualified as Map import Share.IDs -import Share.NamespaceDiffs (DefinitionDiff (..), DefinitionDiffKind (..), DiffAtPath (..), NamespaceTreeDiff) +import Share.NamespaceDiffs (NamespaceTreeDiff) import Share.Postgres.IDs (CausalHash) import Share.Prelude -import Unison.Name (Name) -import Unison.NameSegment (NameSegment) -import Unison.Server.Types (DisplayObjectDiff (..), TermDefinition, TermTag, TypeDefinition, TypeTag) +import Share.Utils.Aeson (PreEncoded) +import Unison.Server.Types (DisplayObjectDiff (..), TermDefinition, TermDefinitionDiff (..), TermTag, TypeDefinition, TypeDefinitionDiff (..), TypeTag) import Unison.ShortHash (ShortHash) -type ShareNamespaceDiff = NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash) +type ShareNamespaceDiff = NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash) TermDefinition TypeDefinition TermDefinitionDiff TypeDefinitionDiff data ShareNamespaceDiffResponse = ShareNamespaceDiffResponse { project :: ProjectShortHand, @@ -23,13 +19,13 @@ data ShareNamespaceDiffResponse = ShareNamespaceDiffResponse oldRefHash :: Maybe (PrefixedHash "#" CausalHash), newRef :: BranchOrReleaseShortHand, newRefHash :: Maybe (PrefixedHash "#" CausalHash), - diff :: ShareNamespaceDiff + diff :: PreEncoded ShareNamespaceDiff } instance ToJSON ShareNamespaceDiffResponse where toJSON (ShareNamespaceDiffResponse {diff, project, oldRef, newRef, oldRefHash, newRefHash}) = object - [ "diff" .= namespaceTreeDiffJSON diff, + [ "diff" .= diff, "project" .= project, "oldRef" .= oldRef, "oldRefHash" .= oldRefHash, @@ -37,56 +33,6 @@ instance ToJSON ShareNamespaceDiffResponse where "newRefHash" .= newRefHash ] where - text :: Text -> Text - text t = t - hqNameJSON :: Name -> NameSegment -> ShortHash -> Value - hqNameJSON fqn name sh = object ["hash" .= sh, "shortName" .= name, "fullName" .= fqn] - -- The preferred frontend format is a bit clunky to calculate here: - diffDataJSON :: (ToJSON tag) => NameSegment -> DefinitionDiff (tag, ShortHash) -> (tag, Value) - diffDataJSON shortName (DefinitionDiff {fqn, kind}) = case kind of - Added (defnTag, r) -> (defnTag, object ["tag" .= text "Added", "contents" .= hqNameJSON fqn shortName r]) - NewAlias (defnTag, r) existingNames -> - let contents = object ["hash" .= r, "aliasShortName" .= shortName, "aliasFullName" .= fqn, "otherNames" .= toList existingNames] - in (defnTag, object ["tag" .= text "Aliased", "contents" .= contents]) - Removed (defnTag, r) -> (defnTag, object ["tag" .= text "Removed", "contents" .= hqNameJSON fqn shortName r]) - Updated (oldTag, oldRef) (newTag, newRef) -> - let contents = object ["oldHash" .= oldRef, "newHash" .= newRef, "shortName" .= shortName, "fullName" .= fqn, "oldTag" .= oldTag, "newTag" .= newTag] - in (newTag, object ["tag" .= text "Updated", "contents" .= contents]) - RenamedTo (defnTag, r) newNames -> - let contents = object ["oldShortName" .= shortName, "oldFullName" .= fqn, "newNames" .= newNames, "hash" .= r] - in (defnTag, object ["tag" .= text "RenamedTo", "contents" .= contents]) - RenamedFrom (defnTag, r) oldNames -> - let contents = object ["oldNames" .= oldNames, "newShortName" .= shortName, "newFullName" .= fqn, "hash" .= r] - in (defnTag, object ["tag" .= text "RenamedFrom", "contents" .= contents]) - - namespaceTreeDiffJSON :: NamespaceTreeDiff (TermTag, ShortHash) (TypeTag, ShortHash) -> Value - namespaceTreeDiffJSON (diffs Cofree.:< children) = - let changesJSON = - diffs - & Map.toList - & foldMap - ( \(name, DiffAtPath {termDiffsAtPath, typeDiffsAtPath}) -> - ( Foldable.toList termDiffsAtPath - & fmap (diffDataJSON name) - & fmap (\(tag, dJSON) -> object ["tag" .= tag, "contents" .= dJSON]) - ) - <> ( Foldable.toList typeDiffsAtPath - & fmap (diffDataJSON name) - & fmap (\(tag, dJSON) -> object ["tag" .= tag, "contents" .= dJSON]) - ) - ) - & toJSON @([Value]) - childrenJSON = - children - & Map.toList - & fmap - ( \(path, childNode) -> - object ["path" .= path, "contents" .= namespaceTreeDiffJSON childNode] - ) - in object - [ "changes" .= changesJSON, - "children" .= childrenJSON - ] data ShareTermDiffResponse = ShareTermDiffResponse { project :: ProjectShortHand, diff --git a/src/Share/Web/Share/Projects/Impl.hs b/src/Share/Web/Share/Projects/Impl.hs index 29326531..d614721d 100644 --- a/src/Share/Web/Share/Projects/Impl.hs +++ b/src/Share/Web/Share/Projects/Impl.hs @@ -50,6 +50,7 @@ import Share.Web.Share.Tickets.Impl (ticketsByProjectServer) import Share.Web.Share.Types import Unison.Name (Name) import Unison.Server.Orphans () +import Unison.Server.Types import Unison.Syntax.Name qualified as Name data ProjectErrors @@ -152,8 +153,8 @@ diffNamespacesEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle project project@Project {projectId} <- PG.runTransactionOrRespondError do Q.projectByShortHand projectShortHand `whenNothingM` throwError (EntityMissing (ErrorID "project-not-found") ("Project not found: " <> IDs.toText @IDs.ProjectShortHand projectShortHand)) authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkProjectBranchDiff callerUserId project - (_, oldCausalId, _oldBranchId) <- namespaceHashForBranchOrRelease authZReceipt project oldShortHand - (_, newCausalId, _newBranchId) <- namespaceHashForBranchOrRelease authZReceipt project newShortHand + (oldCodebase, oldCausalId, _oldBranchId) <- namespaceHashForBranchOrRelease authZReceipt project oldShortHand + (newCodebase, newCausalId, _newBranchId) <- namespaceHashForBranchOrRelease authZReceipt project newShortHand let cacheKeys = [IDs.toText projectId, IDs.toText oldShortHand, IDs.toText newShortHand, Caching.causalIdCacheKey oldCausalId, Caching.causalIdCacheKey newCausalId] Caching.cachedResponse authZReceipt "project-diff-namespaces" cacheKeys do @@ -161,7 +162,7 @@ diffNamespacesEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle project ancestorCausalId <- fromMaybe oldCausalId <$> CausalQ.bestCommonAncestor oldCausalId newCausalId (ancestorCausalHash, newCausalHash) <- CausalQ.expectCausalHashesByIdsOf both (ancestorCausalId, newCausalId) pure (ancestorCausalId, ancestorCausalHash, newCausalHash) - namespaceDiff <- Diffs.diffCausals authZReceipt ancestorCausalId newCausalId + namespaceDiff <- respondExceptT (Diffs.diffCausals authZReceipt (oldCodebase, ancestorCausalId) (newCodebase, newCausalId)) pure $ ShareNamespaceDiffResponse { project = projectShortHand, @@ -194,15 +195,15 @@ projectDiffTermsEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle proje let cacheKeys = [IDs.toText projectId, IDs.toText oldShortHand, IDs.toText newShortHand, Caching.branchIdCacheKey oldBhId, Caching.branchIdCacheKey newBhId, Name.toText oldTermName, Name.toText newTermName] Caching.cachedResponse authZReceipt "project-diff-terms" cacheKeys do - (oldTerm, newTerm, displayObjectDiff) <- Diffs.diffTerms authZReceipt (oldCodebase, oldBhId, oldTermName) (newCodebase, newBhId, newTermName) + termDiff <- respondExceptT (Diffs.diffTerms authZReceipt (oldCodebase, oldBhId, oldTermName) (newCodebase, newBhId, newTermName)) pure $ ShareTermDiffResponse { project = projectShortHand, oldBranch = oldShortHand, newBranch = newShortHand, - oldTerm = oldTerm, - newTerm = newTerm, - diff = displayObjectDiff + oldTerm = termDiff.left, + newTerm = termDiff.right, + diff = termDiff.diff } where projectShortHand :: IDs.ProjectShortHand @@ -228,15 +229,15 @@ projectDiffTypesEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle proje let cacheKeys = [IDs.toText projectId, IDs.toText oldShortHand, IDs.toText newShortHand, Caching.branchIdCacheKey oldBhId, Caching.branchIdCacheKey newBhId, Name.toText oldTypeName, Name.toText newTypeName] Caching.cachedResponse authZReceipt "project-diff-types" cacheKeys do - (oldType, newType, typeDiffDisplayObject) <- Diffs.diffTypes authZReceipt (oldCodebase, oldBhId, oldTypeName) (newCodebase, newBhId, newTypeName) + typeDiff <- respondExceptT (Diffs.diffTypes authZReceipt (oldCodebase, oldBhId, oldTypeName) (newCodebase, newBhId, newTypeName)) pure $ ShareTypeDiffResponse { project = projectShortHand, oldBranch = oldShortHand, newBranch = newShortHand, - oldType = oldType, - newType = newType, - diff = typeDiffDisplayObject + oldType = typeDiff.left, + newType = typeDiff.right, + diff = typeDiff.diff } where projectShortHand :: IDs.ProjectShortHand diff --git a/transcripts/share-apis/contribution-diffs/contribution-diff.json b/transcripts/share-apis/contribution-diffs/contribution-diff.json index 9c8e19e5..0525c217 100644 --- a/transcripts/share-apis/contribution-diffs/contribution-diff.json +++ b/transcripts/share-apis/contribution-diffs/contribution-diff.json @@ -10,7 +10,51 @@ "hash": "#bbsbe7lolqunqrftm9jeg299caa91r2mlviqic54toilse443ljup5eojm1et3lqv6ni5gsu9l9hpldptga3cp5e0qffhg36gv5u2jo", "otherNames": [ "DataAliasMe" - ] + ], + "rendered": { + "bestTypeName": "ATypeAlias", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "ATypeAlias", + "tag": "HashQualifier" + }, + "segment": "ATypeAlias" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#bbsbe7lolqunqrftm9jeg299caa91r2mlviqic54toilse443ljup5eojm1et3lqv6ni5gsu9l9hpldptga3cp5e0qffhg36gv5u2jo#d0", + "tag": "TermReference" + }, + "segment": "B" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "ATypeAlias", + "DataAliasMe" + ] + } }, "tag": "Aliased" }, @@ -24,7 +68,95 @@ "hash": "#qfgn5crplnhh308pepplqtleojiqhlpveimv0htug2mqbvhnia7qjfcravqlfb8ooos56jo5qq6brr99gg5kj0g5bgllvgn1nesv608", "otherNames": [ "AbilityAliasMe" - ] + ], + "rendered": { + "bestTypeName": "AbilityAlias", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityAlias", + "tag": "HashQualifier" + }, + "segment": "AbilityAlias" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#qfgn5crplnhh308pepplqtleojiqhlpveimv0htug2mqbvhnia7qjfcravqlfb8ooos56jo5qq6brr99gg5kj0g5bgllvgn1nesv608#a0", + "tag": "TermReference" + }, + "segment": "abilityAliasMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#qfgn5crplnhh308pepplqtleojiqhlpveimv0htug2mqbvhnia7qjfcravqlfb8ooos56jo5qq6brr99gg5kj0g5bgllvgn1nesv608", + "tag": "TypeReference" + }, + "segment": "AbilityAlias" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityAlias", + "AbilityAliasMe" + ] + } }, "tag": "Aliased" }, @@ -35,6 +167,93 @@ "contents": { "fullName": "AbilityDeleteMe", "hash": "#val3i3ikhjc998qh1lfefhh08ad77f1eshera5d0hnbrp6qpgmfelbfa96pvsc18d5qd5qm7lij5el0raipb3mbjgalkh7g3aujej1o", + "rendered": { + "bestTypeName": "AbilityDeleteMe", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityDeleteMe", + "tag": "HashQualifier" + }, + "segment": "AbilityDeleteMe" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#val3i3ikhjc998qh1lfefhh08ad77f1eshera5d0hnbrp6qpgmfelbfa96pvsc18d5qd5qm7lij5el0raipb3mbjgalkh7g3aujej1o#a0", + "tag": "TermReference" + }, + "segment": "abilityDeleteMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#val3i3ikhjc998qh1lfefhh08ad77f1eshera5d0hnbrp6qpgmfelbfa96pvsc18d5qd5qm7lij5el0raipb3mbjgalkh7g3aujej1o", + "tag": "TypeReference" + }, + "segment": "AbilityDeleteMe" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityDeleteMe" + ] + }, "shortName": "AbilityDeleteMe" }, "tag": "Removed" @@ -46,6 +265,93 @@ "contents": { "fullName": "AbilityNew", "hash": "#t66tvdfo0l4pqj6hgav05tqifbuld8dc22g4rom3olfqj7b6cfpvf15j7307j8m2fpdsvcgv4ourrltpjutgpu3bh08efu2jl2nfqq0", + "rendered": { + "bestTypeName": "AbilityNew", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityNew", + "tag": "HashQualifier" + }, + "segment": "AbilityNew" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#t66tvdfo0l4pqj6hgav05tqifbuld8dc22g4rom3olfqj7b6cfpvf15j7307j8m2fpdsvcgv4ourrltpjutgpu3bh08efu2jl2nfqq0#a0", + "tag": "TermReference" + }, + "segment": "abilityNew" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#t66tvdfo0l4pqj6hgav05tqifbuld8dc22g4rom3olfqj7b6cfpvf15j7307j8m2fpdsvcgv4ourrltpjutgpu3bh08efu2jl2nfqq0", + "tag": "TypeReference" + }, + "segment": "AbilityNew" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityNew" + ] + }, "shortName": "AbilityNew" }, "tag": "Added" @@ -60,7 +366,94 @@ "newShortName": "AbilityRenamed", "oldNames": [ "AbilityRenameMe" - ] + ], + "rendered": { + "bestTypeName": "AbilityRenamed", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityRenamed", + "tag": "HashQualifier" + }, + "segment": "AbilityRenamed" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#iqmiiehu802p15ssntohl6l5kedd0j266rh7815s1t10rfe2bp207vh8ccngrlkii7i32h1n080dggr3r89osrq450kv6dj5uuc0o0o#a0", + "tag": "TermReference" + }, + "segment": "abilityRenameMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#iqmiiehu802p15ssntohl6l5kedd0j266rh7815s1t10rfe2bp207vh8ccngrlkii7i32h1n080dggr3r89osrq450kv6dj5uuc0o0o", + "tag": "TypeReference" + }, + "segment": "AbilityRenamed" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityRenamed" + ] + } }, "tag": "RenamedFrom" }, @@ -69,6 +462,306 @@ { "contents": { "contents": { + "diff": { + "diff": { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityUpdateMe", + "tag": "HashQualifier" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "annotationChange", + "fromAnnotation": { + "contents": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg#a0", + "tag": "TermReference" + }, + "segment": "abilityUpdateMe", + "toAnnotation": { + "contents": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18#a0", + "tag": "TermReference" + } + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + } + ] + }, + { + "diffTag": "annotationChange", + "fromAnnotation": { + "contents": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg", + "tag": "TypeReference" + }, + "segment": "AbilityUpdateMe", + "toAnnotation": { + "contents": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18", + "tag": "TypeReference" + } + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff" + }, + "left": { + "bestTypeName": "AbilityUpdateMe", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityUpdateMe", + "tag": "HashQualifier" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg#a0", + "tag": "TermReference" + }, + "segment": "abilityUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg", + "tag": "TypeReference" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityUpdateMe" + ] + }, + "right": { + "bestTypeName": "AbilityUpdateMe", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityUpdateMe", + "tag": "HashQualifier" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18#a0", + "tag": "TermReference" + }, + "segment": "abilityUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18", + "tag": "TypeReference" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityUpdateMe" + ] + } + }, "fullName": "AbilityUpdateMe", "newHash": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18", "newTag": "Ability", @@ -85,6 +778,49 @@ "contents": { "fullName": "DataDeleteMe", "hash": "#keu02n8is0irijd65cvuos41kukj3f4ni18mmnudrbll2epo6ftd03nt9l0vqc4fvg98198tefgoupco4o0d0gvnigqgr1bmo2neo88", + "rendered": { + "bestTypeName": "DataDeleteMe", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "DataDeleteMe", + "tag": "HashQualifier" + }, + "segment": "DataDeleteMe" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#keu02n8is0irijd65cvuos41kukj3f4ni18mmnudrbll2epo6ftd03nt9l0vqc4fvg98198tefgoupco4o0d0gvnigqgr1bmo2neo88#d0", + "tag": "TermReference" + }, + "segment": "C" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "DataDeleteMe" + ] + }, "shortName": "DataDeleteMe" }, "tag": "Removed" @@ -94,22 +830,235 @@ { "contents": { "contents": { - "fullName": "DataUpdateMe", - "newHash": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0", - "newTag": "Data", - "oldHash": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o", - "oldTag": "Data", - "shortName": "DataUpdateMe" - }, - "tag": "Updated" - }, - "tag": "Data" - }, - { - "contents": { - "contents": { + "diff": { + "diff": { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "DataUpdateMe", + "tag": "HashQualifier" + }, + "segment": "DataUpdateMe" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "contents": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o#d0", + "tag": "TermReference" + }, + "segment": "D" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0#d0", + "tag": "TermReference" + }, + "segment": "D2" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff" + }, + "left": { + "bestTypeName": "DataUpdateMe", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "DataUpdateMe", + "tag": "HashQualifier" + }, + "segment": "DataUpdateMe" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o#d0", + "tag": "TermReference" + }, + "segment": "D" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "DataUpdateMe" + ] + }, + "right": { + "bestTypeName": "DataUpdateMe", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "DataUpdateMe", + "tag": "HashQualifier" + }, + "segment": "DataUpdateMe" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0#d0", + "tag": "TermReference" + }, + "segment": "D2" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "DataUpdateMe" + ] + } + }, + "fullName": "DataUpdateMe", + "newHash": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0", + "newTag": "Data", + "oldHash": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o", + "oldTag": "Data", + "shortName": "DataUpdateMe" + }, + "tag": "Updated" + }, + "tag": "Data" + }, + { + "contents": { + "contents": { "fullName": "NewType", "hash": "#sa4ptibggqmbifhfj37gj2lq487q5ucfuojjcblfaas9bunlthhkvhstsrj20fvlpqakb8e9mqds4p32lnh8ohmf1s5omvdhc23jibg", + "rendered": { + "bestTypeName": "NewType", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "NewType", + "tag": "HashQualifier" + }, + "segment": "NewType" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#sa4ptibggqmbifhfj37gj2lq487q5ucfuojjcblfaas9bunlthhkvhstsrj20fvlpqakb8e9mqds4p32lnh8ohmf1s5omvdhc23jibg#d0", + "tag": "TermReference" + }, + "segment": "X" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "NewType" + ] + }, "shortName": "NewType" }, "tag": "Added" @@ -124,7 +1073,50 @@ "newShortName": "RenamedType", "oldNames": [ "DataRenameMe" - ] + ], + "rendered": { + "bestTypeName": "RenamedType", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "RenamedType", + "tag": "HashQualifier" + }, + "segment": "RenamedType" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#8s3lsrv3p6ngq2bqotvli1f0gfcf9uvci4trmia6dosl3d8vu6i6kubdi3ic7m22r34m4mkru3hatdbgihj0fngmj7gktlq41ncs1e0#d0", + "tag": "TermReference" + }, + "segment": "E" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "RenamedType" + ] + } }, "tag": "RenamedFrom" }, @@ -135,6 +1127,123 @@ "contents": { "fullName": "aDoc", "hash": "#areni4s9liksvfs3923a4ub81qpu37f964fqhbq832artpff8vm1em45ic0k2hlkv4nn08u712ibvjo9b4fl5u19o65g9medo7645i8", + "rendered": { + "bestTermName": "aDoc", + "defnTermTag": "Doc", + "signature": [ + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "aDoc", + "tag": "HashQualifier" + }, + "segment": "aDoc" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "aDoc", + "tag": "HashQualifier" + }, + "segment": "aDoc" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DocDelimiter" + }, + "segment": "{{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "Test" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "Doc" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DocDelimiter" + }, + "segment": "}}" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "aDoc", + "#areni4s9liksvfs3923a4ub81qpu37f964fqhbq832artpff8vm1em45ic0k2hlkv4nn08u712ibvjo9b4fl5u19o65g9medo7645i8", + { + "contents": [ + { + "contents": "Test", + "tag": "Word" + }, + { + "contents": "Doc", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "aDoc" + ] + }, "shortName": "aDoc" }, "tag": "Removed" @@ -149,7 +1258,81 @@ "hash": "#gjmq673r1vrurfotlnirv7vutdhm6sa3s02em5g22kk606mv6duvv8be402dv79312i4a0onepq5bo7citsodvq2g720nttj0ee9p0g", "otherNames": [ "termAliasMe" - ] + ], + "rendered": { + "bestTermName": "aTermAlias", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "aTermAlias", + "tag": "HashQualifier" + }, + "segment": "aTermAlias" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "aTermAlias", + "tag": "HashQualifier" + }, + "segment": "aTermAlias" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "aTermAlias", + "termAliasMe" + ] + } }, "tag": "Aliased" }, @@ -160,6 +1343,128 @@ "contents": { "fullName": "aTest", "hash": "#qak36j7cshv12m9meuc97ovllqm8k2i305sh4oq5dbo4834t7atugsdpto6mou1tch2b3q9j2hbi23gdf4jpth7m97mannv9noucgl8", + "rendered": { + "bestTermName": "aTest", + "defnTermTag": "Test", + "signature": [ + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "[" + }, + { + "annotation": { + "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0", + "tag": "TypeReference" + }, + "segment": "Result" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "]" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "aTest", + "tag": "HashQualifier" + }, + "segment": "aTest" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "[" + }, + { + "annotation": { + "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0", + "tag": "TypeReference" + }, + "segment": "Result" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "]" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "aTest", + "tag": "HashQualifier" + }, + "segment": "aTest" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Sequence", + "tag": "TypeReference" + }, + "segment": "[" + }, + { + "annotation": { + "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0#d1", + "tag": "TermReference" + }, + "segment": "Ok" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"Done\"" + }, + { + "annotation": { + "contents": "##Sequence", + "tag": "TypeReference" + }, + "segment": "]" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "aTest" + ] + }, "shortName": "aTest" }, "tag": "Removed" @@ -171,6 +1476,79 @@ "contents": { "fullName": "newTerm", "hash": "#u1qsl3nk5t2svl58ifqepem851775qca9p4hc10j3iordu1v7u8e16oodui9kvt2c0j1cbc50avado53bl2vt3pphrfj9mhbut1ipm8", + "rendered": { + "bestTermName": "newTerm", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "newTerm", + "tag": "HashQualifier" + }, + "segment": "newTerm" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "newTerm", + "tag": "HashQualifier" + }, + "segment": "newTerm" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "100" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "newTerm" + ] + }, "shortName": "newTerm" }, "tag": "Added" @@ -185,7 +1563,80 @@ "newShortName": "renamedTerm", "oldNames": [ "termRenameMe" - ] + ], + "rendered": { + "bestTermName": "renamedTerm", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "renamedTerm", + "tag": "HashQualifier" + }, + "segment": "renamedTerm" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "renamedTerm", + "tag": "HashQualifier" + }, + "segment": "renamedTerm" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "3" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "renamedTerm" + ] + } }, "tag": "RenamedFrom" }, @@ -196,6 +1647,79 @@ "contents": { "fullName": "termDeleteMe", "hash": "#dcgdua2lj6upd1ah5v0qp09gjsej0d77d87fu6qn8e2qrssnlnmuinoio46hiu53magr7qn8vnqke8ndt0v76700o5u8gcvo7st28jg", + "rendered": { + "bestTermName": "termDeleteMe", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "termDeleteMe", + "tag": "HashQualifier" + }, + "segment": "termDeleteMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "termDeleteMe", + "tag": "HashQualifier" + }, + "segment": "termDeleteMe" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "2" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "termDeleteMe" + ] + }, "shortName": "termDeleteMe" }, "tag": "Removed" @@ -205,6 +1729,234 @@ { "contents": { "contents": { + "diff": { + "diff": { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"original\"" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"updated\"" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff" + }, + "left": { + "bestTermName": "termUpdateMe", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"original\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "termUpdateMe" + ] + }, + "right": { + "bestTermName": "termUpdateMe", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"updated\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "termUpdateMe" + ] + } + }, "fullName": "termUpdateMe", "newHash": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", "newTag": "Plain", @@ -218,222 +1970,6 @@ } ], "children": [ - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "aliasFullName": "ATypeAlias.B", - "aliasShortName": "B", - "hash": "#bbsbe7lolqunqrftm9jeg299caa91r2mlviqic54toilse443ljup5eojm1et3lqv6ni5gsu9l9hpldptga3cp5e0qffhg36gv5u2jo#0", - "otherNames": [ - "DataAliasMe.B" - ] - }, - "tag": "Aliased" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "ATypeAlias" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "aliasFullName": "AbilityAlias.abilityAliasMe", - "aliasShortName": "abilityAliasMe", - "hash": "#qfgn5crplnhh308pepplqtleojiqhlpveimv0htug2mqbvhnia7qjfcravqlfb8ooos56jo5qq6brr99gg5kj0g5bgllvgn1nesv608#0", - "otherNames": [ - "AbilityAliasMe.abilityAliasMe" - ] - }, - "tag": "Aliased" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityAlias" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "AbilityDeleteMe.abilityDeleteMe", - "hash": "#val3i3ikhjc998qh1lfefhh08ad77f1eshera5d0hnbrp6qpgmfelbfa96pvsc18d5qd5qm7lij5el0raipb3mbjgalkh7g3aujej1o#0", - "shortName": "abilityDeleteMe" - }, - "tag": "Removed" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityDeleteMe" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "AbilityNew.abilityNew", - "hash": "#t66tvdfo0l4pqj6hgav05tqifbuld8dc22g4rom3olfqj7b6cfpvf15j7307j8m2fpdsvcgv4ourrltpjutgpu3bh08efu2jl2nfqq0#0", - "shortName": "abilityNew" - }, - "tag": "Added" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityNew" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "hash": "#iqmiiehu802p15ssntohl6l5kedd0j266rh7815s1t10rfe2bp207vh8ccngrlkii7i32h1n080dggr3r89osrq450kv6dj5uuc0o0o#0", - "newFullName": "AbilityRenamed.abilityRenameMe", - "newShortName": "abilityRenameMe", - "oldNames": [ - "AbilityRenameMe.abilityRenameMe" - ] - }, - "tag": "RenamedFrom" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityRenamed" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "AbilityUpdateMe.abilityUpdateMe", - "newHash": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18#0", - "newTag": "AbilityConstructor", - "oldHash": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg#0", - "oldTag": "AbilityConstructor", - "shortName": "abilityUpdateMe" - }, - "tag": "Updated" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityUpdateMe" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "DataDeleteMe.C", - "hash": "#keu02n8is0irijd65cvuos41kukj3f4ni18mmnudrbll2epo6ftd03nt9l0vqc4fvg98198tefgoupco4o0d0gvnigqgr1bmo2neo88#0", - "shortName": "C" - }, - "tag": "Removed" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "DataDeleteMe" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "DataUpdateMe.D", - "hash": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o#0", - "shortName": "D" - }, - "tag": "Removed" - }, - "tag": "DataConstructor" - }, - { - "contents": { - "contents": { - "fullName": "DataUpdateMe.D2", - "hash": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0#0", - "shortName": "D2" - }, - "tag": "Added" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "DataUpdateMe" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "NewType.X", - "hash": "#sa4ptibggqmbifhfj37gj2lq487q5ucfuojjcblfaas9bunlthhkvhstsrj20fvlpqakb8e9mqds4p32lnh8ohmf1s5omvdhc23jibg#0", - "shortName": "X" - }, - "tag": "Added" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "NewType" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "hash": "#8s3lsrv3p6ngq2bqotvli1f0gfcf9uvci4trmia6dosl3d8vu6i6kubdi3ic7m22r34m4mkru3hatdbgihj0fngmj7gktlq41ncs1e0#0", - "newFullName": "RenamedType.E", - "newShortName": "E", - "oldNames": [ - "DataRenameMe.E" - ] - }, - "tag": "RenamedFrom" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "RenamedType" - }, { "contents": { "changes": [], @@ -446,6 +1982,79 @@ "contents": { "fullName": "a.definition.at.path1", "hash": "#r303avnmdmja3ch96otiglq37214t43acpr1ikq4hrp5hmcibstipa69frbd6177jvbn28ioc5ii80fc54ecogm4n64dhjvkonrihso", + "rendered": { + "bestTermName": "path1", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "a.definition.at.path1", + "tag": "HashQualifier" + }, + "segment": "a.definition.at.path1" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "a.definition.at.path1", + "tag": "HashQualifier" + }, + "segment": "a.definition.at.path1" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"definition at path\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "a.definition.at.path1" + ] + }, "shortName": "path1" }, "tag": "Removed" @@ -457,6 +2066,79 @@ "contents": { "fullName": "a.definition.at.path2", "hash": "#k43vb9rkd3n4i8g8bbfb31erufbmu6v1f99i587oqsje51thrm1ugdqa7gkjbdvkactuql3cmc00b7oev0glqb2rko48atkuo798mno", + "rendered": { + "bestTermName": "path2", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "a.definition.at.path2", + "tag": "HashQualifier" + }, + "segment": "a.definition.at.path2" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "a.definition.at.path2", + "tag": "HashQualifier" + }, + "segment": "a.definition.at.path2" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"definition at path2\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "a.definition.at.path2" + ] + }, "shortName": "path2" }, "tag": "Removed" @@ -476,6 +2158,79 @@ "contents": { "fullName": "a.different.path", "hash": "#83be375arg68mqk26bu12elka6fb6mvq6cec92un1p1t5kulhh6672qlnego952pp7h4lfl7mq3crithvtvo3col9mfc8vurbnb8hvo", + "rendered": { + "bestTermName": "path", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "a.different.path", + "tag": "HashQualifier" + }, + "segment": "a.different.path" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "a.different.path", + "tag": "HashQualifier" + }, + "segment": "a.different.path" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"definition at different path\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "a.different.path" + ] + }, "shortName": "path" }, "tag": "Removed" diff --git a/transcripts/share-apis/contribution-diffs/namespace-diff.json b/transcripts/share-apis/contribution-diffs/namespace-diff.json index 9c8e19e5..0525c217 100644 --- a/transcripts/share-apis/contribution-diffs/namespace-diff.json +++ b/transcripts/share-apis/contribution-diffs/namespace-diff.json @@ -10,7 +10,51 @@ "hash": "#bbsbe7lolqunqrftm9jeg299caa91r2mlviqic54toilse443ljup5eojm1et3lqv6ni5gsu9l9hpldptga3cp5e0qffhg36gv5u2jo", "otherNames": [ "DataAliasMe" - ] + ], + "rendered": { + "bestTypeName": "ATypeAlias", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "ATypeAlias", + "tag": "HashQualifier" + }, + "segment": "ATypeAlias" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#bbsbe7lolqunqrftm9jeg299caa91r2mlviqic54toilse443ljup5eojm1et3lqv6ni5gsu9l9hpldptga3cp5e0qffhg36gv5u2jo#d0", + "tag": "TermReference" + }, + "segment": "B" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "ATypeAlias", + "DataAliasMe" + ] + } }, "tag": "Aliased" }, @@ -24,7 +68,95 @@ "hash": "#qfgn5crplnhh308pepplqtleojiqhlpveimv0htug2mqbvhnia7qjfcravqlfb8ooos56jo5qq6brr99gg5kj0g5bgllvgn1nesv608", "otherNames": [ "AbilityAliasMe" - ] + ], + "rendered": { + "bestTypeName": "AbilityAlias", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityAlias", + "tag": "HashQualifier" + }, + "segment": "AbilityAlias" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#qfgn5crplnhh308pepplqtleojiqhlpveimv0htug2mqbvhnia7qjfcravqlfb8ooos56jo5qq6brr99gg5kj0g5bgllvgn1nesv608#a0", + "tag": "TermReference" + }, + "segment": "abilityAliasMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#qfgn5crplnhh308pepplqtleojiqhlpveimv0htug2mqbvhnia7qjfcravqlfb8ooos56jo5qq6brr99gg5kj0g5bgllvgn1nesv608", + "tag": "TypeReference" + }, + "segment": "AbilityAlias" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityAlias", + "AbilityAliasMe" + ] + } }, "tag": "Aliased" }, @@ -35,6 +167,93 @@ "contents": { "fullName": "AbilityDeleteMe", "hash": "#val3i3ikhjc998qh1lfefhh08ad77f1eshera5d0hnbrp6qpgmfelbfa96pvsc18d5qd5qm7lij5el0raipb3mbjgalkh7g3aujej1o", + "rendered": { + "bestTypeName": "AbilityDeleteMe", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityDeleteMe", + "tag": "HashQualifier" + }, + "segment": "AbilityDeleteMe" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#val3i3ikhjc998qh1lfefhh08ad77f1eshera5d0hnbrp6qpgmfelbfa96pvsc18d5qd5qm7lij5el0raipb3mbjgalkh7g3aujej1o#a0", + "tag": "TermReference" + }, + "segment": "abilityDeleteMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#val3i3ikhjc998qh1lfefhh08ad77f1eshera5d0hnbrp6qpgmfelbfa96pvsc18d5qd5qm7lij5el0raipb3mbjgalkh7g3aujej1o", + "tag": "TypeReference" + }, + "segment": "AbilityDeleteMe" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityDeleteMe" + ] + }, "shortName": "AbilityDeleteMe" }, "tag": "Removed" @@ -46,6 +265,93 @@ "contents": { "fullName": "AbilityNew", "hash": "#t66tvdfo0l4pqj6hgav05tqifbuld8dc22g4rom3olfqj7b6cfpvf15j7307j8m2fpdsvcgv4ourrltpjutgpu3bh08efu2jl2nfqq0", + "rendered": { + "bestTypeName": "AbilityNew", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityNew", + "tag": "HashQualifier" + }, + "segment": "AbilityNew" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#t66tvdfo0l4pqj6hgav05tqifbuld8dc22g4rom3olfqj7b6cfpvf15j7307j8m2fpdsvcgv4ourrltpjutgpu3bh08efu2jl2nfqq0#a0", + "tag": "TermReference" + }, + "segment": "abilityNew" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#t66tvdfo0l4pqj6hgav05tqifbuld8dc22g4rom3olfqj7b6cfpvf15j7307j8m2fpdsvcgv4ourrltpjutgpu3bh08efu2jl2nfqq0", + "tag": "TypeReference" + }, + "segment": "AbilityNew" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityNew" + ] + }, "shortName": "AbilityNew" }, "tag": "Added" @@ -60,7 +366,94 @@ "newShortName": "AbilityRenamed", "oldNames": [ "AbilityRenameMe" - ] + ], + "rendered": { + "bestTypeName": "AbilityRenamed", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityRenamed", + "tag": "HashQualifier" + }, + "segment": "AbilityRenamed" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#iqmiiehu802p15ssntohl6l5kedd0j266rh7815s1t10rfe2bp207vh8ccngrlkii7i32h1n080dggr3r89osrq450kv6dj5uuc0o0o#a0", + "tag": "TermReference" + }, + "segment": "abilityRenameMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#iqmiiehu802p15ssntohl6l5kedd0j266rh7815s1t10rfe2bp207vh8ccngrlkii7i32h1n080dggr3r89osrq450kv6dj5uuc0o0o", + "tag": "TypeReference" + }, + "segment": "AbilityRenamed" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityRenamed" + ] + } }, "tag": "RenamedFrom" }, @@ -69,6 +462,306 @@ { "contents": { "contents": { + "diff": { + "diff": { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityUpdateMe", + "tag": "HashQualifier" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "annotationChange", + "fromAnnotation": { + "contents": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg#a0", + "tag": "TermReference" + }, + "segment": "abilityUpdateMe", + "toAnnotation": { + "contents": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18#a0", + "tag": "TermReference" + } + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + } + ] + }, + { + "diffTag": "annotationChange", + "fromAnnotation": { + "contents": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg", + "tag": "TypeReference" + }, + "segment": "AbilityUpdateMe", + "toAnnotation": { + "contents": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18", + "tag": "TypeReference" + } + }, + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff" + }, + "left": { + "bestTypeName": "AbilityUpdateMe", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityUpdateMe", + "tag": "HashQualifier" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg#a0", + "tag": "TermReference" + }, + "segment": "abilityUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg", + "tag": "TypeReference" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityUpdateMe" + ] + }, + "right": { + "bestTypeName": "AbilityUpdateMe", + "defnTypeTag": "Ability", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "ability" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "AbilityUpdateMe", + "tag": "HashQualifier" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "ControlKeyword" + }, + "segment": " where" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18#a0", + "tag": "TermReference" + }, + "segment": "abilityUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "{" + }, + { + "annotation": { + "contents": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18", + "tag": "TypeReference" + }, + "segment": "AbilityUpdateMe" + }, + { + "annotation": { + "tag": "AbilityBraces" + }, + "segment": "}" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "AbilityUpdateMe" + ] + } + }, "fullName": "AbilityUpdateMe", "newHash": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18", "newTag": "Ability", @@ -85,6 +778,49 @@ "contents": { "fullName": "DataDeleteMe", "hash": "#keu02n8is0irijd65cvuos41kukj3f4ni18mmnudrbll2epo6ftd03nt9l0vqc4fvg98198tefgoupco4o0d0gvnigqgr1bmo2neo88", + "rendered": { + "bestTypeName": "DataDeleteMe", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "DataDeleteMe", + "tag": "HashQualifier" + }, + "segment": "DataDeleteMe" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#keu02n8is0irijd65cvuos41kukj3f4ni18mmnudrbll2epo6ftd03nt9l0vqc4fvg98198tefgoupco4o0d0gvnigqgr1bmo2neo88#d0", + "tag": "TermReference" + }, + "segment": "C" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "DataDeleteMe" + ] + }, "shortName": "DataDeleteMe" }, "tag": "Removed" @@ -94,22 +830,235 @@ { "contents": { "contents": { - "fullName": "DataUpdateMe", - "newHash": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0", - "newTag": "Data", - "oldHash": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o", - "oldTag": "Data", - "shortName": "DataUpdateMe" - }, - "tag": "Updated" - }, - "tag": "Data" - }, - { - "contents": { - "contents": { + "diff": { + "diff": { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "DataUpdateMe", + "tag": "HashQualifier" + }, + "segment": "DataUpdateMe" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "contents": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o#d0", + "tag": "TermReference" + }, + "segment": "D" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "contents": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0#d0", + "tag": "TermReference" + }, + "segment": "D2" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff" + }, + "left": { + "bestTypeName": "DataUpdateMe", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "DataUpdateMe", + "tag": "HashQualifier" + }, + "segment": "DataUpdateMe" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o#d0", + "tag": "TermReference" + }, + "segment": "D" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "DataUpdateMe" + ] + }, + "right": { + "bestTypeName": "DataUpdateMe", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "DataUpdateMe", + "tag": "HashQualifier" + }, + "segment": "DataUpdateMe" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0#d0", + "tag": "TermReference" + }, + "segment": "D2" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "DataUpdateMe" + ] + } + }, + "fullName": "DataUpdateMe", + "newHash": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0", + "newTag": "Data", + "oldHash": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o", + "oldTag": "Data", + "shortName": "DataUpdateMe" + }, + "tag": "Updated" + }, + "tag": "Data" + }, + { + "contents": { + "contents": { "fullName": "NewType", "hash": "#sa4ptibggqmbifhfj37gj2lq487q5ucfuojjcblfaas9bunlthhkvhstsrj20fvlpqakb8e9mqds4p32lnh8ohmf1s5omvdhc23jibg", + "rendered": { + "bestTypeName": "NewType", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "NewType", + "tag": "HashQualifier" + }, + "segment": "NewType" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#sa4ptibggqmbifhfj37gj2lq487q5ucfuojjcblfaas9bunlthhkvhstsrj20fvlpqakb8e9mqds4p32lnh8ohmf1s5omvdhc23jibg#d0", + "tag": "TermReference" + }, + "segment": "X" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "NewType" + ] + }, "shortName": "NewType" }, "tag": "Added" @@ -124,7 +1073,50 @@ "newShortName": "RenamedType", "oldNames": [ "DataRenameMe" - ] + ], + "rendered": { + "bestTypeName": "RenamedType", + "defnTypeTag": "Data", + "typeDefinition": { + "contents": [ + { + "annotation": { + "tag": "DataTypeKeyword" + }, + "segment": "type" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "RenamedType", + "tag": "HashQualifier" + }, + "segment": "RenamedType" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": " = " + }, + { + "annotation": { + "contents": "#8s3lsrv3p6ngq2bqotvli1f0gfcf9uvci4trmia6dosl3d8vu6i6kubdi3ic7m22r34m4mkru3hatdbgihj0fngmj7gktlq41ncs1e0#d0", + "tag": "TermReference" + }, + "segment": "E" + } + ], + "tag": "UserObject" + }, + "typeDocs": [], + "typeNames": [ + "RenamedType" + ] + } }, "tag": "RenamedFrom" }, @@ -135,6 +1127,123 @@ "contents": { "fullName": "aDoc", "hash": "#areni4s9liksvfs3923a4ub81qpu37f964fqhbq832artpff8vm1em45ic0k2hlkv4nn08u712ibvjo9b4fl5u19o65g9medo7645i8", + "rendered": { + "bestTermName": "aDoc", + "defnTermTag": "Doc", + "signature": [ + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "aDoc", + "tag": "HashQualifier" + }, + "segment": "aDoc" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "#ej86si0ur1lsjade71dojr25phk9bbom9rdks6dltolos5tjivakujcriqe02npba53n9gd7tkh8bmv08ttjb9t35lq2ch5heshqcs0", + "tag": "TypeReference" + }, + "segment": "Doc2" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "aDoc", + "tag": "HashQualifier" + }, + "segment": "aDoc" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DocDelimiter" + }, + "segment": "{{" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "Test" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": null, + "segment": "Doc" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DocDelimiter" + }, + "segment": "}}" + } + ], + "tag": "UserObject" + }, + "termDocs": [ + [ + "aDoc", + "#areni4s9liksvfs3923a4ub81qpu37f964fqhbq832artpff8vm1em45ic0k2hlkv4nn08u712ibvjo9b4fl5u19o65g9medo7645i8", + { + "contents": [ + { + "contents": "Test", + "tag": "Word" + }, + { + "contents": "Doc", + "tag": "Word" + } + ], + "tag": "Paragraph" + } + ] + ], + "termNames": [ + "aDoc" + ] + }, "shortName": "aDoc" }, "tag": "Removed" @@ -149,7 +1258,81 @@ "hash": "#gjmq673r1vrurfotlnirv7vutdhm6sa3s02em5g22kk606mv6duvv8be402dv79312i4a0onepq5bo7citsodvq2g720nttj0ee9p0g", "otherNames": [ "termAliasMe" - ] + ], + "rendered": { + "bestTermName": "aTermAlias", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "aTermAlias", + "tag": "HashQualifier" + }, + "segment": "aTermAlias" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "aTermAlias", + "tag": "HashQualifier" + }, + "segment": "aTermAlias" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "1" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "aTermAlias", + "termAliasMe" + ] + } }, "tag": "Aliased" }, @@ -160,6 +1343,128 @@ "contents": { "fullName": "aTest", "hash": "#qak36j7cshv12m9meuc97ovllqm8k2i305sh4oq5dbo4834t7atugsdpto6mou1tch2b3q9j2hbi23gdf4jpth7m97mannv9noucgl8", + "rendered": { + "bestTermName": "aTest", + "defnTermTag": "Test", + "signature": [ + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "[" + }, + { + "annotation": { + "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0", + "tag": "TypeReference" + }, + "segment": "Result" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "]" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "aTest", + "tag": "HashQualifier" + }, + "segment": "aTest" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "[" + }, + { + "annotation": { + "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0", + "tag": "TypeReference" + }, + "segment": "Result" + }, + { + "annotation": { + "tag": "DelimiterChar" + }, + "segment": "]" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "aTest", + "tag": "HashQualifier" + }, + "segment": "aTest" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Sequence", + "tag": "TypeReference" + }, + "segment": "[" + }, + { + "annotation": { + "contents": "#aql7qk3iud6vs4cvu43aimopoosgk0fnipibdkc3so13adencmibgfn0u5c01r0adei55nkl3ttsjhl8gbj7tr4gnpj63g64ftbq6s0#d1", + "tag": "TermReference" + }, + "segment": "Ok" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"Done\"" + }, + { + "annotation": { + "contents": "##Sequence", + "tag": "TypeReference" + }, + "segment": "]" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "aTest" + ] + }, "shortName": "aTest" }, "tag": "Removed" @@ -171,6 +1476,79 @@ "contents": { "fullName": "newTerm", "hash": "#u1qsl3nk5t2svl58ifqepem851775qca9p4hc10j3iordu1v7u8e16oodui9kvt2c0j1cbc50avado53bl2vt3pphrfj9mhbut1ipm8", + "rendered": { + "bestTermName": "newTerm", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "newTerm", + "tag": "HashQualifier" + }, + "segment": "newTerm" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "newTerm", + "tag": "HashQualifier" + }, + "segment": "newTerm" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "100" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "newTerm" + ] + }, "shortName": "newTerm" }, "tag": "Added" @@ -185,7 +1563,80 @@ "newShortName": "renamedTerm", "oldNames": [ "termRenameMe" - ] + ], + "rendered": { + "bestTermName": "renamedTerm", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "renamedTerm", + "tag": "HashQualifier" + }, + "segment": "renamedTerm" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "renamedTerm", + "tag": "HashQualifier" + }, + "segment": "renamedTerm" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "3" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "renamedTerm" + ] + } }, "tag": "RenamedFrom" }, @@ -196,6 +1647,79 @@ "contents": { "fullName": "termDeleteMe", "hash": "#dcgdua2lj6upd1ah5v0qp09gjsej0d77d87fu6qn8e2qrssnlnmuinoio46hiu53magr7qn8vnqke8ndt0v76700o5u8gcvo7st28jg", + "rendered": { + "bestTermName": "termDeleteMe", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "termDeleteMe", + "tag": "HashQualifier" + }, + "segment": "termDeleteMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Nat", + "tag": "TypeReference" + }, + "segment": "Nat" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "termDeleteMe", + "tag": "HashQualifier" + }, + "segment": "termDeleteMe" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "NumericLiteral" + }, + "segment": "2" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "termDeleteMe" + ] + }, "shortName": "termDeleteMe" }, "tag": "Removed" @@ -205,6 +1729,234 @@ { "contents": { "contents": { + "diff": { + "diff": { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"original\"" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"updated\"" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff" + }, + "left": { + "bestTermName": "termUpdateMe", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"original\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "termUpdateMe" + ] + }, + "right": { + "bestTermName": "termUpdateMe", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "termUpdateMe", + "tag": "HashQualifier" + }, + "segment": "termUpdateMe" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"updated\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "termUpdateMe" + ] + } + }, "fullName": "termUpdateMe", "newHash": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", "newTag": "Plain", @@ -218,222 +1970,6 @@ } ], "children": [ - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "aliasFullName": "ATypeAlias.B", - "aliasShortName": "B", - "hash": "#bbsbe7lolqunqrftm9jeg299caa91r2mlviqic54toilse443ljup5eojm1et3lqv6ni5gsu9l9hpldptga3cp5e0qffhg36gv5u2jo#0", - "otherNames": [ - "DataAliasMe.B" - ] - }, - "tag": "Aliased" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "ATypeAlias" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "aliasFullName": "AbilityAlias.abilityAliasMe", - "aliasShortName": "abilityAliasMe", - "hash": "#qfgn5crplnhh308pepplqtleojiqhlpveimv0htug2mqbvhnia7qjfcravqlfb8ooos56jo5qq6brr99gg5kj0g5bgllvgn1nesv608#0", - "otherNames": [ - "AbilityAliasMe.abilityAliasMe" - ] - }, - "tag": "Aliased" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityAlias" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "AbilityDeleteMe.abilityDeleteMe", - "hash": "#val3i3ikhjc998qh1lfefhh08ad77f1eshera5d0hnbrp6qpgmfelbfa96pvsc18d5qd5qm7lij5el0raipb3mbjgalkh7g3aujej1o#0", - "shortName": "abilityDeleteMe" - }, - "tag": "Removed" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityDeleteMe" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "AbilityNew.abilityNew", - "hash": "#t66tvdfo0l4pqj6hgav05tqifbuld8dc22g4rom3olfqj7b6cfpvf15j7307j8m2fpdsvcgv4ourrltpjutgpu3bh08efu2jl2nfqq0#0", - "shortName": "abilityNew" - }, - "tag": "Added" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityNew" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "hash": "#iqmiiehu802p15ssntohl6l5kedd0j266rh7815s1t10rfe2bp207vh8ccngrlkii7i32h1n080dggr3r89osrq450kv6dj5uuc0o0o#0", - "newFullName": "AbilityRenamed.abilityRenameMe", - "newShortName": "abilityRenameMe", - "oldNames": [ - "AbilityRenameMe.abilityRenameMe" - ] - }, - "tag": "RenamedFrom" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityRenamed" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "AbilityUpdateMe.abilityUpdateMe", - "newHash": "#qat72tp0lb43gp5pra5rgobup5r24qrc494crqd5pqjddbneiqdn3hq6puo2344nja1v6cp7aps1p0350ug0f1kvo9cp2gu9l31in18#0", - "newTag": "AbilityConstructor", - "oldHash": "#0d5ej3mann48uffjea4epi8ss486689gsj46cscorhs3d4j7ohvj9t7ghg05tra792umcmgjr6lgqkskoo3odge7jm2ci91dlmpefcg#0", - "oldTag": "AbilityConstructor", - "shortName": "abilityUpdateMe" - }, - "tag": "Updated" - }, - "tag": "AbilityConstructor" - } - ], - "children": [] - }, - "path": "AbilityUpdateMe" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "DataDeleteMe.C", - "hash": "#keu02n8is0irijd65cvuos41kukj3f4ni18mmnudrbll2epo6ftd03nt9l0vqc4fvg98198tefgoupco4o0d0gvnigqgr1bmo2neo88#0", - "shortName": "C" - }, - "tag": "Removed" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "DataDeleteMe" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "DataUpdateMe.D", - "hash": "#fhc8jn2bhvfdnfr89dv2jf7tekuesna7gvje4ck6lfheh9rb184q4ddd29vm9mvfm6u1a98kpgditn8vb09durtel67rpof1c62535o#0", - "shortName": "D" - }, - "tag": "Removed" - }, - "tag": "DataConstructor" - }, - { - "contents": { - "contents": { - "fullName": "DataUpdateMe.D2", - "hash": "#qnblpurkqedrq0kae95ep7b8f6uh5b7igefp21r1nvl22agjoup5e7aunua4q8ku8mb532fh3lst4mj3m2bsb3kluchc3fuau5cllr0#0", - "shortName": "D2" - }, - "tag": "Added" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "DataUpdateMe" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "fullName": "NewType.X", - "hash": "#sa4ptibggqmbifhfj37gj2lq487q5ucfuojjcblfaas9bunlthhkvhstsrj20fvlpqakb8e9mqds4p32lnh8ohmf1s5omvdhc23jibg#0", - "shortName": "X" - }, - "tag": "Added" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "NewType" - }, - { - "contents": { - "changes": [ - { - "contents": { - "contents": { - "hash": "#8s3lsrv3p6ngq2bqotvli1f0gfcf9uvci4trmia6dosl3d8vu6i6kubdi3ic7m22r34m4mkru3hatdbgihj0fngmj7gktlq41ncs1e0#0", - "newFullName": "RenamedType.E", - "newShortName": "E", - "oldNames": [ - "DataRenameMe.E" - ] - }, - "tag": "RenamedFrom" - }, - "tag": "DataConstructor" - } - ], - "children": [] - }, - "path": "RenamedType" - }, { "contents": { "changes": [], @@ -446,6 +1982,79 @@ "contents": { "fullName": "a.definition.at.path1", "hash": "#r303avnmdmja3ch96otiglq37214t43acpr1ikq4hrp5hmcibstipa69frbd6177jvbn28ioc5ii80fc54ecogm4n64dhjvkonrihso", + "rendered": { + "bestTermName": "path1", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "a.definition.at.path1", + "tag": "HashQualifier" + }, + "segment": "a.definition.at.path1" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "a.definition.at.path1", + "tag": "HashQualifier" + }, + "segment": "a.definition.at.path1" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"definition at path\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "a.definition.at.path1" + ] + }, "shortName": "path1" }, "tag": "Removed" @@ -457,6 +2066,79 @@ "contents": { "fullName": "a.definition.at.path2", "hash": "#k43vb9rkd3n4i8g8bbfb31erufbmu6v1f99i587oqsje51thrm1ugdqa7gkjbdvkactuql3cmc00b7oev0glqb2rko48atkuo798mno", + "rendered": { + "bestTermName": "path2", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "a.definition.at.path2", + "tag": "HashQualifier" + }, + "segment": "a.definition.at.path2" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "a.definition.at.path2", + "tag": "HashQualifier" + }, + "segment": "a.definition.at.path2" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"definition at path2\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "a.definition.at.path2" + ] + }, "shortName": "path2" }, "tag": "Removed" @@ -476,6 +2158,79 @@ "contents": { "fullName": "a.different.path", "hash": "#83be375arg68mqk26bu12elka6fb6mvq6cec92un1p1t5kulhh6672qlnego952pp7h4lfl7mq3crithvtvo3col9mfc8vurbnb8hvo", + "rendered": { + "bestTermName": "path", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "a.different.path", + "tag": "HashQualifier" + }, + "segment": "a.different.path" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "TypeReference" + }, + "segment": "Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "a.different.path", + "tag": "HashQualifier" + }, + "segment": "a.different.path" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"definition at different path\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "a.different.path" + ] + }, "shortName": "path" }, "tag": "Removed" diff --git a/transcripts/share-apis/contributions/merged-contribution-diff.json b/transcripts/share-apis/contributions/merged-contribution-diff.json index d30db38f..34ba83b6 100644 --- a/transcripts/share-apis/contributions/merged-contribution-diff.json +++ b/transcripts/share-apis/contributions/merged-contribution-diff.json @@ -5,6 +5,234 @@ { "contents": { "contents": { + "diff": { + "diff": { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"start\"" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"feature-one\"" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff" + }, + "left": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"start\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "term" + ] + }, + "right": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"feature-one\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "term" + ] + } + }, "fullName": "term", "newHash": "#t8aquv2oldk8euc6uveu227hiv76tlic78h607s2nr47mruvocg1oq147b4jf8l850qj2jl37n37ohned32c4ag97mq22cvhl0sbbfo", "newTag": "Plain", diff --git a/transcripts/share-apis/contributions/transitive-contribution-diff.json b/transcripts/share-apis/contributions/transitive-contribution-diff.json index f4b61318..861ae60a 100644 --- a/transcripts/share-apis/contributions/transitive-contribution-diff.json +++ b/transcripts/share-apis/contributions/transitive-contribution-diff.json @@ -5,6 +5,234 @@ { "contents": { "contents": { + "diff": { + "diff": { + "diff": { + "contents": [ + { + "diffTag": "both", + "elements": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + } + ] + }, + { + "diffTag": "old", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"feature-one\"" + } + ] + }, + { + "diffTag": "new", + "elements": [ + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"feature-two\"" + } + ] + } + ], + "tag": "UserObject" + }, + "diffKind": "diff" + }, + "left": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"feature-one\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "term" + ] + }, + "right": { + "bestTermName": "term", + "defnTermTag": "Plain", + "signature": [ + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + } + ], + "termDefinition": { + "contents": [ + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "TypeAscriptionColon" + }, + "segment": " :" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "contents": "##Text", + "tag": "HashQualifier" + }, + "segment": "##Text" + }, + { + "annotation": null, + "segment": "\n" + }, + { + "annotation": { + "contents": "term", + "tag": "HashQualifier" + }, + "segment": "term" + }, + { + "annotation": { + "tag": "BindingEquals" + }, + "segment": " =" + }, + { + "annotation": null, + "segment": " " + }, + { + "annotation": { + "tag": "TextLiteral" + }, + "segment": "\"feature-two\"" + } + ], + "tag": "UserObject" + }, + "termDocs": [], + "termNames": [ + "term" + ] + } + }, "fullName": "term", "newHash": "#918iukm79ii0jll0m3qtsrcqjp1sqe5rdpf1kochqp52a52s9ciil7mu6m3t4l39pdk60imhj5be1d9rat2lgdmr6u0jn93v7v8o6rg", "newTag": "Plain", diff --git a/unison b/unison index 55422825..40eac6a1 160000 --- a/unison +++ b/unison @@ -1 +1 @@ -Subproject commit 554228252b1bd1b29d7e28443b455b4340a41faf +Subproject commit 40eac6a121a5edb8e083523b769aa656df0fa54e