Serialize StructuredArguments on demand

Previously, the `Text` format had been preserved from the original code. This
extracts all to a separate function that is called as needed.

All transcripts still pass.

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

@@ -153,7 +153,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
@@ -298,8 +297,8 @@ loop e = do
  let (shortEntries, numberedEntries) =
  unzip $
  expandedEntries <&> \(time, hash, reason) ->
- let ((exp, txt), sa) = ((id &&& ("#" <>) . SCH.toText) . SCH.fromHash schLength &&& SA.Namespace) hash
- in ((time, exp, reason), (txt, sa))
+ let (exp, sa) = (SCH.fromHash schLength &&& SA.Namespace) hash
+ in ((time, exp, reason), sa)
  Cli.setNumberedArgs numberedEntries
  Cli.respond $ ShowReflog shortEntries
  where
@@ -791,13 +790,13 @@ loop e = do
  (seg, _) <- Map.toList (Branch._edits b)
  ]
  Cli.respond $ ListOfPatches $ Set.fromList patches
- Cli.setNumberedArgs $ fmap (Name.toText &&& SA.Name) 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 (entryToHQText &&& SA.ShallowListEntry pathArg) 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
@@ -807,21 +806,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
- entryToHQText :: ShallowListEntry v Ann -> Text
- entryToHQText e =
- fixup $ 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 =
- pathArgStr
- <> if Text.null pathArgStr || Text.isSuffixOf "." pathArgStr
- then s
- else "." <> s
- pathArgStr = Text.pack $ show pathArg
  FindI isVerbose fscope ws -> handleFindI isVerbose fscope ws input
  StructuredFindI _fscope ws -> handleStructuredFindI ws
  StructuredFindReplaceI ws -> handleStructuredFindReplaceI ws
@@ -1501,7 +1485,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 (HQ.toText . IP.searchResultToHQ searchRoot &&& SA.SearchResult 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
@@ -1556,8 +1540,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 ((Reference.toText &&& SA.Type) . snd) types
- <> map ((Reference.toText &&& SA.Term) . Referent.toReference . snd) terms
+ map (SA.Type . snd) types
+ <> map (SA.Term . Referent.toReference . snd) terms
  Cli.respond $ ListDependencies suffixifiedPPE lds (fst <$> types) (fst <$> terms)
 
 handleDependents :: HQ.HashQualified Name -> Cli ()
@@ -1594,7 +1578,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 ((Reference.toText &&& SA.Type) . view _2) types <> map ((Reference.toText &&& SA.Term) . view _2) terms
+ Cli.setNumberedArgs $ map (SA.Type . view _2) types <> map (SA.Term . view _2) terms
  Cli.respond (ListDependents ppe lds (fst <$> types) (fst <$> terms))
 
 handleDiffNamespaceToPatch :: Text -> DiffNamespaceToPatchInput -> Cli ()
@@ -1775,7 +1759,7 @@ doShowTodoOutput patch scopePath = do
  then Cli.respond NoConflictsOrEdits
  else do
  Cli.setNumberedArgs
- ((Reference.toText &&& SA.Ref) . view _2 <$> fst (TO.todoFrontierDependents todo))
+ (SA.Ref . view _2 <$> fst (TO.todoFrontierDependents todo))
  pped <- Cli.currentPrettyPrintEnvDecl
  Cli.respondNumbered $ TodoOutput pped todo
 

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

@@ -4,7 +4,6 @@ module Unison.Codebase.Editor.HandleInput.FindAndReplace
  )
 where
 
-import Control.Arrow ((&&&))
 import Control.Lens hiding (at)
 import Control.Monad.Reader (ask)
 import Control.Monad.State
@@ -89,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 = (Reference.toText &&& SA.Ref) . 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

@@ -90,7 +90,7 @@ type SourceName = Text
 -- __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 = [(Text, StructuredArgument)]
+type NumberedArgs = [StructuredArgument]
 
 type HashLength = Int
 

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

@@ -20,15 +20,12 @@ import Unison.Symbol (Symbol)
 -- re-parsed in `expandNumbers`. The later version will only have a
 -- handful of distinct types.
 data StructuredArgument
- = -- only on input side
- Path' Path'
- | -- on both sides
- Name Name
+ = Path' Path'
+ | Name Name
  | HashQualified (HQ.HashQualified Name)
  | Project ProjectName
  | ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
- | -- only on output side
- Ref Reference
+ | Ref Reference
  | Term TermReference
  | Type TypeReference
  | Namespace CausalHash

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

@@ -51,7 +51,7 @@ data Visibility = Hidden | Visible
 -- 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 (Text, StructuredArgument)
+type Argument = Either String StructuredArgument
 
 type Arguments = [Argument]