Merge pull request #2729 from unisonweb/cp/hide-empty-namespaces

Hide empty namespaces from ucm output

lib/unison-util-relation/src/Unison/Util/Relation3.hs

@@ -128,6 +128,9 @@ fromList xs = insertAll xs empty
 empty :: (Ord a, Ord b, Ord c) => Relation3 a b c
 empty = mempty
 
+null :: Relation3 a b c -> Bool
+null r = Map.null $ d1 r
+
 insert, delete
   :: (Ord a, Ord b, Ord c)
   => a -> b -> c -> Relation3 a b c -> Relation3 a b c

lib/unison-util-relation/src/Unison/Util/Relation4.hs

@@ -47,6 +47,9 @@ toList = fmap (\(a,(b,(c,d))) -> (a,b,c,d)) . toNestedList
 empty :: (Ord a, Ord b, Ord c, Ord d) => Relation4 a b c d
 empty = mempty
 
+null :: Relation4 a b c d -> Bool
+null r = Map.null $ d1 r
+
 fromList :: (Ord a, Ord b, Ord c, Ord d) => [(a,b,c,d)] -> Relation4 a b c d
 fromList xs = insertAll xs empty
 

parser-typechecker/src/Unison/Codebase/Branch.hs

@@ -39,6 +39,7 @@ module Unison.Codebase.Branch
   , head
   , headHash
   , children
+  , nonEmptyChildren
   , deepEdits'
   , toList0
   -- * step
@@ -118,6 +119,7 @@ import qualified Unison.Util.Star3             as Star3
 import qualified Unison.Util.List as List
 import qualified Data.Semialign as Align
 import Data.These (These(..))
+import qualified Unison.Util.Relation as Relation
 
 -- | A node in the Unison namespace hierarchy
 -- along with its history.
@@ -228,6 +230,12 @@ types =
 children :: Lens' (Branch0 m) (Map NameSegment (Branch m))
 children = lens _children (\Branch0{..} x -> branch0 _terms _types x _edits)
 
+nonEmptyChildren :: Branch0 m -> Map NameSegment (Branch m)
+nonEmptyChildren b =
+  b
+  & _children
+  & Map.filter (not . isEmpty0 . head)
+
 -- creates a Branch0 from the primary fields and derives the others.
 branch0 ::
   forall m.
@@ -260,7 +268,7 @@ branch0 terms types children edits =
 -- | Derive the 'deepTerms' field of a branch.
 deriveDeepTerms :: Branch0 m -> Branch0 m
 deriveDeepTerms branch =
-  branch {deepTerms = makeDeepTerms (_terms branch) (_children branch)}
+  branch {deepTerms = makeDeepTerms (_terms branch) (nonEmptyChildren branch)}
   where
     makeDeepTerms :: Metadata.Star Referent NameSegment -> Map NameSegment (Branch m) -> Relation Referent Name
     makeDeepTerms terms children =
@@ -273,7 +281,7 @@ deriveDeepTerms branch =
 -- | Derive the 'deepTypes' field of a branch.
 deriveDeepTypes :: Branch0 m -> Branch0 m
 deriveDeepTypes branch =
-  branch {deepTypes = makeDeepTypes (_types branch) (_children branch)}
+  branch {deepTypes = makeDeepTypes (_types branch) (nonEmptyChildren branch)}
   where
     makeDeepTypes :: Metadata.Star TypeReference NameSegment -> Map NameSegment (Branch m) -> Relation TypeReference Name
     makeDeepTypes types children =
@@ -286,7 +294,7 @@ deriveDeepTypes branch =
 -- | Derive the 'deepTermMetadata' field of a branch.
 deriveDeepTermMetadata :: Branch0 m -> Branch0 m
 deriveDeepTermMetadata branch =
-  branch {deepTermMetadata = makeDeepTermMetadata (_terms branch) (_children branch)}
+  branch {deepTermMetadata = makeDeepTermMetadata (_terms branch) (nonEmptyChildren branch)}
   where
     makeDeepTermMetadata :: Metadata.Star Referent NameSegment -> Map NameSegment (Branch m) -> Metadata.R4 Referent Name
     makeDeepTermMetadata terms children =
@@ -299,7 +307,7 @@ deriveDeepTermMetadata branch =
 -- | Derive the 'deepTypeMetadata' field of a branch.
 deriveDeepTypeMetadata :: Branch0 m -> Branch0 m
 deriveDeepTypeMetadata branch =
-  branch {deepTypeMetadata = makeDeepTypeMetadata (_types branch) (_children branch)}
+  branch {deepTypeMetadata = makeDeepTypeMetadata (_types branch) (nonEmptyChildren branch)}
   where
     makeDeepTypeMetadata :: Metadata.Star TypeReference NameSegment -> Map NameSegment (Branch m) -> Metadata.R4 TypeReference Name
     makeDeepTypeMetadata types children =
@@ -312,7 +320,7 @@ deriveDeepTypeMetadata branch =
 -- | Derive the 'deepPaths' field of a branch.
 deriveDeepPaths :: Branch0 m -> Branch0 m
 deriveDeepPaths branch =
-  branch {deepPaths = makeDeepPaths (_children branch)}
+  branch {deepPaths = makeDeepPaths (nonEmptyChildren branch)}
   where
     makeDeepPaths :: Map NameSegment (Branch m) -> Set Path
     makeDeepPaths children =
@@ -325,7 +333,7 @@ deriveDeepPaths branch =
 -- | Derive the 'deepEdits' field of a branch.
 deriveDeepEdits :: Branch0 m -> Branch0 m
 deriveDeepEdits branch =
-  branch {deepEdits = makeDeepEdits (_edits branch) (_children branch)}
+  branch {deepEdits = makeDeepEdits (_edits branch) (nonEmptyChildren branch)}
   where
     makeDeepEdits :: Map NameSegment (EditHash, m Patch) -> Map NameSegment (Branch m) -> Map Name EditHash
     makeDeepEdits edits children =
@@ -500,9 +508,15 @@ empty0 :: Branch0 m
 empty0 =
   Branch0 mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty
 
--- | Checks whether a Branch0 is empty.
+-- | Checks whether a Branch0 is empty, which means that the branch contains no terms or
+-- types, and that the heads of all children are empty by the same definition.
+-- This is not as easy as checking whether the branch is equal to the `empty0` branch
+-- because child branches may be empty, but still have history.
 isEmpty0 :: Branch0 m -> Bool
-isEmpty0 = (== empty0)
+isEmpty0 (Branch0 _terms _types _children _edits deepTerms deepTypes _deepTermMetadata _deepTypeMetadata _deepPaths deepEdits) =
+  Relation.null deepTerms
+    && Relation.null deepTypes
+    && Map.null deepEdits
 
 -- | Checks whether a branch is empty AND has no history.
 isEmpty :: Branch m -> Bool

parser-typechecker/src/Unison/Server/Backend.hs

@@ -431,7 +431,7 @@ findShallowInBranch codebase b = do
       [ ShallowBranchEntry ns
                            (SBH.fullFromHash $ Branch.headHash b)
                            (defnCount b)
-      | (ns, b) <- Map.toList $ Branch._children b0
+      | (ns, b) <- Map.toList $ Branch.nonEmptyChildren b0
       ]
     patchEntries =
       [ ShallowPatchEntry ns

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -848,7 +848,7 @@ loop = do
                   let path = resolveToAbsolute path'
                   LoopState.currentPathStack %= Nel.cons path
                   branch' <- getAt path
-                  when (Branch.isEmpty branch') (respond $ CreatedNewBranch path)
+                  when (Branch.isEmpty0 $ Branch.head branch') (respond $ CreatedNewBranch path)
             UpI ->
               use LoopState.currentPath >>= \p -> case Path.unsnoc (Path.unabsolute p) of
                 Nothing -> pure ()

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -2057,7 +2057,7 @@ bothCompletors c1 c2 q code b currentPath = do
     . nubOrdOn Completion.display
     $ suggestions1 ++ suggestions2
 
--- |
+-- | A completer for namespace paths.
 pathCompletor ::
   Applicative f =>
   -- | Turns a query and list of possible completions into a 'Completion'.
@@ -2092,7 +2092,7 @@ namespaceArg =
 -- | Recursively collects all names of namespaces which are children of the branch.
 allSubNamespaces :: Branch.Branch0 m -> [Text]
 allSubNamespaces b =
-  flip Map.foldMapWithKey (Branch._children b) $
+  flip Map.foldMapWithKey (Branch.nonEmptyChildren b) $
     \(NameSegment k) (Branch.head -> b') ->
       (k : fmap (\sn -> k <> "." <> sn) (allSubNamespaces b'))
 

unison-src/transcripts/empty-namespaces.md

@@ -0,0 +1,36 @@
+# Empty namespace behaviours
+
+```unison:hide
+mynamespace.x = 1
+```
+
+```ucm:hide
+.> add
+.> delete.namespace mynamespace
+```
+
+The deleted namespace shouldn't appear in `ls` output.
+```ucm:error
+.> ls
+```
+```ucm:error
+.> ls.verbose
+```
+```ucm:error
+.> find mynamespace
+```
+
+
+The history of the namespace should still exist if requested explicitly.
+
+```ucm
+.> history mynamespace
+```
+
+Merging an empty namespace should still copy its history if it has some.
+
+```ucm
+.empty> history
+.empty> merge .mynamespace
+.empty> history
+```

unison-src/transcripts/empty-namespaces.output.md

@@ -0,0 +1,75 @@
+# Empty namespace behaviours
+
+```unison
+mynamespace.x = 1
+```
+
+The deleted namespace shouldn't appear in `ls` output.
+```ucm
+.> ls
+
+  nothing to show
+
+```
+```ucm
+.> ls.verbose
+
+  😶
+  
+  No results. Check your spelling, or try using tab completion
+  to supply command arguments.
+
+```
+```ucm
+.> find mynamespace
+
+  😶
+  
+  No results. Check your spelling, or try using tab completion
+  to supply command arguments.
+
+```
+The history of the namespace should still exist if requested explicitly.
+
+```ucm
+.> history mynamespace
+
+  Note: The most recent namespace hash is immediately below this
+        message.
+  
+  ⊙ #qjc20aua9h
+  
+    - Deletes:
+    
+      x
+  
+  □ #hkrqt3tm05 (start of history)
+
+```
+Merging an empty namespace should still copy its history if it has some.
+
+```ucm
+  ☝️  The namespace .empty is empty.
+
+.empty> history
+
+  ☝️  The namespace .empty is empty.
+
+.empty> merge .mynamespace
+
+  Nothing changed as a result of the merge.
+
+.empty> history
+
+  Note: The most recent namespace hash is immediately below this
+        message.
+  
+  ⊙ #qjc20aua9h
+  
+    - Deletes:
+    
+      x
+  
+  □ #hkrqt3tm05 (start of history)
+
+```