Merge pull request #5600 from unisonweb/25-02-24-dependencies

use full names in `dependencies` output

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

@@ -1102,14 +1102,15 @@ causalHashesByPrefix (ShortCausalHash b32prefix) = do
   pure $ Set.fromList . map CausalHash $ hashes
 
 directDependenciesOfScope ::
+  (C.Reference -> Bool) ->
   DefnsF Set C.TermReferenceId C.TypeReferenceId ->
   Transaction (DefnsF Set C.TermReference C.TypeReference)
-directDependenciesOfScope scope0 = do
+directDependenciesOfScope isBuiltinType scope0 = do
   -- Convert C -> S
   scope1 <- bitraverse (Set.traverse c2sReferenceId) (Set.traverse c2sReferenceId) scope0
 
   -- Do the query
-  dependencies0 <- Q.getDirectDependenciesOfScope scope1
+  dependencies0 <- Q.getDirectDependenciesOfScope (fmap isBuiltinType . s2cReference) scope1
 
   -- Convert S -> C
   dependencies1 <- bitraverse (Set.traverse s2cReference) (Set.traverse s2cReference) dependencies0

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

@@ -159,7 +159,6 @@ module U.Codebase.Sqlite.Queries
     DependentsSelector (..),
     getDependentsForDependency,
     getDependentsForDependencyComponent,
-    getDependenciesForDependent,
     getDependencyIdsForDependent,
     getDependenciesBetweenTerms,
     getDirectDependenciesOfScope,
@@ -1712,23 +1711,6 @@ getDependentsForDependencyComponent dependency =
     isNotSelfReference = \case
       (C.Reference.Id oid1 _pos1) -> dependency /= oid1
 
--- | Get non-self dependencies of a user-defined dependent.
-getDependenciesForDependent :: S.Reference.Id -> Transaction [S.Reference]
-getDependenciesForDependent dependent@(C.Reference.Id oid0 _) =
-  fmap (filter isNotSelfReference) $
-    queryListRow
-      [sql|
-        SELECT dependency_builtin, dependency_object_id, dependency_component_index
-        FROM dependents_index
-        WHERE dependent_object_id IS @dependent
-          AND dependent_component_index IS @
-      |]
-  where
-    isNotSelfReference :: S.Reference -> Bool
-    isNotSelfReference = \case
-      ReferenceBuiltin _ -> True
-      ReferenceDerived (C.Reference.Id oid1 _) -> oid0 /= oid1
-
 -- | Get non-self, user-defined dependencies of a user-defined dependent.
 getDependencyIdsForDependent :: S.Reference.Id -> Transaction [S.Reference.Id]
 getDependencyIdsForDependent dependent@(C.Reference.Id oid0 _) =
@@ -1861,21 +1843,25 @@ getDependenciesBetweenTerms oid1 oid2 =
 {- ORMOLU_ENABLE -}
 
 getDirectDependenciesOfScope ::
+  (S.Reference -> Transaction Bool) ->
   DefnsF Set S.TermReferenceId S.TypeReferenceId ->
   Transaction (DefnsF Set S.TermReference S.TypeReference)
-getDirectDependenciesOfScope scope = do
+getDirectDependenciesOfScope isBuiltinType scope = do
   let tempTableName = [sql| temp_dependents |]
 
   -- Populate a temporary table with all of the references in `scope`
   createTemporaryTableOfReferenceIds tempTableName (Set.union scope.terms scope.types)
 
   -- Get their direct dependencies (tagged with object type)
+  --
+  -- Builtins don't have an object type – just a textual string. We have to figure out if it's a term or a type outside
+  -- of the codebase.
   dependencies0 <-
-    queryListRow @(S.Reference :. Only ObjectType)
+    queryListRow @(S.Reference :. Only (Maybe ObjectType))
       [sql|
         SELECT d.dependency_builtin, d.dependency_object_id, d.dependency_component_index, o.type_id
         FROM dependents_index d
-          JOIN object o ON d.dependency_object_id = o.id
+          LEFT JOIN object o ON d.dependency_object_id = o.id
         WHERE (d.dependent_object_id, d.dependent_component_index) IN (
           SELECT object_id, component_index
           FROM $tempTableName
@@ -1886,15 +1872,19 @@ getDirectDependenciesOfScope scope = do
   execute [sql| DROP TABLE $tempTableName |]
 
   -- Post-process the query result
-  let dependencies1 =
-        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)
-          dependencies0
+  dependencies1 <-
+    Foldable.foldlM
+      ( \deps -> \case
+          dep :. Only (Just TermComponent) -> pure $! deps & over #terms (Set.insert dep)
+          dep :. Only (Just DeclComponent) -> pure $! deps & over #types (Set.insert dep)
+          dep :. Only Nothing ->
+            isBuiltinType dep <&> \case
+              False -> deps & over #terms (Set.insert dep)
+              True -> deps & over #types (Set.insert dep)
+          _ -> pure deps -- impossible; could error here
+      )
+      (Defns Set.empty Set.empty)
+      dependencies0
 
   pure dependencies1
 

parser-typechecker/src/Unison/Builtin.hs

@@ -81,7 +81,9 @@ names = Names terms types
 -- note: this function is really for deciding whether `r` is a term or type,
 -- but it can only answer correctly for Builtins.
 isBuiltinType :: R.Reference -> Bool
-isBuiltinType r = elem r . fmap snd $ builtinTypes
+isBuiltinType =
+  let refs = Set.fromList (map snd builtinTypes)
+  in (`Set.member` refs)
 
 typeLookup :: TL.TypeLookup Symbol Ann
 typeLookup =

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

@@ -33,7 +33,6 @@ import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils (getCurrentProjectBranch)
 import Unison.Cli.MonadUtils qualified as Cli
-import Unison.Cli.NameResolutionUtils (resolveHQToLabeledDependencies)
 import Unison.Cli.NamesUtils qualified as Cli
 import Unison.Cli.ProjectUtils qualified as ProjectUtils
 import Unison.Codebase qualified as Codebase
@@ -58,6 +57,7 @@ import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTe
 import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch)
 import Unison.Codebase.Editor.HandleInput.DeleteNamespace (getEndangeredDependents, handleDeleteNamespace)
 import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject)
+import Unison.Codebase.Editor.HandleInput.Dependencies (handleDependencies)
 import Unison.Codebase.Editor.HandleInput.Dependents (handleDependents)
 import Unison.Codebase.Editor.HandleInput.EditDependents (handleEditDependents)
 import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
@@ -118,13 +118,10 @@ import Unison.CommandLine.DisplayValues qualified as DisplayValues
 import Unison.CommandLine.InputPattern qualified as IP
 import Unison.CommandLine.InputPatterns qualified as IP
 import Unison.CommandLine.InputPatterns qualified as InputPatterns
-import Unison.ConstructorReference (GConstructorReference (..))
 import Unison.DataDeclaration qualified as DD
 import Unison.HashQualified qualified as HQ
 import Unison.HashQualifiedPrime qualified as HQ'
 import Unison.LabeledDependency (LabeledDependency)
-import Unison.LabeledDependency qualified as LD
-import Unison.LabeledDependency qualified as LabeledDependency
 import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.NameSegment qualified as NameSegment
@@ -169,7 +166,7 @@ import Unison.UnisonFile (TypecheckedUnisonFile)
 import Unison.UnisonFile qualified as UF
 import Unison.UnisonFile.Names qualified as UF
 import Unison.Util.Find qualified as Find
-import Unison.Util.List (nubOrdOn, uniqueBy)
+import Unison.Util.List (uniqueBy)
 import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Pretty qualified as P
 import Unison.Util.Pretty qualified as Pretty
@@ -1141,46 +1138,6 @@ handleFindI isVerbose fscope ws input = do
       results' <- Cli.runTransaction (Backend.loadSearchResults codebase results)
       Cli.respond $ ListOfDefinitions fscope ppe isVerbose results'
 
-handleDependencies :: HQ.HashQualified Name -> Cli ()
-handleDependencies hq = do
-  Cli.Env {codebase} <- ask
-  -- todo: add flag to handle transitive efficiently
-  lds <- resolveHQToLabeledDependencies hq
-  names <- Cli.currentNames
-  let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names)
-  let suffixifiedPPE = PPED.suffixifiedPPE pped
-  when (null lds) do
-    Cli.returnEarly (LabeledReferenceNotFound hq)
-  results <- for (toList lds) \ld -> do
-    dependencies :: Set LabeledDependency <-
-      Cli.runTransaction do
-        let tp r@(Reference.DerivedId i) =
-              Codebase.getTypeDeclaration codebase i <&> \case
-                Nothing -> error $ "What happened to " ++ show i ++ "?"
-                Just decl ->
-                  Set.map LabeledDependency.TypeReference . Set.delete r . DD.typeDependencies $
-                    DD.asDataDecl decl
-            tp _ = pure mempty
-            tm r@(Referent.Ref (Reference.DerivedId i)) =
-              Codebase.getTerm codebase i <&> \case
-                Nothing -> error $ "What happened to " ++ show i ++ "?"
-                Just tm -> Set.delete (LabeledDependency.TermReferent r) (Term.labeledDependencies tm)
-            tm con@(Referent.Con (ConstructorReference (Reference.DerivedId i) cid) _ct) =
-              Codebase.getTypeDeclaration codebase i <&> \case
-                Nothing -> error $ "What happened to " ++ show i ++ "?"
-                Just decl -> case DD.typeOfConstructor (DD.asDataDecl decl) cid of
-                  Nothing -> error $ "What happened to " ++ show con ++ "?"
-                  Just tp -> Type.labeledDependencies tp
-            tm _ = pure mempty
-         in LD.fold tp tm ld
-    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 = 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
-
 doDisplay :: OutputLocation -> Names -> Term Symbol () -> Cli ()
 doDisplay outputLoc names tm = do
   Cli.Env {codebase} <- ask

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

@@ -0,0 +1,103 @@
+module Unison.Codebase.Editor.HandleInput.Dependencies
+  ( handleDependencies,
+  )
+where
+
+import Control.Arrow ((***))
+import Data.Bifoldable (bifoldMap, binull)
+import Data.Set qualified as Set
+import U.Codebase.Sqlite.Operations qualified as Operations
+import Unison.Builtin qualified as Builtin
+import Unison.Cli.Monad (Cli)
+import Unison.Cli.Monad qualified as Cli
+import Unison.Cli.MonadUtils qualified as Cli
+import Unison.Cli.NameResolutionUtils (resolveHQName)
+import Unison.Codebase.Branch.Names qualified as Branch
+import Unison.Codebase.Editor.Output
+import Unison.Codebase.Editor.StructuredArgument qualified as SA
+import Unison.ConstructorReference qualified as ConstructorReference
+import Unison.HashQualified qualified as HQ
+import Unison.HashQualifiedPrime qualified as HQ'
+import Unison.LabeledDependency qualified as LD
+import Unison.Name (Name)
+import Unison.Name qualified as Name
+import Unison.Prelude
+import Unison.PrettyPrintEnv qualified as PPE
+import Unison.PrettyPrintEnv.Names qualified as PPE
+import Unison.Reference (Reference)
+import Unison.Reference qualified as Reference
+import Unison.Referent qualified as Referent
+import Unison.Syntax.HashQualifiedPrime qualified as HQ'
+import Unison.Util.Defns (Defns (..), DefnsF)
+import Unison.Util.Defns qualified as Defns
+
+handleDependencies :: HQ.HashQualified Name -> Cli ()
+handleDependencies hq = do
+  refs <- resolveHQName hq
+
+  when (binull refs) do
+    Cli.returnEarly (LabeledReferenceNotFound hq)
+
+  namespace <- Cli.getCurrentProjectRoot0
+  let ppe =
+        let names = Branch.toNames namespace
+         in PPE.makePPE (PPE.hqNamer 10 names) (PPE.suffixifyByHash names)
+
+  dependencies <- do
+    Cli.runTransaction do
+      Operations.directDependenciesOfScope
+        Builtin.isBuiltinType
+        ( let refToIds :: Reference -> Set Reference.Id
+              refToIds =
+                maybe Set.empty Set.singleton . Reference.toId
+           in bifoldMap
+                ( foldMap \case
+                    Referent.Con ref _ -> Defns.fromTypes (refToIds (ref ^. ConstructorReference.reference_))
+                    Referent.Ref ref -> Defns.fromTerms (refToIds ref)
+                )
+                (foldMap (refToIds >>> Defns.fromTypes))
+                refs
+        )
+
+  let dependencyNames ::
+        DefnsF
+          []
+          (HQ.HashQualified Name, HQ.HashQualified Name)
+          (HQ.HashQualified Name, HQ.HashQualified Name)
+      dependencyNames =
+        bimap
+          (f (Referent.fromTermReference >>> PPE.termNames ppe))
+          (f (PPE.typeNames ppe))
+          dependencies
+        where
+          f ::
+            (Reference -> [(HQ'.HashQualified Name, HQ'.HashQualified Name)]) ->
+            Set Reference ->
+            [(HQ.HashQualified Name, HQ.HashQualified Name)]
+          f g =
+            Set.toList
+              -- Pick the best name for a reference (with `listToMaybe`), else use the ref (if nameless)
+              >>> map (\x -> maybe (Left x) Right (listToMaybe (g x)))
+              >>> partitionEithers
+              -- Sort the named references alphabetically, then stick the hash-only ones at the end
+              >>> h
+
+          h ::
+            ([Reference], [(HQ'.HashQualified Name, HQ'.HashQualified Name)]) ->
+            [(HQ.HashQualified Name, HQ.HashQualified Name)]
+          h (nameless, named) =
+            concat
+              [ named
+                  & Name.sortByText (fst >>> HQ'.toText)
+                  & map (HQ'.toHQ *** HQ'.toHQ),
+                nameless
+                  & map (\x -> let y = HQ.fromReference x in (y, y))
+              ]
+
+  -- Set numbered args
+  (dependencyNames.types ++ dependencyNames.terms)
+    & map (SA.HashQualified . fst)
+    & Cli.setNumberedArgs
+
+  let lds = bifoldMap (Set.map LD.referent) (Set.map LD.typeRef) refs
+  Cli.respond (ListDependencies ppe lds dependencyNames)

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

@@ -62,6 +62,7 @@ handleTodo = do
 
       directDependencies <-
         Operations.directDependenciesOfScope
+          Builtin.isBuiltinType
           Defns
             { terms = Branch.deepTermReferenceIds currentNamespaceWithoutLibdeps,
               types = Branch.deepTypeReferenceIds currentNamespaceWithoutLibdeps

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

@@ -336,7 +336,15 @@ data Output
   | PreviewMergeAlreadyUpToDate ProjectPath ProjectPath
   | NotImplemented
   | NoBranchWithHash ShortCausalHash
-  | ListDependencies PPE.PrettyPrintEnv (Set LabeledDependency) [HQ.HashQualified Name] [HQ.HashQualified Name] -- types, terms
+  | -- | List direct dependencies of a type or term.
+    ListDependencies
+      PPE.PrettyPrintEnv
+      (Set LabeledDependency)
+      ( DefnsF
+          []
+          (HQ.HashQualified Name, HQ.HashQualified Name)
+          (HQ.HashQualified Name, HQ.HashQualified Name)
+      )
   | -- | List dependents of a type or term.
     ListDependents
       PPE.PrettyPrintEnv

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

@@ -1446,10 +1446,17 @@ notifyUser dir = \case
         "Dependents"
         "dependents"
         lds
-        (map (HQ'.toHQ . fst) defns.types)
+        (map (HQ'.toHQ *** HQ'.toHQ) defns.types)
         (map (HQ'.toHQ *** HQ'.toHQ) defns.terms)
-  ListDependencies ppe lds types terms ->
-    pure $ listDependentsOrDependencies ppe "Dependencies" "dependencies" lds types (map (\x -> (x, x)) terms)
+  ListDependencies ppe lds defns ->
+    pure $
+      listDependentsOrDependencies
+        ppe
+        "Dependencies"
+        "dependencies"
+        lds
+        defns.types
+        defns.terms
   ListStructuredFind terms ->
     pure $ listFind False Nothing terms
   ListTextFind True terms ->
@@ -3774,7 +3781,7 @@ listDependentsOrDependencies ::
   Text ->
   Text ->
   Set LabeledDependency ->
-  [HQ.HashQualified Name] ->
+  [(HQ.HashQualified Name, HQ.HashQualified Name)] ->
   [(HQ.HashQualified Name, HQ.HashQualified Name)] ->
   Pretty
 listDependentsOrDependencies ppe labelStart label lds types terms =
@@ -3792,7 +3799,7 @@ listDependentsOrDependencies ppe labelStart label lds types terms =
           P.lines $
             [ P.indentN 2 $ P.bold "Types:",
               "",
-              P.indentN 2 . P.numberedList $ c . prettyHashQualified <$> types
+              P.indentN 2 . P.numberedList $ prettyHashQualifiedFull <$> types
             ]
     termsOut =
       if null terms
@@ -3803,7 +3810,6 @@ listDependentsOrDependencies ppe labelStart label lds types terms =
               "",
               P.indentN 2 . P.numberedListFrom (length types) $ prettyHashQualifiedFull <$> terms
             ]
-    c = P.syntaxToColor
 
 displayProjectBranchReflogEntries ::
   Maybe UTCTime ->

unison-cli/unison-cli.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.37.0.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
@@ -59,6 +59,7 @@ library
       Unison.Codebase.Editor.HandleInput.DeleteBranch
       Unison.Codebase.Editor.HandleInput.DeleteNamespace
       Unison.Codebase.Editor.HandleInput.DeleteProject
+      Unison.Codebase.Editor.HandleInput.Dependencies
       Unison.Codebase.Editor.HandleInput.Dependents
       Unison.Codebase.Editor.HandleInput.EditDependents
       Unison.Codebase.Editor.HandleInput.EditNamespace