Add ability to find over EVERY branch.

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

@@ -63,6 +63,7 @@ import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject)
 import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
 import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI)
 import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format
+import Unison.Codebase.Editor.HandleInput.Global qualified as Global
 import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib)
 import Unison.Codebase.Editor.HandleInput.LSPDebug qualified as LSPDebug
 import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile)
@@ -1089,7 +1090,7 @@ handleFindI ::
   Cli ()
 handleFindI isVerbose fscope ws input = do
   Cli.Env {codebase} <- ask
-  (pped, names, searchRoot, branch0) <- case fscope of
+  case fscope of
     FindLocal p -> do
       searchRoot <- Cli.resolvePath' p
       branch0 <- Cli.getBranch0FromProjectPath searchRoot
@@ -1097,7 +1098,21 @@ handleFindI isVerbose fscope ws input = do
       -- Don't exclude anything from the pretty printer, since the type signatures we print for
       -- results may contain things in lib.
       pped <- Cli.currentPrettyPrintEnvDecl
-      pure (pped, names, Just p, branch0)
+      let suffixifiedPPE = PPED.suffixifiedPPE pped
+      results <- searchBranch0 codebase branch0 names
+      if (null results)
+        then do
+          Cli.respond FindNoLocalMatches
+          -- We've already searched everything else, so now we search JUST the
+          -- names in lib.
+          let mayOnlyLibBranch = branch0 & Branch.children %%~ \cs -> Map.singleton NameSegment.libSegment <$> Map.lookup NameSegment.libSegment cs
+          case mayOnlyLibBranch of
+            Nothing -> respondResults codebase suffixifiedPPE (Just p) []
+            Just onlyLibBranch -> do
+              let onlyLibNames = Branch.toNames onlyLibBranch
+              results <- searchBranch0 codebase branch0 onlyLibNames
+              respondResults codebase suffixifiedPPE (Just p) results
+        else respondResults codebase suffixifiedPPE (Just p) results
     FindLocalAndDeps p -> do
       searchRoot <- Cli.resolvePath' p
       branch0 <- Cli.getBranch0FromProjectPath searchRoot
@@ -1105,64 +1120,57 @@ handleFindI isVerbose fscope ws input = do
       -- Don't exclude anything from the pretty printer, since the type signatures we print for
       -- results may contain things in lib.
       pped <- Cli.currentPrettyPrintEnvDecl
-      pure (pped, names, Just p, branch0)
+      let suffixifiedPPE = PPED.suffixifiedPPE pped
+      results <- searchBranch0 codebase branch0 names
+      respondResults codebase suffixifiedPPE (Just p) results
     FindGlobal -> do
-      -- TODO: Rewrite to be properly global again
-      projectRootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getCurrentProjectRoot0
-      pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames
-      currentBranch0 <- Cli.getCurrentBranch0
-      pure (pped, projectRootNames, Nothing, currentBranch0)
-  let suffixifiedPPE = PPED.suffixifiedPPE pped
-  let getResults :: Names -> Cli [SearchResult]
-      getResults names =
-        case ws of
-          [] -> pure (List.sortBy SR.compareByName (SR.fromNames names))
-          -- type query
-          ":" : ws -> do
-            typ <- parseSearchType (show input) (unwords ws)
-            let keepNamed = Set.intersection (Branch.deepReferents branch0)
-            (noExactTypeMatches, matches) <- do
-              Cli.runTransaction do
-                matches <- keepNamed <$> Codebase.termsOfType codebase typ
-                if null matches
-                  then (True,) . keepNamed <$> Codebase.termsMentioningType codebase typ
-                  else pure (False, matches)
-            when noExactTypeMatches (Cli.respond NoExactTypeMatches)
-            pure $
-              -- in verbose mode, aliases are shown, so we collapse all
-              -- aliases to a single search result; in non-verbose mode,
-              -- a separate result may be shown for each alias
-              (if isVerbose then uniqueBy SR.toReferent else id) $
-                searchResultsFor names (Set.toList matches) []
+      Global.forAllProjectBranches \(projAndBranchNames, _ids) branch -> do
+        let branch0 = Branch.head branch
+        let projectRootNames = Names.makeAbsolute . Branch.toNames $ branch0
+        pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames
+        results <- searchBranch0 codebase branch0 projectRootNames
+        when (not $ null results) do
+          Cli.setNumberedArgs $ fmap (SA.SearchResult Nothing) results
+          results' <- Cli.runTransaction (Backend.loadSearchResults codebase results)
+          Cli.respond $ GlobalFindBranchResults projAndBranchNames (PPED.suffixifiedPPE pped) isVerbose results'
+  where
+    searchBranch0 :: Codebase.Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult]
+    searchBranch0 codebase branch0 names =
+      case ws of
+        [] -> pure (List.sortBy SR.compareByName (SR.fromNames names))
+        -- type query
+        ":" : ws -> do
+          typ <- parseSearchType (show input) (unwords ws)
+          let keepNamed = Set.intersection (Branch.deepReferents branch0)
+          (noExactTypeMatches, matches) <- do
+            Cli.runTransaction do
+              matches <- keepNamed <$> Codebase.termsOfType codebase typ
+              if null matches
+                then (True,) . keepNamed <$> Codebase.termsMentioningType codebase typ
+                else pure (False, matches)
+          when noExactTypeMatches (Cli.respond NoExactTypeMatches)
+          pure $
+            -- in verbose mode, aliases are shown, so we collapse all
+            -- aliases to a single search result; in non-verbose mode,
+            -- a separate result may be shown for each alias
+            (if isVerbose then uniqueBy SR.toReferent else id) $
+              searchResultsFor names (Set.toList matches) []
 
-          -- name query
-          qs -> do
-            let anythingBeforeHash :: Megaparsec.Parsec (Lexer.Token Text) [Char] Text
-                anythingBeforeHash = Text.pack <$> Megaparsec.takeWhileP Nothing (/= '#')
-            let srs =
-                  searchBranchScored
-                    names
-                    Find.simpleFuzzyScore
-                    (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs)
-            pure $ uniqueBy SR.toReferent srs
-  let respondResults results = do
-        Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results
-        results' <- Cli.runTransaction (Backend.loadSearchResults codebase results)
-        Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results'
-  results <- getResults names
-  case (results, fscope) of
-    ([], FindLocal {}) -> do
-      Cli.respond FindNoLocalMatches
-      -- We've already searched everything else, so now we search JUST the
-      -- names in lib.
-      let mayOnlyLibBranch = branch0 & Branch.children %%~ \cs -> Map.singleton NameSegment.libSegment <$> Map.lookup NameSegment.libSegment cs
-      case mayOnlyLibBranch of
-        Nothing -> respondResults []
-        Just onlyLibBranch -> do
-          let onlyLibNames = Branch.toNames onlyLibBranch
-          results <- getResults onlyLibNames
-          respondResults results
-    _ -> respondResults results
+        -- name query
+        qs -> do
+          let anythingBeforeHash :: Megaparsec.Parsec (Lexer.Token Text) [Char] Text
+              anythingBeforeHash = Text.pack <$> Megaparsec.takeWhileP Nothing (/= '#')
+          let srs =
+                searchBranchScored
+                  names
+                  Find.simpleFuzzyScore
+                  (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs)
+          pure $ uniqueBy SR.toReferent srs
+    respondResults :: Codebase.Codebase m Symbol Ann -> PPE.PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli ()
+    respondResults codebase ppe searchRoot results = do
+      Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results
+      results' <- Cli.runTransaction (Backend.loadSearchResults codebase results)
+      Cli.respond $ ListOfDefinitions fscope ppe isVerbose results'
 
 handleDependencies :: HQ.HashQualified Name -> Cli ()
 handleDependencies hq = do

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

@@ -0,0 +1,22 @@
+module Unison.Codebase.Editor.HandleInput.Global (forAllProjectBranches) where
+
+import Control.Monad.Reader
+import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId)
+import U.Codebase.Sqlite.Queries qualified as Q
+import Unison.Cli.Monad (Cli)
+import Unison.Cli.Monad qualified as Cli
+import Unison.Codebase qualified as Codebase
+import Unison.Codebase.Branch (Branch)
+import Unison.Core.Project
+import Unison.Prelude
+import Unison.Util.Monoid (foldMapM)
+
+-- | Map over ALL project branches in the codebase.
+-- This is a _very_ big hammer, that you should basically never use, except for things like debugging or migrations.
+forAllProjectBranches :: (Monoid r) => ((ProjectAndBranch ProjectName ProjectBranchName, ProjectAndBranch ProjectId ProjectBranchId) -> Branch IO -> Cli r) -> Cli r
+forAllProjectBranches f = do
+  Cli.Env {codebase} <- ask
+  projectBranches <- Cli.runTransaction Q.loadAllProjectBranchNamePairs
+  projectBranches & foldMapM \(names, ids@(ProjectAndBranch projId branchId)) -> do
+    b <- liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId
+    f (names, ids) b

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

@@ -127,8 +127,8 @@ data Input
   | PushRemoteBranchI PushRemoteBranchInput
   | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -})
   -- todo: Q: Does it make sense to publish to not-the-root of a Github repo?
-  --          Does it make sense to fork from not-the-root of a Github repo?
-  | -- used in Welcome module to give directions to user
+  | --          Does it make sense to fork from not-the-root of a Github repo?
+    -- used in Welcome module to give directions to user
     CreateMessage (P.Pretty P.ColorText)
   | -- Change directory.
     SwitchBranchI Path'

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

@@ -261,7 +261,6 @@ data Output
   | MovedOverExistingBranch Path'
   | DeletedEverything
   | ListNames
-      IsGlobal
       Int -- hq length to print References
       [(Reference, [HQ'.HashQualified Name])] -- type match, type names
       [(Referent, [HQ'.HashQualified Name])] -- term match, term names
@@ -269,6 +268,7 @@ data Output
   | ListOfDefinitions FindScope PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann]
   | ListShallow (IO PPE.PrettyPrintEnv) [ShallowListEntry Symbol Ann]
   | ListStructuredFind [HQ.HashQualified Name]
+  | GlobalFindBranchResults (ProjectAndBranch ProjectName ProjectBranchName) PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann]
   | -- ListStructuredFind patternMatchingUsages termBodyUsages
     -- show the result of add/update
     SlurpOutput Input PPE.PrettyPrintEnv SlurpResult
@@ -545,6 +545,7 @@ isFailure o = case o of
   DeletedEverything -> False
   ListNames _ _ tys tms -> null tms && null tys
   ListOfDefinitions _ _ _ ds -> null ds
+  GlobalFindBranchResults _ _ _ _ -> False
   ListStructuredFind tms -> null tms
   SlurpOutput _ _ sr -> not $ SR.isOk sr
   ParseErrors {} -> True

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

@@ -1149,7 +1149,7 @@ findAll :: InputPattern
 findAll = find' "find.all" (Input.FindLocalAndDeps Path.relativeEmpty')
 
 findGlobal :: InputPattern
-findGlobal = find' "find.global" Input.FindGlobal
+findGlobal = find' "debug.find.global" Input.FindGlobal
 
 findIn, findInAll :: InputPattern
 findIn = findIn' "find-in" Input.FindLocal
@@ -1197,8 +1197,8 @@ findHelp =
           "lists all definitions with a name similar to 'foo' or 'bar' in the "
             <> "specified subnamespace (including one level of its 'lib')."
         ),
-        ( "find.global foo",
-          "lists all definitions with a name similar to 'foo' in any namespace"
+        ( "debug.find.global foo",
+          "Iteratively searches all projects and branches and lists all definitions with a name similar to 'foo'. Note that this is a very slow operation."
         )
       ]
   )

unison-cli/unison-cli.cabal

@@ -64,6 +64,7 @@ library
       Unison.Codebase.Editor.HandleInput.EditNamespace
       Unison.Codebase.Editor.HandleInput.FindAndReplace
       Unison.Codebase.Editor.HandleInput.FormatFile
+      Unison.Codebase.Editor.HandleInput.Global
       Unison.Codebase.Editor.HandleInput.InstallLib
       Unison.Codebase.Editor.HandleInput.Load
       Unison.Codebase.Editor.HandleInput.Ls