diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 0a53fb6025..2175ce06a0 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -492,7 +492,7 @@ loop e = do description <- inputDescription input Cli.stepAt description (BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm) Cli.respond Success - AliasTypeI src' dest' -> do + AliasTypeI force src' dest' -> do src <- traverseOf _Right Cli.resolveSplit' src' srcTypes <- either @@ -510,7 +510,7 @@ loop e = do pure (DeleteNameAmbiguous hqLength name Set.empty srcTypes) dest <- Cli.resolveSplit' dest' destTypes <- Cli.getTypesAt (HQ'.NameOnly <$> dest) - when (not (Set.null destTypes)) do + when (not force && not (Set.null destTypes)) do Cli.returnEarly (TypeAlreadyExists dest' destTypes) description <- inputDescription input Cli.stepAt description (BranchUtil.makeAddTypeName (first Path.unabsolute dest) srcType) @@ -978,11 +978,11 @@ inputDescription input = AliasTermI force src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 - pure ((if force then "alias.term.force " else "alias.term ") <> src <> " " <> dest) - AliasTypeI src0 dest0 -> do + pure ((if force then "debug.alias.term.force " else "alias.term ") <> src <> " " <> dest) + AliasTypeI force src0 dest0 -> do src <- hhqs' src0 dest <- ps' dest0 - pure ("alias.type " <> src <> " " <> dest) + pure ((if force then "debug.alias.type.force " else "alias.term ") <> src <> " " <> dest) AliasManyI srcs0 dest0 -> do srcs <- traverse hqs srcs0 dest <- p' dest0 diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 8dc38bb14d..86ecb38491 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -133,7 +133,7 @@ data Input -- > names #sdflkjsdfhsdf NamesI IsGlobal (HQ.HashQualified Name) | AliasTermI !Bool HashOrHQSplit' Path.Split' -- bool = force? - | AliasTypeI HashOrHQSplit' Path.Split' + | AliasTypeI !Bool HashOrHQSplit' Path.Split' -- bool = force? | AliasManyI [Path.HQSplit] Path' | MoveAllI Path.Path' Path.Path' | -- Move = Rename; It's an HQSplit' not an HQSplit', meaning the arg has to have a name. diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 7b395659a0..31fcd41ae6 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1392,8 +1392,8 @@ aliasTerm = _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`." } -aliasTermForce :: InputPattern -aliasTermForce = +debugAliasTermForce :: InputPattern +debugAliasTermForce = InputPattern { patternName = "debug.alias.term.force", aliases = [], @@ -1416,9 +1416,24 @@ aliasType = [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)] "`alias.type Foo Bar` introduces `Bar` with the same definition as `Foo`." \case - [oldName, newName] -> Input.AliasTypeI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + [oldName, newName] -> Input.AliasTypeI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName _ -> Left . warn $ P.wrap "`alias.type` takes two arguments, like `alias.type oldname newname`." +debugAliasTypeForce :: InputPattern +debugAliasTypeForce = + InputPattern + { patternName = "debug.alias.type.force", + aliases = [], + visibility = I.Hidden, + args = [("type to alias", Required, exactDefinitionTypeQueryArg), ("alias name", Required, newNameArg)], + help = "`debug.alias.type.force Foo Bar` introduces `Bar` with the same definition as `Foo`.", + parse = \case + [oldName, newName] -> Input.AliasTypeI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName + _ -> + Left . warn $ + P.wrap "`debug.alias.type.force` takes two arguments, like `debug.alias.type.force oldname newname`." + } + aliasMany :: InputPattern aliasMany = InputPattern @@ -3299,7 +3314,6 @@ validInputs = [ add, aliasMany, aliasTerm, - aliasTermForce, aliasType, api, authLogin, @@ -3313,6 +3327,8 @@ validInputs = clone, compileScheme, createAuthor, + debugAliasTermForce, + debugAliasTypeForce, debugClearWatchCache, debugDoctor, debugDumpNamespace, diff --git a/unison-src/transcripts/alias-type.md b/unison-src/transcripts/alias-type.md new file mode 100644 index 0000000000..b167daa2cc --- /dev/null +++ b/unison-src/transcripts/alias-type.md @@ -0,0 +1,28 @@ +`alias.type` makes a new name for a type. + +```ucm:hide +project/main> builtins.mergeio lib.builtins +``` + +```ucm +project/main> alias.type lib.builtins.Nat Foo +project/main> ls +``` + +It won't create a conflicted name, though. + +```ucm:error +project/main> alias.type lib.builtins.Int Foo +``` + +```ucm +project/main> ls +``` + +You can use `debug.alias.type.force` for that. + +```ucm +project/main> debug.alias.type.force lib.builtins.Int Foo +project/main> ls +``` + diff --git a/unison-src/transcripts/alias-type.output.md b/unison-src/transcripts/alias-type.output.md new file mode 100644 index 0000000000..820c817614 --- /dev/null +++ b/unison-src/transcripts/alias-type.output.md @@ -0,0 +1,44 @@ +`alias.type` makes a new name for a type. + +```ucm +project/main> alias.type lib.builtins.Nat Foo + + Done. + +project/main> ls + + 1. Foo (builtin type) + 2. lib/ (643 terms, 92 types) + +``` +It won't create a conflicted name, though. + +```ucm +project/main> alias.type lib.builtins.Int Foo + + ⚠️ + + A type by that name already exists. + +``` +```ucm +project/main> ls + + 1. Foo (builtin type) + 2. lib/ (643 terms, 92 types) + +``` +You can use `debug.alias.type.force` for that. + +```ucm +project/main> debug.alias.type.force lib.builtins.Int Foo + + Done. + +project/main> ls + + 1. Foo (builtin type) + 2. Foo (builtin type) + 3. lib/ (643 terms, 92 types) + +```