Merge pull request #5521 from xmbhasin/cli-cmd-multi

Author: aryairani

lib/unison-pretty-printer/src/Unison/Util/Pretty.hs

@@ -695,8 +695,8 @@ column2UnzippedM bottomPadding left right =
 column3sep ::
   (LL.ListLike s Char, IsString s) => Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s
 column3sep sep rows =
-  let bc = align [(b, sep <> c) | (_, b, c) <- rows]
-      abc = group <$> align [(a, sep <> bc) | ((a, _, _), bc) <- rows `zip` bc]
+  let bc = align $ [(b, indent sep c) | (_, b, c) <- rows]
+      abc = group <$> align [(a, indent sep bc) | ((a, _, _), bc) <- rows `zip` bc]
    in lines abc
 
 -- | Creates an aligned table with an arbitrary number of columns separated by `sep`

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

@@ -59,8 +59,8 @@ import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch)
 import Unison.Codebase.Editor.HandleInput.DeleteNamespace (getEndangeredDependents, handleDeleteNamespace)
 import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject)
 import Unison.Codebase.Editor.HandleInput.Dependents (handleDependents)
-import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
 import Unison.Codebase.Editor.HandleInput.EditDependents (handleEditDependents)
+import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
 import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI, handleTextFindI)
 import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format
 import Unison.Codebase.Editor.HandleInput.Global qualified as Global
@@ -73,6 +73,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.Names (handleNames)
 import Unison.Codebase.Editor.HandleInput.NamespaceDependencies (handleNamespaceDependencies)
 import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper)
 import Unison.Codebase.Editor.HandleInput.ProjectClone (handleClone)
@@ -497,29 +498,8 @@ loop e = do
 
                 fixupOutput :: Path.HQSplit -> HQ.HashQualified Name
                 fixupOutput = HQ'.toHQ . Path.nameFromHQSplit
-            NamesI global query -> do
-              hqLength <- Cli.runTransaction Codebase.hashLength
-              let searchNames names = do
-                    let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names)
-                        unsuffixifiedPPE = PPED.unsuffixifiedPPE pped
-                        terms = Names.lookupHQTerm Names.IncludeSuffixes query names
-                        types = Names.lookupHQType Names.IncludeSuffixes query names
-                        terms' :: [(Referent, [HQ'.HashQualified Name])]
-                        terms' = map (\r -> (r, PPE.allTermNames unsuffixifiedPPE r)) (Set.toList terms)
-                        types' :: [(Reference, [HQ'.HashQualified Name])]
-                        types' = map (\r -> (r, PPE.allTypeNames unsuffixifiedPPE r)) (Set.toList types)
-                    pure (terms', types')
-              if global
-                then do
-                  Global.forAllProjectBranches \(projBranchNames, _ids) branch -> do
-                    let names = Branch.toNames . Branch.head $ branch
-                    (terms, types) <- searchNames names
-                    when (not (null terms) || not (null types)) do
-                      Cli.respond $ GlobalListNames projBranchNames hqLength types terms
-                else do
-                  names <- Cli.currentNames
-                  (terms, types) <- searchNames names
-                  Cli.respond $ ListNames hqLength types terms
+            NamesI global queries -> do
+              mapM_ (handleNames global) queries
             DocsI srcs -> do
               for_ srcs docsI
             CreateAuthorI authorNameSegment authorFullName -> do

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

@@ -0,0 +1,70 @@
+module Unison.Codebase.Editor.HandleInput.Names (handleNames) where
+
+import Control.Monad (when)
+import Data.Set qualified as Set
+import Unison.Cli.Monad (Cli)
+import Unison.Cli.Monad qualified as Cli
+import Unison.Cli.NamesUtils qualified as Cli
+import Unison.Codebase qualified as Codebase
+import Unison.Codebase.Branch qualified as Branch
+import Unison.Codebase.Branch.Names qualified as Branch
+import Unison.Codebase.Editor.HandleInput.Global qualified as Global
+import Unison.Codebase.Editor.Input (ErrorMessageOrName, RawQuery)
+import Unison.Codebase.Editor.Output (Output (..))
+import Unison.HashQualifiedPrime qualified as HQ'
+import Unison.Name (Name)
+import Unison.NamesWithHistory qualified as Names
+import Unison.PrettyPrintEnv qualified as PPE
+import Unison.PrettyPrintEnv.Names qualified as PPE
+import Unison.PrettyPrintEnvDecl qualified as PPED
+import Unison.PrettyPrintEnvDecl.Names qualified as PPED
+import Unison.Reference (Reference)
+import Unison.Referent (Referent)
+import Unison.Util.Pretty qualified as P
+
+-- | Handles a single @NamesI@ input query returning terms that match a given name.
+--
+-- Parameters:
+--
+-- * @global :: Bool@
+-- ** If @True@, search all projects and branches.
+-- ** If @False@, search only the current branch.
+--
+-- * @query :: (RawQuery, ErrorMessageOrName)@
+-- ** The first member is the raw @nameQuery@ being handled.
+-- ** The second member is the parsed @nameQuery@ that is either an error message
+--    to be printed or a name that can be looked up in the codebase.
+handleNames ::
+  Bool ->
+  (RawQuery, ErrorMessageOrName) ->
+  Cli ()
+handleNames _ (nameQuery, Left errMsg) = do
+  Cli.respond $
+    PrintMessage $
+      P.lines [prettyNameQuery, errMsg]
+  where
+    prettyNameQuery =
+      P.red (P.bold $ P.string nameQuery) <> ":"
+handleNames global (nameQuery, Right query) = do
+  hqLength <- Cli.runTransaction Codebase.hashLength
+  let searchNames names = do
+        let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names)
+            unsuffixifiedPPE = PPED.unsuffixifiedPPE pped
+            terms = Names.lookupHQTerm Names.IncludeSuffixes query names
+            types = Names.lookupHQType Names.IncludeSuffixes query names
+            terms' :: [(Referent, [HQ'.HashQualified Name])]
+            terms' = map (\r -> (r, PPE.allTermNames unsuffixifiedPPE r)) (Set.toList terms)
+            types' :: [(Reference, [HQ'.HashQualified Name])]
+            types' = map (\r -> (r, PPE.allTypeNames unsuffixifiedPPE r)) (Set.toList types)
+        pure (terms', types')
+  if global
+    then do
+      Global.forAllProjectBranches \(projBranchNames, _ids) branch -> do
+        let names = Branch.toNames . Branch.head $ branch
+        (terms, types) <- searchNames names
+        when (not (null terms) || not (null types)) do
+          Cli.respond $ GlobalListNames nameQuery projBranchNames hqLength types terms
+    else do
+      names <- Cli.currentNames
+      (terms, types) <- searchNames names
+      Cli.respond $ ListNames nameQuery hqLength types terms

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

@@ -27,6 +27,10 @@ module Unison.Codebase.Editor.Input
     IsGlobal,
     DeleteOutput (..),
     DeleteTarget (..),
+
+    -- * Type aliases
+    ErrorMessageOrName,
+    RawQuery,
   )
 where
 
@@ -61,6 +65,12 @@ type SourceName = Text -- "foo.u" or "buffer 7"
 
 type PatchPath = Path.Split'
 
+type ErrorMessageOrValue a = Either (P.Pretty P.ColorText) a
+
+type ErrorMessageOrName = ErrorMessageOrValue (HQ.HashQualified Name)
+
+type RawQuery = String
+
 data OptionalPatch = NoPatch | DefaultPatch | UsePatch PatchPath
   deriving (Eq, Ord, Show)
 
@@ -141,7 +151,8 @@ data Input
     -- > names .foo.bar
     -- > names .foo.bar#asdflkjsdf
     -- > names #sdflkjsdfhsdf
-    NamesI IsGlobal (HQ.HashQualified Name)
+    -- > names foo.bar foo.baz #sdflkjsdfhsdf
+    NamesI IsGlobal [(RawQuery, ErrorMessageOrName)]
   | AliasTermI !Bool HashOrHQSplit' Path.Split' -- bool = force?
   | AliasTypeI !Bool HashOrHQSplit' Path.Split' -- bool = force?
   | AliasManyI [Path.HQSplit] Path'

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

@@ -264,10 +264,12 @@ data Output
   | MovedOverExistingBranch Path'
   | DeletedEverything
   | ListNames
+      String -- input namesQuery for which this output is being produced
       Int -- hq length to print References
       [(Reference, [HQ'.HashQualified Name])] -- type match, type names
       [(Referent, [HQ'.HashQualified Name])] -- term match, term names
   | GlobalListNames
+      String -- input namesQuery for which this output is being produced
       (ProjectAndBranch ProjectName ProjectBranchName)
       Int -- hq length to print References
       [(Reference, [HQ'.HashQualified Name])] -- type match, type names
@@ -547,7 +549,7 @@ isFailure o = case o of
   MoveRootBranchConfirmation -> False
   MovedOverExistingBranch {} -> False
   DeletedEverything -> False
-  ListNames _ tys tms -> null tms && null tys
+  ListNames _ _ tys tms -> null tms && null tys
   GlobalListNames {} -> False
   ListOfDefinitions _ _ _ ds -> null ds
   GlobalFindBranchResults _ _ _ _ -> False

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

@@ -281,9 +281,13 @@ formatStructuredArgument schLength = \case
               else "." <> s
         pathArgStr = Text.pack $ show pathArg
 
--- | Converts an arbitrary argument to a `String`. This is for cases where the
+-- | Converts an arbitrary argument to a `String`.
+--
+-- This is for cases where the
 -- command /should/ accept a structured argument of some type, but currently
 -- wants a `String`.
+--
+-- This can also be used where the input argument needs to be included in the output.
 unifyArgument :: I.Argument -> String
 unifyArgument = either id (Text.unpack . formatStructuredArgument Nothing)
 
@@ -2687,16 +2691,30 @@ names isGlobal =
     cmdName
     []
     I.Visible
-    [("name or hash", Required, definitionQueryArg)]
-    (P.wrap $ makeExample (names isGlobal) ["foo"] <> description)
+    [("name or hash", OnePlus, definitionQueryArg)]
+    description
     $ \case
-      [thing] -> Input.NamesI isGlobal <$> handleHashQualifiedNameArg thing
-      args -> wrongArgsLength "exactly one argument" args
+      [] -> wrongArgsLength "at least one argument" []
+      [rawArg] -> do
+        let arg = handleArg rawArg
+        case arg of
+          (_, Left errMsg) -> Left errMsg
+          (argString, Right name) -> pure $ Input.NamesI isGlobal [(argString, Right name)]
+      rawArgs -> do
+        let args = handleArg <$> rawArgs
+        pure $ Input.NamesI isGlobal args
   where
-    description
-      | isGlobal = "Iteratively search across all projects and branches for names matching `foo`. Note that this is expected to be quite slow and is primarily for debugging issues with your codebase."
-      | otherwise = "List all known names for `foo` in the current branch."
+    isGlobalPreamble = "Iteratively search names or hashes across all projects and branches."
+    isNotGlobalPreamble = "Search names or hashes in the current branch."
     cmdName = if isGlobal then "debug.names.global" else "names"
+    description =
+      P.lines
+        [ if isGlobal then isGlobalPreamble else isNotGlobalPreamble,
+          P.wrap $ makeExample (names isGlobal) ["foo"] <> "List all known names for `foo`.",
+          P.wrap $ makeExample (names isGlobal) ["foo", "#bar"] <> "List all known names for the name `foo` and for the hash `#bar`.",
+          P.wrap $ makeExample (names isGlobal) [] <> "without arguments invokes a search to select names/hashes to list, which requires that `fzf` can be found within your PATH."
+        ]
+    handleArg arg = (unifyArgument arg, handleHashQualifiedNameArg arg)
 
 dependents, dependencies :: InputPattern
 dependents =

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

@@ -14,6 +14,7 @@ import Data.List qualified as List
 import Data.List.Extra (notNull, nubOrd, nubOrdOn)
 import Data.List.NonEmpty qualified as NEList
 import Data.Map qualified as Map
+import Data.Ord (comparing)
 import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
 import Data.Set.NonEmpty (NESet)
@@ -138,7 +139,6 @@ import Unison.Term (Term)
 import Unison.Term qualified as Term
 import Unison.Type (Type)
 import Unison.UnisonFile qualified as UF
-import Unison.Util.ColorText qualified
 import Unison.Util.Conflicted (Conflicted (..))
 import Unison.Util.Defn (Defn (..))
 import Unison.Util.Defns (Defns (..))
@@ -863,23 +863,16 @@ notifyUser dir = \case
           "",
           output
         ]
-  ListNames len types terms ->
-    listOfNames len types terms
-  GlobalListNames projectBranchName len types terms -> do
-    output <- listOfNames len types terms
+  ListNames namesQuery len types terms ->
+    listOfNames namesQuery len types terms
+  GlobalListNames namesQuery projectBranchName len types terms -> do
+    output <- listOfNames namesQuery len types terms
     pure $
       P.lines
         [ P.wrap $ "Found results in " <> P.text (into @Text projectBranchName),
           "",
           output
         ]
-  -- > names foo
-  --   Terms:
-  --     Hash: #asdflkjasdflkjasdf
-  --     Names: .util.frobnicate foo blarg.mcgee
-  --
-  --   Term (with hash #asldfkjsdlfkjsdf): .util.frobnicate, foo, blarg.mcgee
-  --   Types (with hash #hsdflkjsdfsldkfj): Optional, Maybe, foo
   ListShallow buildPPE entries -> do
     let needPPE =
           entries
@@ -2364,7 +2357,7 @@ prettyTransportError = \case
   Share.UnexpectedResponse resp ->
     unexpectedServerResponse resp
 
-unexpectedServerResponse :: Servant.ResponseF LazyByteString.ByteString -> P.Pretty Unison.Util.ColorText.ColorText
+unexpectedServerResponse :: Servant.ResponseF LazyByteString.ByteString -> Pretty
 unexpectedServerResponse resp =
   (P.lines . catMaybes)
     [ Just
@@ -2916,44 +2909,63 @@ listOfDefinitions ::
 listOfDefinitions fscope ppe detailed results =
   pure $ listOfDefinitions' fscope ppe detailed results
 
-listOfNames :: Int -> [(Reference, [HQ'.HashQualified Name])] -> [(Referent, [HQ'.HashQualified Name])] -> IO Pretty
-listOfNames len types terms = do
+listOfNames :: String -> Int -> [(Reference, [HQ'.HashQualified Name])] -> [(Referent, [HQ'.HashQualified Name])] -> IO Pretty
+listOfNames namesQuery len types terms = do
   if null types && null terms
     then
-      pure . P.callout "😶" $
-        P.sepNonEmpty "\n\n" $
-          [ P.wrap "I couldn't find anything by that name."
+      pure
+        . P.sepNonEmpty "\n"
+        $ [ P.red prettyQuery,
+            P.string "😶",
+            P.wrap "I couldn't find anything by that name."
           ]
     else
-      pure . P.sepNonEmpty "\n\n" $
-        [ formatTypes types,
-          formatTerms terms
+      pure . P.sepNonEmpty "\n" $
+        [ P.green prettyQuery,
+          makeTable prettyRows
         ]
   where
-    formatTerms tms =
-      P.lines . P.nonEmpty $ P.plural tms (P.blue "Term") : List.intersperse "" (go <$> tms)
+    prettyQuery = P.singleQuoted' (P.string namesQuery) ":"
+
+    makeTable =
+      P.column3Header "Hash" "Kind" "Names"
+
+    prettyRows = makePrettyRows $ List.sortBy compareRows rows
+    makePrettyRows =
+      fmap
+        ( \(ref, kind, hqs) ->
+            ( P.syntaxToColor ref,
+              P.blue kind,
+              P.group $
+                P.commas $
+                  P.bold . P.syntaxToColor . prettyHashQualified'
+                    <$> hqs
+            )
+        )
+
+    -- Compare rows by their list of names, first by comparing each name in the list
+    -- then by the length of the list of they share the same prefix
+    compareRows :: (a, b, [HQ'.HashQualified Name]) -> (a, b, [HQ'.HashQualified Name]) -> Ordering
+    compareRows (_, _, hqs1) (_, _, hqs2) =
+      Name.compareAlphabetical hqs1 hqs2 <> comparing length hqs1 hqs2
+
+    rows = termRows terms ++ typeRows types
+
+    termRows terms =
+      makeSortedRow "Term" <$> prettyTerms
       where
-        go (ref, hqs) =
-          P.column2
-            [ ("Hash:", P.syntaxToColor (prettyReferent len ref)),
-              ( "Names: ",
-                P.group $
-                  P.spaced $
-                    P.bold . P.syntaxToColor . prettyHashQualified' <$> List.sortBy Name.compareAlphabetical hqs
-              )
-            ]
-    formatTypes types =
-      P.lines . P.nonEmpty $ P.plural types (P.blue "Type") : List.intersperse "" (go <$> types)
+        prettyTerms = terms & over (mapped . _1) (prettyReferent len)
+
+    typeRows types =
+      makeSortedRow "Type" <$> prettyTypes
       where
-        go (ref, hqs) =
-          P.column2
-            [ ("Hash:", P.syntaxToColor (prettyReference len ref)),
-              ( "Names:",
-                P.group $
-                  P.spaced $
-                    P.bold . P.syntaxToColor . prettyHashQualified' <$> List.sortBy Name.compareAlphabetical hqs
-              )
-            ]
+        prettyTypes = types & over (mapped . _1) (prettyReference len)
+
+    makeSortedRow kind (ref, hqs) =
+      ( ref,
+        kind,
+        List.sortBy Name.compareAlphabetical hqs
+      )
 
 data ShowNumbers = ShowNumbers | HideNumbers
 

unison-cli/unison-cli.cabal

@@ -74,6 +74,7 @@ library
       Unison.Codebase.Editor.HandleInput.MoveBranch
       Unison.Codebase.Editor.HandleInput.MoveTerm
       Unison.Codebase.Editor.HandleInput.MoveType
+      Unison.Codebase.Editor.HandleInput.Names
       Unison.Codebase.Editor.HandleInput.NamespaceDependencies
       Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils
       Unison.Codebase.Editor.HandleInput.ProjectClone