Merge pull request #5139 from unisonweb/24-06-26-delete-type-force

feat: add debug.alias.type.force

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

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.

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,

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
+```
+

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