Avoid printing/parsing numbered args

unison-cli/src/Unison/Cli/Pretty.hs

@@ -367,8 +367,8 @@ prettyWhichBranchEmpty = \case
   WhichBranchEmptyPath path -> prettyPath' path
 
 -- | Displays a full, non-truncated Branch.CausalHash to a string, e.g. #abcdef
-displayBranchHash :: CausalHash -> String
-displayBranchHash = ("#" <>) . Text.unpack . Hash.toBase32HexText . unCausalHash
+displayBranchHash :: CausalHash -> Text
+displayBranchHash = ("#" <>) . Hash.toBase32HexText . unCausalHash
 
 prettyHumanReadableTime :: UTCTime -> UTCTime -> Pretty
 prettyHumanReadableTime now time =

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

@@ -5,6 +5,7 @@ module Unison.Codebase.Editor.HandleInput (loop) where
 
 -- TODO: Don't import backend
 
+import Control.Arrow ((&&&))
 import Control.Error.Util qualified as ErrorUtil
 import Control.Lens hiding (from)
 import Control.Monad.Reader (ask)
@@ -98,6 +99,7 @@ import Unison.Codebase.Editor.Output.DumpNamespace qualified as Output.DN
 import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
 import Unison.Codebase.Editor.Slurp qualified as Slurp
 import Unison.Codebase.Editor.SlurpResult qualified as SlurpResult
+import Unison.Codebase.Editor.StructuredArgument qualified as SA
 import Unison.Codebase.Editor.TodoOutput qualified as TO
 import Unison.Codebase.IntegrityCheck qualified as IntegrityCheck (integrityCheckFullCodebase)
 import Unison.Codebase.Metadata qualified as Metadata
@@ -153,7 +155,6 @@ import Unison.Reference qualified as Reference
 import Unison.Referent (Referent)
 import Unison.Referent qualified as Referent
 import Unison.Runtime.IOSource qualified as IOSource
-import Unison.Server.Backend (ShallowListEntry (..))
 import Unison.Server.Backend qualified as Backend
 import Unison.Server.CodebaseServer qualified as Server
 import Unison.Server.Doc.Markdown.Render qualified as Md
@@ -283,19 +284,22 @@ loop e = do
               Cli.respond $ PrintMessage pretty
             ShowReflogI -> do
               let numEntriesToShow = 500
-              entries <-
-                Cli.runTransaction do
-                  schLength <- Codebase.branchHashLength
-                  Codebase.getReflog numEntriesToShow <&> fmap (first $ SCH.fromHash schLength)
+              (schLength, entries) <-
+                Cli.runTransaction $
+                  (,) <$> Codebase.branchHashLength <*> Codebase.getReflog numEntriesToShow
               let moreEntriesToLoad = length entries == numEntriesToShow
               let expandedEntries = List.unfoldr expandEntries (entries, Nothing, moreEntriesToLoad)
-              let numberedEntries = expandedEntries <&> \(_time, hash, _reason) -> "#" <> SCH.toString hash
+              let (shortEntries, numberedEntries) =
+                    unzip $
+                      expandedEntries <&> \(time, hash, reason) ->
+                        let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash
+                         in ((time, exp, reason), sa)
               Cli.setNumberedArgs numberedEntries
-              Cli.respond $ ShowReflog expandedEntries
+              Cli.respond $ ShowReflog shortEntries
               where
                 expandEntries ::
-                  ([Reflog.Entry SCH.ShortCausalHash Text], Maybe SCH.ShortCausalHash, Bool) ->
-                  Maybe ((Maybe UTCTime, SCH.ShortCausalHash, Text), ([Reflog.Entry SCH.ShortCausalHash Text], Maybe SCH.ShortCausalHash, Bool))
+                  ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool) ->
+                  Maybe ((Maybe UTCTime, CausalHash, Text), ([Reflog.Entry CausalHash Text], Maybe CausalHash, Bool))
                 expandEntries ([], Just expectedHash, moreEntriesToLoad) =
                   if moreEntriesToLoad
                     then Nothing
@@ -785,13 +789,13 @@ loop e = do
                         (seg, _) <- Map.toList (Branch._edits b)
                     ]
               Cli.respond $ ListOfPatches $ Set.fromList patches
-              Cli.setNumberedArgs $ fmap (Text.unpack . Name.toText) patches
+              Cli.setNumberedArgs $ fmap SA.Name patches
             FindShallowI pathArg -> do
               Cli.Env {codebase} <- ask
 
               pathArgAbs <- Cli.resolvePath' pathArg
               entries <- liftIO (Backend.lsAtPath codebase Nothing pathArgAbs)
-              Cli.setNumberedArgs $ fmap entryToHQString entries
+              Cli.setNumberedArgs $ fmap (SA.ShallowListEntry pathArg) entries
               pped <- Cli.currentPrettyPrintEnvDecl
               let suffixifiedPPE = PPED.suffixifiedPPE pped
               -- This used to be a delayed action which only forced the loading of the root
@@ -801,20 +805,6 @@ loop e = do
               -- in an improvement, so perhaps it's not worth the effort.
               let buildPPE = pure suffixifiedPPE
               Cli.respond $ ListShallow buildPPE entries
-              where
-                entryToHQString :: ShallowListEntry v Ann -> String
-                entryToHQString e =
-                  fixup $ Text.unpack case e of
-                    ShallowTypeEntry te -> Backend.typeEntryDisplayName te
-                    ShallowTermEntry te -> Backend.termEntryDisplayName te
-                    ShallowBranchEntry ns _ _ -> NameSegment.toEscapedText ns
-                    ShallowPatchEntry ns -> NameSegment.toEscapedText ns
-                  where
-                    fixup s = case pathArgStr of
-                      "" -> s
-                      p | last p == '.' -> p ++ s
-                      p -> p ++ "." ++ s
-                    pathArgStr = show pathArg
             FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input
             StructuredFindI _fscope ws -> handleStructuredFindI ws
             StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws
@@ -1496,7 +1486,7 @@ handleFindI isVerbose fscope ws input = do
                     (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs)
             pure $ uniqueBy SR.toReferent srs
   let respondResults results = do
-        Cli.setNumberedArgs $ fmap (searchResultToHQString searchRoot) results
+        Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results
         results' <- Cli.runTransaction (Backend.loadSearchResults codebase results)
         Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results'
   results <- getResults names
@@ -1551,8 +1541,8 @@ handleDependencies hq = do
   let types = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ fst <$> results)
   let terms = nubOrdOn snd . Name.sortByText (HQ.toText . fst) $ (join $ snd <$> results)
   Cli.setNumberedArgs $
-    map (Text.unpack . Reference.toText . snd) types
-      <> map (Text.unpack . Reference.toText . Referent.toReference . snd) terms
+    map (SA.Ref . snd) types
+      <> map (SA.Ref . Referent.toReference . snd) terms
   Cli.respond $ ListDependencies suffixifiedPPE lds (fst <$> types) (fst <$> terms)
 
 handleDependents :: HQ.HashQualified Name -> Cli ()
@@ -1589,7 +1579,7 @@ handleDependents hq = do
   let sort = nubOrdOn snd . Name.sortByText (HQ.toText . fst)
   let types = sort [(n, r) | (False, n, r) <- join results]
   let terms = sort [(n, r) | (True, n, r) <- join results]
-  Cli.setNumberedArgs $ map (Text.unpack . Reference.toText . view _2) (types <> terms)
+  Cli.setNumberedArgs . map (SA.Ref . view _2) $ types <> terms
   Cli.respond (ListDependents ppe lds (fst <$> types) (fst <$> terms))
 
 handleDiffNamespaceToPatch :: Text -> DiffNamespaceToPatchInput -> Cli ()
@@ -1770,9 +1760,7 @@ doShowTodoOutput patch scopePath = do
     then Cli.respond NoConflictsOrEdits
     else do
       Cli.setNumberedArgs
-        ( Text.unpack . Reference.toText . view _2
-            <$> fst (TO.todoFrontierDependents todo)
-        )
+        (SA.Ref . view _2 <$> fst (TO.todoFrontierDependents todo))
       pped <- Cli.currentPrettyPrintEnvDecl
       Cli.respondNumbered $ TodoOutput pped todo
 
@@ -1818,16 +1806,6 @@ confirmedCommand i = do
   loopState <- State.get
   pure $ Just i == (loopState ^. #lastInput)
 
--- | restores the full hash to these search results, for _numberedArgs purposes
-searchResultToHQString :: Maybe Path -> SearchResult -> String
-searchResultToHQString oprefix = \case
-  SR.Tm' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify (addPrefix <$> n) r
-  SR.Tp' n r _ -> Text.unpack $ HQ.toText $ HQ.requalify (addPrefix <$> n) (Referent.Ref r)
-  _ -> error "impossible match failure"
-  where
-    addPrefix :: Name -> Name
-    addPrefix = maybe id Path.prefixName2 oprefix
-
 -- return `name` and `name.<everything>...`
 _searchBranchPrefix :: Branch m -> Name -> [SearchResult]
 _searchBranchPrefix b n = case Path.unsnoc (Path.fromName n) of

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

@@ -18,6 +18,7 @@ import Unison.Cli.Pretty qualified as P
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch.Names qualified as Branch
 import Unison.Codebase.Editor.Output
+import Unison.Codebase.Editor.StructuredArgument qualified as SA
 import Unison.HashQualified qualified as HQ
 import Unison.HashQualified' qualified as HQ'
 import Unison.Name (Name)
@@ -87,7 +88,7 @@ handleStructuredFindI rule = do
       ok t = pure (t, False)
   results0 <- traverse ok results
   let results = Alphabetical.sortAlphabeticallyOn fst [(hq, r) | ((hq, r), True) <- results0]
-  let toNumArgs = Text.unpack . Reference.toText . Referent.toReference . view _2
+  let toNumArgs = SA.Ref . Referent.toReference . view _2
   Cli.setNumberedArgs $ map toNumArgs results
   Cli.respond (ListStructuredFind (fst <$> results))
 

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

@@ -37,6 +37,7 @@ import Unison.Codebase.Editor.Output.PushPull (PushPull)
 import Unison.Codebase.Editor.RemoteRepo
 import Unison.Codebase.Editor.SlurpResult (SlurpResult (..))
 import Unison.Codebase.Editor.SlurpResult qualified as SR
+import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
 import Unison.Codebase.Editor.TodoOutput qualified as TO
 import Unison.Codebase.IntegrityCheck (IntegrityResult (..))
 import Unison.Codebase.Patch (Patch)
@@ -85,7 +86,12 @@ type ListDetailed = Bool
 
 type SourceName = Text
 
-type NumberedArgs = [String]
+-- |
+--
+--  __NB__: This only temporarily holds `Text`. Until all of the inputs are
+--          updated to handle `StructuredArgument`s, we need to ensure that the
+--          serialization remains unchanged.
+type NumberedArgs = [StructuredArgument]
 
 type HashLength = Int
 

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

@@ -0,0 +1,31 @@
+module Unison.Codebase.Editor.StructuredArgument where
+
+import GHC.Generics (Generic)
+import U.Codebase.HashTags (CausalHash)
+import Unison.Codebase.Editor.Input
+import Unison.Codebase.Path (Path, Path')
+import Unison.Codebase.Path qualified as Path
+import Unison.HashQualified qualified as HQ
+import Unison.HashQualified' qualified as HQ'
+import Unison.Name (Name)
+import Unison.Parser.Ann (Ann)
+import Unison.Project (ProjectAndBranch, ProjectBranchName, ProjectName)
+import Unison.Reference (Reference)
+import Unison.Server.Backend (ShallowListEntry)
+import Unison.Server.SearchResult (SearchResult)
+import Unison.Symbol (Symbol)
+
+-- | The types that can be referenced by a numeric command argument.
+data StructuredArgument
+  = AbsolutePath Path.Absolute
+  | Name Name
+  | HashQualified (HQ.HashQualified Name)
+  | Project ProjectName
+  | ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
+  | Ref Reference
+  | Namespace CausalHash
+  | NameWithBranchPrefix AbsBranchId Name
+  | HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name)
+  | ShallowListEntry Path' (ShallowListEntry Symbol Ann)
+  | SearchResult (Maybe Path) SearchResult
+  deriving (Eq, Generic, Show)

unison-cli/src/Unison/CommandLine.hs

@@ -46,6 +46,7 @@ import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Branch (Branch0)
 import Unison.Codebase.Branch qualified as Branch
 import Unison.Codebase.Editor.Input (Event (..), Input (..))
+import Unison.Codebase.Editor.Output (NumberedArgs)
 import Unison.Codebase.Path qualified as Path
 import Unison.Codebase.Watch qualified as Watch
 import Unison.CommandLine.FZFResolvers qualified as FZFResolvers
@@ -123,14 +124,14 @@ parseInput ::
   -- | Current path from root
   Path.Absolute ->
   -- | Numbered arguments
-  [String] ->
+  NumberedArgs ->
   -- | Input Pattern Map
   Map String InputPattern ->
   -- | command:arguments
   [String] ->
   -- Returns either an error message or the fully expanded arguments list and parsed input.
   -- If the output is `Nothing`, the user cancelled the input (e.g. ctrl-c)
-  IO (Either (P.Pretty CT.ColorText) (Maybe ([String], Input)))
+  IO (Either (P.Pretty CT.ColorText) (Maybe (InputPattern.Arguments, Input)))
 parseInput codebase currentPath numberedArgs patterns segments = runExceptT do
   let getCurrentBranch0 :: IO (Branch0 IO)
       getCurrentBranch0 = Branch.head <$> Codebase.getBranchAtPath codebase currentPath
@@ -140,16 +141,16 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do
     [] -> throwE ""
     command : args -> case Map.lookup command patterns of
       Just pat@(InputPattern {parse, help}) -> do
-        let expandedNumbers :: [String]
+        let expandedNumbers :: InputPattern.Arguments
             expandedNumbers =
-              foldMap (expandNumber numberedArgs) args
+              foldMap (\arg -> maybe [Left arg] (fmap pure) $ expandNumber numberedArgs arg) args
         lift (fzfResolve codebase projCtx getCurrentBranch0 pat expandedNumbers) >>= \case
           Left (NoFZFResolverForArgumentType _argDesc) -> throwError help
           Left (NoFZFOptions argDesc) -> throwError (noCompletionsMessage argDesc)
           Left FZFCancelled -> pure Nothing
           Right resolvedArgs -> do
             parsedInput <- except . parse $ resolvedArgs
-            pure $ Just (command : resolvedArgs, parsedInput)
+            pure $ Just (Left command : resolvedArgs, parsedInput)
       Nothing ->
         throwE
           . warn
@@ -168,11 +169,9 @@ parseInput codebase currentPath numberedArgs patterns segments = runExceptT do
           ]
 
 -- Expand a numeric argument like `1` or a range like `3-9`
-expandNumber :: [String] -> String -> [String]
-expandNumber numberedArgs s = case expandedNumber of
-  Nothing -> [s]
-  Just nums ->
-    [s | i <- nums, Just s <- [vargs Vector.!? (i - 1)]]
+expandNumber :: NumberedArgs -> String -> Maybe NumberedArgs
+expandNumber numberedArgs s =
+  (\nums -> [arg | i <- nums, Just arg <- [vargs Vector.!? (i - 1)]]) <$> expandedNumber
   where
     vargs = Vector.fromList numberedArgs
     rangeRegex = "([0-9]+)-([0-9]+)" :: String
@@ -193,13 +192,13 @@ data FZFResolveFailure
   | NoFZFOptions Text {- argument description -}
   | FZFCancelled
 
-fzfResolve :: Codebase IO Symbol Ann -> ProjectContext -> (IO (Branch0 IO)) -> InputPattern -> [String] -> IO (Either FZFResolveFailure [String])
+fzfResolve :: Codebase IO Symbol Ann -> ProjectContext -> (IO (Branch0 IO)) -> InputPattern -> InputPattern.Arguments -> IO (Either FZFResolveFailure InputPattern.Arguments)
 fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do
   -- We resolve args in two steps, first we check that all arguments that will require a fzf
   -- resolver have one, and only if so do we prompt the user to actually do a fuzzy search.
   -- Otherwise, we might ask the user to perform a search only to realize we don't have a resolver
   -- for a later arg.
-  argumentResolvers :: [ExceptT FZFResolveFailure IO [String]] <-
+  argumentResolvers :: [ExceptT FZFResolveFailure IO InputPattern.Arguments] <-
     (Align.align (InputPattern.args pat) args)
       & traverse \case
         This (argName, opt, InputPattern.ArgumentType {fzfResolver})
@@ -212,7 +211,7 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do
         These _ arg -> pure $ pure [arg]
   argumentResolvers & foldMapM id
   where
-    fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO [String]
+    fuzzyFillArg :: InputPattern.IsOptional -> Text -> InputPattern.FZFResolver -> ExceptT FZFResolveFailure IO InputPattern.Arguments
     fuzzyFillArg opt argDesc InputPattern.FZFResolver {getOptions} = do
       currentBranch <- Branch.withoutTransitiveLibs <$> liftIO getCurrentBranch
       options <- liftIO $ getOptions codebase projCtx currentBranch
@@ -223,8 +222,9 @@ fzfResolve codebase projCtx getCurrentBranch pat args = runExceptT do
           `whenNothingM` throwError FZFCancelled
       -- If the user triggered the fuzzy finder, but selected nothing, abort the command rather than continuing execution
       -- with no arguments.
-      when (null results) $ throwError FZFCancelled
-      pure (Text.unpack <$> results)
+      if null results
+        then throwError FZFCancelled
+        else pure (Left . Text.unpack <$> results)
 
     multiSelectForOptional :: InputPattern.IsOptional -> Bool
     multiSelectForOptional = \case

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

@@ -4,8 +4,10 @@
 
 module Unison.CommandLine.InputPattern
   ( InputPattern (..),
+    Argument,
     ArgumentType (..),
     ArgumentDescription,
+    Arguments,
     argType,
     FZFResolver (..),
     IsOptional (..),
@@ -25,6 +27,7 @@ import System.Console.Haskeline qualified as Line
 import Unison.Auth.HTTPClient (AuthenticatedHttpClient)
 import Unison.Codebase (Codebase)
 import Unison.Codebase.Editor.Input (Input (..))
+import Unison.Codebase.Editor.StructuredArgument (StructuredArgument)
 import Unison.Codebase.Path as Path
 import Unison.CommandLine.FZFResolvers (FZFResolver (..))
 import Unison.Prelude
@@ -44,6 +47,14 @@ data IsOptional
 data Visibility = Hidden | Visible
   deriving (Show, Eq, Ord)
 
+-- | An argument to a command is either a string provided by the user which
+-- needs to be parsed or a numbered argument that doesn’t need to be parsed, as
+-- we’ve preserved its representation (although the numbered argument could
+-- still be of the wrong type, which should result in an error).
+type Argument = Either String StructuredArgument
+
+type Arguments = [Argument]
+
 -- | Argument description
 -- It should fit grammatically into sentences like "I was expecting an argument for the <argDesc>"
 -- e.g. "namespace to merge", "definition to delete", "remote target to push to" etc.
@@ -55,7 +66,7 @@ data InputPattern = InputPattern
     visibility :: Visibility, -- Allow hiding certain commands when debugging or work-in-progress
     args :: [(ArgumentDescription, IsOptional, ArgumentType)],
     help :: P.Pretty CT.ColorText,
-    parse :: [String] -> Either (P.Pretty CT.ColorText) Input
+    parse :: Arguments -> Either (P.Pretty CT.ColorText) Input
   }
 
 data ArgumentType = ArgumentType