diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 07a75640ab..51df09f996 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -66,6 +66,7 @@ import Unison.Codebase.Editor.HandleInput.AuthLogin (authLogin) import Unison.Codebase.Editor.HandleInput.Branch (handleBranch) import Unison.Codebase.Editor.HandleInput.BranchRename (handleBranchRename) import Unison.Codebase.Editor.HandleInput.Branches (handleBranches) +import Unison.Codebase.Editor.HandleInput.DebugDefinition qualified as DebugDefinition import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch) import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject) import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) @@ -1141,6 +1142,8 @@ loop e = do traceM $ show name ++ ",Type," ++ Text.unpack (Reference.toText r) for_ (Relation.toList . Branch.deepTerms $ rootBranch0) \(r, name) -> traceM $ show name ++ ",Term," ++ Text.unpack (Referent.toText r) + DebugTermI isVerbose hqName -> DebugDefinition.debugTerm isVerbose hqName + DebugTypeI hqName -> DebugDefinition.debugDecl hqName DebugClearWatchI {} -> Cli.runTransaction Codebase.clearWatches DebugDoctorI {} -> do @@ -1355,6 +1358,11 @@ inputDescription input = DebugDoctorI {} -> wat DebugDumpNamespaceSimpleI {} -> wat DebugDumpNamespacesI {} -> wat + DebugTermI verbose hqName -> + if verbose + then pure ("debug.term.verbose " <> HQ.toText hqName) + else pure ("debug.term " <> HQ.toText hqName) + DebugTypeI hqName -> pure ("debug.type " <> HQ.toText hqName) DebugNameDiffI {} -> wat DebugNumberedArgsI {} -> wat DebugTabCompletionI _input -> wat diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDefinition.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDefinition.hs new file mode 100644 index 0000000000..dd57624bdc --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDefinition.hs @@ -0,0 +1,59 @@ +module Unison.Codebase.Editor.HandleInput.DebugDefinition + ( debugTerm, + debugDecl, + ) +where + +import Control.Monad.Reader +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Editor.Output (Output (..)) +import Unison.ConstructorReference (GConstructorReference (ConstructorReference)) +import Unison.DataDeclaration.ConstructorId (ConstructorId) +import Unison.HashQualified qualified as HQ +import Unison.Name (Name) +import Unison.NamesWithHistory qualified as Names +import Unison.Prelude +import Unison.Reference (TermReference, TypeReference) +import Unison.Reference qualified as Reference +import Unison.Referent qualified as Referent + +debugTermReference :: Bool -> TermReference -> Cli () +debugTermReference verbose ref = do + Cli.Env {codebase} <- ask + case ref of + Reference.DerivedId refId -> do + Cli.runTransaction (Codebase.getTerm codebase refId) >>= \case + Nothing -> Cli.respond $ TermNotFound' (Reference.toShortHash ref) + Just term -> do + Cli.respond $ DebugTerm verbose (Right term) + Reference.Builtin builtinTxt -> do + Cli.respond $ DebugTerm verbose (Left builtinTxt) + +debugTypeReference :: TypeReference -> Maybe ConstructorId -> Cli () +debugTypeReference ref mayConId = do + Cli.Env {codebase} <- ask + case ref of + Reference.DerivedId refId -> do + Cli.runTransaction (Codebase.getTypeDeclaration codebase refId) >>= \case + Nothing -> Cli.respond $ TypeNotFound' (Reference.toShortHash ref) + Just decl -> do + Cli.respond $ DebugDecl (Right decl) mayConId + Reference.Builtin builtinTxt -> do + Cli.respond $ DebugDecl (Left builtinTxt) mayConId + +debugTerm :: Bool -> HQ.HashQualified Name -> Cli () +debugTerm verbose hqName = do + names <- Cli.currentNames + let matches = Names.lookupHQTerm Names.IncludeSuffixes hqName names + for_ matches \case + Referent.Ref termReference -> debugTermReference verbose termReference + Referent.Con (ConstructorReference typeRef conId) _conTyp -> debugTypeReference typeRef (Just conId) + +debugDecl :: HQ.HashQualified Name -> Cli () +debugDecl hqName = do + names <- Cli.currentNames + let matches = Names.lookupHQType Names.IncludeSuffixes hqName names + for_ matches \typeRef -> debugTypeReference typeRef Nothing diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 1deebecd28..34ec1981a4 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -220,6 +220,8 @@ data Input | DebugTypecheckedUnisonFileI | DebugDumpNamespacesI | DebugDumpNamespaceSimpleI + | DebugTermI (Bool {- Verbose mode -}) (HQ.HashQualified Name) + | DebugTypeI (HQ.HashQualified Name) | DebugClearWatchI | DebugDoctorI | DebugNameDiffI ShortCausalHash ShortCausalHash diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 2cc685a29c..b646a2867e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -47,6 +47,7 @@ import Unison.Codebase.ShortCausalHash (ShortCausalHash) import Unison.Codebase.ShortCausalHash qualified as SCH import Unison.Codebase.Type (GitError) import Unison.CommandLine.InputPattern qualified as Input +import Unison.DataDeclaration qualified as DD import Unison.DataDeclaration.ConstructorId (ConstructorId) import Unison.HashQualified qualified as HQ import Unison.HashQualified' qualified as HQ' @@ -324,6 +325,8 @@ data Output | DisplayDebugCompletions [Completion.Completion] | DebugDisplayFuzzyOptions Text [String {- arg description, options -}] | DebugFuzzyOptionsNoResolver + | DebugTerm (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (Term Symbol Ann)) + | DebugDecl (Either (Text {- A builtin hash -}) (DD.Decl Symbol Ann)) (Maybe ConstructorId {- If 'Just' we're debugging a constructor of the given decl -}) | ClearScreen | PulledEmptyBranch (ReadRemoteNamespace Share.RemoteProjectBranch) | CreatedProject Bool {- randomly-generated name? -} ProjectName @@ -569,6 +572,8 @@ isFailure o = case o of DisplayDebugCompletions {} -> False DebugDisplayFuzzyOptions {} -> False DebugFuzzyOptionsNoResolver {} -> True + DebugTerm {} -> False + DebugDecl {} -> False DisplayDebugNameDiff {} -> False ClearScreen -> False PulledEmptyBranch {} -> False diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 61260818a9..c88f11378b 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2275,6 +2275,45 @@ debugDumpNamespaceSimple = "Dump the namespace to a text file" (const $ Right Input.DebugDumpNamespaceSimpleI) +debugTerm :: InputPattern +debugTerm = + InputPattern + "debug.term.abt" + [] + I.Hidden + [("term", Required, exactDefinitionTermQueryArg)] + "View debugging information for a given term." + ( \case + [thing] -> fmap (Input.DebugTermI False) $ parseHashQualifiedName thing + _ -> Left (I.help debugTerm) + ) + +debugTermVerbose :: InputPattern +debugTermVerbose = + InputPattern + "debug.term.abt.verbose" + [] + I.Hidden + [("term", Required, exactDefinitionTermQueryArg)] + "View verbose debugging information for a given term." + ( \case + [thing] -> fmap (Input.DebugTermI True) $ parseHashQualifiedName thing + _ -> Left (I.help debugTermVerbose) + ) + +debugType :: InputPattern +debugType = + InputPattern + "debug.type.abt" + [] + I.Hidden + [("type", Required, exactDefinitionTypeQueryArg)] + "View debugging information for a given type." + ( \case + [thing] -> fmap (Input.DebugTypeI) $ parseHashQualifiedName thing + _ -> Left (I.help debugType) + ) + debugClearWatchCache :: InputPattern debugClearWatchCache = InputPattern @@ -3001,6 +3040,9 @@ validInputs = debugDoctor, debugDumpNamespace, debugDumpNamespaceSimple, + debugTerm, + debugTermVerbose, + debugType, debugFileHashes, debugNameDiff, debugNumberedArgs, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f2775f0e79..374865ad0f 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -21,15 +21,18 @@ import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text +import Data.Text.Lazy qualified as TL import Data.Time (UTCTime, getCurrentTime) import Data.Tuple (swap) import Data.Tuple.Extra (dupe) import Data.Void (absurd) +import Debug.RecoverRTTI qualified as RTTI import Network.HTTP.Types qualified as Http import Servant.Client qualified as Servant import System.Console.ANSI qualified as ANSI import System.Console.Haskeline.Completion qualified as Completion import System.Directory (canonicalizePath, getHomeDirectory) +import Text.Pretty.Simple (pShowNoColor, pStringNoColor) import U.Codebase.Branch (NamespaceStats (..)) import U.Codebase.Branch.Diff (NameChanges (..)) import U.Codebase.HashTags (CausalHash (..)) @@ -1772,6 +1775,21 @@ notifyUser dir = \case IntegrityCheck result -> pure $ case result of NoIntegrityErrors -> "🎉 No issues detected 🎉" IntegrityErrorDetected ns -> prettyPrintIntegrityErrors ns + DebugTerm verbose builtinOrTerm -> pure $ case builtinOrTerm of + Left builtin -> "Builtin term: ##" <> P.text builtin + Right trm -> + if verbose + then P.text . TL.toStrict . pStringNoColor $ RTTI.anythingToString trm + else P.shown trm + DebugDecl typ mayConId -> do + let constructorMsg = case mayConId of + Nothing -> "" + Just conId -> "Constructor #" <> P.shown conId <> " of the following type:\n" + pure $ + constructorMsg + <> case typ of + Left builtinTxt -> "Builtin type: ##" <> P.text builtinTxt + Right decl -> either (P.text . TL.toStrict . pShowNoColor) (P.text . TL.toStrict . pShowNoColor) decl DisplayDebugNameDiff NameChanges {termNameAdds, termNameRemovals, typeNameAdds, typeNameRemovals} -> do let referentText = -- We don't use the constructor type in the actual output here, so there's no @@ -2748,7 +2766,7 @@ renderEditConflicts ppe Patch {..} = do then "deprecated and also replaced with" else "replaced with" ) - `P.hang` P.lines replacements + `P.hang` P.lines replacements formatTermEdits :: (Reference.TermReference, Set TermEdit.TermEdit) -> Numbered Pretty @@ -2763,7 +2781,7 @@ renderEditConflicts ppe Patch {..} = do then "deprecated and also replaced with" else "replaced with" ) - `P.hang` P.lines replacements + `P.hang` P.lines replacements formatConflict :: Either (Reference, Set TypeEdit.TypeEdit) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 48e43fe680..d5a90ee3ff 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -50,6 +50,7 @@ library Unison.Codebase.Editor.HandleInput.Branch Unison.Codebase.Editor.HandleInput.Branches Unison.Codebase.Editor.HandleInput.BranchRename + Unison.Codebase.Editor.HandleInput.DebugDefinition Unison.Codebase.Editor.HandleInput.DeleteBranch Unison.Codebase.Editor.HandleInput.DeleteProject Unison.Codebase.Editor.HandleInput.EditNamespace diff --git a/unison-src/transcripts/debug-definitions.md b/unison-src/transcripts/debug-definitions.md new file mode 100644 index 0000000000..4717486917 --- /dev/null +++ b/unison-src/transcripts/debug-definitions.md @@ -0,0 +1,28 @@ +```ucm:hide +.> builtins.merge +``` + +```unison:hide +x = 30 + +y : Nat +y = + z = x + 2 + z + 10 + +structural type Optional a = Some a | None + +ability Ask a where + ask : a +``` + +```ucm +.> add +.> debug.term.abt Nat.+ +.> debug.term.abt y +.> debug.term.abt Some +.> debug.term.abt ask +.> debug.type.abt Nat +.> debug.type.abt Optional +.> debug.type.abt Ask +``` diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md new file mode 100644 index 0000000000..cb1b14d1a2 --- /dev/null +++ b/unison-src/transcripts/debug-definitions.output.md @@ -0,0 +1,154 @@ +```unison +x = 30 + +y : Nat +y = + z = x + 2 + z + 10 + +structural type Optional a = Some a | None + +ability Ask a where + ask : a +``` + +```ucm +.> add + + ⍟ I've added these definitions: + + ability Ask a + structural type Optional a + (also named builtin.Optional) + x : Nat + y : Nat + +.> debug.term.abt Nat.+ + + Builtin term: ##Nat.+ + +.> debug.term.abt y + + (let Ref(ReferenceBuiltin "Nat.+") Ref(ReferenceDerived (Id "qpo3o788girkkbb43uf6ggqberfduhtnqbt7096eojlrp27jieco09mdasb7b0b06ej9hj60a00nnbbdo8he0b4e0m7vtopifiuhdig" 0)) 2 in (User "z". Ref(ReferenceBuiltin "Nat.+") (Var User "z") 10)):ReferenceBuiltin "Nat" + +.> debug.term.abt Some + + Constructor #0 of the following type: + DataDeclaration + { modifier = Structural + , annotation = External + , bound = + [ User "a" ] + , constructors' = + [ + ( External + , User "Constructor0" + , + ( User "a". Var User "a" -> ReferenceDerived + ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) + ( Var User "a" ) + ) + ) + , + ( External + , User "Constructor1" + , + ( User "a". ReferenceDerived + ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) + ( Var User "a" ) + ) + ) + ] + } + +.> debug.term.abt ask + + Constructor #0 of the following type: + EffectDeclaration + { toDataDecl = DataDeclaration + { modifier = Unique "a1ns7cunv2dvjmum0q8jbc54g6811cbh" + , annotation = External + , bound = + [ User "a" ] + , constructors' = + [ + ( External + , User "Constructor0" + , + ( User "a". + ( + { + [ ReferenceDerived + ( Id "d8m1kmiscgfrl5n9ruvq1432lntfntl7nnao45qlk2uqhparm0uq2im0kbspu6u6kv65hd0i5oljq9m4b78peh5ekpma7gkihtsmfh0" 0 ) + ( Var User "a" ) + ] + } Var User "a" + ) + ) + ) + ] + } + } + +.> debug.type.abt Nat + + Builtin type: ##Nat + +.> debug.type.abt Optional + + DataDeclaration + { modifier = Structural + , annotation = External + , bound = + [ User "a" ] + , constructors' = + [ + ( External + , User "Constructor0" + , + ( User "a". Var User "a" -> ReferenceDerived + ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) + ( Var User "a" ) + ) + ) + , + ( External + , User "Constructor1" + , + ( User "a". ReferenceDerived + ( Id "nirp5os0q69o4e1u9p3t6mmq6l6otluefi3ksm7dhm0diidjvkkgl8o9bvnflbj0sanuvdusf34f1qrins3ktcaglpcqv9oums2slsg" 0 ) + ( Var User "a" ) + ) + ) + ] + } + +.> debug.type.abt Ask + + EffectDeclaration + { toDataDecl = DataDeclaration + { modifier = Unique "a1ns7cunv2dvjmum0q8jbc54g6811cbh" + , annotation = External + , bound = + [ User "a" ] + , constructors' = + [ + ( External + , User "Constructor0" + , + ( User "a". + ( + { + [ ReferenceDerived + ( Id "d8m1kmiscgfrl5n9ruvq1432lntfntl7nnao45qlk2uqhparm0uq2im0kbspu6u6kv65hd0i5oljq9m4b78peh5ekpma7gkihtsmfh0" 0 ) + ( Var User "a" ) + ] + } Var User "a" + ) + ) + ) + ] + } + } + +```