Remove Reference from StructuredArgument

Almost everywhere we produce a `Reference` for numbered args, we also have a `HashQualified Name` handy, which is much more consumable by commands. The only case we don’t have an `HQ` is in the `todo` command output, so that now explicitly builds a `HQ.HashOnly`. This also fixes an issue with `StructuredArgument` handling where `alias.term` and `alias.type` wouldn’t make an alias to a `HQ.HashOnly` `StructuredArgument`. Fixes #4898.
2024-09-11 02:25:39 +03:00 · 2024-05-29 10:31:04 -06:00 · 2024-05-29 10:31:04 -06:00 · 78816fdc3a
commit 78816fdc3a
parent 8b46f81084
6 changed files with 47 additions and 52 deletions
--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs
@ -1285,12 +1285,10 @@ handleDependencies hq = do
    let types = [(PPE.typeName suffixifiedPPE r, r) | LabeledDependency.TypeReference r <- toList dependencies]
    let terms = [(PPE.termName suffixifiedPPE r, r) | LabeledDependency.TermReferent r <- toList dependencies]
    pure (types, terms)
-  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 (SA.Ref . snd) types
-      <> map (SA.Ref . Referent.toReference . snd) terms
-  Cli.respond $ ListDependencies suffixifiedPPE lds (fst <$> types) (fst <$> terms)
+  let types = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) . join $ fst <$> results
+  let terms = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) . join $ snd <$> results
+  Cli.setNumberedArgs . map SA.HashQualified $ types <> terms
+  Cli.respond $ ListDependencies suffixifiedPPE lds types terms

 handleDependents :: HQ.HashQualified Name -> Cli ()
 handleDependents hq = do
@ -1307,7 +1305,7 @@ handleDependents hq = do
  results <- for (toList lds) \ld -> do
    -- The full set of dependent references, any number of which may not have names in the current namespace.
    dependents <-
-      let tp r = Codebase.dependents Queries.ExcludeOwnComponent r
+      let tp = Codebase.dependents Queries.ExcludeOwnComponent
          tm = \case
            Referent.Ref r -> Codebase.dependents Queries.ExcludeOwnComponent r
            Referent.Con (ConstructorReference r _cid) _ct ->
@ -1323,11 +1321,11 @@ handleDependents hq = do
          Just shortName <- pure $ PPE.terms ppe (Referent.Ref r) <|> PPE.types ppe r
          pure (isTerm, HQ'.toHQ shortName, r)
    pure results
-  let sort = nubOrdOn snd . Name.sortByText (HQ.toText . fst)
+  let sort = fmap fst . 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 (SA.Ref . view _2) $ types <> terms
-  Cli.respond (ListDependents ppe lds (fst <$> types) (fst <$> terms))
+  Cli.setNumberedArgs . map SA.HashQualified $ types <> terms
+  Cli.respond (ListDependents ppe lds types terms)

 -- | Handle a @ShowDefinitionI@ input command, i.e. `view` or `edit`.
 handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> NonEmpty (HQ.HashQualified Name) -> Cli ()
@ -1439,8 +1437,9 @@ doShowTodoOutput patch scopePath = do
  if TO.noConflicts todo && TO.noEdits todo
    then Cli.respond NoConflictsOrEdits
    else do
-      Cli.setNumberedArgs
-        (SA.Ref . view _2 <$> fst (TO.todoFrontierDependents todo))
+      Cli.setNumberedArgs $
+        SA.HashQualified . HQ.HashOnly . Reference.toShortHash . view _2
+          <$> fst (TO.todoFrontierDependents todo)
      pped <- Cli.currentPrettyPrintEnvDecl
      Cli.respondNumbered $ TodoOutput pped todo

--- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/FindAndReplace.hs
@ -82,15 +82,14 @@ handleStructuredFindI rule = do
    Referent.Ref _ <- pure r
    Just shortName <- [PPE.terms (PPED.suffixifiedPPE ppe) r]
    pure (HQ'.toHQ shortName, r)
-  let ok t@(_, Referent.Ref (Reference.DerivedId r)) = do
+  let ok (hq, Referent.Ref (Reference.DerivedId r)) = do
        oe <- Cli.runTransaction (Codebase.getTerm codebase r)
-        pure $ (t, maybe False (\e -> any ($ e) rules) oe)
-      ok t = pure (t, False)
+        pure $ (hq, maybe False (\e -> any ($ e) rules) oe)
+      ok (hq, _) = pure (hq, False)
  results0 <- traverse ok results
-  let results = Alphabetical.sortAlphabeticallyOn fst [(hq, r) | ((hq, r), True) <- results0]
-  let toNumArgs = SA.Ref . Referent.toReference . view _2
-  Cli.setNumberedArgs $ map toNumArgs results
-  Cli.respond (ListStructuredFind (fst <$> results))
+  let results = Alphabetical.sortAlphabetically [hq | (hq, True) <- results0]
+  Cli.setNumberedArgs $ map SA.HashQualified results
+  Cli.respond (ListStructuredFind results)

 lookupRewrite ::
  (HQ.HashQualified Name -> Output) ->
--- a/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs
+++ b/unison-cli/src/Unison/Codebase/Editor/StructuredArgument.hs
@ -10,7 +10,6 @@ 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)
@ -22,7 +21,6 @@ data StructuredArgument
  | HashQualified (HQ.HashQualified Name)
  | Project ProjectName
  | ProjectBranch (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-  | Ref Reference
  | Namespace CausalHash
  | NameWithBranchPrefix AbsBranchId Name
  | HashQualifiedWithBranchPrefix AbsBranchId (HQ'.HashQualified Name)
--- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs
+++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@ -203,7 +203,6 @@ import Unison.Project
    branchWithOptionalProjectParser,
  )
 import Unison.Project.Util (ProjectContext (..), projectContextFromPath)
-import Unison.Reference qualified as Reference
 import Unison.Referent qualified as Referent
 import Unison.Server.Backend (ShallowListEntry (..))
 import Unison.Server.Backend qualified as Backend
@ -227,8 +226,6 @@ formatStructuredArgument schLength = \case
  SA.Project projectName -> into @Text projectName
  SA.ProjectBranch (ProjectAndBranch mproj branch) ->
    maybe (Text.cons '/' . into @Text) (\project -> into @Text . ProjectAndBranch project) mproj branch
-  -- also: ShortHash.toText . Reference.toShortHash
-  SA.Ref reference -> Reference.toText reference
  -- also: ("#" <>) . Hash.toBase32HexText . unCausalHash
  SA.Namespace causalHash -> ("#" <>) . SCH.toText $ maybe SCH.fromFullHash SCH.fromHash schLength causalHash
  SA.NameWithBranchPrefix absBranchId name -> prefixBranchId absBranchId name
@ -291,17 +288,23 @@ unsupportedStructuredArgument :: Text -> I.Argument -> Either (P.Pretty CT.Color
 unsupportedStructuredArgument expected =
  either pure (const . Left . P.text $ "can’t use a numbered argument for " <> expected)

-expectedButActually :: Text -> Text -> Text -> Text
+expectedButActually :: Text -> StructuredArgument -> Text -> P.Pretty CT.ColorText
 expectedButActually expected actualValue actualType =
-  "Expected " <> expected <> ", but the numbered arg resulted in " <> actualValue <> ", which is " <> actualType <> "."
+  P.text $
+    "Expected "
+      <> expected
+      <> ", but the numbered arg resulted in "
+      <> formatStructuredArgument Nothing actualValue
+      <> ", which is "
+      <> actualType
+      <> "."

 wrongStructuredArgument :: Text -> StructuredArgument -> P.Pretty CT.ColorText
 wrongStructuredArgument expected actual =
-  P.text $ expectedButActually
+  expectedButActually
    expected
-    (formatStructuredArgument Nothing actual)
+    actual
    case actual of
-      SA.Ref _ -> "a reference"
      SA.Name _ -> "a name"
      SA.AbsolutePath _ -> "an absolute path"
      SA.Namespace _ -> "a namespace"
@ -381,7 +384,6 @@ handleHashQualifiedNameArg =
      SA.Name name -> pure $ HQ.NameOnly name
      SA.NameWithBranchPrefix mprefix name ->
        pure . HQ.NameOnly $ foldr (\prefix -> Name.makeAbsolute . Path.prefixName prefix) name mprefix
-      SA.Ref ref -> pure . HQ.HashOnly $ Reference.toShortHash ref
      SA.HashQualified hqname -> pure hqname
      SA.HashQualifiedWithBranchPrefix mprefix hqname ->
        pure . HQ'.toHQ $ foldr (\prefix -> fmap $ Name.makeAbsolute . Path.prefixName prefix) hqname mprefix
@ -526,15 +528,15 @@ handleBranchRelativePathArg =
        pure . BranchRelative . This $ maybe (Left branch) (pure . (,branch)) mproject
      otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg

-hqNameToSplit' :: HQ.HashQualified Name -> Either (P.Pretty CT.ColorText) Path.HQSplit'
+hqNameToSplit' :: HQ.HashQualified Name -> Either ShortHash Path.HQSplit'
 hqNameToSplit' = \case
-  HQ.HashOnly _ -> Left $ P.text "Only have a hash"
+  HQ.HashOnly hash -> Left hash
  HQ.NameOnly name -> pure . fmap HQ'.NameOnly $ Path.splitFromName' name
  HQ.HashQualified name hash -> pure . fmap (`HQ'.HashQualified` hash) $ Path.splitFromName' name

-hqNameToSplit :: HQ.HashQualified Name -> Either (P.Pretty CT.ColorText) Path.HQSplit
+hqNameToSplit :: HQ.HashQualified Name -> Either ShortHash Path.HQSplit
 hqNameToSplit = \case
-  HQ.HashOnly _ -> Left $ P.text "Only have a hash"
+  HQ.HashOnly hash -> Left hash
  HQ.NameOnly name -> pure . fmap HQ'.NameOnly $ Path.splitFromName name
  HQ.HashQualified name hash -> pure . fmap (`HQ'.HashQualified` hash) $ Path.splitFromName name

@ -553,11 +555,12 @@ handleHashQualifiedSplit'Arg =
  either
    (first P.text . Path.parseHQSplit')
    \case
-      SA.HashQualified name -> hqNameToSplit' name
+      hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit' name
      SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit' hqname
      SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
        pure . hq'NameToSplit' $ Name.makeAbsolute . Path.prefixName prefix <$> hqname
-      SA.SearchResult mpath result -> hqNameToSplit' $ searchResultToHQ mpath result
+      sr@(SA.SearchResult mpath result) ->
+        first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit' $ searchResultToHQ mpath result
      otherNumArg -> Left $ wrongStructuredArgument "a name" otherNumArg

 handleHashQualifiedSplitArg :: I.Argument -> Either (P.Pretty CT.ColorText) Path.HQSplit
@ -565,11 +568,12 @@ handleHashQualifiedSplitArg =
  either
    (first P.text . Path.parseHQSplit)
    \case
-      SA.HashQualified name -> hqNameToSplit name
+      hq@(SA.HashQualified name) -> first (const $ expectedButActually "a name" hq "a hash") $ hqNameToSplit name
      SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure $ hq'NameToSplit hqname
      SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
        pure . hq'NameToSplit $ Name.makeAbsolute . Path.prefixName prefix <$> hqname
-      SA.SearchResult mpath result -> hqNameToSplit $ searchResultToHQ mpath result
+      sr@(SA.SearchResult mpath result) ->
+        first (const $ expectedButActually "a name" sr "a hash") . hqNameToSplit $ searchResultToHQ mpath result
      otherNumArg -> Left $ wrongStructuredArgument "a relative name" otherNumArg

 handleShortCausalHashArg :: I.Argument -> Either (P.Pretty CT.ColorText) ShortCausalHash
@ -586,12 +590,11 @@ handleShortHashOrHQSplit'Arg =
  either
    (first P.text . Path.parseShortHashOrHQSplit')
    \case
-      SA.Ref ref -> pure $ Left $ Reference.toShortHash ref
-      SA.HashQualified name -> pure <$> hqNameToSplit' name
+      SA.HashQualified name -> pure $ hqNameToSplit' name
      SA.HashQualifiedWithBranchPrefix (Left _) hqname -> pure . pure $ hq'NameToSplit' hqname
      SA.HashQualifiedWithBranchPrefix (Right prefix) hqname ->
        pure . pure $ hq'NameToSplit' (Name.makeAbsolute . Path.prefixName prefix <$> hqname)
-      SA.SearchResult mpath result -> fmap pure . hqNameToSplit' $ searchResultToHQ mpath result
+      SA.SearchResult mpath result -> pure . hqNameToSplit' $ searchResultToHQ mpath result
      otherNumArg -> Left $ wrongStructuredArgument "a hash or name" otherNumArg

 handleRelativeNameSegmentArg :: I.Argument -> Either (P.Pretty CT.ColorText) NameSegment
--- a/unison-cli/tests/Unison/Test/Cli/Monad.hs
+++ b/unison-cli/tests/Unison/Test/Cli/Monad.hs
@ -7,7 +7,7 @@ import Control.Lens
 import EasyTest
 import Unison.Cli.Monad qualified as Cli
 import Unison.Codebase.Editor.StructuredArgument qualified as SA
-import Unison.Reference qualified as Reference
+import Unison.Syntax.Name qualified as Name

 test :: Test ()
 test =
@ -18,13 +18,15 @@ test =
            Cli.runCli dummyEnv dummyLoopState do
              Cli.label \goto -> do
                Cli.label \_ -> do
-                  Cli.setNumberedArgs [SA.Ref $ Reference.ReferenceBuiltin "foo"]
+                  Cli.setNumberedArgs [SA.Name $ Name.unsafeParseText "foo"]
                  goto (1 :: Int)
                pure 2
        -- test that 'goto' short-circuits, as expected
        expectEqual' (Cli.Success 1) r
        -- test that calling 'goto' doesn't lose state changes made along the way
-        expectEqual' [SA.Ref $ Reference.ReferenceBuiltin "foo"] (state ^. #numberedArgs)
+        expectEqual'
+          [SA.Name $ Name.unsafeParseText "foo"]
+          (state ^. #numberedArgs)
        ok
    ]

--- a/unison-src/transcripts/fix4898.output.md
+++ b/unison-src/transcripts/fix4898.output.md
@ -47,12 +47,6 @@ redouble x = double x + double x

 .> delete.term 1

+  Done.
+
 ```
-
-
-
-🛑
-
-The transcript failed due to an error in the stanza above. The error is:
-
-Expected a name, but the numbered arg resulted in #1gupumeruksjs4sb5mg8jcb891dmbufmqrfblfss1sevbl62fr7oud24mpo03jm2qlbdt6ntordsmfj1jovhfsp3mij461odaahfh2g, which is a reference.