Merge pull request #5019 from sellout/delete-dependents

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
 

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) ->

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)

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,23 +555,25 @@ 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
 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

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
  ]
 

unison-src/transcripts/fix4898.md

@@ -0,0 +1,17 @@
+```ucm
+.> builtins.merge
+```
+
+```unison
+double : Int -> Int
+double x = x + x
+
+redouble : Int -> Int
+redouble x = double x + double x
+```
+
+```ucm
+.> add
+.> dependents double
+.> delete.term 1
+```

unison-src/transcripts/fix4898.output.md

@@ -0,0 +1,52 @@
+```ucm
+.> builtins.merge
+
+ Done.
+
+```
+```unison
+double : Int -> Int
+double x = x + x
+
+redouble : Int -> Int
+redouble x = double x + double x
+```
+
+```ucm
+
+ Loading changes detected in scratch.u.
+
+ I found and typechecked these definitions in scratch.u. If you
+ do an `add` or `update`, here's how your codebase would
+ change:
+ 
+ ⍟ These new definitions are ok to `add`:
+ 
+ double : Int -> Int
+ redouble : Int -> Int
+
+```
+```ucm
+.> add
+
+ ⍟ I've added these definitions:
+ 
+ double : Int -> Int
+ redouble : Int -> Int
+
+.> dependents double
+
+ Dependents of: double
+ 
+ Terms:
+ 
+ 1. redouble
+ 
+ Tip: Try `view 1` to see the source of any numbered item in
+ the above list.
+
+.> delete.term 1
+
+ Done.
+
+```