diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml index c2ebd010..0e36807b 100644 --- a/.github/workflows/ci.yaml +++ b/.github/workflows/ci.yaml @@ -238,7 +238,7 @@ jobs: # Install ucm mkdir ucm - curl -L https://github.com/unisonweb/unison/releases/download/release%2F0.5.44/ucm-linux-x64.tar.gz | tar -xz -C ucm + curl -L https://github.com/unisonweb/unison/releases/download/release%2F0.5.45/ucm-linux-x64.tar.gz | tar -xz -C ucm export PATH=$PWD/ucm:$PATH # Start share and it's dependencies in the background diff --git a/src/Share/Backend.hs b/src/Share/Backend.hs index 9a85a80a..61616932 100644 --- a/src/Share/Backend.hs +++ b/src/Share/Backend.hs @@ -41,7 +41,7 @@ import Data.Map qualified as Map import Data.Set qualified as Set import Share.Codebase qualified as Codebase import Share.Codebase.CodeCache qualified as CC -import Share.Codebase.Types (CodebaseRuntime (CodebaseRuntime, cachedEvalResult)) +import Share.Codebase.Types (CodeCache, CodebaseRuntime (CodebaseRuntime, cachedEvalResult)) import Share.Postgres (QueryM) import Share.Postgres qualified as PG import Share.Postgres.Causal.Conversions (namespaceStatsPgToV2) @@ -69,7 +69,7 @@ import Unison.NameSegment.Internal (NameSegment (..)) import Unison.Parser.Ann (Ann) import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.Reference (Reference) +import Unison.Reference (Reference, TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent import Unison.Runtime.IOSource qualified as DD @@ -248,8 +248,13 @@ getTypeTagsOf trav s = do Just CT.Data -> Data Just CT.Effect -> Ability -displayTermsOf :: (QueryM m) => Codebase.CodebaseEnv -> Traversal s t Reference (DisplayObject (Type Symbol Ann) (V1.Term Symbol Ann)) -> s -> m t -displayTermsOf codebase trav s = +displayTermsOf :: + (QueryM m) => + CodeCache scope -> + Traversal s t TermReference (DisplayObject (Type Symbol Ann) (V1.Term Symbol Ann)) -> + s -> + m t +displayTermsOf codeCache trav s = s & asListOfDeduped trav %%~ \refs -> do let partitionedRefs = @@ -261,7 +266,7 @@ displayTermsOf codebase trav s = Nothing -> Left $ MissingObject $ Reference.toShortHash ref Just typ -> Left $ BuiltinObject (mempty <$ typ) Reference.DerivedId rid -> Right rid - r <- Codebase.expectTermsByRefIdsOf codebase (traversed . _Right) partitionedRefs + r <- CC.expectTermsAndTypesByRefIdsOf codeCache (traversed . _Right) partitionedRefs r & traversed %~ \case @@ -272,15 +277,15 @@ displayTermsOf codebase trav s = Left obj -> obj & pure -displayTypesOf :: (QueryM m) => Codebase.CodebaseEnv -> Traversal s t Reference (DisplayObject () (DD.Decl Symbol Ann)) -> s -> m t -displayTypesOf codebase trav s = +displayTypesOf :: (QueryM m) => CodeCache scope -> Traversal s t TypeReference (DisplayObject () (DD.Decl Symbol Ann)) -> s -> m t +displayTypesOf codeCache trav s = s & asListOf trav %%~ \refs -> do let partitionedRefs = refs <&> \case Reference.Builtin _ -> Left (BuiltinObject ()) Reference.DerivedId rid -> Right rid - Codebase.expectTypeDeclarationsByRefIdsOf codebase (traversed . _Right) partitionedRefs + CC.expectTypeDeclsByRefIdsOf codeCache (traversed . _Right) partitionedRefs <&> fmap \case Left obj -> obj Right decl -> (UserObject decl) diff --git a/src/Share/BackgroundJobs/Search/DefinitionSync.hs b/src/Share/BackgroundJobs/Search/DefinitionSync.hs index c92badeb..da52e5fb 100644 --- a/src/Share/BackgroundJobs/Search/DefinitionSync.hs +++ b/src/Share/BackgroundJobs/Search/DefinitionSync.hs @@ -22,6 +22,8 @@ import Share.BackgroundJobs.Monad (Background) import Share.BackgroundJobs.Search.DefinitionSync.Types (Arity (..), DefinitionDocument (..), DefnSearchToken (..), Occurrence, OccurrenceKind (..), TermOrTypeSummary (..), TermOrTypeTag (..), VarId (..)) import Share.BackgroundJobs.Workers (newWorker) import Share.Codebase qualified as Codebase +import Share.Codebase.CodeCache qualified as CodeCache +import Share.Codebase.Types (CodeCache) import Share.IDs (ReleaseId, UserId) import Share.Metrics qualified as Metrics import Share.Postgres qualified as PG @@ -165,12 +167,13 @@ syncRoot authZReceipt (mayReleaseId, rootBranchHashId, codebaseOwner) = do let nlReceipt = nameLookupReceipt namesPerspective let codebaseLoc = Codebase.codebaseLocationForProjectRelease codebaseOwner let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc - termsCursor <- NLOps.projectTermsWithinRoot nlReceipt rootBranchHashId + CodeCache.withCodeCache codebase \codeCache -> do + termsCursor <- NLOps.projectTermsWithinRoot nlReceipt rootBranchHashId - termErrs <- syncTerms codebase namesPerspective rootBranchHashId termsCursor - typesCursor <- NLOps.projectTypesWithinRoot nlReceipt rootBranchHashId - typeErrs <- syncTypes codebase namesPerspective rootBranchHashId typesCursor - pure (termErrs <> typeErrs) + termErrs <- syncTerms codebase namesPerspective rootBranchHashId termsCursor + typesCursor <- NLOps.projectTypesWithinRoot nlReceipt rootBranchHashId + typeErrs <- syncTypes codebase codeCache namesPerspective rootBranchHashId typesCursor + pure (termErrs <> typeErrs) True -> pure mempty -- Copy relevant index rows into the global search index as well for mayReleaseId (syncRelease rootBranchHashId) @@ -377,11 +380,12 @@ typeSigTokens typ = syncTypes :: (PG.QueryM m) => Codebase.CodebaseEnv -> + CodeCache scope -> NamesPerspective m -> BranchHashId -> Cursors.PGCursor (Name, TypeReference) -> m ([DefnIndexingFailure], [Text]) -syncTypes codebase namesPerspective rootBranchHashId typesCursor = do +syncTypes codebase codeCache namesPerspective rootBranchHashId typesCursor = do Cursors.foldBatched typesCursor defnBatchSize \types -> do let nonLibTypes = types @@ -408,7 +412,7 @@ syncTypes codebase namesPerspective rootBranchHashId typesCursor = do <&> V.unzip3 let basicTokens = Data.zipWith2 fqns refs \fqn ref -> Set.fromList [NameToken fqn, HashToken $ Reference.toShortHash ref] let allTokens = Data.zipWith2 declTokens basicTokens Set.union - typeSummaries <- Summary.typeSummariesForReferencesOf codebase Nothing traversed (Data.zip2 refs (Just <$> fqns)) + typeSummaries <- Summary.typeSummariesForReferencesOf codeCache Nothing traversed (Data.zip2 refs (Just <$> fqns)) let defDocuments = Data.zipWith5 refs fqns typeSummaries allTokens arities $ \ref fqn typeSummary tokens arity -> let sh = Reference.toShortHash ref in DefinitionDocument diff --git a/src/Share/Codebase.hs b/src/Share/Codebase.hs index e4d4b6a1..070fb071 100644 --- a/src/Share/Codebase.hs +++ b/src/Share/Codebase.hs @@ -7,6 +7,7 @@ module Share.Codebase ( shorthashLength, CodebaseEnv, codebaseOwner, + CodebaseError (..), CodebaseRuntime (..), codebaseEnv, codebaseForProjectBranch, diff --git a/src/Share/Codebase/CodeCache.hs b/src/Share/Codebase/CodeCache.hs index 0d9a9b2e..68862ecb 100644 --- a/src/Share/Codebase/CodeCache.hs +++ b/src/Share/Codebase/CodeCache.hs @@ -6,7 +6,9 @@ module Share.Codebase.CodeCache termsForRefsOf, typesOfReferentsOf, getTermsAndTypesByRefIdsOf, + expectTermsAndTypesByRefIdsOf, getTypeDeclsByRefIdsOf, + expectTypeDeclsByRefIdsOf, getTypeDeclsByRefsOf, cacheTermAndTypes, cacheDecls, @@ -34,6 +36,7 @@ import Unison.DataDeclaration qualified as V1 import Unison.DataDeclaration.ConstructorId qualified as V1Decl import Unison.Hash (Hash) import Unison.Parser.Ann +import Unison.Reference (TermReferenceId, TypeReferenceId) import Unison.Reference qualified as Reference import Unison.Referent qualified as V1Referent import Unison.Runtime.IOSource qualified as IOSource @@ -43,6 +46,9 @@ import Unison.Term qualified as V1 import Unison.Type qualified as Type import Unison.Type qualified as V1 +type TermAndType = + (V1.Term Symbol Ann, V1.Type Symbol Ann) + withCodeCache :: (QueryM m) => CodebaseEnv -> (forall s. CodeCache s -> m r) -> m r withCodeCache codeCacheCodebaseEnv action = do codeCacheVar <- PG.transactionUnsafeIO (newTVarIO (CodeCacheData Map.empty Map.empty)) @@ -52,30 +58,24 @@ withCodeCache codeCacheCodebaseEnv action = do readCodeCache :: (QueryM m) => CodeCache s -> m CodeCacheData readCodeCache CodeCache {codeCacheVar} = PG.transactionUnsafeIO (readTVarIO codeCacheVar) -cacheTermAndTypes :: - (QueryM m) => - CodeCache s -> - [(Reference.Id, (V1.Term Symbol Ann, V1.Type Symbol Ann))] -> - m () +cacheTermAndTypes :: (QueryM m) => CodeCache s -> Map TermReferenceId TermAndType -> m () cacheTermAndTypes CodeCache {codeCacheVar} termAndTypes = do PG.transactionUnsafeIO do atomically do modifyTVar' codeCacheVar \CodeCacheData {termCache, ..} -> - let newTermMap = Map.fromList termAndTypes - termCache' = Map.union termCache newTermMap + let !termCache' = Map.union termCache termAndTypes in CodeCacheData {termCache = termCache', ..} cacheDecls :: (QueryM m) => CodeCache s -> - [(Reference.Id, V1.Decl Symbol Ann)] -> + Map TypeReferenceId (V1.Decl Symbol Ann) -> m () cacheDecls CodeCache {codeCacheVar} decls = do PG.transactionUnsafeIO do atomically do modifyTVar' codeCacheVar \CodeCacheData {typeCache, ..} -> - let newDeclsMap = Map.fromList decls - typeCache' = Map.union typeCache newDeclsMap + let !typeCache' = Map.union typeCache decls in CodeCacheData {typeCache = typeCache', ..} builtinsCodeLookup :: (Monad m) => CL.CodeLookup Symbol m Ann @@ -97,7 +97,7 @@ toCodeLookup codeCache = do getTermsAndTypesByRefIdsOf :: (QueryM m) => CodeCache scope -> - Traversal s t Reference.Id (Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann)) -> + Traversal s t TermReferenceId (Maybe TermAndType) -> s -> m t getTermsAndTypesByRefIdsOf codeCache@(CodeCache {codeCacheCodebaseEnv}) trav s = do @@ -123,19 +123,34 @@ getTermsAndTypesByRefIdsOf codeCache@(CodeCache {codeCacheCodebaseEnv}) trav s = Nothing -> (mempty, Nothing) Right tt -> (mempty, Just tt) - cacheTermAndTypes codeCache cacheable - pure $ hydrated' - where - findBuiltinTT :: Reference.Id -> Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann) - findBuiltinTT refId = do - tm <- runIdentity $ CL.getTerm builtinsCodeLookup refId - typ <- runIdentity $ CL.getTypeOfTerm builtinsCodeLookup refId - pure (tm, typ) + cacheTermAndTypes codeCache (Map.fromList cacheable) + pure hydrated' + +-- | Like 'getTermsAndTypesByRefIdsOf', but throws an unrecoverable error when the term isn't in the database. +expectTermsAndTypesByRefIdsOf :: + forall m scope s t. + (QueryM m) => + CodeCache scope -> + Traversal s t TermReferenceId TermAndType -> + s -> + m t +expectTermsAndTypesByRefIdsOf codeCache trav = + asListOf trav %%~ \refs -> do + termsAndTypes <- getTermsAndTypesByRefIdsOf codeCache traverse refs + for (zip refs termsAndTypes) \case + (_, Just tt) -> pure tt + (ref, Nothing) -> PG.unrecoverableError (Codebase.MissingTerm ref) + +findBuiltinTT :: TermReferenceId -> Maybe TermAndType +findBuiltinTT refId = do + tm <- runIdentity $ CL.getTerm builtinsCodeLookup refId + typ <- runIdentity $ CL.getTypeOfTerm builtinsCodeLookup refId + pure (tm, typ) getTypeDeclsByRefIdsOf :: (QueryM m) => CodeCache scope -> - Traversal s t Reference.Id (Maybe (V1.Decl Symbol Ann)) -> + Traversal s t TypeReferenceId (Maybe (V1.Decl Symbol Ann)) -> s -> m t getTypeDeclsByRefIdsOf codeCache@(CodeCache {codeCacheCodebaseEnv}) trav s = do @@ -161,12 +176,25 @@ getTypeDeclsByRefIdsOf codeCache@(CodeCache {codeCacheCodebaseEnv}) trav s = do Nothing -> (mempty, Nothing) Right decl -> (mempty, Just decl) - cacheDecls codeCache cacheable - pure $ hydrated' - where - findBuiltinDecl :: Reference.Id -> Maybe (V1.Decl Symbol Ann) - findBuiltinDecl refId = do - runIdentity $ CL.getTypeDeclaration builtinsCodeLookup refId + cacheDecls codeCache (Map.fromList cacheable) + pure hydrated' + +expectTypeDeclsByRefIdsOf :: + (QueryM m) => + CodeCache scope -> + Traversal s t TypeReferenceId (V1.Decl Symbol Ann) -> + s -> + m t +expectTypeDeclsByRefIdsOf codeCache trav = + asListOf trav %%~ \refs -> do + decls <- getTypeDeclsByRefIdsOf codeCache traverse refs + for (zip refs decls) \case + (_, Just decl) -> pure decl + (ref, Nothing) -> PG.unrecoverableError (Codebase.MissingDecl ref) + +findBuiltinDecl :: Reference.Id -> Maybe (V1.Decl Symbol Ann) +findBuiltinDecl refId = do + runIdentity $ CL.getTypeDeclaration builtinsCodeLookup refId getTypeDeclsByRefsOf :: (QueryM m) => @@ -196,7 +224,7 @@ termsForRefsOf codeCache trav s = do s & asListOf trav %%~ \refs -> do - let trav :: Traversal Reference (Maybe (V1.Term Symbol ())) Reference.Id (Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann)) + let trav :: Traversal Reference (Maybe (V1.Term Symbol ())) Reference.Id (Maybe TermAndType) trav f = \case -- Builtins are their own terms ref@(Reference.Builtin _) -> pure (Just (Term.ref () ref)) @@ -241,7 +269,7 @@ typesOfReferentsOf codeCache trav s = do [ Either (V1.Type Symbol ()) ( Either - (Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann)) + (Maybe TermAndType) (Reference.Id' Hash, V1Decl.ConstructorId) ) ] <- @@ -250,7 +278,7 @@ typesOfReferentsOf codeCache trav s = do [ Either (V1.Type Symbol ()) ( Either - (Maybe (V1.Term Symbol Ann, V1.Type Symbol Ann)) + (Maybe TermAndType) (Maybe (V1.Decl Symbol Ann), V1Decl.ConstructorId) ) ] <- diff --git a/src/Share/Codebase/Types.hs b/src/Share/Codebase/Types.hs index 5a82c666..ab51a63d 100644 --- a/src/Share/Codebase/Types.hs +++ b/src/Share/Codebase/Types.hs @@ -21,6 +21,7 @@ import Unison.Codebase.Runtime qualified as Rt import Unison.DataDeclaration qualified as V1 import Unison.NameSegment.Internal (NameSegment (..)) import Unison.Parser.Ann (Ann) +import Unison.Reference (TermReferenceId, TypeReferenceId) import Unison.Reference qualified as Reference import Unison.Symbol (Symbol) import Unison.Term qualified as V1 @@ -31,9 +32,12 @@ publicRoot :: Path.Path publicRoot = Path.singleton (NameSegment "public") -- | The scope of a given codebase transaction. +-- +-- If two @CodebaseEnv@ are equal, they correspond to the same codebase. data CodebaseEnv = CodebaseEnv { codebaseOwner :: UserId } + deriving stock (Eq) data CodeCache scope = CodeCache { codeCacheCodebaseEnv :: CodebaseEnv, @@ -41,8 +45,8 @@ data CodeCache scope = CodeCache } data CodeCacheData = CodeCacheData - { termCache :: Map Reference.Id (V1.Term Symbol Ann, V1.Type Symbol Ann), - typeCache :: Map Reference.Id (V1.Decl Symbol Ann) + { termCache :: Map TermReferenceId (V1.Term Symbol Ann, V1.Type Symbol Ann), + typeCache :: Map TypeReferenceId (V1.Decl Symbol Ann) } -- | The runtime environment for a codebase transaction. diff --git a/src/Share/NamespaceDiffs.hs b/src/Share/NamespaceDiffs.hs index 519444e2..d5e4dc17 100644 --- a/src/Share/NamespaceDiffs.hs +++ b/src/Share/NamespaceDiffs.hs @@ -13,19 +13,24 @@ module Share.NamespaceDiffs DefinitionDiff (..), DefinitionDiffKind (..), computeThreeWayNamespaceDiff, + makeNamespaceDiffTree, compressNameTree, namespaceTreeDiffReferences_, namespaceTreeDiffReferents_, namespaceTreeDiffTermDiffs_, + mapMaybeNamespaceTreeDiffTermDiffs, witherNamespaceTreeDiffTermDiffs, namespaceTreeDiffTypeDiffs_, namespaceTreeDiffRenderedTerms_, namespaceTreeDiffRenderedTypes_, namespaceTreeTermDiffKinds_, + mapMaybeNamespaceTreeTermDiffKinds, witherNamespaceTreeTermDiffKinds, namespaceTreeTypeDiffKinds_, namespaceAndLibdepsDiffDefns_, namespaceAndLibdepsDiffLibdeps_, + definitionDiffKindRendered_, + definitionDiffKindRenderedOldNew_, ) where @@ -40,6 +45,8 @@ import Data.Map qualified as Map import Data.Set qualified as Set import Data.Set.NonEmpty qualified as NESet import Share.Codebase qualified as Codebase +import Share.Codebase.CodeCache qualified as CodeCache +import Share.Codebase.Types (CodeCache) import Share.Names.Postgres qualified as PGNames import Share.NamespaceDiffs.Types import Share.Postgres qualified as PG @@ -49,19 +56,20 @@ import Share.Postgres.NameLookups.Ops qualified as NL import Share.Postgres.NameLookups.Types (NameLookupReceipt) import Share.Postgres.NameLookups.Types qualified as NL import Share.Postgres.NamesPerspective.Ops qualified as NPOps -import Share.Postgres.NamesPerspective.Types (NamesPerspective) import Share.Prelude -import Share.Utils.Lens (asListOfDeduped) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.DataDeclaration (Decl) +import Unison.DeclCoherencyCheck (checkDeclCoherency, lenientCheckDeclCoherency) import Unison.LabeledDependency (LabeledDependency) -import Unison.Merge (Mergeblob0, Mergeblob1, ThreeWay (..), TwoOrThreeWay (..), TwoWay (..)) import Unison.Merge qualified as Merge -import Unison.Merge.HumanDiffOp (HumanDiffOp (..)) -import Unison.Merge.Mergeblob1 qualified as Mergeblob1 +import Unison.Merge.EitherWay qualified as EitherWay +import Unison.Merge.Synhashed (Synhashed) import Unison.Merge.ThreeWay qualified as ThreeWay +import Unison.Merge.TwoOrThreeWay qualified as TwoOrThreeWay +import Unison.Merge.TwoWay qualified as TwoWay +import Unison.Merge.Updated qualified as Updated import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment (NameSegment (..)) @@ -69,18 +77,18 @@ import Unison.NameSegment qualified as NameSegment import Unison.Names (Names) import Unison.Names qualified as Names import Unison.Parser.Ann (Ann) -import Unison.Reference (Reference, TermReferenceId, TypeReference, TypeReferenceId) +import Unison.Reference (TermReferenceId, TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference import Unison.Referent (Referent) -import Unison.Referent qualified as Referent import Unison.Symbol (Symbol) import Unison.Syntax.NameSegment qualified as NameSegment import Unison.Term (Term) import Unison.Type (Type) +import Unison.UnconflictedLocalDefnsView qualified as UnconflictedLocalDefnsView import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, DefnsF3, alignDefnsWith) -import Unison.Util.Nametree (Nametree (..)) +import Unison.Util.Defns qualified as Defns -- | Convert a `DefinitionDiffs` into a tree of differences. definitionDiffsToTree :: @@ -88,11 +96,10 @@ definitionDiffsToTree :: (Ord ref) => DefinitionDiffs Name ref -> GNamespaceTreeOf NameSegment (Set (DefinitionDiff ref Name Name)) -definitionDiffsToTree dd = - let DefinitionDiffs {added, removed, updated, propagated, renamed, newAliases} = dd - expandedAliases :: Map Name (Set (DefinitionDiffKind ref Name Name)) +definitionDiffsToTree diff = + let expandedAliases :: Map Name (Set (DefinitionDiffKind ref Name Name)) expandedAliases = - newAliases + diff.newAliases & Map.toList & foldMap ( \(r, (existingNames, newNames)) -> @@ -103,7 +110,7 @@ definitionDiffsToTree dd = & Map.unionsWith (<>) expandedRenames :: Map Name (Set (DefinitionDiffKind ref Name Name)) expandedRenames = - renamed + diff.renamed & Map.toList & foldMap \(r, (oldNames, newNames)) -> ( -- We don't currently want to track the old names in a rename, and including them messes up @@ -120,12 +127,11 @@ definitionDiffsToTree dd = diffTree :: Map Name (Set (DefinitionDiffKind ref Name Name)) diffTree = Map.unionsWith - (<>) - [ (added & Map.mapWithKey \n r -> Set.singleton $ Added r n), + Set.union + [ (diff.added & Map.mapWithKey \n r -> Set.singleton $ Added r n), expandedAliases, - (removed & Map.mapWithKey \n r -> Set.singleton $ Removed r n), - (updated & Map.mapWithKey \name (oldR, newR) -> Set.singleton $ Updated oldR newR name), - (propagated & Map.mapWithKey \name (oldR, newR) -> Set.singleton $ Propagated oldR newR name), + (diff.removed & Map.mapWithKey \n r -> Set.singleton $ Removed r n), + (diff.updated & Map.mapWithKey \name (oldR, newR) -> Set.singleton $ Updated oldR newR name), expandedRenames ] includeFQNs :: Map Name (Set (DefinitionDiffKind ref Name Name)) -> Map Name (Set (DefinitionDiff ref Name Name)) @@ -210,178 +216,198 @@ compressNameTree (diffs Cofree.:< children) = in diffs Cofree.:< compressedChildren computeThreeWayNamespaceDiff :: - TwoWay Codebase.CodebaseEnv -> - TwoOrThreeWay BranchHashId -> - TwoOrThreeWay NameLookupReceipt -> - PG.Transaction NamespaceDiffError (GNamespaceAndLibdepsDiff NameSegment Referent Reference Name Name Name Name BranchHashId) -computeThreeWayNamespaceDiff codebaseEnvs2 branchHashIds3 nameLookupReceipts3 = PG.transactionSpan "computeThreeWayNamespaceDiff" mempty $ do - -- Load a flat definitions names (no lib) for Alice/Bob/LCA - defnsNames3 :: TwoOrThreeWay Names <- - sequence (NL.projectNamesWithoutLib <$> nameLookupReceipts3 <*> branchHashIds3) + Merge.TwoWay Codebase.CodebaseEnv -> + CodeCache alice -> + CodeCache bob -> + Merge.TwoOrThreeWay BranchHashId -> + Merge.TwoOrThreeWay NameLookupReceipt -> + PG.Transaction NamespaceDiffError (Merge.Diffblob BranchHashId) +computeThreeWayNamespaceDiff codebaseEnvs2 aliceCodeCache bobCodeCache branchHashIds nameLookupReceipts = PG.transactionSpan "computeThreeWayNamespaceDiff" mempty do + -- Load the shallow libdeps for Alice/Bob/LCA. This can fail with "lib at unexpected path" + libdeps :: Merge.ThreeWay (Map NameSegment BranchHashId) <- do + PG.transactionSpan "load libdeps" mempty do + let f :: NameLookupReceipt -> BranchHashId -> PG.Transaction NamespaceDiffError (Map NameSegment BranchHashId) + f nameLookupReceipt branchHashId = do + mounts <- NL.listNameLookupMounts nameLookupReceipt branchHashId + libDepsList <- + for mounts \(NL.PathSegments path, libBhId) -> do + case NameSegment.unsafeParseText <$> path of + [NameSegment.LibSegment, dep] -> pure (dep, libBhId) + p -> throwError $ LibFoundAtUnexpectedPath (Path.fromList p) + pure $ Map.fromList libDepsList + TwoOrThreeWay.toThreeWay Map.empty <$> sequence (f <$> nameLookupReceipts <*> branchHashIds) - -- Unflatten each Names to a Nametree (leniently). Really, only the LCA is "allowed" to break the diff/merge rules of - -- no conflicted names, but we don't enforce that here. If Alice or Bob have a conflicted name for some reason, we'll - -- just silently pick one of the refs and move on. - let defnsNametrees3 :: TwoOrThreeWay (Nametree (DefnsF (Map NameSegment) Referent TypeReference)) - defnsNametrees3 = - Names.lenientToNametree <$> defnsNames3 + -- Load all local definition names (outside lib) for Alice/Bob/LCA. + -- + -- FIXME In a normal diff+merge, we require that the local names are unconflicted: each name may only refer to one + -- thing. However, we currently don't represent that in the `NamespaceDiffError` type. We should, but for now, we + -- instead just ignore conflicted names, if they exist. + defnsList <- + PG.transactionSpan "load definitions names" mempty do + sequence (NL.projectNamesWithoutLib <$> nameLookupReceipts <*> branchHashIds) + let defns = + let f = foldr (uncurry Map.insert) Map.empty + in TwoOrThreeWay.toThreeWay + UnconflictedLocalDefnsView.empty + (UnconflictedLocalDefnsView.fromDefns . bimap f f <$> defnsList) - -- Load the shallow libdeps for Alice/Bob/LCA. This can fail with "lib at unexpected path" - libdeps3 :: TwoOrThreeWay (Map NameSegment BranchHashId) <- do - let f :: NameLookupReceipt -> BranchHashId -> PG.Transaction NamespaceDiffError (Map NameSegment BranchHashId) - f nameLookupReceipt branchHashId = do - mounts <- NL.listNameLookupMounts nameLookupReceipt branchHashId - libDepsList <- - for mounts \(NL.PathSegments path, libBhId) -> do - case NameSegment.unsafeParseText <$> path of - [NameSegment.LibSegment, dep] -> pure (dep, libBhId) - p -> throwError $ LibFoundAtUnexpectedPath (Path.fromList p) - pure $ Map.fromList libDepsList - sequence (f <$> nameLookupReceipts3 <*> branchHashIds3) + -- Load decl name lookups for Alice/Bob/LCA. This can fail with "incoherent decl". + declNameLookups <- do + numConstructors <- + PG.transactionSpan "load constructor counts" mempty do + TwoOrThreeWay.toThreeWay Map.empty + <$> sequence (NL.projectConstructorCountsWithoutLib <$> nameLookupReceipts <*> branchHashIds) + declNameLookups <- + PG.transactionSpan "check decl coherency" mempty do + sequence $ + ( \v c e -> + checkDeclCoherency v.nametree c + & mapLeft (IncoherentDecl . e) + & liftEither + ) + <$> ThreeWay.forgetLca defns + <*> ThreeWay.forgetLca numConstructors + <*> Merge.TwoWay EitherWay.Alice EitherWay.Bob + let lcaDeclNameLookup = + lenientCheckDeclCoherency defns.lca.nametree numConstructors.lca + pure (TwoWay.gtoThreeWay lcaDeclNameLookup declNameLookups) - -- Make that 0th mergeblob - let blob0 :: Mergeblob0 BranchHashId - blob0 = - Merge.makeMergeblob0 - ThreeWay - { alice = defnsNametrees3.alice, - bob = defnsNametrees3.bob, - lca = fromMaybe Nametree {value = Defns Map.empty Map.empty, children = Map.empty} defnsNametrees3.lca - } - ThreeWay - { alice = libdeps3.alice, - bob = libdeps3.bob, - lca = fromMaybe Map.empty libdeps3.lca - } + let hydrate :: + Merge.ThreeWay (DefnsF Set TermReferenceId TypeReferenceId) -> + PG.Transaction + e + ( Defns + (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)) + (Map TypeReferenceId (Decl Symbol Ann)) + ) + hydrate Merge.ThreeWay {lca = lcaDefns, alice = aliceDefns, bob = bobDefns} = do + -- We assume LCA and Alice come from the same codebase, so hydrate them together. + let lcaAndAliceDefns = lcaDefns <> aliceDefns + lcaAndAliceHydratedDefns <- hydrateDefns "hydrate alice & lca definitions" codebaseEnvs2.alice aliceCodeCache lcaAndAliceDefns - -- Hydrate defns in Alice/Bob/LCA - hydratedDefns3 :: - ThreeWay - ( DefnsF - (Map Name) - (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) - (TypeReferenceId, Decl Symbol Ann) - ) <- PG.transactionSpan "hydratedDefns3" mempty do - let hydrateTermsOf :: - Codebase.CodebaseEnv -> - Traversal s t TermReferenceId (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) -> - s -> - PG.Transaction e t - hydrateTermsOf codebase trav s = PG.transactionSpan "hydrateTerms" mempty do - s - & asListOfDeduped trav %%~ \refs -> do - v2Terms <- DefnsQ.expectTermsByRefIdsOf codebase traversed refs - let v2TermsWithRef = zip refs v2Terms - let refHashes = v2TermsWithRef <&> \(refId, (term, typ)) -> (refId, ((Reference.idToHash refId), term, typ)) - Codebase.convertTerms2to1Of (traversed . _2) refHashes - hydrateTypesOf :: - Codebase.CodebaseEnv -> - Traversal s t TypeReferenceId (TypeReferenceId, Decl Symbol Ann) -> - s -> - PG.Transaction e t - hydrateTypesOf codebase trav s = PG.transactionSpan "hydrateTypes" mempty do - s - & asListOf trav %%~ \typeReferenceIds -> do - typeIdsWithComponents <- zip typeReferenceIds <$> DefnsQ.expectTypeComponentElementsAndTypeIdsOf codebase traversed typeReferenceIds - DefnsQ.loadDeclByTypeComponentElementAndTypeIdsOf (traversed . _2) typeIdsWithComponents - <&> fmap \(refId, v2Decl) -> - let v1Decl = Cv.decl2to1 (Reference.idToHash refId) v2Decl - in (refId, v1Decl) - hydrateDefns :: - Codebase.CodebaseEnv -> - Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> - PG.Transaction - e - ( DefnsF - (Map Name) - (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) - (TypeReferenceId, Decl Symbol Ann) - ) - hydrateDefns codebase (Defns {terms, types}) = PG.transactionSpan "hydrateDefns" mempty do - let termReferenceIds = Map.mapMaybe Referent.toTermReferenceId (BiMultimap.range terms) - hydratedTerms <- hydrateTermsOf codebase traversed termReferenceIds - let typeReferenceIds = Map.mapMaybe Reference.toId (BiMultimap.range types) - hydratedTypes <- hydrateTypesOf codebase traversed typeReferenceIds - pure - Defns - { terms = hydratedTerms, - types = hydratedTypes - } + -- Only bother hydrating Bob defns that we haven't already found in Alice's codebase. + let bobDefnsNotInAlice = Defns.zipDefnsWith Set.difference Set.difference bobDefns lcaAndAliceDefns + bobHydratedDefns <- hydrateDefns "hydrate bob definitions" codebaseEnvs2.bob bobCodeCache bobDefnsNotInAlice - let -- Here we assume that the LCA is in the same codebase as Alice. - codebaseEnvs3 :: ThreeWay Codebase.CodebaseEnv - codebaseEnvs3 = - ThreeWay - { alice = codebaseEnvs2.alice, - bob = codebaseEnvs2.bob, - lca = codebaseEnvs2.alice - } - sequence (hydrateDefns <$> codebaseEnvs3 <*> blob0.defns) + pure (lcaAndAliceHydratedDefns <> bobHydratedDefns) - -- Get a names object that contains just enough names to compute the diff: - names3 :: TwoOrThreeWay Names <- do - -- Massage the hydrated definitions into a set of "labeled dependency" that contains the definitions themselves - -- and their direct references. - -- - -- FIXME: Mitchell wonders why self is necessary. Aren't direct dependency names enough? - let labeledDeps3 :: ThreeWay (Set LabeledDependency) - labeledDeps3 = - Mergeblob1.hydratedDefnsLabeledDependencies <$> hydratedDefns3 - -- Get a names perspective for Alice/Bob/LCA - namesPerspectives3 :: TwoOrThreeWay (NamesPerspective m) <- - for branchHashIds3 \branchHashId -> NPOps.namesPerspectiveForRoot branchHashId - sequence (PGNames.namesForReferences <$> namesPerspectives3 <*> ThreeWay.toTwoOrThreeWay labeledDeps3) + let loadNames :: Merge.ThreeWay (Set LabeledDependency) -> PG.Transaction NamespaceDiffError (Merge.ThreeWay Names) + loadNames dependencies = do + perspectives <- + PG.transactionSpan "load names perspectives" mempty do + traverse NPOps.namesPerspectiveForRoot branchHashIds + names <- + PG.transactionSpan "load names" mempty do + sequence (PGNames.namesForReferences <$> perspectives <*> ThreeWay.toTwoOrThreeWay dependencies) + pure (TwoOrThreeWay.toThreeWay Names.empty names) - blob1 :: Mergeblob1 BranchHashId <- do - let names3' = ThreeWay {alice = names3.alice, bob = names3.bob, lca = fromMaybe (mempty @Names) names3.lca} - case Merge.makeMergeblob1 blob0 names3' hydratedDefns3 of - Right blob -> pure blob - Left err -> throwError (IncoherentDecl err) + Merge.makeDiffblob + Merge.DiffblobLog + { logDefns = \_ -> pure (), + logDiff = \_ -> pure (), + logDiffsFromLCA = \_ -> pure (), + logNarrowedDefns = \_ -> pure (), + logSynhashedNarrowedDefns = \_ -> pure () + } + hydrate + loadNames + defns + libdeps + declNameLookups - -- Boilerplate conversion: make a "DefinitionDiffs" from the info in a "Mergeblob1". - -- - -- (Mitchell says: I think Share and UCM should share a type here – perhaps DefinitionDiffs should be pushed down? Or - -- is it just isomorphic to something that already exists in UCM?) - -- - -- We start focusing only on Bob here, the contributor, even though Alice could have a diff as well of course (since - -- the LCA is arbitrarily behind Alice). +hydrateDefns :: + Text -> + Codebase.CodebaseEnv -> + CodeCache scope -> + DefnsF Set TermReferenceId TypeReferenceId -> + PG.Transaction + e + ( Defns + (Map TermReferenceId (Term Symbol Ann, Type Symbol Ann)) + (Map TypeReferenceId (Decl Symbol Ann)) + ) +hydrateDefns description codebase codeCache Defns {terms, types} + | Set.null terms && Set.null types = pure (Defns Map.empty Map.empty) + | otherwise = + PG.transactionSpan description mempty do + hydratedTerms <- + if Set.null terms + then pure Map.empty + else do + hydratedTerms <- Map.fromList <$> hydrateTermsOf codebase traversed (Set.toList terms) + CodeCache.cacheTermAndTypes codeCache hydratedTerms + pure hydratedTerms + hydratedTypes <- + if Set.null types + then pure Map.empty + else do + hydratedTypes <- Map.fromList <$> hydrateTypesOf codebase traversed (Set.toList types) + CodeCache.cacheDecls codeCache hydratedTypes + pure hydratedTypes + pure Defns {terms = hydratedTerms, types = hydratedTypes} - let definitionDiffs :: DefnsF (DefinitionDiffs Name) Referent TypeReference - definitionDiffs = - let f :: forall ref. (Ord ref) => Map Name (HumanDiffOp ref) -> DefinitionDiffs Name ref - f = - Map.toList >>> foldMap \(name, op) -> - case op of - HumanDiffOp'Add ref -> mempty {added = Map.singleton name ref} - HumanDiffOp'Delete ref -> mempty {removed = Map.singleton name ref} - HumanDiffOp'Update refs -> mempty {updated = Map.singleton name (refs.old, refs.new)} - HumanDiffOp'PropagatedUpdate refs -> mempty {propagated = Map.singleton name (refs.old, refs.new)} - HumanDiffOp'AliasOf ref names -> - mempty {newAliases = Map.singleton ref (names, NESet.singleton name)} - HumanDiffOp'RenamedFrom ref names -> - mempty {renamed = Map.singleton ref (names, NESet.singleton name)} - HumanDiffOp'RenamedTo ref names -> - mempty {renamed = Map.singleton ref (NESet.singleton name, names)} - in bimap f f blob1.humanDiffsFromLCA.bob +hydrateTermsOf :: + Codebase.CodebaseEnv -> + Traversal s t TermReferenceId (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) -> + s -> + PG.Transaction e t +hydrateTermsOf codebase trav = + asListOf trav %%~ \refs -> do + v2Terms <- DefnsQ.expectTermsByRefIdsOf codebase traversed refs + let v2TermsWithRef = zip refs v2Terms + let refHashes = v2TermsWithRef <&> \(refId, (term, typ)) -> (refId, (Reference.idToHash refId, term, typ)) + Codebase.convertTerms2to1Of (traversed . _2) refHashes - -- Convert definition diffs to two uncompressed trees of diffs (one for terms, one for types) - let twoUncompressedTrees :: - DefnsF3 - (Cofree (Map NameSegment)) - (Map NameSegment) - Set - (DefinitionDiff Referent Name Name) - (DefinitionDiff TypeReference Name Name) - twoUncompressedTrees = - bimap definitionDiffsToTree definitionDiffsToTree definitionDiffs +hydrateTypesOf :: + Codebase.CodebaseEnv -> + Traversal s t TypeReferenceId (TypeReferenceId, Decl Symbol Ann) -> + s -> + PG.Transaction e t +hydrateTypesOf codebase trav = + asListOf trav %%~ \typeReferenceIds -> do + typeIdsWithComponents <- zip typeReferenceIds <$> DefnsQ.expectTypeComponentElementsAndTypeIdsOf codebase traversed typeReferenceIds + DefnsQ.loadDeclByTypeComponentElementAndTypeIdsOf (traversed . _2) typeIdsWithComponents + <&> fmap \(refId, v2Decl) -> + let v1Decl = Cv.decl2to1 (Reference.idToHash refId) v2Decl + in (refId, v1Decl) - -- Align terms and types trees into one tree (still uncompressed) - let oneUncompressedTree :: GNamespaceTreeDiff NameSegment Referent TypeReference Name Name Name Name - oneUncompressedTree = - alignDefnsWith combineTermsAndTypes twoUncompressedTrees +-- Boilerplate conversion: make a "DefinitionDiffs" from the info in a "Mergeblob1". +-- +-- We start focusing only on Bob here, the contributor, even though Alice could have a diff as well of course (since +-- the LCA is arbitrarily behind Alice). +makeNamespaceDiffTree :: + Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name) -> + DefnsF3 (Map Name) Merge.DiffOp Synhashed Referent TypeReference -> + DefnsF (Map Name) (Merge.Updated Referent) (Merge.Updated TypeReference) -> + Defns Merge.SimpleRenames Merge.SimpleRenames -> + GNamespaceTreeDiff NameSegment Referent TypeReference Name Name Name Name +makeNamespaceDiffTree lcaDefns diffFromLca propagatedUpdates simpleRenames = + ( Defns.zipDefnsWith3 f f lcaDefns simpleRenames diffFromLca + <> bimap g g propagatedUpdates + ) + -- Convert definition diffs to two uncompressed trees of diffs (one for terms, one for types) + & bimap definitionDiffsToTree definitionDiffsToTree + -- Align terms and types trees into one tree (still uncompressed) + & alignDefnsWith combineTermsAndTypes + where + f :: (Ord ref) => BiMultimap ref Name -> Merge.SimpleRenames -> Map Name (Merge.DiffOp (Synhashed ref)) -> DefinitionDiffs Name ref + f lca renames = + Map.toList >>> foldMap \(name, op) -> + case op of + Merge.DiffOp'Add ref -> + case Map.lookup name renames.backwards of + Nothing -> + case NESet.nonEmptySet (BiMultimap.lookupDom ref.value lca) of + Nothing -> mempty {added = Map.singleton name ref.value} + Just oldNames -> mempty {newAliases = Map.singleton ref.value (oldNames, NESet.singleton name)} + Just oldName -> mempty {renamed = Map.singleton ref.value (NESet.singleton oldName, NESet.singleton name)} + Merge.DiffOp'Delete ref -> + case Map.lookup name renames.forwards of + Nothing -> mempty {removed = Map.singleton name ref.value} + -- we include the rename when handling the add side + Just _newName -> mempty + Merge.DiffOp'Update refs -> mempty {updated = Map.singleton name (Updated.toPair (Updated.map (.value) refs))} - pure - NamespaceAndLibdepsDiff - { defns = oneUncompressedTree, - libdeps = blob1.libdepsDiffs.bob - } + g :: (Ord ref) => Map Name (Merge.Updated ref) -> DefinitionDiffs Name ref + g propagatedUpdates = + mempty {propagated = Map.map Updated.toPair propagatedUpdates} diff --git a/src/Share/NamespaceDiffs/Types.hs b/src/Share/NamespaceDiffs/Types.hs index b1ab6bdd..203f9ea8 100644 --- a/src/Share/NamespaceDiffs/Types.hs +++ b/src/Share/NamespaceDiffs/Types.hs @@ -17,13 +17,17 @@ module Share.NamespaceDiffs.Types namespaceTreeDiffReferents_, namespaceTreeDiffReferences_, namespaceTreeDiffTermDiffs_, + mapMaybeNamespaceTreeDiffTermDiffs, witherNamespaceTreeDiffTermDiffs, namespaceTreeDiffTypeDiffs_, namespaceTreeTermDiffKinds_, + mapMaybeNamespaceTreeTermDiffKinds, witherNamespaceTreeTermDiffKinds, namespaceTreeTypeDiffKinds_, namespaceTreeDiffRenderedTerms_, namespaceTreeDiffRenderedTypes_, + definitionDiffKindRendered_, + definitionDiffKindRenderedOldNew_, ) where @@ -186,6 +190,16 @@ definitionDiffKindRendered_ f = \case RenamedTo r old rendered -> RenamedTo r old <$> f rendered RenamedFrom r old rendered -> RenamedFrom r old <$> f rendered +definitionDiffKindRenderedOldNew_ :: Traversal (DefinitionDiffKind r rendered diff) (DefinitionDiffKind r rendered' diff) (Either rendered rendered) rendered' +definitionDiffKindRenderedOldNew_ f = \case + Added r rendered -> Added r <$> f (Right rendered) + NewAlias r ns rendered -> NewAlias r ns <$> f (Right rendered) + Removed r rendered -> Removed r <$> f (Left rendered) + Propagated old new diff -> Propagated old new <$> pure diff + Updated old new diff -> Updated old new <$> pure diff + RenamedTo r old rendered -> RenamedTo r old <$> f (Left rendered) + RenamedFrom r old rendered -> RenamedFrom r old <$> f (Right rendered) + data NamespaceDiffResult = NamespaceDiffResult'Ok ( NamespaceAndLibdepsDiff @@ -527,6 +541,15 @@ namespaceTreeDiffReferences_ = traversed . traversed . diffAtPathReferences_ namespaceTreeDiffTermDiffs_ :: (Ord termDiff', Ord referent, Ord renderedTerm) => Traversal (GNamespaceTreeDiff k referent reference renderedTerm renderedType termDiff typeDiff) (GNamespaceTreeDiff k referent reference renderedTerm renderedType termDiff' typeDiff) termDiff termDiff' namespaceTreeDiffTermDiffs_ = traversed . traversed . diffAtPathTermDiffs_ +mapMaybeNamespaceTreeDiffTermDiffs :: + forall k reference referent renderedTerm renderedType termDiff termDiff' typeDiff. + (Ord termDiff', Ord referent, Ord renderedTerm) => + (termDiff -> Maybe termDiff') -> + GNamespaceTreeDiff k referent reference renderedTerm renderedType termDiff typeDiff -> + GNamespaceTreeDiff k referent reference renderedTerm renderedType termDiff' typeDiff +mapMaybeNamespaceTreeDiffTermDiffs f = + runIdentity . witherNamespaceTreeDiffTermDiffs (Identity . f) + witherNamespaceTreeDiffTermDiffs :: forall f k reference referent renderedTerm renderedType termDiff termDiff' typeDiff. (Monad f, Ord termDiff', Ord referent, Ord renderedTerm) => @@ -556,6 +579,15 @@ namespaceTreeDiffTypeDiffs_ = traversed . traversed . diffAtPathTypeDiffs_ namespaceTreeTermDiffKinds_ :: (Ord renderedTerm', Ord termDiff', Ord referent') => Traversal (GNamespaceTreeDiff k referent reference renderedTerm renderedType termDiff typeDiff) (GNamespaceTreeDiff k referent' reference renderedTerm' renderedType termDiff' typeDiff) (DefinitionDiffKind referent renderedTerm termDiff) (DefinitionDiffKind referent' renderedTerm' termDiff') namespaceTreeTermDiffKinds_ = traversed . traversed . diffAtPathTermDiffKinds_ +mapMaybeNamespaceTreeTermDiffKinds :: + forall k reference referent referent' renderedTerm renderedTerm' renderedType termDiff termDiff' typeDiff. + (Ord renderedTerm', Ord termDiff', Ord referent') => + (DefinitionDiffKind referent renderedTerm termDiff -> Maybe (DefinitionDiffKind referent' renderedTerm' termDiff')) -> + GNamespaceTreeDiff k referent reference renderedTerm renderedType termDiff typeDiff -> + GNamespaceTreeDiff k referent' reference renderedTerm' renderedType termDiff' typeDiff +mapMaybeNamespaceTreeTermDiffKinds f = + runIdentity . witherNamespaceTreeTermDiffKinds (Identity . f) + witherNamespaceTreeTermDiffKinds :: forall f k reference referent referent' renderedTerm renderedTerm' renderedType termDiff termDiff' typeDiff. (Monad f, Ord renderedTerm', Ord termDiff', Ord referent') => diff --git a/src/Share/Postgres/Definitions/Queries.hs b/src/Share/Postgres/Definitions/Queries.hs index c1328674..941a66fa 100644 --- a/src/Share/Postgres/Definitions/Queries.hs +++ b/src/Share/Postgres/Definitions/Queries.hs @@ -494,22 +494,22 @@ loadTypeComponentElementsAndTypeIdsOf (CodebaseEnv codebaseUser) trav s = do <&> \(ord, Reference.Id compHash compIndex) -> (ord, compHash, (pgComponentIndex compIndex)) queryListRows @(Maybe TypeComponentElement, Maybe TypeId) [sql| - WITH ref_ids(ord, comp_hash, comp_index) AS ( - SELECT t.ord, t.comp_hash, t.comp_index FROM ^{toTable refsTable} AS t(ord, comp_hash, comp_index) - ) SELECT bytes.bytes, typ.id - FROM ref_ids - LEFT JOIN component_hashes ch ON ref_ids.comp_hash = ch.base32 - LEFT JOIN types typ ON (typ.component_index = ref_ids.comp_index AND typ.component_hash_id = ch.id) - LEFT JOIN sandboxed_types sandboxed ON (typ.id = sandboxed.type_id AND sandboxed.user_id = #{codebaseUser}) - LEFT JOIN bytes ON sandboxed.bytes_id = bytes.id - ORDER BY ref_ids.ord ASC + WITH ref_ids(ord, comp_hash, comp_index) AS ( + SELECT t.ord, t.comp_hash, t.comp_index FROM ^{toTable refsTable} AS t(ord, comp_hash, comp_index) + ) SELECT bytes.bytes, typ.id + FROM ref_ids + LEFT JOIN component_hashes ch ON ref_ids.comp_hash = ch.base32 + LEFT JOIN types typ ON (typ.component_index = ref_ids.comp_index AND typ.component_hash_id = ch.id) + LEFT JOIN sandboxed_types sandboxed ON (typ.id = sandboxed.type_id AND sandboxed.user_id = #{codebaseUser}) + LEFT JOIN bytes ON sandboxed.bytes_id = bytes.id + ORDER BY ref_ids.ord ASC |] <&> fmap \(element, typeId) -> liftA2 (,) element typeId expectTypeComponentElementsAndTypeIdsOf :: (QueryA m) => CodebaseEnv -> Traversal s t TypeReferenceId (TypeComponentElement, TypeId) -> s -> m t expectTypeComponentElementsAndTypeIdsOf codebase trav s = s - & asListOfDeduped trav %%~ \refs -> do + & asListOf trav %%~ \refs -> do unrecoverableEitherMap ( \elems -> for (zip refs elems) \case (refId, Nothing) -> Left (expectedTypeError $ Right refId) diff --git a/src/Share/Postgres/NameLookups/Ops.hs b/src/Share/Postgres/NameLookups/Ops.hs index 2e917dbf..4de466dc 100644 --- a/src/Share/Postgres/NameLookups/Ops.hs +++ b/src/Share/Postgres/NameLookups/Ops.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TypeOperators #-} + module Share.Postgres.NameLookups.Ops ( fuzzySearchDefinitions, termNamesForRefsWithinNamespaceOf, @@ -11,12 +13,15 @@ module Share.Postgres.NameLookups.Ops Q.projectTypesWithinRoot, Q.listNameLookupMounts, projectNamesWithoutLib, + projectConstructorCountsWithoutLib, ) where import Control.Lens +import Data.Map.Strict qualified as Map import Data.Set qualified as Set -import Share.Postgres (QueryM) +import Data.Vector qualified as Vector +import Share.Postgres (Only (..), QueryM, (:.) (..)) import Share.Postgres qualified as PG import Share.Postgres.Cursors qualified as Cursor import Share.Postgres.Hashes.Queries qualified as HashQ @@ -31,12 +36,12 @@ import Share.Postgres.NamesPerspective.Types (NamesPerspective (..)) import Share.Postgres.Refs.Types import Share.Prelude import Share.Utils.Lens (asListOfDeduped) -import U.Codebase.Reference (Reference) import U.Codebase.Referent (ConstructorType, Referent) -import Unison.Names (Names) -import Unison.Names qualified as Names +import Unison.Name (Name) +import Unison.Reference (Reference, TypeReference, TypeReferenceId) import Unison.Reference qualified as V1 import Unison.Referent qualified as V1 +import Unison.Util.Defns (Defns (..), DefnsF) -- | Search for term or type names which contain the provided list of segments in order. -- Search is case insensitive. @@ -115,10 +120,24 @@ deleteNameLookupsExceptFor reachable = do -- | Build a 'Names' for all definitions within the given root, without any dependencies. -- Note: This loads everything into memory at once, so avoid this and prefer streaming when possible. -projectNamesWithoutLib :: (QueryM m) => NameLookupReceipt -> BranchHashId -> m Names +projectNamesWithoutLib :: + (QueryM m) => + NameLookupReceipt -> + BranchHashId -> + m (DefnsF [] (Name, V1.Referent) (Name, TypeReference)) projectNamesWithoutLib !nlr rootBranchHashId = do termNamesCursor <- Q.projectTermsWithinRootV1 nlr rootBranchHashId - allTerms <- Cursor.foldBatched termNamesCursor 1000 (pure . toList) + terms <- Cursor.foldBatched termNamesCursor 1000 (pure . toList) typesCursor <- (Q.projectTypesWithinRoot nlr rootBranchHashId) - allTypes <- Cursor.foldBatched typesCursor 1000 (pure . toList) - pure $ Names.fromTermsAndTypes allTerms allTypes + types <- Cursor.foldBatched typesCursor 1000 (pure . toList) + pure Defns {terms, types} + +-- | Build a @Map TypeReferenceId Int@ constructor count map for all types within the given root, without any dependencies. +projectConstructorCountsWithoutLib :: (QueryM m) => NameLookupReceipt -> BranchHashId -> m (Map TypeReferenceId Int) +projectConstructorCountsWithoutLib !nlr rootBranchHashId = do + cursor <- Q.projectConstructorCountsWithinRoot nlr rootBranchHashId + Cursor.foldBatched cursor 1000 (pure . Vector.foldl' f Map.empty) + where + f :: Map TypeReferenceId Int -> TypeReferenceId :. Only Int64 -> Map TypeReferenceId Int + f acc (ref :. Only count) = + Map.insert ref (fromIntegral @Int64 @Int count) acc diff --git a/src/Share/Postgres/NameLookups/Queries.hs b/src/Share/Postgres/NameLookups/Queries.hs index 95cc4ee9..dd204dd9 100644 --- a/src/Share/Postgres/NameLookups/Queries.hs +++ b/src/Share/Postgres/NameLookups/Queries.hs @@ -16,6 +16,7 @@ module Share.Postgres.NameLookups.Queries projectTermsWithinRoot, projectTermsWithinRootV1, projectTypesWithinRoot, + projectConstructorCountsWithinRoot, -- * Name lookup management listNameLookupMounts, @@ -41,11 +42,11 @@ import Share.Postgres.NamesPerspective.Types (NamesPerspective, perspectiveCurre import Share.Postgres.Refs.Types (PGReference, PGReferent, referenceFields, referentFields) import Share.Prelude import Share.Utils.Postgres (ordered) -import U.Codebase.Reference (Reference) import U.Codebase.Referent (ConstructorType) import U.Codebase.Referent qualified as V2 import Unison.Codebase.SqliteCodebase.Conversions qualified as Cv import Unison.Name (Name) +import Unison.Reference (TypeReference, TypeReferenceId) import Unison.Referent qualified as V1 import Unison.Util.Monoid qualified as Monoid @@ -489,9 +490,9 @@ referent2to1 :: (HasCallStack) => (V2.Referent PG.:. PG.Only (Maybe V2.Construct referent2to1 (r PG.:. PG.Only mayCT) = Cv.referent2to1UsingCT (fromMaybe (error "Required constructor type for constructor but it was null") mayCT) r -- | Get a cursor over all non-lib types within the given root branch. -projectTypesWithinRoot :: (QueryM m) => NameLookupReceipt -> BranchHashId -> m (PGCursor (Name, Reference)) +projectTypesWithinRoot :: (QueryM m) => NameLookupReceipt -> BranchHashId -> m (PGCursor (Name, TypeReference)) projectTypesWithinRoot !_nlReceipt bhId = do - Cursors.newRowCursor @(NamedRef Reference) + Cursors.newRowCursor @(NamedRef TypeReference) "typesForSearchSyncCursor" [sql| SELECT reversed_name, reference_builtin, reference_component_hash.base32, reference_component_index @@ -501,6 +502,37 @@ projectTypesWithinRoot !_nlReceipt bhId = do |] <&> fmap (\NamedRef {reversedSegments, ref} -> (reversedNameToName reversedSegments, ref)) +-- | Get a cursor over all non-lib, non-builtin types and their corresponding constructor counts, within the given root branch. +projectConstructorCountsWithinRoot :: (QueryM m) => NameLookupReceipt -> BranchHashId -> m (PGCursor (TypeReferenceId :. Only Int64)) +projectConstructorCountsWithinRoot !_ bhId = + Cursors.newRowCursor + "constructorCountsCursor" + [sql| + WITH x AS ( + SELECT DISTINCT ON (scoped_type_name_lookup.type_id) + scoped_type_name_lookup.type_id, + component_hashes.base32, + scoped_type_name_lookup.reference_component_index + FROM scoped_type_name_lookup + JOIN component_hashes + ON scoped_type_name_lookup.reference_component_hash_id = component_hashes.id + WHERE scoped_type_name_lookup.root_branch_hash_id = #{bhId} + AND scoped_type_name_lookup.reference_builtin IS NULL + ) + SELECT + x.base32 AS hash, + x.reference_component_index AS component_index, + COALESCE(y.constructor_index + 1, 0) AS constructor_count + FROM x + LEFT JOIN LATERAL ( + SELECT constructors.constructor_index + FROM constructors + WHERE x.type_id = constructors.type_id + ORDER BY constructors.constructor_index DESC + LIMIT 1 + ) y ON true; + |] + ensureNameLookupForBranchId :: (QueryM m) => BranchHashId -> m NameLookupReceipt ensureNameLookupForBranchId branchHashId = PG.transactionSpan "ensureNameLookupForBranchId" mempty do UnsafeNameLookupReceipt diff --git a/src/Share/Web/Share/Branches/Impl.hs b/src/Share/Web/Share/Branches/Impl.hs index 49cd62da..1bf9aa51 100644 --- a/src/Share/Web/Share/Branches/Impl.hs +++ b/src/Share/Web/Share/Branches/Impl.hs @@ -13,6 +13,7 @@ import Data.Time (UTCTime) import Servant import Share.Branch (Branch (..), branchCausals_) import Share.Codebase qualified as Codebase +import Share.Codebase.CodeCache qualified as CodeCache import Share.Codebase.CodebaseRuntime qualified as CR import Share.Env qualified as Env import Share.IDs (BranchId, BranchShortHand (..), ProjectBranchShortHand (..), ProjectShortHand (..), ProjectSlug (..), UserHandle, UserId) @@ -235,9 +236,10 @@ projectBranchTypeSummaryEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHand let codebaseLoc = Codebase.codebaseLocationForProjectBranchCodebase projectOwnerUserId contributorId let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc causalId <- resolveRootHash codebase branchHead rootHash - Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-type-summary" cacheParams causalId $ do - PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - serveTypeSummary codebase ref mayName renderWidth + Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-type-summary" cacheParams causalId do + PG.runTransactionMode PG.ReadCommitted PG.ReadWrite do + CodeCache.withCodeCache codebase \codeCache -> do + serveTypeSummary codeCache ref mayName renderWidth where projectBranchShortHand = ProjectBranchShortHand {userHandle, projectSlug, contributorHandle, branchName} cacheParams = [IDs.toText projectBranchShortHand, toUrlPiece ref, maybe "" Name.toText mayName, tShow $ fromMaybe mempty relativeTo, foldMap toUrlPiece renderWidth] @@ -260,9 +262,10 @@ projectBranchDefinitionDependenciesByNameEndpoint (AuthN.MaybeAuthedUserID calle causalId <- resolveRootHash codebase branchHead rootHash Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definition-dependencies-by-name" cacheParams causalId $ do PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId - np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) - DefinitionSearchResults <$> ShareBackend.definitionDependencyResults codebase name projectShorthand branchOrReleaseShortHand np renderWidth + CodeCache.withCodeCache codebase \codeCache -> do + rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId + np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) + DefinitionSearchResults <$> ShareBackend.definitionDependencyResults codebase codeCache name projectShorthand branchOrReleaseShortHand np renderWidth where branchOrReleaseShortHand = IDs.IsBranchShortHand bsh projectShorthand = ProjectShortHand {userHandle, projectSlug} @@ -289,9 +292,10 @@ projectBranchDefinitionDependenciesByHashEndpoint (AuthN.MaybeAuthedUserID calle causalId <- resolveRootHash codebase branchHead rootHash Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definition-dependencies-by-hash" (cacheParams query) causalId $ do PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId - np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) - DefinitionSearchResults <$> ShareBackend.definitionDependencyResults codebase query projectShorthand branchOrReleaseShortHand np renderWidth + CodeCache.withCodeCache codebase \codeCache -> do + rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId + np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) + DefinitionSearchResults <$> ShareBackend.definitionDependencyResults codebase codeCache query projectShorthand branchOrReleaseShortHand np renderWidth where branchOrReleaseShortHand = IDs.IsBranchShortHand bsh projectShorthand = ProjectShortHand {userHandle, projectSlug} @@ -316,9 +320,10 @@ projectBranchDefinitionDependentsByNameEndpoint (AuthN.MaybeAuthedUserID callerU causalId <- resolveRootHash codebase branchHead rootHash Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definition-dependents-by-name" cacheParams causalId $ do PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId - np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) - DefinitionSearchResults <$> ShareBackend.definitionDependentResults codebase name projectShorthand branchOrReleaseShortHand np renderWidth + CodeCache.withCodeCache codebase \codeCache -> do + rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId + np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) + DefinitionSearchResults <$> ShareBackend.definitionDependentResults codebase codeCache name projectShorthand branchOrReleaseShortHand np renderWidth where branchOrReleaseShortHand = IDs.IsBranchShortHand bsh projectShorthand = ProjectShortHand {userHandle, projectSlug} @@ -345,9 +350,10 @@ projectBranchDefinitionDependentsByHashEndpoint (AuthN.MaybeAuthedUserID callerU causalId <- resolveRootHash codebase branchHead rootHash Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definition-dependents-by-hash" (cacheParams query) causalId $ do PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId - np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) - DefinitionSearchResults <$> ShareBackend.definitionDependentResults codebase query projectShorthand branchOrReleaseShortHand np renderWidth + CodeCache.withCodeCache codebase \codeCache -> do + rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId + np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) + DefinitionSearchResults <$> ShareBackend.definitionDependentResults codebase codeCache query projectShorthand branchOrReleaseShortHand np renderWidth where branchOrReleaseShortHand = IDs.IsBranchShortHand bsh projectShorthand = ProjectShortHand {userHandle, projectSlug} diff --git a/src/Share/Web/Share/Diffs/Impl.hs b/src/Share/Web/Share/Diffs/Impl.hs index e72d5ae7..02fba7db 100644 --- a/src/Share/Web/Share/Diffs/Impl.hs +++ b/src/Share/Web/Share/Diffs/Impl.hs @@ -8,11 +8,16 @@ where import Control.Lens hiding ((.=)) import Control.Monad.Except import Data.Aeson qualified as Aeson +import Data.Either (partitionEithers) +import Data.Map.Strict qualified as Map +import Data.Set qualified as Set +import Data.Set.Lens (setOf) import Data.Text.Lazy qualified as TL import Data.Text.Lazy.Encoding qualified as TL import Share.Codebase qualified as Codebase -import Share.NamespaceDiffs (DefinitionDiffKind (..), GNamespaceTreeDiff, NamespaceDiffError (..)) +import Share.NamespaceDiffs (DefinitionDiffKind (..), NamespaceDiffError (..)) import Share.NamespaceDiffs qualified as NamespaceDiffs +import Share.NamespaceDiffs.Types (GNamespaceTreeDiff) import Share.Postgres qualified as PG import Share.Postgres.Causal.Queries qualified as CausalQ import Share.Postgres.Contributions.Queries qualified as ContributionQ @@ -24,21 +29,27 @@ import Share.Postgres.NamesPerspective.Types (NamesPerspective (..)) import Share.Prelude import Share.PrettyPrintEnvDecl.Postgres qualified as PPEPostgres import Share.Utils.Aeson (PreEncoded (PreEncoded)) -import Share.Utils.Lens (asListOfDeduped) import Share.Web.Authorization (AuthZReceipt) import Share.Web.Errors import U.Codebase.Reference qualified as V2Reference import Unison.Codebase.SqliteCodebase.Conversions (referent1to2) import Unison.ConstructorReference (ConstructorReference) import Unison.Merge (TwoOrThreeWay (..), TwoWay (..)) +import Unison.Merge qualified as Merge +import Unison.Merge.DiffOp qualified as DiffOp import Unison.Name (Name) import Unison.NameSegment (NameSegment) +import Unison.Reference (TypeReference) +import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Server.Backend.DefinitionDiff qualified as DefinitionDiff import Unison.Server.Share.Definitions qualified as Definitions import Unison.Server.Types import Unison.ShortHash (ShortHash) import Unison.Syntax.Name qualified as Name +import Unison.UnconflictedLocalDefnsView qualified +import Unison.Util.BiMultimap qualified as BiMultimap +import Unison.Util.Defns qualified import Unison.Util.Pretty (Width) -- | Diff two causals and store the diff in the database. @@ -54,10 +65,11 @@ computeAndStoreCausalDiff authZReceipt old@(oldCodebase, _, oldCausalId) new@(ne Right diff -> NamespaceDiffs.NamespaceDiffResult'Ok diff Left err -> NamespaceDiffs.NamespaceDiffResult'Err err let encoded = Aeson.encode result - ContributionQ.savePrecomputedNamespaceDiff - (oldCodebase, oldCausalId) - (newCodebase, newCausalId) - (TL.toStrict $ TL.decodeUtf8 encoded) + PG.transactionSpan "savePrecomputedNamespaceDiff" mempty do + ContributionQ.savePrecomputedNamespaceDiff + (oldCodebase, oldCausalId) + (newCodebase, newCausalId) + (TL.toStrict $ TL.decodeUtf8 encoded) pure (PreEncoded encoded) tryComputeCausalDiff :: @@ -91,83 +103,147 @@ tryComputeCausalDiff !_authZReceipt (oldCodebase, oldRuntime, oldCausalId) (newC (lcaBranchHashId, lcaBranchNLReceipt, lcaPerspective) <- PG.transactionSpan "getNewBranch" mempty $ getBranch lcaCausalId pure (Just lcaBranchHashId, Just lcaBranchNLReceipt, Just lcaPerspective) Nothing -> pure (Nothing, Nothing, Nothing) + -- Do the initial 3-way namespace diff - diff0 <- + diffblob <- NamespaceDiffs.computeThreeWayNamespaceDiff TwoWay {alice = oldCodebase, bob = newCodebase} + oldRuntime.codeCache + newRuntime.codeCache TwoOrThreeWay {alice = oldBranchHashId, bob = newBranchHashId, lca = maybeLcaBranchHashId} TwoOrThreeWay {alice = oldBranchNLReceipt, bob = newBranchNLReceipt, lca = maybeLcaBranchNLReceipt} + + -- Boilerplate conversion: make a "DefinitionDiffs" from the info in a "Mergeblob1". + -- + -- We start focusing only on Bob here, the contributor, even though Alice could have a diff as well of course (since + -- the LCA is arbitrarily behind Alice). + let defns0 :: GNamespaceTreeDiff NameSegment Referent TypeReference Name Name Name Name + defns0 = + NamespaceDiffs.makeNamespaceDiffTree + diffblob.defns.lca.defns + diffblob.diffsFromLCA.bob + diffblob.propagatedUpdates.bob + diffblob.simpleRenames.bob + + let oldPerspective1 = + fromMaybe oldPerspective maybeLcaPerspective + + (getOldTermDefinitionByName, getNewTermDefinitionByName) <- do + let newNameToReferent :: Name -> Referent + newNameToReferent = + (BiMultimap.range diffblob.defns.bob.defns.terms Map.!) + + let oldNameToReferent :: Name -> Referent + oldNameToReferent = + case maybeLcaPerspective of + Just _ -> (BiMultimap.range diffblob.defns.lca.defns.terms Map.!) + Nothing -> newNameToReferent + + let (oldTermNamesToRender, newTermNamesToRender) = + defns0 + & toListOf (NamespaceDiffs.namespaceTreeTermDiffKinds_ . to partitionDiffKind . NamespaceDiffs.definitionDiffKindRendered_) + & partitionEithers + & bimap Set.fromList Set.fromList + + let termNamesToDiff = + setOf NamespaceDiffs.namespaceTreeDiffTermDiffs_ defns0 + + oldTermDefinitionsByName <- + PG.transactionSpan "load old terms" mempty do + deriveMapOf + (expectTermDefinitionsByNamedRefsOf oldCodebase oldRuntime oldPerspective1 oldNameToReferent) + (Set.toList (Set.union oldTermNamesToRender termNamesToDiff)) + + newTermDefinitionsByName <- do + PG.transactionSpan "load new terms" mempty do + deriveMapOf + (expectTermDefinitionsByNamedRefsOf newCodebase newRuntime newPerspective newNameToReferent) + (Set.toList (Set.union newTermNamesToRender termNamesToDiff)) + + pure ((oldTermDefinitionsByName Map.!), (newTermDefinitionsByName Map.!)) + + (getOldTypeDefinitionByName, getNewTypeDefinitionByName) <- do + let newNameToReference :: Name -> TypeReference + newNameToReference = + (BiMultimap.range diffblob.defns.bob.defns.types Map.!) + + let oldNameToReference :: Name -> TypeReference + oldNameToReference = + case maybeLcaPerspective of + Just _ -> (BiMultimap.range diffblob.defns.lca.defns.types Map.!) + Nothing -> newNameToReference + + let (oldTypeNamesToRender, newTypeNamesToRender) = + defns0 + & toListOf (NamespaceDiffs.namespaceTreeTypeDiffKinds_ . to partitionDiffKind . NamespaceDiffs.definitionDiffKindRendered_) + & partitionEithers + & bimap Set.fromList Set.fromList + + let typeNamesToDiff = + setOf NamespaceDiffs.namespaceTreeDiffTypeDiffs_ defns0 + + oldTypeDefinitionsByName <- do + PG.transactionSpan "load old types" mempty do + deriveMapOf + (expectTypeDefinitionsByNamedRefsOf oldCodebase oldRuntime oldPerspective1 oldNameToReference) + (Set.toList (Set.union oldTypeNamesToRender typeNamesToDiff)) + pure (oldTypeDefinitionsByName Map.!) + + newTypeDefinitionsByName <- do + PG.transactionSpan "load new types" mempty do + deriveMapOf + (expectTypeDefinitionsByNamedRefsOf newCodebase newRuntime newPerspective newNameToReference) + (Set.toList (Set.union newTypeNamesToRender typeNamesToDiff)) + + pure ((oldTypeDefinitionsByName Map.!), (newTypeDefinitionsByName Map.!)) + -- Resolve the term referents to tag + hash - diff1 <- PG.transactionSpan "hydrate-diff1" mempty $ do - diff0 - & asListOf (NamespaceDiffs.namespaceAndLibdepsDiffDefns_ . NamespaceDiffs.namespaceTreeDiffReferents_) - %%~ \refs -> do + defns1 :: NamespaceDiffs.GNamespaceTreeDiff NameSegment (TermTag, ShortHash) TypeReference Name Name Name Name <- + PG.transactionSpan "load term tags" mempty do + defns0 + & asListOf NamespaceDiffs.namespaceTreeDiffReferents_ %%~ \refs -> do termTags <- Codebase.termTagsByReferentsOf traversed (referent1to2 <$> refs) pure $ zip termTags (refs <&> Referent.toShortHash) + -- Resolve the type references to tag + hash - diff2 <- - PG.transactionSpan "hydrate-diff2" mempty $ - diff1 - & asListOf (NamespaceDiffs.namespaceAndLibdepsDiffDefns_ . NamespaceDiffs.namespaceTreeDiffReferences_) - %%~ \refs -> do - typeTags <- Codebase.typeTagsByReferencesOf traversed refs - pure $ zip typeTags (refs <&> V2Reference.toShortHash) + defns2 :: NamespaceDiffs.GNamespaceTreeDiff NameSegment (TermTag, ShortHash) (TypeTag, ShortHash) Name Name Name Name <- + PG.transactionSpan "load type tags" mempty do + defns1 + & asListOf NamespaceDiffs.namespaceTreeDiffReferences_ %%~ \refs -> do + typeTags <- Codebase.typeTagsByReferencesOf traversed refs + pure $ zip typeTags (refs <&> V2Reference.toShortHash) + + -- Resolve the actual term/type definitions. Use the LCA as the "old" (because that's what we're rendering the diff + -- relative to, unless there isn't an LCA (unlikely), in which case we fall back on the other branch (we won't have + -- anything classified as an "update" in this case so it doesn't really matter). + + let defns3 :: GNamespaceTreeDiff NameSegment (TermTag, ShortHash) (TypeTag, ShortHash) TermDefinition TypeDefinition TermDefinitionDiff TypeDefinitionDiff + defns3 = + defns2 + & NamespaceDiffs.mapMaybeNamespaceTreeDiffTermDiffs (\name -> diffTermsPure (getOldTermDefinitionByName name) (getNewTermDefinitionByName name)) + & NamespaceDiffs.mapMaybeNamespaceTreeTermDiffKinds + ( NamespaceDiffs.definitionDiffKindRenderedOldNew_ + ( either + (eitherToMaybe . getOldTermDefinitionByName) + (eitherToMaybe . getNewTermDefinitionByName) + ) + ) + & NamespaceDiffs.namespaceTreeDiffTypeDiffs_ %~ (\name -> diffTypesPure (getOldTypeDefinitionByName name) (getNewTypeDefinitionByName name)) + & NamespaceDiffs.namespaceTreeTypeDiffKinds_ . NamespaceDiffs.definitionDiffKindRenderedOldNew_ + %~ either getOldTypeDefinitionByName getNewTypeDefinitionByName + -- Resolve libdeps branch hash ids to branch hashes - diff3 <- - PG.transactionSpan "hydrate-diff3" mempty $ + libdeps <- + PG.transactionSpan "load libdeps branch hashes" mempty do HashQ.expectNamespaceHashesByNamespaceHashIdsOf - (NamespaceDiffs.namespaceAndLibdepsDiffLibdeps_ . traversed . traversed) - diff2 - -- Resolve the actual term/type definitions. Use the LCA as the "old" (because that's what we're rendering the - -- diff relative to, unless there isn't an LCA (unlikely), in which case we fall back on the other branch (we - -- won't have anything classified as an "update" in this case so it doesn't really matter). - diff4 <- - PG.transactionSpan "hydrate-diff4" mempty $ - diff3 - & NamespaceDiffs.namespaceAndLibdepsDiffDefns_ - %%~ computeUpdatedDefinitionDiffs - (oldCodebase, oldRuntime, fromMaybe oldPerspective maybeLcaPerspective) - (newCodebase, newRuntime, newPerspective) - pure diff4 - -computeUpdatedDefinitionDiffs :: - forall a b from to. - (Ord a, Ord b) => - (Codebase.CodebaseEnv, Codebase.CodebaseRuntime from IO, NamesPerspective (PG.Transaction NamespaceDiffError)) -> - (Codebase.CodebaseEnv, Codebase.CodebaseRuntime to IO, NamesPerspective (PG.Transaction NamespaceDiffError)) -> - GNamespaceTreeDiff NameSegment a b Name Name Name Name -> - PG.Transaction - NamespaceDiffError - (NamespaceDiffs.NamespaceTreeDiff a b TermDefinition TypeDefinition TermDefinitionDiff TypeDefinitionDiff) -computeUpdatedDefinitionDiffs (fromCodebase, fromRuntime, fromPerspective) (toCodebase, toRuntime, toPerspective) diff0 = PG.transactionSpan "computeUpdatedDefinitionDiffs" mempty $ do - diff1 <- PG.transactionSpan "termDiffs" mempty $ do - diff0 - & NamespaceDiffs.namespaceTreeDiffTermDiffs_ %~ (\name -> (name, name)) - & expectTermDefinitionsOf fromCodebase fromRuntime fromPerspective (NamespaceDiffs.namespaceTreeDiffTermDiffs_ . _1) - >>= expectTermDefinitionsOf toCodebase toRuntime toPerspective (NamespaceDiffs.namespaceTreeDiffTermDiffs_ . _2) - >>= NamespaceDiffs.witherNamespaceTreeDiffTermDiffs (pure . diffTermsPure) - - diff2 <- PG.transactionSpan "termDiffKinds" mempty $ do - diff1 - & NamespaceDiffs.namespaceTreeTermDiffKinds_ %~ partitionDiffKind - & expectTermDefinitionsOf fromCodebase fromRuntime fromPerspective (NamespaceDiffs.namespaceTreeDiffRenderedTerms_ . _Left) - >>= expectTermDefinitionsOf toCodebase toRuntime toPerspective (NamespaceDiffs.namespaceTreeDiffRenderedTerms_ . _Right) - <&> NamespaceDiffs.namespaceTreeDiffRenderedTerms_ %~ either id id - >>= NamespaceDiffs.witherNamespaceTreeTermDiffKinds (pure . throwAwayConstructorDiffs) - - diff3 <- PG.transactionSpan "typeDiffs" mempty $ do - diff2 - & NamespaceDiffs.namespaceTreeDiffTypeDiffs_ %~ (\name -> (name, name)) - & expectTypeDefinitionsOf fromCodebase fromRuntime fromPerspective (NamespaceDiffs.namespaceTreeDiffTypeDiffs_ . _1) - >>= expectTypeDefinitionsOf toCodebase toRuntime toPerspective (NamespaceDiffs.namespaceTreeDiffTypeDiffs_ . _2) - <&> NamespaceDiffs.namespaceTreeDiffTypeDiffs_ %~ diffTypesPure - diff4 <- PG.transactionSpan "typeDiffKinds" mempty $ do - diff3 - & NamespaceDiffs.namespaceTreeTypeDiffKinds_ %~ partitionDiffKind - & expectTypeDefinitionsOf fromCodebase fromRuntime fromPerspective (NamespaceDiffs.namespaceTreeDiffRenderedTypes_ . _Left) - >>= expectTypeDefinitionsOf toCodebase fromRuntime toPerspective (NamespaceDiffs.namespaceTreeDiffRenderedTypes_ . _Right) - <&> NamespaceDiffs.namespaceTreeDiffRenderedTypes_ %~ either id id - pure (NamespaceDiffs.compressNameTree diff4) + (traversed . DiffOp.traverse) + diffblob.libdepsDiffs.bob + + pure + NamespaceDiffs.NamespaceAndLibdepsDiff + { defns = NamespaceDiffs.compressNameTree defns3, + libdeps + } where -- Splits the diff kind into the parts from the 'from' and 'to' sections of a diff. -- @@ -182,23 +258,6 @@ computeUpdatedDefinitionDiffs (fromCodebase, fromRuntime, fromPerspective) (toCo RenamedTo r names name -> RenamedTo r names (Left name) RenamedFrom r names name -> RenamedFrom r names (Right name) - throwAwayConstructorDiffs :: - DefinitionDiffKind a (Either ConstructorReference TermDefinition) diff -> Maybe (DefinitionDiffKind a TermDefinition diff) - throwAwayConstructorDiffs = \case - Added ref (Right term) -> Just (Added ref term) - NewAlias ref names (Right term) -> Just (NewAlias ref names term) - Removed ref (Right term) -> Just (Removed ref term) - Updated old new diff -> Just (Updated old new diff) - Propagated old new diff -> Just (Propagated old new diff) - RenamedTo ref names (Right term) -> Just (RenamedTo ref names term) - RenamedFrom ref names (Right term) -> Just (RenamedFrom ref names term) - -- - Added _ (Left _) -> Nothing - NewAlias _ _ (Left _) -> Nothing - Removed _ (Left _) -> Nothing - RenamedFrom _ _ (Left _) -> Nothing - RenamedTo _ _ (Left _) -> Nothing - -- | Note: Only use this if you're diffing a single definition, otherwise batch operations are -- more efficient. diffTerms :: @@ -207,19 +266,17 @@ diffTerms :: (Codebase.CodebaseEnv, Codebase.CodebaseRuntime new IO, NamesPerspective (PG.Transaction NamespaceDiffError), Name) -> PG.Transaction NamespaceDiffError (Maybe TermDefinitionDiff) diffTerms !_authZReceipt (oldCodebase, oldRt, oldNp, oldName) (newCodebase, newRt, newNp, newName) = do - oldTerm <- getTermDefinitionsOf oldCodebase oldRt oldNp id oldName `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "term-not-found") ("'From' term not found: " <> Name.toText oldName)) - newTerm <- getTermDefinitionsOf newCodebase newRt newNp id newName `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "term-not-found") ("'To' term not found: " <> Name.toText newName)) - pure $ diffTermsPure (oldTerm, newTerm) - -diffTermsPure :: - (Either a2 TermDefinition, Either a3 TermDefinition) -> (Maybe TermDefinitionDiff) -diffTermsPure = \case - (Right oldTerm, Right newTerm) -> - let termDiffDisplayObject = DefinitionDiff.diffDisplayObjects (termDefinition oldTerm) (termDefinition newTerm) - in (Just TermDefinitionDiff {left = oldTerm, right = newTerm, diff = termDiffDisplayObject}) - -- For later: decide how to render a constructor-to-term or constructor-to-constructor diff - -- Just dropping them from the diff for now - _ -> Nothing + oldTerm <- expectTermDefinitionsOf oldCodebase oldRt oldNp id oldName + newTerm <- expectTermDefinitionsOf newCodebase newRt newNp id newName + pure $ diffTermsPure oldTerm newTerm + +diffTermsPure :: Either ConstructorReference TermDefinition -> Either ConstructorReference TermDefinition -> Maybe TermDefinitionDiff +diffTermsPure (Right oldTerm) (Right newTerm) = + let termDiffDisplayObject = DefinitionDiff.diffDisplayObjects (termDefinition oldTerm) (termDefinition newTerm) + in (Just TermDefinitionDiff {left = oldTerm, right = newTerm, diff = termDiffDisplayObject}) +-- For later: decide how to render a constructor-to-term or constructor-to-constructor diff +-- Just dropping them from the diff for now +diffTermsPure _ _ = Nothing -- | Get definitions for a batch of terms within a codebase and perspective. -- NOTE: The names should already be properly scoped to the names perspective. @@ -233,7 +290,7 @@ getTermDefinitionsOf :: m t getTermDefinitionsOf codebase rt namesPerspective trav s = do s - & asListOfDeduped trav %%~ \names -> do + & asListOf trav %%~ \names -> do Definitions.termDefinitionByNamesOf codebase ppedBuilder namesPerspective renderWidth rt includeDocs traversed names where includeDocs = False @@ -256,23 +313,45 @@ expectTermDefinitionsOf codebase rt np trav s = (name, Nothing) -> throwError (MissingEntityError $ EntityMissing (ErrorID "term-not-found") ("Term not found: " <> Name.toText name <> ", in names perspective: " <> tShow np)) (_, Just termDef) -> pure termDef +expectTermDefinitionsByNamedRefsOf :: + (PG.QueryM m) => + Codebase.CodebaseEnv -> + Codebase.CodebaseRuntime sym IO -> + NamesPerspective m -> + (Name -> Referent) -> + Traversal s t Name (Either ConstructorReference TermDefinition) -> + s -> + m t +expectTermDefinitionsByNamedRefsOf codebase rt namesPerspective toReferent trav s = do + s + & asListOf trav %%~ \names -> + Definitions.termDefinitionByNamedRefsOf + codebase + ppedBuilder + namesPerspective + renderWidth + rt + includeDocs + traverse + (map (\name -> (name, toReferent name)) names) + where + includeDocs = False + ppedBuilder deps = PPEPostgres.ppedForReferences namesPerspective deps + renderWidth :: Width + renderWidth = 80 + diffTypes :: AuthZReceipt -> (Codebase.CodebaseEnv, Codebase.CodebaseRuntime old IO, NamesPerspective (PG.Transaction NamespaceDiffError), Name) -> (Codebase.CodebaseEnv, Codebase.CodebaseRuntime new IO, NamesPerspective (PG.Transaction NamespaceDiffError), Name) -> PG.Transaction NamespaceDiffError TypeDefinitionDiff diffTypes !_authZReceipt (oldCodebase, oldRt, oldNp, oldTypeName) (newCodebase, newRt, newNp, newTypeName) = do - oldType <- - getTypeDefinitionsOf oldCodebase oldRt oldNp id oldTypeName - `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "type-not-found") ("'From' Type not found: " <> Name.toText oldTypeName)) - newType <- - getTypeDefinitionsOf newCodebase newRt newNp id newTypeName - `whenNothingM` throwError (MissingEntityError $ EntityMissing (ErrorID "type-not-found") ("'To' Type not found: " <> Name.toText newTypeName)) - pure $ diffTypesPure (oldType, newType) - -diffTypesPure :: - (TypeDefinition, TypeDefinition) -> TypeDefinitionDiff -diffTypesPure (oldType, newType) = do + oldType <- expectTypeDefinitionsOf oldCodebase oldRt oldNp id oldTypeName + newType <- expectTypeDefinitionsOf newCodebase newRt newNp id newTypeName + pure $ diffTypesPure oldType newType + +diffTypesPure :: TypeDefinition -> TypeDefinition -> TypeDefinitionDiff +diffTypesPure oldType newType = let typeDiffDisplayObject = DefinitionDiff.diffDisplayObjects (typeDefinition oldType) (typeDefinition newType) in TypeDefinitionDiff {left = oldType, right = newType, diff = typeDiffDisplayObject} @@ -288,11 +367,38 @@ getTypeDefinitionsOf :: m t getTypeDefinitionsOf codebase rt namesPerspective trav s = do s - & asListOfDeduped trav %%~ \names -> do + & asListOf trav %%~ \names -> do Definitions.typeDefinitionsByNamesOf codebase ppedBuilder namesPerspective renderWidth rt includeDocs traversed names where includeDocs = False - ppedBuilder deps = PPEPostgres.ppedForReferences namesPerspective deps + ppedBuilder = PPEPostgres.ppedForReferences namesPerspective + renderWidth :: Width + renderWidth = 80 + +expectTypeDefinitionsByNamedRefsOf :: + (PG.QueryM m) => + Codebase.CodebaseEnv -> + Codebase.CodebaseRuntime sym IO -> + NamesPerspective m -> + (Name -> TypeReference) -> + Traversal s t Name TypeDefinition -> + s -> + m t +expectTypeDefinitionsByNamedRefsOf codebase rt namesPerspective toReference trav s = do + s + & asListOf trav %%~ \names -> + Definitions.typeDefinitionsByNamedRefsOf + codebase + ppedBuilder + namesPerspective + renderWidth + rt + includeDocs + traverse + (map (\name -> (name, toReference name)) names) + where + includeDocs = False + ppedBuilder = PPEPostgres.ppedForReferences namesPerspective renderWidth :: Width renderWidth = 80 @@ -310,3 +416,15 @@ expectTypeDefinitionsOf codebase rt np trav s = for (zip names results) \case (name, Nothing) -> throwError (MissingEntityError $ EntityMissing (ErrorID "type-not-found") ("Type not found: " <> Name.toText name <> ", in names perspective: " <> tShow np)) (_, Just typeDef) -> pure typeDef + +-- Quick helper that makes a `Map k v` from an input list of `k` and a monadic `v`-fetching function +-- +-- A simpler version of this might elide the traversal and instead just be: +-- +-- deriveMapOf :: (Ord k, Functor m) => ([k] -> m [v]) -> [k] -> m (Map k v) +-- +-- However, that'd require the caller to provide a `v`-fetching function that returns the same number of `v` as there +-- were `k` input. That's not hard to do, the traversal just does that for us (assuming it's law-abiding). +deriveMapOf :: (Ord k, Functor m) => (forall s t. Traversal s t k v -> s -> m t) -> [k] -> m (Map k v) +deriveMapOf f ks = do + Map.fromList . zip ks <$> f traverse ks diff --git a/src/Share/Web/Share/Impl.hs b/src/Share/Web/Share/Impl.hs index a0ec4667..2ad23dba 100644 --- a/src/Share/Web/Share/Impl.hs +++ b/src/Share/Web/Share/Impl.hs @@ -12,6 +12,7 @@ import Data.Text qualified as Text import Servant import Share.Branch qualified as Branch import Share.Codebase qualified as Codebase +import Share.Codebase.CodeCache qualified as CodeCache import Share.Codebase.CodebaseRuntime qualified as CR import Share.Codebase.Types qualified as Codebase import Share.Env qualified as Env @@ -247,9 +248,10 @@ typeSummaryEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHandle ref mayNam authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkReadUserCodebase callerUserId codebaseOwner authPath let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc (rootCausalId, _rootCausalHash) <- PG.runTransactionMode PG.ReadCommitted PG.Read $ Codebase.expectLooseCodeRoot codebase - Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "type-summary" cacheParams rootCausalId $ do - PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - serveTypeSummary codebase ref mayName renderWidth + Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "type-summary" cacheParams rootCausalId do + PG.runTransactionMode PG.ReadCommitted PG.ReadWrite do + CodeCache.withCodeCache codebase \codeCache -> do + serveTypeSummary codeCache ref mayName renderWidth where cacheParams = [toUrlPiece ref, maybe "" Name.toText mayName, tShow $ fromMaybe mempty relativeTo, foldMap toUrlPiece renderWidth] authPath :: Path.Path diff --git a/src/Share/Web/Share/Releases/Impl.hs b/src/Share/Web/Share/Releases/Impl.hs index 8bb8069e..f1303894 100644 --- a/src/Share/Web/Share/Releases/Impl.hs +++ b/src/Share/Web/Share/Releases/Impl.hs @@ -70,6 +70,7 @@ import Unison.Server.Share.RenderDoc (findAndRenderDoc) import Unison.Server.Types (DefinitionDisplayResults, NamespaceDetails (..), Suffixify (..)) import Unison.Syntax.Name qualified as Name import Unison.Util.Pretty qualified as Pretty +import qualified Share.Codebase.CodeCache as CodeCache releasesServer :: Maybe Session -> UserHandle -> ProjectSlug -> ServerT API.ProjectReleasesAPI WebApp releasesServer session handle projectSlug = @@ -235,9 +236,10 @@ projectReleaseTypeSummaryEndpoint (AuthN.MaybeAuthedUserID callerUserId) userHan authZReceipt <- AuthZ.permissionGuard $ AuthZ.checkProjectReleaseRead callerUserId projectId let codebaseLoc = Codebase.codebaseLocationForProjectRelease projectOwnerUserId let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc - Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-release-type-summary" cacheParams releaseHead $ do - PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - serveTypeSummary codebase ref mayName renderWidth + Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-release-type-summary" cacheParams releaseHead do + PG.runTransactionMode PG.ReadCommitted PG.ReadWrite do + CodeCache.withCodeCache codebase \codeCache -> do + serveTypeSummary codeCache ref mayName renderWidth where projectReleaseShortHand = ProjectReleaseShortHand {userHandle, projectSlug, releaseVersion} cacheParams = [IDs.toText projectReleaseShortHand, toUrlPiece ref, maybe "" Name.toText mayName, tShow $ fromMaybe mempty relativeTo, foldMap toUrlPiece renderWidth] @@ -260,9 +262,10 @@ projectReleaseDefinitionDependenciesByNameEndpoint (AuthN.MaybeAuthedUserID call let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definition-dependencies-by-name" cacheParams causalId $ do PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId - np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) - DefinitionSearchResults <$> Defns.definitionDependencyResults codebase name projectShorthand branchOrReleaseShortHand np renderWidth + CodeCache.withCodeCache codebase \codeCache -> do + rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId + np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) + DefinitionSearchResults <$> Defns.definitionDependencyResults codebase codeCache name projectShorthand branchOrReleaseShortHand np renderWidth where projectShorthand = ProjectShortHand {userHandle, projectSlug} branchOrReleaseShortHand = IDs.IsReleaseShortHand releaseShortHand @@ -290,9 +293,10 @@ projectReleaseDefinitionDependenciesByHashEndpoint (AuthN.MaybeAuthedUserID call let query = HQ.HashOnly shortHash Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definition-dependencies-by-hash" (cacheParams query) causalId $ do PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId - np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) - DefinitionSearchResults <$> Defns.definitionDependencyResults codebase query projectShorthand branchOrReleaseShortHand np renderWidth + CodeCache.withCodeCache codebase \codeCache -> do + rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId + np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) + DefinitionSearchResults <$> Defns.definitionDependencyResults codebase codeCache query projectShorthand branchOrReleaseShortHand np renderWidth where projectShorthand = ProjectShortHand {userHandle, projectSlug} branchOrReleaseShortHand = IDs.IsReleaseShortHand releaseShortHand @@ -318,9 +322,10 @@ projectReleaseDefinitionDependentsByNameEndpoint (AuthN.MaybeAuthedUserID caller let codebase = Codebase.codebaseEnv authZReceipt codebaseLoc Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definition-dependents-by-name" cacheParams causalId $ do PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId - np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) - DefinitionSearchResults <$> Defns.definitionDependentResults codebase name projectShorthand branchOrReleaseShortHand np renderWidth + CodeCache.withCodeCache codebase \codeCache -> do + rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId + np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) + DefinitionSearchResults <$> Defns.definitionDependentResults codebase codeCache name projectShorthand branchOrReleaseShortHand np renderWidth where projectShorthand = ProjectShortHand {userHandle, projectSlug} branchOrReleaseShortHand = IDs.IsReleaseShortHand releaseShortHand @@ -348,9 +353,10 @@ projectReleaseDefinitionDependentsByHashEndpoint (AuthN.MaybeAuthedUserID caller let query = HQ.HashOnly shortHash Codebase.cachedCodebaseResponse authZReceipt codebaseLoc "project-branch-definition-dependents-by-hash" (cacheParams query) causalId $ do PG.runTransactionMode PG.ReadCommitted PG.ReadWrite $ do - rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId - np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) - DefinitionSearchResults <$> Defns.definitionDependentResults codebase query projectShorthand branchOrReleaseShortHand np renderWidth + CodeCache.withCodeCache codebase \codeCache -> do + rootBranchHashId <- CausalQ.expectNamespaceIdsByCausalIdsOf id causalId + np <- NP.namesPerspectiveForRootAndPath rootBranchHashId (maybe mempty pathToPathSegments relativeTo) + DefinitionSearchResults <$> Defns.definitionDependentResults codebase codeCache query projectShorthand branchOrReleaseShortHand np renderWidth where projectShorthand = ProjectShortHand {userHandle, projectSlug} branchOrReleaseShortHand = IDs.IsReleaseShortHand releaseShortHand diff --git a/src/Unison/Server/Share/DefinitionSummary.hs b/src/Unison/Server/Share/DefinitionSummary.hs index 362d3d7f..2d4ec48e 100644 --- a/src/Unison/Server/Share/DefinitionSummary.hs +++ b/src/Unison/Server/Share/DefinitionSummary.hs @@ -20,6 +20,7 @@ import Control.Lens import Data.List (zipWith4) import Share.Backend qualified as Backend import Share.Codebase qualified as Codebase +import Share.Codebase.Types (CodeCache) import Share.Postgres (QueryM, unrecoverableError) import Share.Postgres.NamesPerspective.Types (NamesPerspective) import Share.Prelude @@ -85,22 +86,22 @@ termSummariesForReferentsOf namesPerspective mayWidth trav s = do serveTypeSummary :: (QueryM m) => - Codebase.CodebaseEnv -> + CodeCache scope -> Reference -> Maybe Name -> Maybe Width -> m TypeSummary -serveTypeSummary codebase reference mayName mayWidth = do - typeSummariesForReferencesOf codebase mayWidth id (reference, mayName) +serveTypeSummary codeCache reference mayName mayWidth = do + typeSummariesForReferencesOf codeCache mayWidth id (reference, mayName) typeSummariesForReferencesOf :: (QueryM m) => - Codebase.CodebaseEnv -> + CodeCache scope -> Maybe Width -> Traversal s t (Reference, Maybe Name) TypeSummary -> s -> m t -typeSummariesForReferencesOf codebase mayWidth trav s = do +typeSummariesForReferencesOf codeCache mayWidth trav s = do s & asListOf trav %%~ \inputs -> do let (refs, mayNames) = unzip inputs @@ -108,7 +109,7 @@ typeSummariesForReferencesOf codebase mayWidth trav s = do let displayNames = zipWith (\mayName shortHash -> maybe (HQ.HashOnly shortHash) HQ.NameOnly mayName) mayNames shortHashes tags <- Backend.getTypeTagsOf traversed refs - displayDecls <- Backend.displayTypesOf codebase traversed refs + displayDecls <- Backend.displayTypesOf codeCache traversed refs let syntaxHeaders = zipWith (Backend.typeToSyntaxHeader width) displayNames displayDecls <&> bimap Backend.mungeSyntaxText Backend.mungeSyntaxText diff --git a/src/Unison/Server/Share/Definitions.hs b/src/Unison/Server/Share/Definitions.hs index 701aa1cd..a5188bd7 100644 --- a/src/Unison/Server/Share/Definitions.hs +++ b/src/Unison/Server/Share/Definitions.hs @@ -3,7 +3,9 @@ module Unison.Server.Share.Definitions resolveHQName, definitionDependencies, termDefinitionByNamesOf, + termDefinitionByNamedRefsOf, typeDefinitionsByNamesOf, + typeDefinitionsByNamedRefsOf, definitionDependencyResults, definitionDependentResults, ) @@ -21,7 +23,7 @@ import Share.Backend qualified as Backend import Share.BackgroundJobs.Search.DefinitionSync.Types (TermOrTypeSummary (..)) import Share.Codebase (CodebaseEnv, CodebaseRuntime) import Share.Codebase qualified as Codebase -import Share.Codebase.Types (CodebaseEnv (..)) +import Share.Codebase.Types (CodeCache, CodebaseEnv (..)) import Share.IDs import Share.Postgres (QueryM, transactionSpan) import Share.Postgres qualified as PG @@ -55,6 +57,7 @@ import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.Reference (TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Reference qualified as V1 +import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Server.Doc qualified as Doc import Unison.Server.NameSearch (NameSearch (..)) @@ -136,13 +139,14 @@ definitionDependencies codebase name nameSearch = do definitionDependencyResults :: (QueryM m) => CodebaseEnv -> + CodeCache scope -> HQ.HashQualified Name -> ProjectShortHand -> BranchOrReleaseShortHand -> NamesPerspective m -> Maybe Width -> m [DefinitionSearchResult] -definitionDependencyResults codebase hqName project branchRef np mayWidth = do +definitionDependencyResults codebase codeCache hqName project branchRef np mayWidth = do let nameSearch = PGNameSearch.nameSearchForPerspective np deps <- definitionDependencies codebase hqName nameSearch ppe <- PPED.unsuffixifiedPPE <$> PPEPostgres.ppedForReferences np deps @@ -161,7 +165,7 @@ definitionDependencyResults codebase hqName project branchRef np mayWidth = do hqFqn <- hoistMaybe $ PPE.types ppe typeRef let fqn = HQ'.toName hqFqn -- TODO: batchify this - summary <- fmap ToTTypeSummary . lift $ Summary.typeSummariesForReferencesOf codebase mayWidth id (typeRef, Just fqn) + summary <- fmap ToTTypeSummary . lift $ Summary.typeSummariesForReferencesOf codeCache mayWidth id (typeRef, Just fqn) pure $ DefinitionSearchResult {fqn, summary, project, branchRef} -- Ideally we'd do this via the database, but we actually _can't_, since the database only @@ -216,16 +220,17 @@ definitionDependents codebase name nameSearch = do -- | Returns all the definitions which depend on the query. definitionDependentResults :: - forall m. + forall m scope. (QueryM m) => CodebaseEnv -> + CodeCache scope -> HQ.HashQualified Name -> ProjectShortHand -> BranchOrReleaseShortHand -> NamesPerspective m -> Maybe Width -> m [DefinitionSearchResult] -definitionDependentResults codebase hqName project branchRef np mayWidth = do +definitionDependentResults codebase codeCache hqName project branchRef np mayWidth = do let nameSearch = PGNameSearch.nameSearchForPerspective np deps <- definitionDependents codebase hqName nameSearch ppe <- PPED.unsuffixifiedPPE <$> PPEPostgres.ppedForReferences np deps @@ -256,7 +261,7 @@ definitionDependentResults codebase hqName project branchRef np mayWidth = do let hqFqns = typeRefsMap & mapMaybe (PPE.types ppe) let fqns = HQ'.toName <$> hqFqns typeSummaries <- - Summary.typeSummariesForReferencesOf codebase mayWidth traversed (Data.zip2 typeRefsMap (Just <$> fqns)) + Summary.typeSummariesForReferencesOf codeCache mayWidth traversed (Data.zip2 typeRefsMap (Just <$> fqns)) <&> fmap ToTTypeSummary Data.zipWith2 fqns typeSummaries (\fqn summary -> DefinitionSearchResult {fqn, summary, project, branchRef}) & Map.elems @@ -313,7 +318,7 @@ displayDefinitionByHQName codebase@(CodebaseEnv {codebaseOwner}) perspective roo let biases = maybeToList $ HQ.toName query let ppedBuilder deps = (PPED.biasTo biases) <$> (PPEPostgres.ppedForReferences perspectiveNP deps) let nameSearch = PGNameSearch.nameSearchForPerspective perspectiveNP - dr@(Backend.DefinitionResults terms types misses) <- mkDefinitionsForQuery codebase nameSearch [query] + dr@(Backend.DefinitionResults terms types misses) <- mkDefinitionsForQuery rt.codeCache nameSearch [query] let width = mayDefaultWidth renderWidth let docResultsOf :: forall s t. Traversal s t Name [(HashQualifiedName, UnisonHash, Doc.Doc)] -> s -> m t docResultsOf trav s = do @@ -375,19 +380,19 @@ type PPEDBuilder m = Set LD.LabeledDependency -> m PPED.PrettyPrintEnvDecl -- | Mirrors Backend.definitionsBySuffixes but without doing a suffix search. mkDefinitionsForQuery :: (QueryM m) => - CodebaseEnv -> + CodeCache scope -> NameSearch m -> [HQ.HashQualified Name] -> m Backend.DefinitionResults -mkDefinitionsForQuery codebase nameSearch query = do +mkDefinitionsForQuery codeCache nameSearch query = do QueryResult misses results <- hqNameQuery nameSearch query let termRefs = Set.toList $ searchResultsToTermRefs results -- todo: remember to replace this with getting components directly, -- and maybe even remove getComponentLength from Codebase interface altogether - displayedTerms <- Backend.displayTermsOf codebase traversed termRefs + displayedTerms <- Backend.displayTermsOf codeCache traversed termRefs let termsMap = Map.fromList (zip termRefs displayedTerms) let typeRefsMap = Data.mapFromSelf . Set.toList $ searchResultsToTypeRefs results - typesMap <- Backend.displayTypesOf codebase traversed typeRefsMap + typesMap <- Backend.displayTypesOf codeCache traversed typeRefsMap pure (Backend.DefinitionResults termsMap typesMap misses) where searchResultsToTermRefs :: [SR.SearchResult] -> Set V1.Reference @@ -408,12 +413,12 @@ mkDefinitionsForQuery codebase nameSearch query = do -- Just Right means term termDisplayObjectsByNamesOf :: (QueryM m) => - Codebase.CodebaseEnv -> + CodeCache scope -> NamesPerspective m -> Traversal s t Name (Maybe (Either ConstructorReference (TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann)))) -> s -> m t -termDisplayObjectsByNamesOf codebase namesPerspective trav s = do +termDisplayObjectsByNamesOf codeCache namesPerspective trav s = do s & asListOfDeduped trav %%~ \names -> do allRefs <- PGNameSearch.termRefsByHQNamesOf namesPerspective traversed (HQ'.NameOnly <$> names) @@ -425,7 +430,7 @@ termDisplayObjectsByNamesOf codebase namesPerspective trav s = do <&> \case (Referent.Ref r) -> Right $ (r, r) (Referent.Con r _) -> (Left r) - Backend.displayTermsOf codebase (traversed . _Just . _Right . _2) partitionedRefs + Backend.displayTermsOf codeCache (traversed . _Just . _Right . _2) partitionedRefs termDefinitionByNamesOf :: (QueryM m) => @@ -441,7 +446,7 @@ termDefinitionByNamesOf :: termDefinitionByNamesOf codebase ppedBuilder namesPerspective width rt includeDocs trav s = do s & asListOf trav %%~ \allNames -> do - constructorsAndRendered <- termDisplayObjectsByNamesOf codebase namesPerspective traversed allNames + constructorsAndRendered <- termDisplayObjectsByNamesOf rt.codeCache namesPerspective traversed allNames let addName name = \case Just (Right (termRef, displayObject)) -> Just (Right (name, termRef, displayObject)) Just (Left constructorRef) -> Just (Left constructorRef) @@ -449,33 +454,68 @@ termDefinitionByNamesOf codebase ppedBuilder namesPerspective width rt includeDo let withNames = zipWith addName allNames constructorsAndRendered -- Only the Right values are terms which we're concerned with, the Left values are constructors withNames - & asListOf (traversed . _Just . _Right) %%~ \(refsDO :: [(Name, TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))]) -> do - let allDeps = refsDO & foldMap \(_name, ref, displayObject) -> termDisplayObjectLabeledDependencies ref displayObject - pped <- ppedBuilder allDeps - let (names, refs, dos) = unzip3 refsDO - allRenderedDocs <- - if includeDocs - then do - allDocRefs <- Docs.docsForDefinitionNamesOf codebase namesPerspective traversed names - -- TODO: properly batchify this - for allDocRefs $ renderDocRefs codebase ppedBuilder width rt - else pure (names $> []) - let syntaxDOs = snd <$> Backend.termsToSyntaxOf (Suffixify False) width pped traversed (zip refs dos) - Backend.mkTermDefinitionsOf codebase pped width traversed (zip4 (Just <$> names) refs allRenderedDocs syntaxDOs) + & asListOf (traversed . _Just . _Right) %%~ mkTermDefinitions codebase ppedBuilder namesPerspective width rt includeDocs -termDisplayObjectLabeledDependencies :: TermReference -> DisplayObject (Type Symbol Ann) (Term Symbol Ann) -> (Set LD.LabeledDependency) +termDefinitionByNamedRefsOf :: + (QueryM m) => + CodebaseEnv -> + PPEDBuilder m -> + NamesPerspective m -> + Width -> + CodebaseRuntime sym IO -> + Bool -> + Traversal s t (Name, Referent) (Either ConstructorReference TermDefinition) -> + s -> + m t +termDefinitionByNamedRefsOf codebase ppedBuilder namesPerspective width rt includeDocs trav s = do + s + & asListOf trav %%~ \refs0 -> do + terms <- + refs0 + & map \case + (_, Referent.Con ref _) -> Left ref + (name, Referent.Ref ref) -> Right (name, ref, ref) + & Backend.displayTermsOf rt.codeCache (traversed . _Right . _3) + terms + & asListOf (traversed . _Right) %%~ mkTermDefinitions codebase ppedBuilder namesPerspective width rt includeDocs + +mkTermDefinitions :: + (QueryM m) => + CodebaseEnv -> + PPEDBuilder m -> + NamesPerspective m -> + Width -> + CodebaseRuntime sym IO -> + Bool -> + [(Name, TermReference, DisplayObject (Type Symbol Ann) (Term Symbol Ann))] -> + m [TermDefinition] +mkTermDefinitions codebase ppedBuilder namesPerspective width rt includeDocs refsDO = do + let allDeps = refsDO & foldMap \(_name, ref, displayObject) -> termDisplayObjectLabeledDependencies ref displayObject + pped <- ppedBuilder allDeps + let (names, refs, dos) = unzip3 refsDO + allRenderedDocs <- + if includeDocs + then do + allDocRefs <- Docs.docsForDefinitionNamesOf codebase namesPerspective traversed names + -- TODO: properly batchify this + for allDocRefs $ renderDocRefs codebase ppedBuilder width rt + else pure (names $> []) + let syntaxDOs = snd <$> Backend.termsToSyntaxOf (Suffixify False) width pped traversed (zip refs dos) + Backend.mkTermDefinitionsOf codebase pped width traversed (zip4 (Just <$> names) refs allRenderedDocs syntaxDOs) + +termDisplayObjectLabeledDependencies :: TermReference -> DisplayObject (Type Symbol Ann) (Term Symbol Ann) -> Set LD.LabeledDependency termDisplayObjectLabeledDependencies termRef displayObject = do displayObject & bifoldMap (Type.labeledDependencies) (Term.labeledDependencies) & Set.insert (LD.TermReference termRef) -typeDisplayObjectsByNamesOf :: (QueryM m) => Codebase.CodebaseEnv -> NamesPerspective m -> Traversal s t Name (Maybe (TypeReference, DisplayObject () (DD.Decl Symbol Ann))) -> s -> m t -typeDisplayObjectsByNamesOf codebase namesPerspective trav s = do +typeDisplayObjectsByNamesOf :: (QueryM m) => CodeCache scope -> NamesPerspective m -> Traversal s t Name (Maybe (TypeReference, DisplayObject () (DD.Decl Symbol Ann))) -> s -> m t +typeDisplayObjectsByNamesOf codeCache namesPerspective trav s = do s & asListOf trav %%~ \names -> do foundRefs <- PGNameSearch.typeRefsByHQNamesOf namesPerspective traversed (HQ'.NameOnly <$> names) let refs = fmap (\ref -> (ref, ref)) . Set.lookupMin <$> foundRefs - Backend.displayTypesOf codebase (traversed . _Just . _2) refs + Backend.displayTypesOf codeCache (traversed . _Just . _2) refs -- | NOTE: If you're displaying many definitions you should probably generate a single PPED to -- share among all of them, it would be more efficient than generating a PPED per definition. @@ -492,26 +532,61 @@ typeDefinitionsByNamesOf :: m t typeDefinitionsByNamesOf codebase ppedBuilder namesPerspective width rt includeDocs trav s = do s - & asListOfDeduped trav %%~ \allNames -> do - typeDisplayObjs <- typeDisplayObjectsByNamesOf codebase namesPerspective traversed allNames + & asListOf trav %%~ \allNames -> do + typeDisplayObjs <- typeDisplayObjectsByNamesOf rt.codeCache namesPerspective traversed allNames let addName name = \case Just (ref, displayObject) -> Just (name, ref, displayObject) Nothing -> Nothing let withNames = zipWith addName allNames typeDisplayObjs withNames - & asListOf (traversed . _Just) %%~ \displayInfos -> do - let (names, refs, displayObjects) = unzip3 displayInfos - let allDeps = displayInfos & foldMap \(_name, ref, dispObj) -> typeDisplayObjectLabeledDependencies ref dispObj - pped <- ppedBuilder allDeps - allRenderedDocs <- - if includeDocs - then do - allDocRefs <- Docs.docsForDefinitionNamesOf codebase namesPerspective traversed names - -- TODO: properly batchify this - for allDocRefs $ renderDocRefs codebase ppedBuilder width rt - else pure (names $> []) - let syntaxDOs = snd <$> Backend.typesToSyntaxOf (Suffixify False) width pped traversed (zip refs displayObjects) - Backend.mkTypeDefinitionsOf pped width traversed (zip4 (Just <$> names) refs allRenderedDocs syntaxDOs) + & asListOf (traversed . _Just) + %%~ mkTypeDefinitions codebase ppedBuilder namesPerspective width rt includeDocs + +-- | NOTE: If you're displaying many definitions you should probably generate a single PPED to +-- share among all of them, it would be more efficient than generating a PPED per definition. +typeDefinitionsByNamedRefsOf :: + (QueryM m) => + CodebaseEnv -> + PPEDBuilder m -> + NamesPerspective m -> + Width -> + CodebaseRuntime sym IO -> + Bool -> + Traversal s t (Name, TypeReference) TypeDefinition -> + s -> + m t +typeDefinitionsByNamedRefsOf codebase ppedBuilder namesPerspective width rt includeDocs trav s = do + s + & asListOf trav %%~ \refs0 -> do + types <- + refs0 + & map (\(name, ref) -> (name, ref, ref)) + & Backend.displayTypesOf rt.codeCache (traversed . _3) + mkTypeDefinitions codebase ppedBuilder namesPerspective width rt includeDocs types + +mkTypeDefinitions :: + (QueryM m) => + CodebaseEnv -> + PPEDBuilder m -> + NamesPerspective m -> + Width -> + CodebaseRuntime sym IO -> + Bool -> + [(Name, TypeReference, DisplayObject () (DD.Decl Symbol Ann))] -> + m [TypeDefinition] +mkTypeDefinitions codebase ppedBuilder namesPerspective width rt includeDocs displayInfos = do + let (names, refs, displayObjects) = unzip3 displayInfos + let allDeps = displayInfos & foldMap \(_name, ref, dispObj) -> typeDisplayObjectLabeledDependencies ref dispObj + pped <- ppedBuilder allDeps + allRenderedDocs <- + if includeDocs + then do + allDocRefs <- Docs.docsForDefinitionNamesOf codebase namesPerspective traversed names + -- TODO: properly batchify this + for allDocRefs $ renderDocRefs codebase ppedBuilder width rt + else pure (names $> []) + let syntaxDOs = snd <$> Backend.typesToSyntaxOf (Suffixify False) width pped traversed (zip refs displayObjects) + Backend.mkTypeDefinitionsOf pped width traversed (zip4 (Just <$> names) refs allRenderedDocs syntaxDOs) typeDisplayObjectLabeledDependencies :: TypeReference -> DisplayObject () (DD.Decl Symbol Ann) -> Set LD.LabeledDependency typeDisplayObjectLabeledDependencies typeRef displayObject = do diff --git a/transcripts/share-apis/contribution-diffs/contribution-diff.json b/transcripts/share-apis/contribution-diffs/contribution-diff.json index 172ac1b2..84e70b48 100644 --- a/transcripts/share-apis/contribution-diffs/contribution-diff.json +++ b/transcripts/share-apis/contribution-diffs/contribution-diff.json @@ -1737,418 +1737,6 @@ }, "tag": "Plain" }, - { - "contents": { - "contents": { - "diff": { - "diff": { - "diff": { - "contents": [ - { - "diffTag": "both", - "elements": [ - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - } - ] - }, - { - "diffTag": "annotationChange", - "fromAnnotation": { - "contents": "#ofktbubbloi1omgpr09e0t90pg0cnf0lsuuopqese9biqvpdafsuhq0b4dfasbk6g3hp5r7crp4t486fc8bava7q7rrreg9j2volam8", - "tag": "TermReference" - }, - "segment": "termUpdateMe", - "toAnnotation": { - "contents": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", - "tag": "TermReference" - } - }, - { - "diffTag": "both", - "elements": [ - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text.++", - "tag": "TermReference" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": " " - } - ] - }, - { - "diffTag": "annotationChange", - "fromAnnotation": { - "contents": "#ofktbubbloi1omgpr09e0t90pg0cnf0lsuuopqese9biqvpdafsuhq0b4dfasbk6g3hp5r7crp4t486fc8bava7q7rrreg9j2volam8", - "tag": "TermReference" - }, - "segment": "termUpdateMe", - "toAnnotation": { - "contents": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", - "tag": "TermReference" - } - } - ], - "tag": "UserObject" - }, - "diffKind": "diff" - }, - "left": { - "bestTermName": "termDependsOnUpdateMe", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#ofktbubbloi1omgpr09e0t90pg0cnf0lsuuopqese9biqvpdafsuhq0b4dfasbk6g3hp5r7crp4t486fc8bava7q7rrreg9j2volam8", - "tag": "TermReference" - }, - "segment": "termUpdateMe" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text.++", - "tag": "TermReference" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#ofktbubbloi1omgpr09e0t90pg0cnf0lsuuopqese9biqvpdafsuhq0b4dfasbk6g3hp5r7crp4t486fc8bava7q7rrreg9j2volam8", - "tag": "TermReference" - }, - "segment": "termUpdateMe" - } - ], - "tag": "UserObject" - }, - "termDocs": [], - "termNames": [ - "termDependsOnUpdateMe" - ] - }, - "right": { - "bestTermName": "termDependsOnUpdateMe", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", - "tag": "TermReference" - }, - "segment": "termUpdateMe" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text.++", - "tag": "TermReference" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", - "tag": "TermReference" - }, - "segment": "termUpdateMe" - } - ], - "tag": "UserObject" - }, - "termDocs": [], - "termNames": [ - "termDependsOnUpdateMe" - ] - } - }, - "fullName": "termDependsOnUpdateMe", - "newHash": "#t3u2jnk3eej5hrcrfr80vqiaj7n26grg15n4eb67bd1601jb65ikhbfdk18eeirovmaithk3ipukum6qnhttld43ovitj01kdkd4jrg", - "newTag": "Plain", - "oldHash": "#8imj19nvqqdtl1jd9ns5fksnuh4slku9hoi3sl7dh353k7o209eek4aievkp1sbqq5lqpgqouvf00k5b6t1fkv8omnpsnvmpu0a5lr8", - "oldTag": "Plain", - "shortName": "termDependsOnUpdateMe" - }, - "tag": "Propagated" - }, - "tag": "Plain" - }, { "contents": { "contents": { diff --git a/transcripts/share-apis/contribution-diffs/namespace-diff.json b/transcripts/share-apis/contribution-diffs/namespace-diff.json index 172ac1b2..84e70b48 100644 --- a/transcripts/share-apis/contribution-diffs/namespace-diff.json +++ b/transcripts/share-apis/contribution-diffs/namespace-diff.json @@ -1737,418 +1737,6 @@ }, "tag": "Plain" }, - { - "contents": { - "contents": { - "diff": { - "diff": { - "diff": { - "contents": [ - { - "diffTag": "both", - "elements": [ - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - } - ] - }, - { - "diffTag": "annotationChange", - "fromAnnotation": { - "contents": "#ofktbubbloi1omgpr09e0t90pg0cnf0lsuuopqese9biqvpdafsuhq0b4dfasbk6g3hp5r7crp4t486fc8bava7q7rrreg9j2volam8", - "tag": "TermReference" - }, - "segment": "termUpdateMe", - "toAnnotation": { - "contents": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", - "tag": "TermReference" - } - }, - { - "diffTag": "both", - "elements": [ - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text.++", - "tag": "TermReference" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": " " - } - ] - }, - { - "diffTag": "annotationChange", - "fromAnnotation": { - "contents": "#ofktbubbloi1omgpr09e0t90pg0cnf0lsuuopqese9biqvpdafsuhq0b4dfasbk6g3hp5r7crp4t486fc8bava7q7rrreg9j2volam8", - "tag": "TermReference" - }, - "segment": "termUpdateMe", - "toAnnotation": { - "contents": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", - "tag": "TermReference" - } - } - ], - "tag": "UserObject" - }, - "diffKind": "diff" - }, - "left": { - "bestTermName": "termDependsOnUpdateMe", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#ofktbubbloi1omgpr09e0t90pg0cnf0lsuuopqese9biqvpdafsuhq0b4dfasbk6g3hp5r7crp4t486fc8bava7q7rrreg9j2volam8", - "tag": "TermReference" - }, - "segment": "termUpdateMe" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text.++", - "tag": "TermReference" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#ofktbubbloi1omgpr09e0t90pg0cnf0lsuuopqese9biqvpdafsuhq0b4dfasbk6g3hp5r7crp4t486fc8bava7q7rrreg9j2volam8", - "tag": "TermReference" - }, - "segment": "termUpdateMe" - } - ], - "tag": "UserObject" - }, - "termDocs": [], - "termNames": [ - "termDependsOnUpdateMe" - ] - }, - "right": { - "bestTermName": "termDependsOnUpdateMe", - "defnTermTag": "Plain", - "signature": [ - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - } - ], - "termDefinition": { - "contents": [ - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "TypeAscriptionColon" - }, - "segment": " :" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text", - "tag": "TypeReference" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": { - "contents": "termDependsOnUpdateMe", - "tag": "HashQualifier" - }, - "segment": "termDependsOnUpdateMe" - }, - { - "annotation": { - "tag": "BindingEquals" - }, - "segment": " =" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseKeyword" - }, - "segment": "use " - }, - { - "annotation": { - "tag": "UsePrefix" - }, - "segment": "Text" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "tag": "UseSuffix" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": "\n" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", - "tag": "TermReference" - }, - "segment": "termUpdateMe" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "##Text.++", - "tag": "TermReference" - }, - "segment": "++" - }, - { - "annotation": null, - "segment": " " - }, - { - "annotation": { - "contents": "#711u1t9cjso4t3rhlq2rp491n2n5n4t9o7701053kpj5ouu3kfs2e2l63i879pnsb6ob9fp0gpj18u6fpcl1qosd704h4doklfo734g", - "tag": "TermReference" - }, - "segment": "termUpdateMe" - } - ], - "tag": "UserObject" - }, - "termDocs": [], - "termNames": [ - "termDependsOnUpdateMe" - ] - } - }, - "fullName": "termDependsOnUpdateMe", - "newHash": "#t3u2jnk3eej5hrcrfr80vqiaj7n26grg15n4eb67bd1601jb65ikhbfdk18eeirovmaithk3ipukum6qnhttld43ovitj01kdkd4jrg", - "newTag": "Plain", - "oldHash": "#8imj19nvqqdtl1jd9ns5fksnuh4slku9hoi3sl7dh353k7o209eek4aievkp1sbqq5lqpgqouvf00k5b6t1fkv8omnpsnvmpu0a5lr8", - "oldTag": "Plain", - "shortName": "termDependsOnUpdateMe" - }, - "tag": "Propagated" - }, - "tag": "Plain" - }, { "contents": { "contents": { diff --git a/unison b/unison index dbeea4d1..e1b98c86 160000 --- a/unison +++ b/unison @@ -1 +1 @@ -Subproject commit dbeea4d1a10b732bec992f1a0e2847cc7bc0ac93 +Subproject commit e1b98c8608fcce3c79c8e09f9d3e507175c9ac56