implement dependents <x>, dependencies <x>, and debug.file

parser-typechecker/src/Unison/Codebase/Branch.hs

@@ -32,6 +32,7 @@ module Unison.Codebase.Branch
   , before
   , findHistoricalHQs
   , findHistoricalRefs
+  , findHistoricalRefs'
   , namesDiff
     -- ** History updates
   , step
@@ -240,6 +241,12 @@ findHistoricalRefs = findInHistory
   (\query r _n -> LD.fold (const False) (==r) query)
   (\query r _n -> LD.fold (==r) (const False) query)
 
+findHistoricalRefs' :: Monad m => Set Reference -> Branch m
+                    -> m (Set Reference, Names0)
+findHistoricalRefs' = findInHistory
+  (\queryRef r _n -> r == Referent.Ref queryRef)
+  (\queryRef r _n -> r == queryRef)
+
 findInHistory :: forall m q. (Monad m, Ord q)
   => (q -> Referent -> Name -> Bool)
   -> (q -> Reference -> Name -> Bool)

parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs

@@ -310,7 +310,7 @@ loop = do
         typeNotFound' = respond . TypeNotFound'
         termNotFound = respond . TermNotFound
         termNotFound' = respond . TermNotFound'
-        nameConflicted src tms tys = respond (NameAmbiguous hqLength src tms tys)
+        nameConflicted src tms tys = respond (DeleteNameAmbiguous hqLength src tms tys)
         typeConflicted src = nameConflicted src Set.empty
         termConflicted src tms = nameConflicted src tms Set.empty
         hashConflicted src = respond . HashAmbiguous src
@@ -431,6 +431,8 @@ loop = do
           NamesI{} -> wat
           TodoI{} -> wat
           ListEditsI{} -> wat
+          ListDependenciesI{} -> wat
+          ListDependentsI{} -> wat
           HistoryI{} -> wat
           TestI{} -> wat
           LinksI{} -> wat
@@ -444,6 +446,7 @@ loop = do
           ShowReflogI{} -> wat
           DebugNumberedArgsI{} -> wat
           DebugBranchHistoryI{} -> wat
+          DebugTypecheckedUnisonFileI{} -> wat
           QuitI{} -> wat
           DeprecateTermI{} -> undefined
           DeprecateTypeI{} -> undefined
@@ -1569,10 +1572,52 @@ loop = do
             error $ "impossible match, resolveConfiguredGitUrl shouldn't return"
                 <> " `Just` unless it was passed `Just`; and here it is passed"
                 <> " `Nothing` by `expandRepo`."
+      ListDependentsI hq -> do -- todo: add flag to handle transitive efficiently
+        resolveHQToLabeledDependencies hq >>= \lds ->
+          if null lds
+          then respond $ LabeledReferenceNotFound hq
+          else for_ lds $ \ld -> do
+            dependents <- let
+              tp r = eval $ GetDependents r
+              tm (Referent.Ref r) = eval $ GetDependents r
+              tm (Referent.Con r _i _ct) = eval $ GetDependents r
+              in LD.fold tp tm ld
+            (missing, names0) <- eval . Eval $ Branch.findHistoricalRefs' dependents root'
+            respond $ ListDependents hqLength ld names0 missing
+      ListDependenciesI hq -> do -- todo: add flag to handle transitive efficiently
+        resolveHQToLabeledDependencies hq >>= \lds ->
+          if null lds
+          then respond $ LabeledReferenceNotFound hq
+          else for_ lds $ \ld -> do
+            dependencies :: Set Reference <- let
+              tp (Reference.DerivedId r) = eval (LoadType r) <&> \case
+                Nothing -> error $ "What happened to " ++ show r ++ "?"
+                Just decl -> DD.dependencies $ DD.asDataDecl decl
+              tp _ = pure mempty
+              tm (Referent.Ref (Reference.DerivedId r)) = eval (LoadTerm r) <&> \case
+                Nothing -> error $ "What happened to " ++ show r ++ "?"
+                Just tm -> Term.dependencies tm
+              tm con@(Referent.Con (Reference.DerivedId r) i _ct) = eval (LoadType r) <&> \case
+                Nothing -> error $ "What happened to " ++ show r ++ "?"
+                Just decl ->  case DD.typeOfConstructor (DD.asDataDecl decl) i of
+                  Nothing -> error $ "What happened to " ++ show con ++ "?"
+                  Just tp -> Type.dependencies tp
+              tm _ = pure mempty
+              in LD.fold tp tm ld
+            (missing, names0) <- eval . Eval $ Branch.findHistoricalRefs' dependencies root'
+            respond $ ListDependencies hqLength ld names0 missing
       DebugNumberedArgsI -> use numberedArgs >>= respond . DumpNumberedArgs
       DebugBranchHistoryI ->
         eval . Notify . DumpBitBooster (Branch.headHash currentBranch') =<<
           (eval . Eval $ Causal.hashToRaw (Branch._history currentBranch'))
+      DebugTypecheckedUnisonFileI -> case uf of
+        Nothing -> respond NoUnisonFile
+        Just uf -> let
+          datas, effects, terms :: [(Name, Reference.Id)]
+          datas = [ (Name.fromVar v, r) | (v, (r, _d)) <- Map.toList $ UF.dataDeclarationsId' uf ]
+          effects = [ (Name.fromVar v, r) | (v, (r, _e)) <- Map.toList $ UF.effectDeclarationsId' uf ]
+          terms = [ (Name.fromVar v, r) | (v, (r, _tm, _tp)) <- Map.toList $ UF.hashTermsId uf ]
+          in eval . Notify $ DumpUnisonFileHashes hqLength datas effects terms
 
       DeprecateTermI {} -> notImplemented
       DeprecateTypeI {} -> notImplemented
@@ -1639,6 +1684,24 @@ loop = do
       <> "I tried to put it back, but couldn't. Everybody panic!"
   -}
 
+-- todo: compare to `getHQTerms` / `getHQTypes`.  Is one universally better?
+resolveHQToLabeledDependencies :: Functor m => HQ.HashQualified -> Action' m v (Set LabeledDependency)
+resolveHQToLabeledDependencies = \case
+  HQ.NameOnly n -> do
+    parseNames <- Names3.suffixify0 <$> basicParseNames0
+    let terms, types :: Set LabeledDependency
+        terms = Set.map LD.referent . R.lookupDom n $ Names3.terms0 parseNames
+        types = Set.map LD.typeRef . R.lookupDom n $ Names3.types0 parseNames
+    pure $ terms <> types
+  -- rationale: the hash should be unique enough that the name never helps
+  HQ.HashQualified _n sh -> resolveHashOnly sh
+  HQ.HashOnly sh -> resolveHashOnly sh
+  where
+  resolveHashOnly sh = do
+    terms <- eval $ TermReferentsByShortHash sh
+    types <- eval $ TypeReferencesByShortHash sh
+    pure $ Set.map LD.referent terms <> Set.map LD.typeRef types
+
 doDisplay :: Var v => OutputLocation -> Names -> Referent -> Action' m v ()
 doDisplay outputLoc names r = do
   let tm = Term.fromReferent External r

parser-typechecker/src/Unison/Codebase/Editor/Input.hs

@@ -123,8 +123,11 @@ data Input
   | ShowReflogI
   | UpdateBuiltinsI
   | MergeBuiltinsI
+  | ListDependenciesI HQ.HashQualified
+  | ListDependentsI HQ.HashQualified
   | DebugNumberedArgsI
   | DebugBranchHistoryI
+  | DebugTypecheckedUnisonFileI
   | QuitI
   deriving (Eq, Show)
 

parser-typechecker/src/Unison/Codebase/Editor/Output.hs

@@ -24,8 +24,9 @@ import Unison.Codebase.GitError
 import Unison.Codebase.Path (Path', Path)
 import Unison.Codebase.Patch (Patch)
 import Unison.Name ( Name )
-import Unison.Names2 ( Names )
+import Unison.Names2 ( Names, Names0 )
 import Unison.Parser ( Ann )
+import qualified Unison.Reference as Reference
 import Unison.Reference ( Reference )
 import Unison.Referent  ( Referent )
 import Unison.DataDeclaration ( Decl )
@@ -55,6 +56,7 @@ import Unison.Var (Var)
 import Unison.Codebase.ShortBranchHash (ShortBranchHash)
 import Unison.Codebase.Editor.RemoteRepo as RemoteRepo
 import Unison.Codebase.Editor.Output.BranchDiff (BranchDiffOutput)
+import Unison.LabeledDependency (LabeledDependency)
 
 type ListDetailed = Bool
 type SourceName = Text
@@ -101,9 +103,9 @@ data Output v
   | ParseResolutionFailures String [Names.ResolutionFailure v Ann]
   | TypeHasFreeVars (Type v Ann)
   | TermAlreadyExists Path.Split' (Set Referent)
-  | NameAmbiguous
-      Int -- codebase hash length
-      Path.HQSplit' (Set Referent) (Set Reference)
+  | LabeledReferenceAmbiguous Int HQ.HashQualified (Set LabeledDependency)
+  | LabeledReferenceNotFound HQ.HashQualified
+  | DeleteNameAmbiguous Int Path.HQSplit' (Set Referent) (Set Reference)
   | TermAmbiguous HQ.HashQualified (Set Referent)
   | HashAmbiguous ShortHash (Set Referent)
   | BranchHashAmbiguous ShortBranchHash (Set ShortBranchHash)
@@ -191,8 +193,11 @@ data Output v
   | NoConflictsOrEdits
   | NotImplemented
   | NoBranchWithHash ShortBranchHash
+  | ListDependencies Int LabeledDependency Names0 (Set Reference)
+  | ListDependents Int LabeledDependency Names0 (Set Reference)
   | DumpNumberedArgs NumberedArgs
   | DumpBitBooster Branch.Hash (Map Branch.Hash [Branch.Hash])
+  | DumpUnisonFileHashes Int [(Name, Reference.Id)] [(Name, Reference.Id)] [(Name, Reference.Id)]
   | BadName String
   deriving (Show)
 
@@ -261,7 +266,9 @@ isFailure o = case o of
   ParseResolutionFailures{} -> True
   TypeHasFreeVars{} -> True
   TermAlreadyExists{} -> True
-  NameAmbiguous{} -> True
+  LabeledReferenceAmbiguous{} -> True
+  LabeledReferenceNotFound{} -> True
+  DeleteNameAmbiguous{} -> True
   TermAmbiguous{} -> True
   BranchHashAmbiguous{} -> True
   BadDestinationBranch{} -> True
@@ -323,6 +330,9 @@ isFailure o = case o of
   HashAmbiguous{} -> True
   ShowReflog{} -> False
   LoadPullRequest{} -> False
+  ListDependencies{} -> False
+  ListDependents{} -> False
+  DumpUnisonFileHashes _ x y z -> x == mempty && y == mempty && z == mempty
 
 isNumberedFailure :: NumberedOutput v -> Bool
 isNumberedFailure = \case

parser-typechecker/src/Unison/Codebase/FileCodebase/Common.hs

@@ -485,6 +485,7 @@ termReferencesByPrefix root = loadReferencesByPrefix (termsDir root)
 typeReferencesByPrefix root = loadReferencesByPrefix (typesDir root)
 
 -- returns all the derived terms and derived constructors
+-- that have `sh` as a prefix
 termReferentsByPrefix :: MonadIO m
   => (CodebasePath -> Reference.Id -> m (Maybe (DD.Decl v a)))
   -> CodebasePath
@@ -493,7 +494,7 @@ termReferentsByPrefix :: MonadIO m
 termReferentsByPrefix getDecl root sh = do
   terms <- termReferencesByPrefix root sh
   ctors <- do
-    types <- typeReferencesByPrefix root sh
+    types <- typeReferencesByPrefix root sh { SH.cid = Nothing }
     foldMapM collectCtors types
   pure (Set.map Referent.Ref' terms <> ctors)
   where
@@ -502,8 +503,10 @@ termReferentsByPrefix getDecl root sh = do
   collectCtors ref = getDecl root ref <&> \case
     Nothing -> mempty
     Just decl ->
-      Set.fromList [ Referent.Con' ref i ct
-                   | i <- [0 .. ctorCount-1]]
+      Set.fromList [ con
+                   | i <- [0 .. ctorCount-1]
+                   , let con = Referent.Con' ref i ct
+                   , SH.isPrefixOf sh $ Referent.toShortHashId con]
       where ct = either (const CT.Effect) (const CT.Data) decl
             ctorCount = length . DD.constructors' $ DD.asDataDecl decl
 

parser-typechecker/src/Unison/CommandLine/InputPatterns.hs

@@ -1179,6 +1179,18 @@ names = InputPattern "names" []
     _ -> Left (I.help names)
   )
 
+dependents, dependencies :: InputPattern
+dependents = InputPattern "dependents" [] []
+  "List the dependents of the specified definition."
+  (\case
+    [thing] -> fmap Input.ListDependentsI $ parseHashQualifiedName thing
+    _ -> Left (I.help names))
+dependencies = InputPattern "dependencies" [] []
+  "List the dependencies of the specified definition."
+  (\case
+    [thing] -> fmap Input.ListDependenciesI $ parseHashQualifiedName thing
+    _ -> Left (I.help names))
+
 debugNumberedArgs :: InputPattern
 debugNumberedArgs = InputPattern "debug.numberedArgs" [] []
   "Dump the contents of the numbered args state."
@@ -1189,7 +1201,12 @@ debugBranchHistory = InputPattern "debug.history" []
   [(Optional, noCompletions)]
   "Dump codebase history, compatible with bit-booster.com/graph.html"
   (const $ Right Input.DebugBranchHistoryI)
-
+  
+debugFileHashes :: InputPattern
+debugFileHashes = InputPattern "debug.file" [] []
+  "View details about the most recent succesfully typechecked file."
+  (const $ Right Input.DebugTypecheckedUnisonFileI)
+   
 test :: InputPattern
 test = InputPattern "test" [] []
     "`test` runs unit tests for the current branch."
@@ -1273,8 +1290,10 @@ validInputs =
   , quit
   , updateBuiltins
   , mergeBuiltins
+  , dependents, dependencies
   , debugNumberedArgs
   , debugBranchHistory
+  , debugFileHashes
   ]
 
 commandNames :: [String]

parser-typechecker/src/Unison/CommandLine/OutputMessages.hs

@@ -62,6 +62,7 @@ import qualified Unison.Name                   as Name
 import qualified Unison.Codebase.NameSegment   as NameSegment
 import           Unison.NamePrinter            (prettyHashQualified,
                                                 prettyReference, prettyReferent,
+                                                prettyLabeledDependency,
                                                 prettyNamedReference,
                                                 prettyNamedReferent,
                                                 prettyName, prettyShortHash,
@@ -107,6 +108,8 @@ import qualified Unison.Util.Monoid            as Monoid
 import Data.Tuple (swap)
 import Unison.Codebase.ShortBranchHash (ShortBranchHash)
 import Control.Lens (view, over, _1, _3)
+import qualified Unison.ShortHash as SH
+import Unison.LabeledDependency as LD
 
 type Pretty = P.Pretty P.ColorText
 
@@ -790,7 +793,27 @@ notifyUser dir o = case o of
     P.wrap $ "I don't know of a namespace with that hash."
   NotImplemented -> pure $ P.wrap "That's not implemented yet. Sorry! 😬"
   BranchAlreadyExists _ -> pure "That namespace already exists."
-  NameAmbiguous hashLen p tms tys ->
+  LabeledReferenceNotFound hq ->
+    pure . P.callout "\129300" . P.wrap . P.syntaxToColor $
+      "Sorry, I couldn't find anything named" <> prettyHashQualified hq <> "."
+  LabeledReferenceAmbiguous hashLen hq (LD.partition -> (tps, tms)) ->
+    pure . P.callout "\129300" . P.lines $ [
+      P.wrap "That name is ambiguous. It could refer to any of the following definitions:"
+    , ""
+    , P.indentN 2 (P.lines (map qualifyTerm tms ++ map qualifyType tps))
+    ]
+    where
+      qualifyTerm :: Referent -> P.Pretty P.ColorText
+      qualifyTerm = P.syntaxToColor . case hq of
+        HQ.NameOnly n -> prettyNamedReferent hashLen n
+        HQ.HashQualified n _ -> prettyNamedReferent hashLen n
+        HQ.HashOnly _ -> prettyReferent hashLen
+      qualifyType :: Reference -> P.Pretty P.ColorText
+      qualifyType = P.syntaxToColor . case hq of
+        HQ.NameOnly n -> prettyNamedReference hashLen n
+        HQ.HashQualified n _ -> prettyNamedReference hashLen n
+        HQ.HashOnly _ -> prettyReference hashLen
+  DeleteNameAmbiguous hashLen p tms tys ->
     pure . P.callout "\129300" . P.lines $ [
       P.wrap "That name is ambiguous. It could refer to any of the following definitions:"
     , ""
@@ -950,6 +973,48 @@ notifyUser dir o = case o of
       "",
       "Paste that output into http://bit-booster.com/graph.html"
       ]
+  ListDependents hqLength ld names0 missing -> pure . P.syntaxToColor $
+    if names0 == mempty && missing == mempty
+    then prettyLabeledDependency hqLength ld <> " doesn't have any dependents."
+    else
+      "Dependents of " <> prettyLabeledDependency hqLength ld <> ":\n\n" <>
+      (P.indentN 2 . P.lines) ((P.column2 $
+      [ (prettyShortHash . SH.take hqLength $ Reference.toShortHash r
+      , prettyName n)
+      | (n, r) <- R.toList $ Names.types0 names0 ] ++
+      [ (prettyShortHash . SH.take hqLength $ Referent.toShortHash r
+      , prettyName n)
+      | (n, r) <- R.toList $ Names.terms names0 ]) :
+      map (prettyShortHash . SH.take hqLength . Reference.toShortHash)
+          (toList missing))
+  -- this definition is identical to the previous one, apart from the word
+  -- "Dependencies", but undecided about whether or how to refactor
+  ListDependencies hqLength ld names0 missing -> pure . P.syntaxToColor $
+    if names0 == mempty && missing == mempty
+    then prettyLabeledDependency hqLength ld <> " doesn't have any dependencies."
+    else
+      "Dependencies of " <> prettyLabeledDependency hqLength ld <> ":\n\n" <>
+      (P.indentN 2 . P.lines) ((P.column2 $
+      [ (prettyShortHash . SH.take hqLength $ Reference.toShortHash r
+      , prettyName n)
+      | (n, r) <- R.toList $ Names.types0 names0 ] ++
+      [ (prettyShortHash . SH.take hqLength $ Referent.toShortHash r
+      , prettyName n)
+      | (n, r) <- R.toList $ Names.terms names0 ]) :
+      map (prettyShortHash . SH.take hqLength . Reference.toShortHash)
+          (toList missing))
+  DumpUnisonFileHashes hqLength datas effects terms ->
+    pure . P.syntaxToColor . P.lines $
+      (effects <&> \(n,r) -> "ability " <>
+        prettyHashQualified'
+          (HQ'.take hqLength . HQ'.fromNamedReference n $ Reference.DerivedId r)) <>
+      (datas <&> \(n,r) -> "type " <>
+        prettyHashQualified'
+          (HQ'.take hqLength . HQ'.fromNamedReference n $ Reference.DerivedId r)) <>
+      (terms <&> \(n,r) ->
+        prettyHashQualified'
+          (HQ'.take hqLength . HQ'.fromNamedReference n $ Reference.DerivedId r))
+
   where
   _nameChange _cmd _pastTenseCmd _oldName _newName _r = error "todo"
   -- do
@@ -988,7 +1053,7 @@ prettyPath' p' =
 prettyRelative :: Path.Relative -> Pretty
 prettyRelative = P.blue . P.shown
 
-prettySBH :: ShortBranchHash -> P.Pretty CT.ColorText
+prettySBH :: IsString s => ShortBranchHash -> P.Pretty s
 prettySBH hash = P.group $ "#" <> P.text (SBH.toText hash)
 
 formatMissingStuff :: (Show tm, Show typ) =>

parser-typechecker/src/Unison/NamePrinter.hs

@@ -4,6 +4,8 @@ import Unison.Prelude
 
 import qualified Unison.HashQualified as HQ
 import qualified Unison.HashQualified' as HQ'
+import           Unison.LabeledDependency (LabeledDependency)
+import qualified Unison.LabeledDependency as LD
 import           Unison.Name          (Name)
 import qualified Unison.Name          as Name
 import           Unison.Reference     (Reference)
@@ -49,6 +51,9 @@ prettyReferent :: Int -> Referent -> Pretty SyntaxText
 prettyReferent len =
   prettyHashQualified . HQ.take len . HQ.fromReferent
 
+prettyLabeledDependency :: Int -> LabeledDependency -> Pretty SyntaxText
+prettyLabeledDependency len = LD.fold (prettyReference len) (prettyReferent len)
+
 prettyShortHash :: IsString s => ShortHash -> Pretty s
 prettyShortHash = fromString . SH.toString
 

unison-core/src/Unison/LabeledDependency.hs

@@ -1,6 +1,18 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-module Unison.LabeledDependency (derivedTerm, derivedType, termRef, typeRef, referent, dataConstructor, effectConstructor, fold, referents, LabeledDependency) where
+module Unison.LabeledDependency 
+  ( derivedTerm
+  , derivedType
+  , termRef
+  , typeRef
+  , referent
+  , dataConstructor
+  , effectConstructor
+  , fold
+  , referents
+  , LabeledDependency
+  , partition
+  ) where
 
 import Unison.Prelude hiding (fold)
 
@@ -31,3 +43,6 @@ referents rs = Set.fromList (map referent $ toList rs)
 
 fold :: (Reference -> a) -> (Referent -> a) -> LabeledDependency -> a
 fold f g (X e) = either f g e
+
+partition :: Foldable t => t LabeledDependency -> ([Reference], [Referent])
+partition = partitionEithers . map (\(X e) -> e) . toList 

unison-core/src/Unison/Referent.hs

@@ -42,6 +42,9 @@ toShortHash :: Referent -> ShortHash
 toShortHash = \case
   Ref r -> R.toShortHash r
   Con r i _ -> patternShortHash r i
+  
+toShortHashId :: Id -> ShortHash
+toShortHashId = toShortHash . fromId
 
 -- also used by HashQualified.fromPattern
 patternShortHash :: Reference -> Int -> ShortHash