mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
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.
This commit is contained in:
parent
8b46f81084
commit
78816fdc3a
@ -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
|
||||
|
||||
|
@ -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) ->
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
]
|
||||
|
||||
|
@ -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.
|
||||
|
Loading…
Reference in New Issue
Block a user