From 5e86a56dcdc2a4589e6f9b1bd947a7c33d717e68 Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Wed, 13 Dec 2023 11:35:29 -0500 Subject: [PATCH 1/3] move handleNamespaceDependencies into its own module --- unison-cli/src/Unison/Cli/MonadUtils.hs | 6 +++++ .../src/Unison/Codebase/Editor/HandleInput.hs | 13 ++--------- .../HandleInput/NamespaceDependencies.hs | 22 ++++++++++++++++++- 3 files changed, 29 insertions(+), 12 deletions(-) diff --git a/unison-cli/src/Unison/Cli/MonadUtils.hs b/unison-cli/src/Unison/Cli/MonadUtils.hs index 4761a15908..d82c80c4a4 100644 --- a/unison-cli/src/Unison/Cli/MonadUtils.hs +++ b/unison-cli/src/Unison/Cli/MonadUtils.hs @@ -31,6 +31,7 @@ module Unison.Cli.MonadUtils getLastSavedRootHash, setLastSavedRootHash, getMaybeBranchAt, + getMaybeBranch0At, expectBranchAtPath, expectBranchAtPath', expectBranch0AtPath, @@ -291,6 +292,11 @@ getMaybeBranchAt path = do rootBranch <- getRootBranch pure (Branch.getAt (Path.unabsolute path) rootBranch) +-- | Get the maybe-branch0 at an absolute path. +getMaybeBranch0At :: Path.Absolute -> Cli (Maybe (Branch0 IO)) +getMaybeBranch0At path = + fmap Branch.head <$> getMaybeBranchAt path + -- | Get the branch at a relative path, or return early if there's no such branch. expectBranchAtPath :: Path -> Cli (Branch IO) expectBranchAtPath = diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 990a39245a..56d1aeb5d3 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -75,7 +75,7 @@ import Unison.Codebase.Editor.HandleInput.MoveAll (handleMoveAll) import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch) import Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm) import Unison.Codebase.Editor.HandleInput.MoveType (doMoveType) -import Unison.Codebase.Editor.HandleInput.NamespaceDependencies qualified as NamespaceDependencies +import Unison.Codebase.Editor.HandleInput.NamespaceDependencies (handleNamespaceDependencies) import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper) import Unison.Codebase.Editor.HandleInput.ProjectClone (handleClone) import Unison.Codebase.Editor.HandleInput.ProjectCreate (projectCreate) @@ -1177,16 +1177,7 @@ loop e = do PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput ListDependentsI hq -> handleDependents hq ListDependenciesI hq -> handleDependencies hq - NamespaceDependenciesI namespacePath' -> do - Cli.Env {codebase} <- ask - path <- maybe Cli.getCurrentPath Cli.resolvePath' namespacePath' - Cli.getMaybeBranchAt path >>= \case - Nothing -> Cli.respond $ BranchEmpty (WhichBranchEmptyPath (Path.absoluteToPath' path)) - Just b -> do - externalDependencies <- - Cli.runTransaction (NamespaceDependencies.namespaceDependencies codebase (Branch.head b)) - ppe <- PPE.unsuffixifiedPPE <$> currentPrettyPrintEnvDecl Backend.Within - Cli.respondNumbered $ ListNamespaceDependencies ppe path externalDependencies + NamespaceDependenciesI path -> handleNamespaceDependencies path DebugNumberedArgsI -> do numArgs <- use #numberedArgs Cli.respond (DumpNumberedArgs numArgs) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index dcaf7fd6c3..1a116594d8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -1,24 +1,32 @@ module Unison.Codebase.Editor.HandleInput.NamespaceDependencies - ( namespaceDependencies, + ( handleNamespaceDependencies, ) where +import Control.Monad.Reader (ask) import Control.Monad.Trans.Maybe import Data.Map qualified as Map import Data.Set qualified as Set +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.PrettyPrintUtils (currentPrettyPrintEnvDecl) import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch (Branch0) import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Editor.Output qualified as Output +import Unison.Codebase.Path qualified as Path import Unison.DataDeclaration qualified as DD import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) import Unison.Prelude +import Unison.PrettyPrintEnvDecl qualified as PPED import Unison.Reference (Reference) import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent +import Unison.Server.Backend qualified as Backend import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Term qualified as Term @@ -26,6 +34,18 @@ import Unison.Util.Relation qualified as Relation import Unison.Util.Relation3 qualified as Relation3 import Unison.Util.Relation4 qualified as Relation4 +handleNamespaceDependencies :: Maybe Path.Path' -> Cli.Cli () +handleNamespaceDependencies namespacePath' = do + Cli.Env {codebase} <- ask + path <- maybe Cli.getCurrentPath Cli.resolvePath' namespacePath' + branch <- + Cli.getMaybeBranch0At path & onNothingM do + Cli.returnEarly (Output.BranchEmpty (Output.WhichBranchEmptyPath (Path.absoluteToPath' path))) + externalDependencies <- + Cli.runTransaction (namespaceDependencies codebase branch) + ppe <- PPED.unsuffixifiedPPE <$> currentPrettyPrintEnvDecl Backend.Within + Cli.respondNumbered $ Output.ListNamespaceDependencies ppe path externalDependencies + -- | Check the dependencies of all types, terms, and metadata in the current namespace, -- returns a map of dependencies which do not have a name within the current namespace, -- alongside the names of all of that thing's dependents. From d38345dbfce69cd8d85488dcf76f7f2f0e44f80a Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 14 Dec 2023 11:29:39 -0500 Subject: [PATCH 2/3] delete metadata concerns from namespace.dependencies --- .../HandleInput/NamespaceDependencies.hs | 26 +------------------ 1 file changed, 1 insertion(+), 25 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index 1a116594d8..9bfeb790fc 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -31,8 +31,6 @@ import Unison.Sqlite qualified as Sqlite import Unison.Symbol (Symbol) import Unison.Term qualified as Term import Unison.Util.Relation qualified as Relation -import Unison.Util.Relation3 qualified as Relation3 -import Unison.Util.Relation4 qualified as Relation4 handleNamespaceDependencies :: Maybe Path.Path' -> Cli.Cli () handleNamespaceDependencies namespacePath' = do @@ -75,7 +73,7 @@ namespaceDependencies codebase branch = do let dependenciesToDependents :: Map LabeledDependency (Set Name) dependenciesToDependents = - Map.unionsWith (<>) (metadata : typeDeps ++ termDeps) + Map.unionsWith (<>) (typeDeps ++ termDeps) let onlyExternalDeps :: Map LabeledDependency (Set Name) onlyExternalDeps = Map.filterWithKey @@ -92,25 +90,3 @@ namespaceDependencies codebase branch = do currentBranchTermRefs = Relation.domain (Branch.deepTerms branch) currentBranchTypeRefs :: Map Reference (Set Name) currentBranchTypeRefs = Relation.domain (Branch.deepTypes branch) - - -- Since metadata is only linked by reference, not by name, - -- it's possible that the metadata itself is external to the branch. - metadata :: Map LabeledDependency (Set Name) - metadata = - let typeMetadataRefs :: Map LabeledDependency (Set Name) - typeMetadataRefs = - (Branch.deepTypeMetadata branch) - & Relation4.d234 -- Select only the type and value portions of the metadata - & \rel -> - let types = Map.mapKeys LD.typeRef $ Relation.range (Relation3.d12 rel) - terms = Map.mapKeys LD.termRef $ Relation.range (Relation3.d13 rel) - in Map.unionWith (<>) types terms - termMetadataRefs :: Map LabeledDependency (Set Name) - termMetadataRefs = - (Branch.deepTermMetadata branch) - & Relation4.d234 -- Select only the type and value portions of the metadata - & \rel -> - let types = Map.mapKeys LD.typeRef $ Relation.range (Relation3.d12 rel) - terms = Map.mapKeys LD.termRef $ Relation.range (Relation3.d13 rel) - in Map.unionWith (<>) types terms - in Map.unionWith (<>) typeMetadataRefs termMetadataRefs From 5e677a3e6a05a534ef12804d807627e46e636d4d Mon Sep 17 00:00:00 2001 From: Mitchell Rosen Date: Thu, 14 Dec 2023 11:55:07 -0500 Subject: [PATCH 3/3] make `namespace.dependencies` ignore external dependencies of things in `lib` --- .../src/Unison/Util/Relation.hs | 6 +-- .../HandleInput/NamespaceDependencies.hs | 38 ++++++++++--------- .../namespace-dependencies.output.md | 4 -- 3 files changed, 23 insertions(+), 25 deletions(-) diff --git a/lib/unison-util-relation/src/Unison/Util/Relation.hs b/lib/unison-util-relation/src/Unison/Util/Relation.hs index db82d93fbb..e56557c6ef 100644 --- a/lib/unison-util-relation/src/Unison/Util/Relation.hs +++ b/lib/unison-util-relation/src/Unison/Util/Relation.hs @@ -367,13 +367,13 @@ lookupDom' x r = M.lookup x (domain r) lookupRan' :: (Ord b) => b -> Relation a b -> Maybe (Set a) lookupRan' y r = M.lookup y (range r) --- | True if the element @ x @ exists in the domain of @ r @. +-- | True if the element exists in the domain. memberDom :: (Ord a) => a -> Relation a b -> Bool -memberDom x r = isJust $ lookupDom' x r +memberDom x r = M.member x (domain r) -- | True if the element exists in the range. memberRan :: (Ord b) => b -> Relation a b -> Bool -memberRan y r = isJust $ lookupRan' y r +memberRan y r = M.member y (range r) filterDom :: (Ord a, Ord b) => (a -> Bool) -> Relation a b -> Relation a b filterDom f r = S.filter f (dom r) <| r diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs index 9bfeb790fc..95bf27ed84 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/NamespaceDependencies.hs @@ -3,6 +3,7 @@ module Unison.Codebase.Editor.HandleInput.NamespaceDependencies ) where +import Control.Lens (over) import Control.Monad.Reader (ask) import Control.Monad.Trans.Maybe import Data.Map qualified as Map @@ -20,11 +21,10 @@ import Unison.DataDeclaration qualified as DD import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Name (Name) +import Unison.Name qualified as Name import Unison.Prelude import Unison.PrettyPrintEnvDecl qualified as PPED -import Unison.Reference (Reference) import Unison.Reference qualified as Reference -import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.Server.Backend qualified as Backend import Unison.Sqlite qualified as Sqlite @@ -59,34 +59,36 @@ handleNamespaceDependencies namespacePath' = do namespaceDependencies :: Codebase m Symbol a -> Branch0 m -> Sqlite.Transaction (Map LabeledDependency (Set Name)) namespaceDependencies codebase branch = do typeDeps <- - for (Map.toList currentBranchTypeRefs) $ \(typeRef, names) -> fmap (fromMaybe Map.empty) . runMaybeT $ do - refId <- MaybeT . pure $ Reference.toId typeRef - decl <- MaybeT $ Codebase.getTypeDeclaration codebase refId - let typeDeps = Set.map LD.typeRef $ DD.typeDependencies (DD.asDataDecl decl) - pure $ foldMap (`Map.singleton` names) typeDeps + for (Map.toList (Relation.domain (Branch.deepTypes branchWithoutLibdeps))) \(typeRef, names) -> + fmap (fromMaybe Map.empty) . runMaybeT $ do + refId <- MaybeT . pure $ Reference.toId typeRef + decl <- MaybeT $ Codebase.getTypeDeclaration codebase refId + let typeDeps = Set.map LD.typeRef $ DD.typeDependencies (DD.asDataDecl decl) + pure $ foldMap (`Map.singleton` names) typeDeps - termDeps <- for (Map.toList currentBranchTermRefs) $ \(termRef, names) -> fmap (fromMaybe Map.empty) . runMaybeT $ do - refId <- MaybeT . pure $ Referent.toReferenceId termRef - term <- MaybeT $ Codebase.getTerm codebase refId - let termDeps = Term.labeledDependencies term - pure $ foldMap (`Map.singleton` names) termDeps + termDeps <- + for (Map.toList (Relation.domain (Branch.deepTerms branchWithoutLibdeps))) \(termRef, names) -> + fmap (fromMaybe Map.empty) . runMaybeT $ do + refId <- MaybeT . pure $ Referent.toReferenceId termRef + term <- MaybeT $ Codebase.getTerm codebase refId + let termDeps = Term.labeledDependencies term + pure $ foldMap (`Map.singleton` names) termDeps let dependenciesToDependents :: Map LabeledDependency (Set Name) dependenciesToDependents = Map.unionsWith (<>) (typeDeps ++ termDeps) + let onlyExternalDeps :: Map LabeledDependency (Set Name) onlyExternalDeps = Map.filterWithKey ( \x _ -> LD.fold - (`Map.notMember` currentBranchTypeRefs) - (`Map.notMember` currentBranchTermRefs) + (\k -> not (Relation.memberDom k (Branch.deepTypes branch))) + (\k -> not (Relation.memberDom k (Branch.deepTerms branch))) x ) dependenciesToDependents + pure onlyExternalDeps where - currentBranchTermRefs :: Map Referent (Set Name) - currentBranchTermRefs = Relation.domain (Branch.deepTerms branch) - currentBranchTypeRefs :: Map Reference (Set Name) - currentBranchTypeRefs = Relation.domain (Branch.deepTypes branch) + branchWithoutLibdeps = branch & over Branch.children (Map.delete Name.libSegment) diff --git a/unison-src/transcripts-using-base/namespace-dependencies.output.md b/unison-src/transcripts-using-base/namespace-dependencies.output.md index 42908a6f69..53cfb44a55 100644 --- a/unison-src/transcripts-using-base/namespace-dependencies.output.md +++ b/unison-src/transcripts-using-base/namespace-dependencies.output.md @@ -39,10 +39,6 @@ hasMetadata = 3 3. dependsOnNat 4. hasMetadata - builtin.Text 4. hasMetadata - builtin.Nat.drop 2. dependsOnIntAndNat - - metadata.myMetadata 4. hasMetadata ```