wip

parser-typechecker/src/U/Codebase/Projects.hs

@@ -9,13 +9,10 @@ import U.Codebase.Branch
 import qualified U.Codebase.Causal as Causal
 import Unison.Codebase.Path
 import qualified Unison.Codebase.Path as Path
-import Unison.NameSegment (NameSegment (..))
+import Unison.Name (libSegment)
 import Unison.Prelude
 import qualified Unison.Sqlite as Sqlite
 
-libSegment :: NameSegment
-libSegment = NameSegment "lib"
-
 -- | Infers path to use for loading names.
 -- Currently this means finding the closest parent with a "lib" child.
 inferNamesRoot :: Path -> Branch Sqlite.Transaction -> Sqlite.Transaction (Maybe Path)

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

@@ -77,6 +77,7 @@ import qualified Unison.Codebase.BranchUtil as BranchUtil
 import qualified Unison.Codebase.Causal as Causal
 import Unison.Codebase.Editor.AuthorInfo (AuthorInfo (..))
 import qualified Unison.Codebase.Editor.AuthorInfo as AuthorInfo
+import qualified Unison.LabeledDependency as LabeledDependency
 import Unison.Codebase.Editor.DisplayObject
 import Unison.Codebase.Editor.HandleInput.AuthLogin (authLogin)
 import Unison.Codebase.Editor.HandleInput.Branch (handleBranch)
@@ -1273,38 +1274,38 @@ loop e = do
             ListDependentsI hq -> handleDependents hq
             ListDependenciesI hq -> do
               Cli.Env {codebase} <- ask
-              hqLength <- Cli.runTransaction Codebase.hashLength
               -- todo: add flag to handle transitive efficiently
               lds <- resolveHQToLabeledDependencies hq
               when (null lds) do
                 Cli.returnEarly (LabeledReferenceNotFound hq)
-              rootBranch <- Cli.getRootBranch
               for_ lds \ld -> do
-                dependencies :: Set Reference <-
+                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.delete r . DD.dependencies $ DD.asDataDecl decl
+                            Just decl -> Set.map LabeledDependency.TypeReference . Set.delete r . DD.dependencies 
+                                       $ DD.asDataDecl decl
                         tp _ = pure mempty
-                        tm (Referent.Ref r@(Reference.DerivedId i)) =
+                        tm r@(Referent.Ref (Reference.DerivedId i)) =
                           Codebase.getTerm codebase i <&> \case
                             Nothing -> error $ "What happened to " ++ show i ++ "?"
-                            Just tm -> Set.delete r $ Term.dependencies tm
+                            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.dependencies tp
+                              Just tp -> Type.labeledDependencies tp
                         tm _ = pure mempty
                      in LD.fold tp tm ld
-                (missing, names0) <- liftIO (Branch.findHistoricalRefs' dependencies rootBranch)
+
-                let types = R.toList $ Names.types names0
+                ppe <- PPE.suffixifiedPPE <$> currentPrettyPrintEnvDecl Backend.WithinStrict
-                let terms = fmap (second Referent.toReference) $ R.toList $ Names.terms names0
+                let types = List.sort [ PPE.typeName ppe r | LabeledDependency.TypeReference r <- toList dependencies ]
+                let terms = List.sort [ PPE.termName ppe r | LabeledDependency.TermReferent r <- toList dependencies ]
                 let names = types <> terms
-                #numberedArgs .= fmap (Text.unpack . Reference.toText) ((fmap snd names) <> toList missing)
+                #numberedArgs .= map HQ.toString names
-                Cli.respond $ ListDependencies hqLength ld names missing
+                Cli.respond $ ListDependencies hq types terms
             NamespaceDependenciesI namespacePath' -> do
               Cli.Env {codebase} <- ask
               path <- maybe Cli.getCurrentPath Cli.resolvePath' namespacePath'
@@ -1760,9 +1761,13 @@ handleDependents hq = do
   hqLength <- Cli.runTransaction Codebase.hashLength
   -- todo: add flag to handle transitive efficiently
   lds <- resolveHQToLabeledDependencies hq
-
+  -- Use an unsuffixified PPE here, so we display full names (relative to the current path), 
+  -- rather than the shortest possible unambiguous name.
+  ppe <- PPE.unsuffixifiedPPE <$> currentPrettyPrintEnvDecl Backend.WithinStrict
   when (null lds) do
     Cli.returnEarly (LabeledReferenceNotFound hq)
+  when (length lds > 1) do
+    Cli.returnEarly (LabeledReferenceAmbiguous hqLength hq lds)
 
   for_ lds \ld -> do
     -- The full set of dependent references, any number of which may not have names in the current namespace.
@@ -1773,25 +1778,22 @@ handleDependents hq = do
             Referent.Con (ConstructorReference r _cid) _ct ->
               Codebase.dependents Queries.ExcludeOwnComponent r
        in Cli.runTransaction (LD.fold tp tm ld)
-    -- Use an unsuffixified PPE here, so we display full names (relative to the current path), rather than the shortest possible
-    -- unambiguous name.
-    ppe <- PPE.unsuffixifiedPPE <$> currentPrettyPrintEnvDecl Backend.Within
     let results :: [(Reference, Maybe Name)]
         results =
-          -- Currently we only retain dependents that are named in the current namespace (hence `mapMaybe`). In the future, we could
+          -- Currently we only retain dependents that are named in the current namespace
-          -- take a flag to control whether we want to show all dependents
+          [ p | Just p <- map f (Set.toList dependents) ]
-          mapMaybe f (Set.toList dependents)
           where
             f :: Reference -> Maybe (Reference, Maybe Name)
             f reference =
               asum
-                [ g <$> PPE.terms ppe (Referent.Ref reference),
+                [ g =<< PPE.terms ppe (Referent.Ref reference),
-                  g <$> PPE.types ppe reference
+                  g =<< PPE.types ppe reference
                 ]
               where
-                g :: HQ'.HashQualified Name -> (Reference, Maybe Name)
+                g :: HQ'.HashQualified Name -> Maybe (Reference, Maybe Name)
-                g hqName =
+                g hqName = case HQ'.toName hqName of
-                  (reference, Just (HQ'.toName hqName))
+                  name | Name.beginsWithSegment name Name.libSegment -> Nothing 
+                       | otherwise -> Just (reference, Just (HQ'.toName hqName))
     #numberedArgs .= map (Text.unpack . Reference.toText . fst) results
     Cli.respond (ListDependents hqLength ld results)
 

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

@@ -272,7 +272,7 @@ data Output
     NoConflictsOrEdits
   | NotImplemented
   | NoBranchWithHash ShortCausalHash
-  | ListDependencies Int LabeledDependency [(Name, Reference)] (Set Reference)
+  | ListDependencies (HQ.HashQualified Name) [HQ.HashQualified Name] [HQ.HashQualified Name] -- types, terms
   | -- | List dependents of a type or term.
     ListDependents Int LabeledDependency [(Reference, Maybe Name)]
   | -- | List all direct dependencies which don't have any names in the current branch

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

@@ -1672,28 +1672,28 @@ notifyUser dir = \case
             Just name -> prettyName name,
           prettyShortHash (SH.take hqLength (Reference.toShortHash reference))
         )
-
+  ListDependencies hq [] [] ->
-  -- this definition is identical to the previous one, apart from the word
+    pure $ P.syntaxToColor $ prettyHashQualified hq <> " doesn't have any dependencies."
-  -- "Dependencies", but undecided about whether or how to refactor
+  ListDependencies _hq types terms ->
-  ListDependencies hqLength ld names missing ->
     pure $
-      if names == mempty && missing == mempty
+      P.lines . join $
-        then c (prettyLabeledDependency hqLength ld) <> " doesn't have any dependencies."
+        [ [ P.bold "Types:",
-        else
+            "",
-          "Dependencies of "
+            P.indentN 2 $ P.numbered (numFrom 0) $ c . prettyHashQualified <$> types
-            <> c (prettyLabeledDependency hqLength ld)
+          ],
-            <> ":\n\n"
+          if null terms
-            <> (P.indentN 2 (P.numberedColumn2Header num pairs))
+            then []
+            else
+              [ "",
+                P.bold "Terms:",
+                "",
+                P.indentN 2 $ P.numbered (numFrom $ length types) $ c . prettyHashQualified <$> terms
+              ],
+          [""],
+          [tip ("Use " <> IP.makeExample IP.view ["1"] <> " to view one of these definitions.")]
+        ]
     where
-      num n = P.hiBlack $ P.shown n <> "."
+      numFrom k n = P.hiBlack $ P.shown (k + n) <> "."
-      header = (P.hiBlack "Reference", P.hiBlack "Name")
-      pairs =
-        header
-          : ( fmap (first c . second c) $
-                [(p $ Reference.toShortHash r, prettyName n) | (n, r) <- names]
-                  ++ [(p $ Reference.toShortHash r, "(no name available)") | r <- toList missing]
-            )
-      p = prettyShortHash . SH.take hqLength
       c = P.syntaxToColor
   ListNamespaceDependencies _ppe _path Empty -> pure $ "This namespace has no external dependencies."
   ListNamespaceDependencies ppe path' externalDependencies -> do

unison-core/src/Unison/Name.hs

@@ -32,6 +32,7 @@ module Unison.Name
     unqualified,
 
     -- * To organize later
+    libSegment,
     sortNames,
     sortNamed,
     sortByText,
@@ -315,12 +316,14 @@ searchByRankedSuffix suffix rel = case searchBySuffix suffix rel of
             | r <- toList rs,
               ns <- [filter ok (toList (R.lookupRan r rel))]
           ]
-      lib = NameSegment "lib"
+      libCount = length . filter (== libSegment) . toList . reverseSegments
-      libCount = length . filter (== lib) . toList . reverseSegments
       minLibs [] = 0
       minLibs ns = minimum (map libCount ns)
       ok name = compareSuffix suffix name == EQ
 
+libSegment :: NameSegment
+libSegment = NameSegment "lib"
+
 sortByText :: (a -> Text) -> [a] -> [a]
 sortByText by as =
   let as' = [(a, by a) | a <- as]

unison-share-api/src/Unison/Server/Backend.hs

@@ -269,6 +269,7 @@ namesForBranch root scope =
     (path, includeAllNames) = case scope of
       AllNames path -> (path, True)
       Within path -> (path, False)
+      WithinStrict path -> (path, False)
     root0 = Branch.head root
     currentBranch = fromMaybe Branch.empty $ Branch.getAt path root
     absoluteRootNames = Names.makeAbsolute (Branch.toNames root0)
@@ -689,18 +690,26 @@ data NameScoping
     AllNames Path
   | -- | Filter returned names to only include names within this path.
     Within Path
+  | -- | Like `Within`, but does not include a fallback
+    WithinStrict Path
 
 toAllNames :: NameScoping -> NameScoping
 toAllNames (AllNames p) = AllNames p
 toAllNames (Within p) = AllNames p
+toAllNames (WithinStrict p) = AllNames p
 
 getCurrentPrettyNames :: Int -> NameScoping -> Branch m -> PPED.PrettyPrintEnvDecl
 getCurrentPrettyNames hashLen scope root =
-  let primary = PPED.fromNamesDecl hashLen $ NamesWithHistory (parseNamesForBranch root scope) mempty
+  case scope of
-      backup = PPED.fromNamesDecl hashLen $ NamesWithHistory (parseNamesForBranch root (AllNames mempty)) mempty
+    WithinStrict _ -> primary
-   in PPED.PrettyPrintEnvDecl
+    _ ->
+      PPED.PrettyPrintEnvDecl
         (PPED.unsuffixifiedPPE primary `PPE.addFallback` PPED.unsuffixifiedPPE backup)
         (PPED.suffixifiedPPE primary `PPE.addFallback` PPED.suffixifiedPPE backup)
+      where
+        backup = PPED.fromNamesDecl hashLen $ NamesWithHistory (parseNamesForBranch root (AllNames mempty)) mempty
+  where
+    primary = PPED.fromNamesDecl hashLen $ NamesWithHistory (parseNamesForBranch root scope) mempty
 
 getCurrentParseNames :: NameScoping -> Branch m -> NamesWithHistory
 getCurrentParseNames scope root =