Merge remote-tracking branch 'upstream/trunk' into numbered-test-results

codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs

@@ -66,7 +66,8 @@ module U.Codebase.Sqlite.Operations
     directDependenciesOfScope,
     dependents,
     dependentsOfComponent,
-    dependentsWithinScope,
+    directDependentsWithinScope,
+    transitiveDependentsWithinScope,
 
     -- ** type index
     Q.addTypeToIndexForTerm,
@@ -1154,19 +1155,43 @@ dependents selector r = do
       sIds <- Q.getDependentsForDependency selector r'
       Set.traverse s2cReferenceId sIds
 
--- | `dependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not
--- including `query` itself). Each dependent is also tagged with whether it is a term or decl.
-dependentsWithinScope :: Set C.Reference.Id -> Set C.Reference -> Transaction (Map C.Reference.Id C.ReferenceType)
-dependentsWithinScope scope query = do
-  scope' <- Set.traverse c2sReferenceId scope
-  query' <- Set.traverse c2sReference query
-  Q.getDependentsWithinScope scope' query'
-    >>= Map.bitraverse s2cReferenceId (pure . objectTypeToReferenceType)
-  where
-    objectTypeToReferenceType = \case
-      ObjectType.TermComponent -> C.RtTerm
-      ObjectType.DeclComponent -> C.RtType
-      _ -> error "Q.getDependentsWithinScope shouldn't return any other types"
+-- | `directDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not
+-- including `query` itself).
+directDependentsWithinScope ::
+  Set C.Reference.Id ->
+  Set C.Reference ->
+  Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId)
+directDependentsWithinScope scope0 query0 = do
+  -- Convert C -> S
+  scope1 <- Set.traverse c2sReferenceId scope0
+  query1 <- Set.traverse c2sReference query0
+
+  -- Do the query
+  dependents0 <- Q.getDirectDependentsWithinScope scope1 query1
+
+  -- Convert S -> C
+  dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0
+
+  pure dependents1
+
+-- | `transitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope` (not
+-- including `query` itself).
+transitiveDependentsWithinScope ::
+  Set C.Reference.Id ->
+  Set C.Reference ->
+  Transaction (DefnsF Set C.TermReferenceId C.TypeReferenceId)
+transitiveDependentsWithinScope scope0 query0 = do
+  -- Convert C -> S
+  scope1 <- Set.traverse c2sReferenceId scope0
+  query1 <- Set.traverse c2sReference query0
+
+  -- Do the query
+  dependents0 <- Q.getTransitiveDependentsWithinScope scope1 query1
+
+  -- Convert S -> C
+  dependents1 <- bitraverse (Set.traverse s2cReferenceId) (Set.traverse s2cReferenceId) dependents0
+
+  pure dependents1
 
 -- | returns a list of known definitions referencing `h`
 dependentsOfComponent :: H.Hash -> Transaction (Set C.Reference.Id)

codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs

@@ -166,7 +166,8 @@ module U.Codebase.Sqlite.Queries
     getDependencyIdsForDependent,
     getDependenciesBetweenTerms,
     getDirectDependenciesOfScope,
-    getDependentsWithinScope,
+    getDirectDependentsWithinScope,
+    getTransitiveDependentsWithinScope,
 
     -- ** type index
     addToTypeIndex,
@@ -1913,28 +1914,68 @@ getDirectDependenciesOfScope scope = do
 
   pure dependencies1
 
-{- ORMOLU_DISABLE -}
+-- | `getDirectDependentsWithinScope scope query` returns all direct dependents of `query` that are in `scope` (not
+-- including `query` itself).
+getDirectDependentsWithinScope ::
+  Set S.Reference.Id ->
+  Set S.Reference ->
+  Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId)
+getDirectDependentsWithinScope scope query = do
+  -- Populate a temporary table with all of the references in `scope`
+  let scopeTableName = [sql| dependents_search_scope |]
+  createTemporaryTableOfReferenceIds scopeTableName scope
+
+  -- Populate a temporary table with all of the references in `query`
+  let queryTableName = [sql| dependencies_query |]
+  createTemporaryTableOfReferences queryTableName query
+
+  -- Get their direct dependents (tagged with object type)
+  dependents0 <-
+    queryListRow @(S.Reference.Id :. Only ObjectType)
+      [sql|
+        SELECT s.object_id, s.component_index, o.type_id
+        FROM $queryTableName q
+          JOIN dependents_index d
+            ON q.builtin IS d.dependency_builtin
+            AND q.object_id IS d.dependency_object_id
+            AND q.component_index IS d.dependency_component_index
+          JOIN $scopeTableName s
+            ON d.dependent_object_id = s.object_id
+            AND d.dependent_component_index = s.component_index
+          JOIN object o ON s.object_id = o.id
+      |]
+
+  -- Drop the temporary tables
+  execute [sql| DROP TABLE $scopeTableName |]
+  execute [sql| DROP TABLE $queryTableName |]
+
+  -- Post-process the query result
+  let dependents1 =
+        List.foldl'
+          ( \deps -> \case
+              dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types
+              dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types)
+              _ -> deps -- impossible; could error here
+          )
+          (Defns Set.empty Set.empty)
+          dependents0
+
+  pure dependents1
 
--- | `getDependentsWithinScope scope query` returns all of transitive dependents of `query` that are in `scope` (not
--- including `query` itself). Each dependent is also tagged with whether it is a term or decl.
-getDependentsWithinScope :: Set S.Reference.Id -> Set S.Reference -> Transaction (Map S.Reference.Id ObjectType)
-getDependentsWithinScope scope query = do
+-- | `getTransitiveDependentsWithinScope scope query` returns all transitive dependents of `query` that are in `scope`
+-- (not including `query` itself).
+getTransitiveDependentsWithinScope ::
+  Set S.Reference.Id ->
+  Set S.Reference ->
+  Transaction (DefnsF Set S.TermReferenceId S.TypeReferenceId)
+getTransitiveDependentsWithinScope scope query = do
   -- Populate a temporary table with all of the references in `scope`
-  createTemporaryTableOfReferenceIds [sql| dependents_search_scope |] scope
+  let scopeTableName = [sql| dependents_search_scope |]
+  createTemporaryTableOfReferenceIds scopeTableName scope
 
   -- Populate a temporary table with all of the references in `query`
-  execute
-    [sql|
-      CREATE TEMPORARY TABLE dependencies_query (
-        dependency_builtin INTEGER NULL,
-        dependency_object_id INTEGER NULL,
-        dependency_component_index INTEGER NULL,
-        CHECK ((dependency_builtin IS NULL) = (dependency_object_id IS NOT NULL)),
-        CHECK ((dependency_object_id IS NULL) = (dependency_component_index IS NULL))
-      )
-    |]
-  for_ query \r ->
-    execute [sql|INSERT INTO dependencies_query VALUES (@r, @, @)|]
+  let queryTableName = [sql| dependencies_query |]
+  createTemporaryTableOfReferences queryTableName query
 
   -- Say the query set is { #foo, #bar }, and the scope set is { #foo, #bar, #baz, #qux, #honk }.
   --
@@ -1954,34 +1995,65 @@ getDependentsWithinScope scope query = do
   -- We use `UNION` rather than `UNION ALL` so as to not track down the transitive dependents of any particular
   -- reference more than once.
 
-  result :: [S.Reference.Id :. Only ObjectType] <- queryListRow [sql|
-    WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS (
-      SELECT d.dependent_object_id, d.dependent_component_index, object.type_id
-      FROM dependents_index d
-      JOIN object ON d.dependent_object_id = object.id
-      JOIN dependencies_query q
-        ON q.dependency_builtin IS d.dependency_builtin
-        AND q.dependency_object_id IS d.dependency_object_id
-        AND q.dependency_component_index IS d.dependency_component_index
-      JOIN dependents_search_scope s
-        ON s.object_id = d.dependent_object_id
-        AND s.component_index = d.dependent_component_index
-
-      UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id
-      FROM dependents_index d
-      JOIN object ON d.dependent_object_id = object.id
-      JOIN transitive_dependents t
-        ON t.dependent_object_id = d.dependency_object_id
-        AND t.dependent_component_index = d.dependency_component_index
-      JOIN dependents_search_scope s
-        ON s.object_id = d.dependent_object_id
-        AND s.component_index = d.dependent_component_index
-    )
-    SELECT * FROM transitive_dependents
-  |]
-  execute [sql| DROP TABLE dependents_search_scope |]
-  execute [sql| DROP TABLE dependencies_query |]
-  pure . Map.fromList $ [(r, t) | r :. Only t <- result]
+  result0 :: [S.Reference.Id :. Only ObjectType] <-
+    queryListRow
+      [sql|
+        WITH RECURSIVE transitive_dependents (dependent_object_id, dependent_component_index, type_id) AS (
+          SELECT d.dependent_object_id, d.dependent_component_index, object.type_id
+          FROM dependents_index d
+          JOIN object ON d.dependent_object_id = object.id
+          JOIN $queryTableName q
+            ON q.builtin IS d.dependency_builtin
+            AND q.object_id IS d.dependency_object_id
+            AND q.component_index IS d.dependency_component_index
+          JOIN $scopeTableName s
+            ON s.object_id = d.dependent_object_id
+            AND s.component_index = d.dependent_component_index
+
+          UNION SELECT d.dependent_object_id, d.dependent_component_index, object.type_id
+          FROM dependents_index d
+          JOIN object ON d.dependent_object_id = object.id
+          JOIN transitive_dependents t
+            ON t.dependent_object_id = d.dependency_object_id
+            AND t.dependent_component_index = d.dependency_component_index
+          JOIN $scopeTableName s
+            ON s.object_id = d.dependent_object_id
+            AND s.component_index = d.dependent_component_index
+        )
+        SELECT * FROM transitive_dependents
+      |]
+
+  execute [sql| DROP TABLE $scopeTableName |]
+  execute [sql| DROP TABLE $queryTableName |]
+
+  -- Post-process the query result
+  let result1 =
+        List.foldl'
+          ( \deps -> \case
+              dep :. Only TermComponent -> Defns (Set.insert dep deps.terms) deps.types
+              dep :. Only DeclComponent -> Defns deps.terms (Set.insert dep deps.types)
+              _ -> deps -- impossible; could error here
+          )
+          (Defns Set.empty Set.empty)
+          result0
+
+  pure result1
+
+createTemporaryTableOfReferences :: Sql -> Set S.Reference -> Transaction ()
+createTemporaryTableOfReferences tableName refs = do
+  execute
+    [sql|
+      CREATE TEMPORARY TABLE $tableName (
+        builtin INTEGER NULL,
+        object_id INTEGER NULL,
+        component_index INTEGER NULL
+        CHECK ((builtin IS NULL) = (object_id IS NOT NULL)),
+        CHECK ((object_id IS NULL) = (component_index IS NULL))
+      )
+    |]
+
+  for_ refs \ref ->
+    execute [sql| INSERT INTO $tableName VALUES (@ref, @, @) |]
 
 createTemporaryTableOfReferenceIds :: Sql -> Set S.Reference.Id -> Transaction ()
 createTemporaryTableOfReferenceIds tableName refs = do
@@ -1996,6 +2068,8 @@ createTemporaryTableOfReferenceIds tableName refs = do
   for_ refs \ref ->
     execute [sql| INSERT INTO $tableName VALUES (@ref, @) |]
 
+{- ORMOLU_DISABLE -}
+
 objectIdByBase32Prefix :: ObjectType -> Text -> Transaction [ObjectId]
 objectIdByBase32Prefix objType prefix =
   queryListCol

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

@@ -468,7 +468,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 <-
@@ -487,7 +487,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)
@@ -975,10 +975,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