⅄ trunk → 24-06-26-port-old-merge-transcripts

parser-typechecker/src/Unison/PrintError.hs

@@ -75,6 +75,7 @@ import Unison.Util.Monoid (intercalateMap)
 import Unison.Util.Pretty (ColorText, Pretty)
 import Unison.Util.Pretty qualified as Pr
 import Unison.Util.Range (Range (..), startingLine)
+import Unison.Util.Text (ordinal)
 import Unison.Var (Var)
 import Unison.Var qualified as Var
 
@@ -831,14 +832,6 @@ renderTypeError e env src = case e of
       let sz = length wrongs
           pl a b = if sz == 1 then a else b
        in mconcat [txt pl, intercalateMap "\n" (renderSuggestion env) wrongs]
-    ordinal :: (IsString s) => Int -> s
-    ordinal n =
-      fromString $
-        show n ++ case last (show n) of
-          '1' -> "st"
-          '2' -> "nd"
-          '3' -> "rd"
-          _ -> "th"
     debugNoteLoc a = if Settings.debugNoteLoc then a else mempty
     debugSummary :: C.ErrorNote v loc -> Pretty ColorText
     debugSummary note =

parser-typechecker/src/Unison/Util/Text.hs

@@ -6,6 +6,7 @@ module Unison.Util.Text where
 
 import Data.Foldable (toList)
 import Data.List (foldl', unfoldr)
+import Data.List qualified as L
 import Data.String (IsString (..))
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
@@ -131,6 +132,25 @@ indexOf needle haystack =
     needle' = toLazyText needle
     haystack' = toLazyText haystack
 
+-- | Return the ordinal representation of a number in English.
+--   A number ending with '1' must finish with 'st'
+--   A number ending with '2' must finish with 'nd'
+--   A number ending with '3' must finish with 'rd'
+--   _except_ for 11, 12, and 13 which must finish with 'th'
+ordinal :: (IsString s) => Int -> s
+ordinal n = do
+  let s = show n
+  fromString $ s ++
+    case L.drop (L.length s - 2) s of
+      ['1', '1'] -> "th"
+      ['1', '2'] -> "th"
+      ['1', '3'] -> "th"
+      _ -> case last s of
+        '1' -> "st"
+        '2' -> "nd"
+        '3' -> "rd"
+        _ -> "th"
+
 -- Drop with both a maximum size and a predicate. Yields actual number of
 -- dropped characters.
 --

parser-typechecker/tests/Unison/Test/Util/Text.hs

@@ -178,7 +178,28 @@ test =
                   )
                   (P.Join [P.Capture (P.Literal "zzzaaa"), P.Capture (P.Literal "!")])
            in P.run p "zzzaaa!!!"
-        ok
+        ok,
+      scope "ordinal" do
+        expectEqual (Text.ordinal 1) ("1st" :: String)
+        expectEqual (Text.ordinal 2) ("2nd" :: String)
+        expectEqual (Text.ordinal 3) ("3rd" :: String)
+        expectEqual (Text.ordinal 4) ("4th" :: String)
+        expectEqual (Text.ordinal 5) ("5th" :: String)
+        expectEqual (Text.ordinal 10) ("10th" :: String)
+        expectEqual (Text.ordinal 11) ("11th" :: String)
+        expectEqual (Text.ordinal 12) ("12th" :: String)
+        expectEqual (Text.ordinal 13) ("13th" :: String)
+        expectEqual (Text.ordinal 14) ("14th" :: String)
+        expectEqual (Text.ordinal 21) ("21st" :: String)
+        expectEqual (Text.ordinal 22) ("22nd" :: String)
+        expectEqual (Text.ordinal 23) ("23rd" :: String)
+        expectEqual (Text.ordinal 24) ("24th" :: String)
+        expectEqual (Text.ordinal 111) ("111th" :: String)
+        expectEqual (Text.ordinal 112) ("112th" :: String)
+        expectEqual (Text.ordinal 113) ("113th" :: String)
+        expectEqual (Text.ordinal 121) ("121st" :: String)
+        expectEqual (Text.ordinal 122) ("122nd" :: String)
+        expectEqual (Text.ordinal 123) ("123rd" :: String)
     ]
   where
     log2 :: Int -> Int

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -470,7 +470,7 @@ loop e = do
               branch <- liftIO $ Codebase.getBranchAtPath codebase absPath
               _evalErrs <- liftIO $ (Backend.docsInBranchToHtmlFiles sandboxedRuntime codebase branch sourceDirectory)
               pure ()
-            AliasTermI src' dest' -> do
+            AliasTermI force src' dest' -> do
               Cli.Env {codebase} <- ask
               src <- traverseOf _Right Cli.resolveSplit' src'
               srcTerms <-
@@ -489,7 +489,7 @@ loop e = do
                       pure (DeleteNameAmbiguous hqLength name srcTerms Set.empty)
               dest <- Cli.resolveSplit' dest'
               destTerms <- Cli.getTermsAt (HQ'.NameOnly <$> dest)
-              when (not (Set.null destTerms)) do
+              when (not force && not (Set.null destTerms)) do
                 Cli.returnEarly (TermAlreadyExists dest' destTerms)
               description <- inputDescription input
               Cli.stepAt description (BranchUtil.makeAddTermName (first Path.unabsolute dest) srcTerm)
@@ -977,10 +977,10 @@ inputDescription input =
     ResetRootI src0 -> do
       src <- hp' src0
       pure ("reset-root " <> src)
-    AliasTermI src0 dest0 -> do
+    AliasTermI force src0 dest0 -> do
       src <- hhqs' src0
       dest <- ps' dest0
-      pure ("alias.term " <> src <> " " <> dest)
+      pure ((if force then "alias.term.force " else "alias.term ") <> src <> " " <> dest)
     AliasTypeI src0 dest0 -> do
       src <- hhqs' src0
       dest <- ps' dest0

unison-cli/src/Unison/Codebase/Editor/Input.hs

@@ -132,7 +132,7 @@ data Input
     -- > names .foo.bar#asdflkjsdf
     -- > names #sdflkjsdfhsdf
     NamesI IsGlobal (HQ.HashQualified Name)
-  | AliasTermI HashOrHQSplit' Path.Split'
+  | AliasTermI !Bool HashOrHQSplit' Path.Split' -- bool = force?
   | AliasTypeI HashOrHQSplit' Path.Split'
   | AliasManyI [Path.HQSplit] Path'
   | MoveAllI Path.Path' Path.Path'

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -1382,14 +1382,30 @@ deleteBranch =
 aliasTerm :: InputPattern
 aliasTerm =
   InputPattern
-    "alias.term"
-    []
-    I.Visible
-    [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)]
-    "`alias.term foo bar` introduces `bar` with the same definition as `foo`."
-    $ \case
-      [oldName, newName] -> Input.AliasTermI <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName
-      _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`."
+    { patternName = "alias.term",
+      aliases = [],
+      visibility = I.Visible,
+      args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)],
+      help = "`alias.term foo bar` introduces `bar` with the same definition as `foo`.",
+      parse = \case
+        [oldName, newName] -> Input.AliasTermI False <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName
+        _ -> Left . warn $ P.wrap "`alias.term` takes two arguments, like `alias.term oldname newname`."
+    }
+
+aliasTermForce :: InputPattern
+aliasTermForce =
+  InputPattern
+    { patternName = "debug.alias.term.force",
+      aliases = [],
+      visibility = I.Hidden,
+      args = [("term to alias", Required, exactDefinitionTermQueryArg), ("alias name", Required, newNameArg)],
+      help = "`debug.alias.term.force foo bar` introduces `bar` with the same definition as `foo`.",
+      parse = \case
+        [oldName, newName] -> Input.AliasTermI True <$> handleShortHashOrHQSplit'Arg oldName <*> handleSplit'Arg newName
+        _ ->
+          Left . warn $
+            P.wrap "`debug.alias.term.force` takes two arguments, like `debug.alias.term.force oldname newname`."
+    }
 
 aliasType :: InputPattern
 aliasType =
@@ -3283,6 +3299,7 @@ validInputs =
     [ add,
       aliasMany,
       aliasTerm,
+      aliasTermForce,
       aliasType,
       api,
       authLogin,

unison-src/transcripts/alias-term.md

@@ -0,0 +1,27 @@
+`alias.term` makes a new name for a term.
+
+```ucm:hide
+project/main> builtins.mergeio lib.builtins
+```
+
+```ucm
+project/main> alias.term lib.builtins.bug foo
+project/main> ls
+```
+
+It won't create a conflicted name, though.
+
+```ucm:error
+project/main> alias.term lib.builtins.todo foo
+```
+
+```ucm
+project/main> ls
+```
+
+You can use `debug.alias.term.force` for that.
+
+```ucm
+project/main> debug.alias.term.force lib.builtins.todo foo
+project/main> ls
+```

unison-src/transcripts/alias-term.output.md

@@ -0,0 +1,44 @@
+`alias.term` makes a new name for a term.
+
+```ucm
+project/main> alias.term lib.builtins.bug foo
+
+  Done.
+
+project/main> ls
+
+  1. foo  (a -> b)
+  2. lib/ (643 terms, 92 types)
+
+```
+It won't create a conflicted name, though.
+
+```ucm
+project/main> alias.term lib.builtins.todo foo
+
+  ⚠️
+  
+  A term by that name already exists.
+
+```
+```ucm
+project/main> ls
+
+  1. foo  (a -> b)
+  2. lib/ (643 terms, 92 types)
+
+```
+You can use `debug.alias.term.force` for that.
+
+```ucm
+project/main> debug.alias.term.force lib.builtins.todo foo
+
+  Done.
+
+project/main> ls
+
+  1. foo  (a -> b)
+  2. foo  (a -> b)
+  3. lib/ (643 terms, 92 types)
+
+```