From 11857af159e669d3cc1141fb4b5dae512c5a3870 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 29 Jan 2024 14:55:05 -0800 Subject: [PATCH 01/22] Add definition debugging commands --- unison-cli/src/Unison/Cli/NamesUtils.hs | 13 +++- .../src/Unison/Codebase/Editor/HandleInput.hs | 5 ++ .../Editor/HandleInput/DebugDefinition.hs | 59 +++++++++++++++++++ .../src/Unison/Codebase/Editor/Input.hs | 2 + .../src/Unison/Codebase/Editor/Output.hs | 5 ++ .../src/Unison/CommandLine/InputPatterns.hs | 26 ++++++++ .../src/Unison/CommandLine/OutputMessages.hs | 31 +++++++++- unison-cli/unison-cli.cabal | 1 + 8 files changed, 139 insertions(+), 3 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDefinition.hs diff --git a/unison-cli/src/Unison/Cli/NamesUtils.hs b/unison-cli/src/Unison/Cli/NamesUtils.hs index 8e3602045..2806d22e9 100644 --- a/unison-cli/src/Unison/Cli/NamesUtils.hs +++ b/unison-cli/src/Unison/Cli/NamesUtils.hs @@ -1,15 +1,26 @@ --- | Utilities that have to do with constructing names objects. +-- | Utilities that have to do with names objects. module Unison.Cli.NamesUtils ( currentNames, + currentNameSearch, ) where import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils (getCurrentBranch0) +import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Names qualified as Branch import Unison.Names (Names) +import Unison.Server.NameSearch +import Unison.Server.NameSearch.FromNames qualified as NameSearch -- | Produce a 'Names' object which contains names for the current branch. currentNames :: Cli Names currentNames = do Branch.toNames <$> getCurrentBranch0 + +-- | Produce a name searcher for things in the scope of the current branch. +currentNameSearch :: Applicative m => Cli (NameSearch m) +currentNameSearch = do + hqLength <- Cli.runTransaction Codebase.hashLength + NameSearch.makeNameSearch hqLength <$> currentNames diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 4f9af0b96..0bb6602e8 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 hqName -> DebugDefinition.debugTerm hqName + DebugTypeI hqName -> DebugDefinition.debugDecl hqName DebugClearWatchI {} -> Cli.runTransaction Codebase.clearWatches DebugDoctorI {} -> do @@ -1355,6 +1358,8 @@ inputDescription input = DebugDoctorI {} -> wat DebugDumpNamespaceSimpleI {} -> wat DebugDumpNamespacesI {} -> wat + DebugTermI hqName -> 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 000000000..98102f864 --- /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 :: TermReference -> Cli () +debugTermReference 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 (Right term) + Reference.Builtin builtinTxt -> do + Cli.respond $ DebugTerm (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 :: HQ.HashQualified Name -> Cli () +debugTerm hqName = do + names <- Cli.currentNames + let matches = Names.lookupHQTerm Names.IncludeSuffixes hqName names + for_ matches \case + Referent.Ref termReference -> debugTermReference 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 1deebecd2..f8da206bf 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 (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 1b08b1ea1..51c344168 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 (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 @@ -568,6 +571,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 61260818a..a22d15a81 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2275,6 +2275,32 @@ debugDumpNamespaceSimple = "Dump the namespace to a text file" (const $ Right Input.DebugDumpNamespaceSimpleI) +debugTerm :: InputPattern +debugTerm = + InputPattern + "debug.term" + [] + I.Hidden + [("term", Required, exactDefinitionTermQueryArg)] + "View debugging information for a given term." + ( \case + [thing] -> fmap Input.DebugTermI $ parseHashQualifiedName thing + _ -> Left (I.help debugTerm) + ) + +debugType :: InputPattern +debugType = + InputPattern + "debug.type" + [] + 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 diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index e41b0ced0..ea55f1636 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -25,6 +25,7 @@ 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 @@ -1772,6 +1773,32 @@ notifyUser dir = \case IntegrityCheck result -> pure $ case result of NoIntegrityErrors -> "🎉 No issues detected 🎉" IntegrityErrorDetected ns -> prettyPrintIntegrityErrors ns + DebugTerm builtinOrTerm -> pure $ case builtinOrTerm of + Left builtin -> P.wrap $ "The term is a builtin: " <> P.text builtin + Right trm -> + P.lines + [ "Verbose:", + P.string $ RTTI.anythingToString trm, + "", + "Abridged:", + P.shown trm + ] + DebugDecl typ mayConId -> do + let constructorMsg = case mayConId of + Nothing -> "" + Just conId -> "Constructor #" <> P.shown conId <> " of the following type:" + pure $ + P.lines $ + [ constructorMsg, + "Verbose:", + P.string $ RTTI.anythingToString typ, + "", + "Abridged:", + P.shown typ, + "", + "ConstructorId:", + P.string $ show mayConId + ] 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 @@ -2737,7 +2764,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 @@ -2752,7 +2779,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 48e43fe68..d5a90ee3f 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 From 706ff7b7d29b12d8e61b40dd05fd2d960675c627 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 29 Jan 2024 15:04:37 -0800 Subject: [PATCH 02/22] Clean up verbose debugging --- .../src/Unison/Codebase/Editor/HandleInput.hs | 14 +++++--- .../Editor/HandleInput/DebugDefinition.hs | 30 ++++++++-------- .../src/Unison/Codebase/Editor/Input.hs | 4 +-- .../src/Unison/Codebase/Editor/Output.hs | 4 +-- .../src/Unison/CommandLine/InputPatterns.hs | 34 +++++++++++++++++-- .../src/Unison/CommandLine/OutputMessages.hs | 24 +++++-------- 6 files changed, 69 insertions(+), 41 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 0bb6602e8..032e2fa32 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1142,8 +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 hqName -> DebugDefinition.debugTerm hqName - DebugTypeI hqName -> DebugDefinition.debugDecl hqName + DebugTermI isVerbose hqName -> DebugDefinition.debugTerm isVerbose hqName + DebugTypeI isVerbose hqName -> DebugDefinition.debugDecl isVerbose hqName DebugClearWatchI {} -> Cli.runTransaction Codebase.clearWatches DebugDoctorI {} -> do @@ -1358,8 +1358,14 @@ inputDescription input = DebugDoctorI {} -> wat DebugDumpNamespaceSimpleI {} -> wat DebugDumpNamespacesI {} -> wat - DebugTermI hqName -> pure ("debug.term " <> HQ.toText hqName) - DebugTypeI hqName -> pure ("debug.type " <> HQ.toText hqName) + DebugTermI verbose hqName -> + if verbose + then pure ("debug.term.verbose " <> HQ.toText hqName) + else pure ("debug.term " <> HQ.toText hqName) + DebugTypeI verbose hqName -> + if verbose + then pure ("debug.type.verbose " <> HQ.toText hqName) + else 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 index 98102f864..93c582b06 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDefinition.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDefinition.hs @@ -20,40 +20,40 @@ import Unison.Reference (TermReference, TypeReference) import Unison.Reference qualified as Reference import Unison.Referent qualified as Referent -debugTermReference :: TermReference -> Cli () -debugTermReference ref = do +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 (Right term) + Cli.respond $ DebugTerm verbose (Right term) Reference.Builtin builtinTxt -> do - Cli.respond $ DebugTerm (Left builtinTxt) + Cli.respond $ DebugTerm verbose (Left builtinTxt) -debugTypeReference :: TypeReference -> Maybe ConstructorId -> Cli () -debugTypeReference ref mayConId = do +debugTypeReference :: Bool -> TypeReference -> Maybe ConstructorId -> Cli () +debugTypeReference verbose 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 + Cli.respond $ DebugDecl verbose (Right decl) mayConId Reference.Builtin builtinTxt -> do - Cli.respond $ DebugDecl (Left builtinTxt) mayConId + Cli.respond $ DebugDecl verbose (Left builtinTxt) mayConId -debugTerm :: HQ.HashQualified Name -> Cli () -debugTerm hqName = do +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 termReference - Referent.Con (ConstructorReference typeRef conId) _conTyp -> debugTypeReference typeRef (Just conId) + Referent.Ref termReference -> debugTermReference verbose termReference + Referent.Con (ConstructorReference typeRef conId) _conTyp -> debugTypeReference verbose typeRef (Just conId) -debugDecl :: HQ.HashQualified Name -> Cli () -debugDecl hqName = do +debugDecl :: Bool -> HQ.HashQualified Name -> Cli () +debugDecl verbose hqName = do names <- Cli.currentNames let matches = Names.lookupHQType Names.IncludeSuffixes hqName names - for_ matches \typeRef -> debugTypeReference typeRef Nothing + for_ matches \typeRef -> debugTypeReference verbose typeRef Nothing diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index f8da206bf..ba2ed2509 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -220,8 +220,8 @@ data Input | DebugTypecheckedUnisonFileI | DebugDumpNamespacesI | DebugDumpNamespaceSimpleI - | DebugTermI (HQ.HashQualified Name) - | DebugTypeI (HQ.HashQualified Name) + | DebugTermI (Bool {- Verbose mode -}) (HQ.HashQualified Name) + | DebugTypeI (Bool {- Verbose mode -}) (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 51c344168..2f86ba1a0 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -325,8 +325,8 @@ data Output | DisplayDebugCompletions [Completion.Completion] | DebugDisplayFuzzyOptions Text [String {- arg description, options -}] | DebugFuzzyOptionsNoResolver - | DebugTerm (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 -}) + | DebugTerm (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (Term Symbol Ann)) + | DebugDecl (Bool {- verbose mode -}) (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 diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index a22d15a81..957e81eb9 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2284,10 +2284,23 @@ debugTerm = [("term", Required, exactDefinitionTermQueryArg)] "View debugging information for a given term." ( \case - [thing] -> fmap Input.DebugTermI $ parseHashQualifiedName thing + [thing] -> fmap (Input.DebugTermI False) $ parseHashQualifiedName thing _ -> Left (I.help debugTerm) ) +debugTermVerbose :: InputPattern +debugTermVerbose = + InputPattern + "debug.term.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 @@ -2297,10 +2310,23 @@ debugType = [("type", Required, exactDefinitionTypeQueryArg)] "View debugging information for a given type." ( \case - [thing] -> fmap Input.DebugTypeI $ parseHashQualifiedName thing + [thing] -> fmap (Input.DebugTypeI False) $ parseHashQualifiedName thing _ -> Left (I.help debugType) ) +debugTypeVerbose :: InputPattern +debugTypeVerbose = + InputPattern + "debug.type.verbose" + [] + I.Hidden + [("type", Required, exactDefinitionTypeQueryArg)] + "View verbose debugging information for a given type." + ( \case + [thing] -> fmap (Input.DebugTypeI True) $ parseHashQualifiedName thing + _ -> Left (I.help debugTypeVerbose) + ) + debugClearWatchCache :: InputPattern debugClearWatchCache = InputPattern @@ -3027,6 +3053,10 @@ validInputs = debugDoctor, debugDumpNamespace, debugDumpNamespaceSimple, + debugTerm, + debugTermVerbose, + debugType, + debugTypeVerbose, debugFileHashes, debugNameDiff, debugNumberedArgs, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index ea55f1636..90b6fd264 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1773,31 +1773,23 @@ notifyUser dir = \case IntegrityCheck result -> pure $ case result of NoIntegrityErrors -> "🎉 No issues detected 🎉" IntegrityErrorDetected ns -> prettyPrintIntegrityErrors ns - DebugTerm builtinOrTerm -> pure $ case builtinOrTerm of + DebugTerm verbose builtinOrTerm -> pure $ case builtinOrTerm of Left builtin -> P.wrap $ "The term is a builtin: " <> P.text builtin Right trm -> - P.lines - [ "Verbose:", - P.string $ RTTI.anythingToString trm, - "", - "Abridged:", - P.shown trm - ] - DebugDecl typ mayConId -> do + if verbose + then P.string $ RTTI.anythingToString trm + else P.shown trm + DebugDecl verbose typ mayConId -> do let constructorMsg = case mayConId of Nothing -> "" Just conId -> "Constructor #" <> P.shown conId <> " of the following type:" pure $ P.lines $ [ constructorMsg, - "Verbose:", - P.string $ RTTI.anythingToString typ, "", - "Abridged:", - P.shown typ, - "", - "ConstructorId:", - P.string $ show mayConId + if verbose + then P.string $ RTTI.anythingToString typ + else P.shown typ ] DisplayDebugNameDiff NameChanges {termNameAdds, termNameRemovals, typeNameAdds, typeNameRemovals} -> do let referentText = From 7cc5afe1c0b1038929eabded57ae9cc894424ab0 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 10:42:16 -0800 Subject: [PATCH 03/22] Undo unnecessary namesearch utils --- unison-cli/src/Unison/Cli/NamesUtils.hs | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/unison-cli/src/Unison/Cli/NamesUtils.hs b/unison-cli/src/Unison/Cli/NamesUtils.hs index 2806d22e9..8e3602045 100644 --- a/unison-cli/src/Unison/Cli/NamesUtils.hs +++ b/unison-cli/src/Unison/Cli/NamesUtils.hs @@ -1,26 +1,15 @@ --- | Utilities that have to do with names objects. +-- | Utilities that have to do with constructing names objects. module Unison.Cli.NamesUtils ( currentNames, - currentNameSearch, ) where import Unison.Cli.Monad (Cli) -import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils (getCurrentBranch0) -import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch.Names qualified as Branch import Unison.Names (Names) -import Unison.Server.NameSearch -import Unison.Server.NameSearch.FromNames qualified as NameSearch -- | Produce a 'Names' object which contains names for the current branch. currentNames :: Cli Names currentNames = do Branch.toNames <$> getCurrentBranch0 - --- | Produce a name searcher for things in the scope of the current branch. -currentNameSearch :: Applicative m => Cli (NameSearch m) -currentNameSearch = do - hqLength <- Cli.runTransaction Codebase.hashLength - NameSearch.makeNameSearch hqLength <$> currentNames From bdb00e748848171374d05f68325d4af581539de3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 11:55:21 -0800 Subject: [PATCH 04/22] Cleaner debug output --- .../src/Unison/Codebase/Editor/HandleInput.hs | 7 ++----- .../Editor/HandleInput/DebugDefinition.hs | 16 ++++++++-------- .../src/Unison/Codebase/Editor/Input.hs | 2 +- .../src/Unison/Codebase/Editor/Output.hs | 2 +- .../src/Unison/CommandLine/InputPatterns.hs | 16 +--------------- .../src/Unison/CommandLine/OutputMessages.hs | 19 +++++++++---------- 6 files changed, 22 insertions(+), 40 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 032e2fa32..80d18bd38 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -1143,7 +1143,7 @@ loop e = do 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 isVerbose hqName -> DebugDefinition.debugDecl isVerbose hqName + DebugTypeI hqName -> DebugDefinition.debugDecl hqName DebugClearWatchI {} -> Cli.runTransaction Codebase.clearWatches DebugDoctorI {} -> do @@ -1362,10 +1362,7 @@ inputDescription input = if verbose then pure ("debug.term.verbose " <> HQ.toText hqName) else pure ("debug.term " <> HQ.toText hqName) - DebugTypeI verbose hqName -> - if verbose - then pure ("debug.type.verbose " <> HQ.toText hqName) - else pure ("debug.type " <> 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 index 93c582b06..dd57624bd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDefinition.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/DebugDefinition.hs @@ -32,17 +32,17 @@ debugTermReference verbose ref = do Reference.Builtin builtinTxt -> do Cli.respond $ DebugTerm verbose (Left builtinTxt) -debugTypeReference :: Bool -> TypeReference -> Maybe ConstructorId -> Cli () -debugTypeReference verbose ref mayConId = do +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 verbose (Right decl) mayConId + Cli.respond $ DebugDecl (Right decl) mayConId Reference.Builtin builtinTxt -> do - Cli.respond $ DebugDecl verbose (Left builtinTxt) mayConId + Cli.respond $ DebugDecl (Left builtinTxt) mayConId debugTerm :: Bool -> HQ.HashQualified Name -> Cli () debugTerm verbose hqName = do @@ -50,10 +50,10 @@ debugTerm verbose hqName = do let matches = Names.lookupHQTerm Names.IncludeSuffixes hqName names for_ matches \case Referent.Ref termReference -> debugTermReference verbose termReference - Referent.Con (ConstructorReference typeRef conId) _conTyp -> debugTypeReference verbose typeRef (Just conId) + Referent.Con (ConstructorReference typeRef conId) _conTyp -> debugTypeReference typeRef (Just conId) -debugDecl :: Bool -> HQ.HashQualified Name -> Cli () -debugDecl verbose hqName = do +debugDecl :: HQ.HashQualified Name -> Cli () +debugDecl hqName = do names <- Cli.currentNames let matches = Names.lookupHQType Names.IncludeSuffixes hqName names - for_ matches \typeRef -> debugTypeReference verbose typeRef Nothing + 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 ba2ed2509..34ec1981a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -221,7 +221,7 @@ data Input | DebugDumpNamespacesI | DebugDumpNamespaceSimpleI | DebugTermI (Bool {- Verbose mode -}) (HQ.HashQualified Name) - | DebugTypeI (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 2f86ba1a0..96bb3968c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -326,7 +326,7 @@ data Output | DebugDisplayFuzzyOptions Text [String {- arg description, options -}] | DebugFuzzyOptionsNoResolver | DebugTerm (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (Term Symbol Ann)) - | DebugDecl (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (DD.Decl Symbol Ann)) (Maybe ConstructorId {- If 'Just' we're debugging a constructor of the given decl -}) + | 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 diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 957e81eb9..9fc511ff1 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2310,23 +2310,10 @@ debugType = [("type", Required, exactDefinitionTypeQueryArg)] "View debugging information for a given type." ( \case - [thing] -> fmap (Input.DebugTypeI False) $ parseHashQualifiedName thing + [thing] -> fmap (Input.DebugTypeI) $ parseHashQualifiedName thing _ -> Left (I.help debugType) ) -debugTypeVerbose :: InputPattern -debugTypeVerbose = - InputPattern - "debug.type.verbose" - [] - I.Hidden - [("type", Required, exactDefinitionTypeQueryArg)] - "View verbose debugging information for a given type." - ( \case - [thing] -> fmap (Input.DebugTypeI True) $ parseHashQualifiedName thing - _ -> Left (I.help debugTypeVerbose) - ) - debugClearWatchCache :: InputPattern debugClearWatchCache = InputPattern @@ -3056,7 +3043,6 @@ validInputs = debugTerm, debugTermVerbose, debugType, - debugTypeVerbose, debugFileHashes, debugNameDiff, debugNumberedArgs, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 90b6fd264..b44d9598f 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -21,6 +21,7 @@ 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) @@ -31,6 +32,7 @@ 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 (..)) @@ -1777,20 +1779,17 @@ notifyUser dir = \case Left builtin -> P.wrap $ "The term is a builtin: " <> P.text builtin Right trm -> if verbose - then P.string $ RTTI.anythingToString trm + then P.text . TL.toStrict . pStringNoColor $ RTTI.anythingToString trm else P.shown trm - DebugDecl verbose typ mayConId -> do + DebugDecl typ mayConId -> do let constructorMsg = case mayConId of Nothing -> "" - Just conId -> "Constructor #" <> P.shown conId <> " of the following type:" + Just conId -> "Constructor #" <> P.shown conId <> " of the following type:\n" pure $ - P.lines $ - [ constructorMsg, - "", - if verbose - then P.string $ RTTI.anythingToString typ - else P.shown typ - ] + 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 From 8a099ce2330b225a0c832f3c18ad722344aacb46 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 11:55:36 -0800 Subject: [PATCH 05/22] Add debug-definition transcripts --- unison-src/transcripts/debug-definitions.md | 29 ++ .../transcripts/debug-definitions.output.md | 323 ++++++++++++++++++ 2 files changed, 352 insertions(+) create mode 100644 unison-src/transcripts/debug-definitions.md create mode 100644 unison-src/transcripts/debug-definitions.output.md diff --git a/unison-src/transcripts/debug-definitions.md b/unison-src/transcripts/debug-definitions.md new file mode 100644 index 000000000..aeb84f2d0 --- /dev/null +++ b/unison-src/transcripts/debug-definitions.md @@ -0,0 +1,29 @@ +```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 y +.> debug.term.verbose y +.> debug.term Some +.> debug.term.verbose Some +.> debug.term ask +.> debug.term.verbose ask +.> debug.type Optional +.> debug.type Ask +``` diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md new file mode 100644 index 000000000..16bf07654 --- /dev/null +++ b/unison-src/transcripts/debug-definitions.output.md @@ -0,0 +1,323 @@ +```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 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.verbose y + + Term + ( fromList [] ) External + ( Tm + ( Ann + ( Term + ( fromList [] ) External + ( Tm + ( Let False + ( Term + ( fromList [] ) External + ( Tm + ( App + ( Term + ( fromList [] ) External + ( Tm + ( App + ( Term + ( fromList [] ) External + ( Tm + ( Ref + ( ReferenceBuiltin "Nat.+" ) + ) + ) + ) + ( Term + ( fromList [] ) External + ( Tm + ( Ref + ( ReferenceDerived + ( Id "Öp<\x1d\x8\x84·J-d\x1f\x9ehCKvÞßG·Òúp$ÎÄë¼\x88ó\x93\x99\x80&ÍW\x16u\x81`3¦\x98ÌÀP\x1{\xadmÂ"à,\x8e\x5\x8fþã2|½\x16Ê" 0 ) + ) + ) + ) + ) + ) + ) + ) + ( Term + ( fromList [] ) External + ( Tm + ( Nat 2 ) + ) + ) + ) + ) + ) + ( Term + ( fromList [] ) External + ( Abs + ( Symbol + ( User "z" ) + ) + ( Term + ( fromList + [ Symbol + ( User "z" ) + ] + ) External + ( Tm + ( App + ( Term + ( fromList + [ Symbol + ( User "z" ) + ] + ) External + ( Tm + ( App + ( Term + ( fromList [] ) External + ( Tm + ( Ref + ( ReferenceBuiltin "Nat.+" ) + ) + ) + ) + ( Term + ( fromList + [ Symbol + ( User "z" ) + ] + ) External + ( Var + ( Symbol + ( User "z" ) + ) + ) + ) + ) + ) + ) + ( Term + ( fromList [] ) External + ( Tm + ( Nat 10 ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ( Term + ( fromList [] ) External + ( Tm + ( Ref + ( ReferenceBuiltin "Nat" ) + ) + ) + ) + ) + ) + +.> debug.term 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.verbose 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 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.term.verbose 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 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 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" + ) + ) + ) + ] + } + } + +``` From 68c78f8d8f6c5c338f047c687ced7d7f35f0fc29 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 11:58:55 -0800 Subject: [PATCH 06/22] Update transcripts --- .../src/Unison/CommandLine/OutputMessages.hs | 4 +- unison-src/transcripts/debug-definitions.md | 4 +- .../transcripts/debug-definitions.output.md | 63 ++----------------- 3 files changed, 10 insertions(+), 61 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index b44d9598f..c76181cb1 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1776,7 +1776,7 @@ notifyUser dir = \case NoIntegrityErrors -> "🎉 No issues detected 🎉" IntegrityErrorDetected ns -> prettyPrintIntegrityErrors ns DebugTerm verbose builtinOrTerm -> pure $ case builtinOrTerm of - Left builtin -> P.wrap $ "The term is a builtin: " <> P.text builtin + Left builtin -> "Builtin term: ##" <> P.text builtin Right trm -> if verbose then P.text . TL.toStrict . pStringNoColor $ RTTI.anythingToString trm @@ -1788,7 +1788,7 @@ notifyUser dir = \case pure $ constructorMsg <> case typ of - Left builtinTxt -> "Builtin type: " <> P.text builtinTxt + 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 = diff --git a/unison-src/transcripts/debug-definitions.md b/unison-src/transcripts/debug-definitions.md index aeb84f2d0..086c0cc94 100644 --- a/unison-src/transcripts/debug-definitions.md +++ b/unison-src/transcripts/debug-definitions.md @@ -18,12 +18,12 @@ ability Ask a where ```ucm .> add +.> debug.term Nat.+ .> debug.term y .> debug.term.verbose y .> debug.term Some -.> debug.term.verbose Some .> debug.term ask -.> debug.term.verbose ask +.> debug.type Nat .> debug.type Optional .> debug.type Ask ``` diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md index 16bf07654..a9ca234df 100644 --- a/unison-src/transcripts/debug-definitions.output.md +++ b/unison-src/transcripts/debug-definitions.output.md @@ -23,6 +23,10 @@ ability Ask a where x : Nat y : Nat +.> debug.term Nat.+ + + Builtin term: ##Nat.+ + .> debug.term y (let Ref(ReferenceBuiltin "Nat.+") Ref(ReferenceDerived (Id "qpo3o788girkkbb43uf6ggqberfduhtnqbt7096eojlrp27jieco09mdasb7b0b06ej9hj60a00nnbbdo8he0b4e0m7vtopifiuhdig" 0)) 2 in (User "z". Ref(ReferenceBuiltin "Nat.+") (Var User "z") 10)):ReferenceBuiltin "Nat" @@ -175,36 +179,6 @@ ability Ask a where ] } -.> debug.term.verbose 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 ask Constructor #0 of the following type: @@ -234,34 +208,9 @@ ability Ask a where } } -.> debug.term.verbose ask +.> debug.type Nat - 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" - ) - ) - ) - ] - } - } + Builtin type: ##Nat .> debug.type Optional From 6706b2e8189177ae7ed8d6194aea02cc605e60ad Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 12:53:27 -0800 Subject: [PATCH 07/22] Remove verbose transcripts since anythingToString seems to be system dependent. --- unison-src/transcripts/debug-definitions.md | 1 - .../transcripts/debug-definitions.output.md | 118 ------------------ 2 files changed, 119 deletions(-) diff --git a/unison-src/transcripts/debug-definitions.md b/unison-src/transcripts/debug-definitions.md index 086c0cc94..1a804ee34 100644 --- a/unison-src/transcripts/debug-definitions.md +++ b/unison-src/transcripts/debug-definitions.md @@ -20,7 +20,6 @@ ability Ask a where .> add .> debug.term Nat.+ .> debug.term y -.> debug.term.verbose y .> debug.term Some .> debug.term ask .> debug.type Nat diff --git a/unison-src/transcripts/debug-definitions.output.md b/unison-src/transcripts/debug-definitions.output.md index a9ca234df..c117f916a 100644 --- a/unison-src/transcripts/debug-definitions.output.md +++ b/unison-src/transcripts/debug-definitions.output.md @@ -31,124 +31,6 @@ ability Ask a where (let Ref(ReferenceBuiltin "Nat.+") Ref(ReferenceDerived (Id "qpo3o788girkkbb43uf6ggqberfduhtnqbt7096eojlrp27jieco09mdasb7b0b06ej9hj60a00nnbbdo8he0b4e0m7vtopifiuhdig" 0)) 2 in (User "z". Ref(ReferenceBuiltin "Nat.+") (Var User "z") 10)):ReferenceBuiltin "Nat" -.> debug.term.verbose y - - Term - ( fromList [] ) External - ( Tm - ( Ann - ( Term - ( fromList [] ) External - ( Tm - ( Let False - ( Term - ( fromList [] ) External - ( Tm - ( App - ( Term - ( fromList [] ) External - ( Tm - ( App - ( Term - ( fromList [] ) External - ( Tm - ( Ref - ( ReferenceBuiltin "Nat.+" ) - ) - ) - ) - ( Term - ( fromList [] ) External - ( Tm - ( Ref - ( ReferenceDerived - ( Id "Öp<\x1d\x8\x84·J-d\x1f\x9ehCKvÞßG·Òúp$ÎÄë¼\x88ó\x93\x99\x80&ÍW\x16u\x81`3¦\x98ÌÀP\x1{\xadmÂ"à,\x8e\x5\x8fþã2|½\x16Ê" 0 ) - ) - ) - ) - ) - ) - ) - ) - ( Term - ( fromList [] ) External - ( Tm - ( Nat 2 ) - ) - ) - ) - ) - ) - ( Term - ( fromList [] ) External - ( Abs - ( Symbol - ( User "z" ) - ) - ( Term - ( fromList - [ Symbol - ( User "z" ) - ] - ) External - ( Tm - ( App - ( Term - ( fromList - [ Symbol - ( User "z" ) - ] - ) External - ( Tm - ( App - ( Term - ( fromList [] ) External - ( Tm - ( Ref - ( ReferenceBuiltin "Nat.+" ) - ) - ) - ) - ( Term - ( fromList - [ Symbol - ( User "z" ) - ] - ) External - ( Var - ( Symbol - ( User "z" ) - ) - ) - ) - ) - ) - ) - ( Term - ( fromList [] ) External - ( Tm - ( Nat 10 ) - ) - ) - ) - ) - ) - ) - ) - ) - ) - ) - ( Term - ( fromList [] ) External - ( Tm - ( Ref - ( ReferenceBuiltin "Nat" ) - ) - ) - ) - ) - ) - .> debug.term Some Constructor #0 of the following type: From 70c343d87ffea9acbba86b8d8d5963d213954ee9 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 13:15:29 -0800 Subject: [PATCH 08/22] Add round-trip test for doc2 --- unison-src/transcripts/doc2.md | 106 ++++++++++ unison-src/transcripts/doc2.output.md | 288 ++++++++++++++++++++++++++ 2 files changed, 394 insertions(+) create mode 100644 unison-src/transcripts/doc2.md create mode 100644 unison-src/transcripts/doc2.output.md diff --git a/unison-src/transcripts/doc2.md b/unison-src/transcripts/doc2.md new file mode 100644 index 000000000..cce635749 --- /dev/null +++ b/unison-src/transcripts/doc2.md @@ -0,0 +1,106 @@ +# Test parsing and round-trip of doc2 syntax elements + +```ucm:hide +.> builtins.mergeio +``` + +```unison:hide +otherDoc : a -> Doc2 +otherDoc _ = {{ yo }} + +otherTerm : Nat +otherTerm = 99 + +fulldoc : Doc2 +fulldoc = + use Nat + + {{ +Heres some text with a +soft line break + +hard line break + +Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block ''1 + 2'' + +# Heading + +## Heading 2 + +Term Link: {otherTerm} + +Type Link: {type Optional} + +Term source: + +@source{term} + +Term signature: + +@signature{term} + +* List item + +Inline code: + +`` 1 + 2 `` + +` "doesn't typecheck" + 1 ` + +[Link](https://unison-lang.org) + +![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + +Horizontal rule + +--- + +Video + +{{ +Special + (Embed + (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) +}} + +Transclusion/evaluation: + +{{ otherDoc (a -> Word a) }} + +--- + +The following markdown features aren't supported by the Doc format yet, but maybe will someday + + +> Block quote + + +Table + +| Header 1 | Header 2 | +| -------- | -------- | +| Cell 1 | Cell 2 | + + + Indented Code block + +''' + Exact whitespace should be preserved, don't mess with the logo! + <- Should be exactly 4 spaces to the left! + + <- Should be 2 spaces here + + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| +''' + +Inline '' text literal with 1 space of padding '' in the middle of a sentence. + +}} +``` + +```ucm +.> debug.format +.> debug.format +``` diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md new file mode 100644 index 000000000..57847c065 --- /dev/null +++ b/unison-src/transcripts/doc2.output.md @@ -0,0 +1,288 @@ +# Test parsing and round-trip of doc2 syntax elements + +```unison +otherDoc : a -> Doc2 +otherDoc _ = {{ yo }} + +otherTerm : Nat +otherTerm = 99 + +fulldoc : Doc2 +fulldoc = + use Nat + + {{ +Heres some text with a +soft line break + +hard line break + +Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block ''1 + 2'' + +# Heading + +## Heading 2 + +Term Link: {otherTerm} + +Type Link: {type Optional} + +Term source: + +@source{term} + +Term signature: + +@signature{term} + +* List item + +Inline code: + +`` 1 + 2 `` + +` "doesn't typecheck" + 1 ` + +[Link](https://unison-lang.org) + +![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + +Horizontal rule + +--- + +Video + +{{ +Special + (Embed + (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) +}} + +Transclusion/evaluation: + +{{ otherDoc (a -> Word a) }} + +--- + +The following markdown features aren't supported by the Doc format yet, but maybe will someday + + +> Block quote + + +Table + +| Header 1 | Header 2 | +| -------- | -------- | +| Cell 1 | Cell 2 | + + + Indented Code block + +''' + Exact whitespace should be preserved, don't mess with the logo! + <- Should be exactly 4 spaces to the left! + + <- Should be 2 spaces here + + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| +''' + +Inline '' text literal with 1 space of padding '' in the middle of a sentence. + +}} +``` + +```ucm +.> debug.format + +.> debug.format + +``` +```unison:added-by-ucm scratch.u +otherDoc : a -> Doc2 +otherDoc _ = {{ yo }} + +otherTerm : Nat +otherTerm = 99 + +fulldoc : Doc2 +fulldoc = + use Nat + + {{ + Heres some text with a soft line break + + hard line break + + Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code + block ''1 + 2'' + + # Heading + + ## Heading 2 + + Term Link: {otherTerm} + + Type Link: {type Optional} + + Term source: + + @source{term} + + Term signature: + + @signature{term} + + * List item + + Inline code: + + `` 1 + 2 `` + + '' "doesn't typecheck" + 1 '' + + [Link](https://unison-lang.org) + + ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + + Horizontal rule + + --- + + Video + + {{ + Special + (Embed + (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) + }} + + Transclusion/evaluation: + + {{ otherDoc (a -> Word a) }} + + --- + + The following markdown features aren't supported by the Doc format yet, + but maybe will someday + + > Block quote + + Table + + | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | Cell 2 | + + Indented Code block + + ''' + Exact whitespace should be preserved, don't mess with the logo! + <- Should be exactly 4 spaces to the left! + + <- Should be 2 spaces here + + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| + ''' + + Inline '' text literal with 1 space of padding '' in the middle of a + sentence. + }} +``` + +```unison:added-by-ucm scratch.u +otherDoc : a -> Doc2 +otherDoc _ = {{ yo }} + +otherTerm : Nat +otherTerm = 99 + +fulldoc : Doc2 +fulldoc = + use Nat + + {{ + Heres some text with a soft line break + + hard line break + + Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code + block ''1 + 2'' + + # Heading + + ## Heading 2 + + Term Link: {otherTerm} + + Type Link: {type Optional} + + Term source: + + @source{term} + + Term signature: + + @signature{term} + + * List item + + Inline code: + + `` 1 + 2 `` + + '' "doesn't typecheck" + 1 '' + + [Link](https://unison-lang.org) + + ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) + + Horizontal rule + + --- + + Video + + {{ + Special + (Embed + (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) + }} + + Transclusion/evaluation: + + {{ otherDoc (a -> Word a) }} + + --- + + The following markdown features aren't supported by the Doc format yet, + but maybe will someday + + > Block quote + + Table + + | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | Cell 2 | + + Indented Code block + + ''' + Exact whitespace should be preserved, don't mess with the logo! + <- Should be exactly 4 spaces to the left! + + <- Should be 2 spaces here + + _____ _ + | | |___|_|___ ___ ___ + | | | | |_ -| . | | + |_____|_|_|_|___|___|_|_| + ''' + + Inline '' text literal with 1 space of padding '' in the middle of a + sentence. + }} +``` + From 203cd8c2532873cb57a988aec3bf0330d35db532 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 14:36:37 -0800 Subject: [PATCH 09/22] Fix whitespace trimming on doc literals --- unison-src/transcripts/doc2.md | 5 +- unison-src/transcripts/doc2.output.md | 40 ++++++----- unison-src/transcripts/doc2markdown.output.md | 12 +++- unison-syntax/src/Unison/Syntax/Lexer.hs | 71 ++++++++++++++++--- 4 files changed, 96 insertions(+), 32 deletions(-) diff --git a/unison-src/transcripts/doc2.md b/unison-src/transcripts/doc2.md index cce635749..68f1a99f2 100644 --- a/unison-src/transcripts/doc2.md +++ b/unison-src/transcripts/doc2.md @@ -84,11 +84,9 @@ Table Indented Code block ''' - Exact whitespace should be preserved, don't mess with the logo! + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! <- Should be exactly 4 spaces to the left! - <- Should be 2 spaces here - _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | @@ -102,5 +100,6 @@ Inline '' text literal with 1 space of padding '' in the middle of a sentence. ```ucm .> debug.format +-- Format it again to ensure multiple round-trips don't cause changes. .> debug.format ``` diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index 57847c065..384b977c0 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -80,11 +80,9 @@ Table Indented Code block ''' - Exact whitespace should be preserved, don't mess with the logo! + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! <- Should be exactly 4 spaces to the left! - <- Should be 2 spaces here - _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | @@ -99,6 +97,7 @@ Inline '' text literal with 1 space of padding '' in the middle of a sentence. ```ucm .> debug.format +-- Format it again to ensure multiple round-trips don't cause changes. .> debug.format ``` @@ -118,7 +117,9 @@ fulldoc = hard line break Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code - block ''1 + 2'' + block ''' + 1 + 2 + ''' # Heading @@ -142,7 +143,9 @@ fulldoc = `` 1 + 2 `` - '' "doesn't typecheck" + 1 '' + ''' + "doesn't typecheck" + 1 + ''' [Link](https://unison-lang.org) @@ -178,19 +181,18 @@ fulldoc = Indented Code block ''' - Exact whitespace should be preserved, don't mess with the logo! + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! <- Should be exactly 4 spaces to the left! - <- Should be 2 spaces here - _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| ''' - Inline '' text literal with 1 space of padding '' in the middle of a - sentence. + Inline ''' + text literal with 1 space of padding + ''' in the middle of a sentence. }} ``` @@ -210,7 +212,9 @@ fulldoc = hard line break Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code - block ''1 + 2'' + block ''' + 1 + 2 + ''' # Heading @@ -234,7 +238,9 @@ fulldoc = `` 1 + 2 `` - '' "doesn't typecheck" + 1 '' + ''' + "doesn't typecheck" + 1 + ''' [Link](https://unison-lang.org) @@ -270,19 +276,19 @@ fulldoc = Indented Code block ''' - Exact whitespace should be preserved, don't mess with the logo! + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! <- Should be exactly 4 spaces to the left! - <- Should be 2 spaces here - _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| ''' - Inline '' text literal with 1 space of padding '' in the middle of a - sentence. + Inline ''' + text literal with 1 space of padding + ''' in the middle of a sentence. + }} ''' in the middle of a sentence. }} ``` diff --git a/unison-src/transcripts/doc2markdown.output.md b/unison-src/transcripts/doc2markdown.output.md index c9b98f984..eea654214 100644 --- a/unison-src/transcripts/doc2markdown.output.md +++ b/unison-src/transcripts/doc2markdown.output.md @@ -88,7 +88,11 @@ Table hard line break - Here's a cool **BOLD** _italic_ ~~strikethrough~~ thing with an inline code block `1 + 2` + Here's a cool **BOLD** _italic_ ~~strikethrough~~ thing with an inline code block ```raw + 1 + 2 + ``` + + # Heading @@ -121,7 +125,11 @@ Table `1 Nat.+ 2` - ` "doesn't typecheck" + 1 ` + ```raw + "doesn't typecheck" + 1 + ``` + + [Link](https://unison-lang.org) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index e3cc264d8..0c9165600 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -38,6 +38,7 @@ import Control.Lens.TH (makePrisms) import Control.Monad.State qualified as S import Data.Char import Data.List +import Data.List qualified as List import Data.List.NonEmpty qualified as Nel import Data.Map.Strict qualified as Map import Data.Set qualified as Set @@ -524,21 +525,26 @@ lexemes' eof = verbatim = P.label "code (examples: ''**unformatted**'', `words` or '''_words_''')" $ do - (start, txt, stop) <- positioned $ do + (start, originalText, stop) <- positioned $ do -- a single backtick followed by a non-backtick is treated as monospaced let tick = P.try (lit "`" <* P.lookAhead (P.satisfy (/= '`'))) -- also two or more ' followed by that number of closing ' quotes <- tick <|> (lit "''" <+> many (P.satisfy (== '\''))) P.someTill P.anySingle (lit quotes) - if all isSpace $ takeWhile (/= '\n') txt - then - wrap "syntax.docVerbatim" $ - wrap "syntax.docWord" $ - pure [Token (Textual (trim txt)) start stop] - else - wrap "syntax.docCode" $ - wrap "syntax.docWord" $ - pure [Token (Textual txt) start stop] + let trimmedText = + if all isSpace $ takeWhile (/= '\n') originalText + then trim originalText + else originalText + + -- If it's a multi-line verbatim block we trim any whitespace representing + -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' + let txt = + if (line start /= line stop) + then trimIndentFromVerbatimBlock (column start - 1) trimmedText + else trimmedText + wrap "syntax.docVerbatim" $ + wrap "syntax.docWord" $ + pure [Token (Textual txt) start stop] trim = f . f where @@ -1127,6 +1133,51 @@ lexemes' eof = where ok c = isDelayOrForce c || isSpace c || isAlphaNum c || Set.member c delimiters || c == '\"' +-- | If it's a multi-line verbatim block we trim any whitespace representing +-- indentation from the pretty-printer. +-- +-- E.g. +-- +-- @@ +-- {{ +-- # Heading +-- ''' +-- code +-- indented +-- ''' +-- }} +-- @@ +-- +-- Should lex to the text literal "code\n indented". +-- +-- If there's text in the literal that has LESS trailing whitespace than the +-- opening delimiters, we don't trim it at all. E.g. +-- +-- @@ +-- {{ +-- # Heading +-- ''' +-- code +-- ''' +-- }} +-- @@ +-- +-- Is parsed as " code". +-- +-- Trim the expected amount of whitespace from a text literal: +-- >>> trimIndentFromVerbatimBlock 2 " code\n indented" +-- "code\n indented" +-- +-- If the text literal has less leading whitespace than the opening delimiters, +-- leave it as-is +-- >>> trimIndentFromVerbatimBlock 2 "code\n indented" +-- "code\n indented" +trimIndentFromVerbatimBlock :: Int -> String -> String +trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do + List.intercalate "\n" <$> for (lines txt) \line -> do + -- If any 'stripPrefix' fails, we fail and return the unaltered text + stripPrefix (replicate leadingSpaces ' ') line + separated :: (Char -> Bool) -> P a -> P a separated ok p = P.try $ p <* P.lookAhead (void (P.satisfy ok) <|> P.eof) From 61059683a8d44d58e5f3bcaf2525847b9a26479b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 14:49:36 -0800 Subject: [PATCH 10/22] Update transcripts --- .../transcripts/bug-strange-closure.output.md | 14 +++------ unison-src/transcripts/doc2.output.md | 31 ++++++------------- unison-src/transcripts/doc2markdown.output.md | 12 ++----- unison-syntax/src/Unison/Syntax/Lexer.hs | 25 +++++++-------- 4 files changed, 29 insertions(+), 53 deletions(-) diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 950ffa04b..ca32772ab 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -142,11 +142,10 @@ We can display the guide before and after adding it to the codebase: syntax highlighting: ``` raw - _____ _ + _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name @@ -353,11 +352,10 @@ We can display the guide before and after adding it to the codebase: syntax highlighting: ``` raw - _____ _ + _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name @@ -572,11 +570,10 @@ rendered = Pretty.get (docFormatConsole doc.guide) syntax highlighting: ``` raw - _____ _ + _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name @@ -776,11 +773,10 @@ rendered = Pretty.get (docFormatConsole doc.guide) syntax highlighting: ``` raw - _____ _ + _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name @@ -3722,7 +3718,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) () (Right (Plain - " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|\n ")) + "_____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|")) , Lit () (Right (Plain "\n")) diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index 384b977c0..30b3fe39a 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -117,9 +117,7 @@ fulldoc = hard line break Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code - block ''' - 1 + 2 - ''' + block ''1 + 2'' # Heading @@ -143,9 +141,7 @@ fulldoc = `` 1 + 2 `` - ''' - "doesn't typecheck" + 1 - ''' + '' "doesn't typecheck" + 1 '' [Link](https://unison-lang.org) @@ -181,7 +177,7 @@ fulldoc = Indented Code block ''' - Exact whitespace should be preserved across multiple updates. Don't mess with the logo! + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! <- Should be exactly 4 spaces to the left! _____ _ @@ -190,9 +186,8 @@ fulldoc = |_____|_|_|_|___|___|_|_| ''' - Inline ''' - text literal with 1 space of padding - ''' in the middle of a sentence. + Inline '' text literal with 1 space of padding '' in the middle of a + sentence. }} ``` @@ -212,9 +207,7 @@ fulldoc = hard line break Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code - block ''' - 1 + 2 - ''' + block ''1 + 2'' # Heading @@ -238,9 +231,7 @@ fulldoc = `` 1 + 2 `` - ''' - "doesn't typecheck" + 1 - ''' + '' "doesn't typecheck" + 1 '' [Link](https://unison-lang.org) @@ -276,7 +267,7 @@ fulldoc = Indented Code block ''' - Exact whitespace should be preserved across multiple updates. Don't mess with the logo! + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! <- Should be exactly 4 spaces to the left! _____ _ @@ -285,10 +276,8 @@ fulldoc = |_____|_|_|_|___|___|_|_| ''' - Inline ''' - text literal with 1 space of padding - ''' in the middle of a sentence. - }} ''' in the middle of a sentence. + Inline '' text literal with 1 space of padding '' in the middle of a + sentence. }} ``` diff --git a/unison-src/transcripts/doc2markdown.output.md b/unison-src/transcripts/doc2markdown.output.md index eea654214..c9b98f984 100644 --- a/unison-src/transcripts/doc2markdown.output.md +++ b/unison-src/transcripts/doc2markdown.output.md @@ -88,11 +88,7 @@ Table hard line break - Here's a cool **BOLD** _italic_ ~~strikethrough~~ thing with an inline code block ```raw - 1 + 2 - ``` - - + Here's a cool **BOLD** _italic_ ~~strikethrough~~ thing with an inline code block `1 + 2` # Heading @@ -125,11 +121,7 @@ Table `1 Nat.+ 2` - ```raw - "doesn't typecheck" + 1 - ``` - - + ` "doesn't typecheck" + 1 ` [Link](https://unison-lang.org) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index 0c9165600..bb5f0193d 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -531,20 +531,19 @@ lexemes' eof = -- also two or more ' followed by that number of closing ' quotes <- tick <|> (lit "''" <+> many (P.satisfy (== '\''))) P.someTill P.anySingle (lit quotes) - let trimmedText = - if all isSpace $ takeWhile (/= '\n') originalText - then trim originalText - else originalText + let isMultiLine = line start /= line stop + if isMultiLine + then -- If it's a multi-line verbatim block we trim any whitespace representing + -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - -- If it's a multi-line verbatim block we trim any whitespace representing - -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - let txt = - if (line start /= line stop) - then trimIndentFromVerbatimBlock (column start - 1) trimmedText - else trimmedText - wrap "syntax.docVerbatim" $ - wrap "syntax.docWord" $ - pure [Token (Textual txt) start stop] + let txt = trimIndentFromVerbatimBlock (column start - 1) (trim originalText) + in wrap "syntax.docVerbatim" $ + wrap "syntax.docWord" $ + pure [Token (Textual (trim txt)) start stop] + else + wrap "syntax.docCode" $ + wrap "syntax.docWord" $ + pure [Token (Textual originalText) start stop] trim = f . f where From b93d2894e55d48205ecb9b9032d7e29fe5a5f129 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 16:02:49 -0800 Subject: [PATCH 11/22] Clean up whitespace trimming --- .../transcripts-using-base/doc.output.md | 3 -- unison-src/transcripts/doc2.output.md | 4 +- unison-syntax/package.yaml | 1 + unison-syntax/src/Unison/Syntax/Lexer.hs | 38 ++++++++++++++----- unison-syntax/unison-syntax.cabal | 2 + 5 files changed, 33 insertions(+), 15 deletions(-) diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 892687f38..24f75d7b3 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -402,7 +402,6 @@ and the rendered output using `display`: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ''' You can use three or more backticks plus a language name @@ -432,7 +431,6 @@ and the rendered output using `display`: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name for @@ -711,7 +709,6 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index 30b3fe39a..a9a62e3e8 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -177,7 +177,7 @@ fulldoc = Indented Code block ''' - Exact whitespace should be preserved across multiple updates. Don't mess with the logo! + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! <- Should be exactly 4 spaces to the left! _____ _ @@ -267,7 +267,7 @@ fulldoc = Indented Code block ''' - Exact whitespace should be preserved across multiple updates. Don't mess with the logo! + Exact whitespace should be preserved across multiple updates. Don't mess with the logo! <- Should be exactly 4 spaces to the left! _____ _ diff --git a/unison-syntax/package.yaml b/unison-syntax/package.yaml index 71e074b5d..f6b39eeef 100644 --- a/unison-syntax/package.yaml +++ b/unison-syntax/package.yaml @@ -9,6 +9,7 @@ dependencies: - bytes - containers - cryptonite + - extra - lens - megaparsec - mtl diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index bb5f0193d..e53623533 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -39,6 +39,7 @@ import Control.Monad.State qualified as S import Data.Char import Data.List import Data.List qualified as List +import Data.List.Extra qualified as List import Data.List.NonEmpty qualified as Nel import Data.Map.Strict qualified as Map import Data.Set qualified as Set @@ -536,22 +537,15 @@ lexemes' eof = then -- If it's a multi-line verbatim block we trim any whitespace representing -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - let txt = trimIndentFromVerbatimBlock (column start - 1) (trim originalText) + let txt = trimIndentFromVerbatimBlock (column start - 1) (trimAroundDelimiters originalText) in wrap "syntax.docVerbatim" $ wrap "syntax.docWord" $ - pure [Token (Textual (trim txt)) start stop] + pure [Token (Textual (trimAroundDelimiters txt)) start stop] else wrap "syntax.docCode" $ wrap "syntax.docWord" $ pure [Token (Textual originalText) start stop] - trim = f . f - where - f = reverse . dropThru - dropThru = dropNl . dropWhile (\ch -> isSpace ch && ch /= '\n') - dropNl ('\n' : t) = t - dropNl as = as - exampleInline = P.label "inline code (examples: ``List.map f xs``, ``[1] :+ 2``)" $ wrap "syntax.docExample" $ do @@ -634,7 +628,7 @@ lexemes' eof = _ <- void CP.eol verbatim <- tok $ - Textual . uncolumn column tabWidth . trim + Textual . uncolumn column tabWidth . trimAroundDelimiters <$> P.someTill P.anySingle ([] <$ lit fence) pure (name <> verbatim) @@ -1177,6 +1171,30 @@ trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do -- If any 'stripPrefix' fails, we fail and return the unaltered text stripPrefix (replicate leadingSpaces ' ') line +-- Trim leading/trailing whitespace from around delimiters, e.g. +-- +-- {{ +-- '''___ <- whitespace here including newline +-- text block +-- 👇 or here +-- __''' +-- }} +-- +-- >>> trimAroundDelimiters " \n text block \n " +-- " text block " +-- +-- >>> trimAroundDelimiters "something before \n text block \nsomething after" +-- "something before \n text block \nsomething after" +trimAroundDelimiters :: String -> String +trimAroundDelimiters txt = reverse . trim . reverse . trim $ txt + where + trim s = + List.breakOn "\n" s + & \case + (prefix, suffix) + | all isSpace prefix -> drop 1 suffix + | otherwise -> prefix <> suffix + separated :: (Char -> Bool) -> P a -> P a separated ok p = P.try $ p <* P.lookAhead (void (P.satisfy ok) <|> P.eof) diff --git a/unison-syntax/unison-syntax.cabal b/unison-syntax/unison-syntax.cabal index 5ebed35dd..cf9c54d25 100644 --- a/unison-syntax/unison-syntax.cabal +++ b/unison-syntax/unison-syntax.cabal @@ -63,6 +63,7 @@ library , bytes , containers , cryptonite + , extra , lens , megaparsec , mtl @@ -118,6 +119,7 @@ test-suite syntax-tests , containers , cryptonite , easytest + , extra , lens , megaparsec , mtl From d07077e223d5f2b42aa14b8503e636cce2c4076f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 16:06:28 -0800 Subject: [PATCH 12/22] Fix parsing/printing of raw syntax blocks in transcripts --- unison-src/transcripts/bug-strange-closure.output.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index ca32772ab..a33bcda87 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -142,7 +142,7 @@ We can display the guide before and after adding it to the codebase: syntax highlighting: ``` raw - _____ _ + _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| @@ -352,7 +352,7 @@ We can display the guide before and after adding it to the codebase: syntax highlighting: ``` raw - _____ _ + _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| @@ -570,7 +570,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) syntax highlighting: ``` raw - _____ _ + _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| @@ -773,7 +773,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) syntax highlighting: ``` raw - _____ _ + _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| @@ -3718,7 +3718,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) () (Right (Plain - "_____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|")) + " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|")) , Lit () (Right (Plain "\n")) From e66806fe13e269c64a8526a89aa6a1510ced92d6 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 16:22:12 -0800 Subject: [PATCH 13/22] Update whitespace trimming --- .../transcripts-using-base/doc.output.md | 3 ++ .../transcripts/bug-strange-closure.output.md | 6 +++- unison-src/transcripts/doc2.md | 3 +- unison-src/transcripts/doc2.output.md | 6 ++++ unison-syntax/src/Unison/Syntax/Lexer.hs | 33 +++++++++++++++---- 5 files changed, 43 insertions(+), 8 deletions(-) diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 24f75d7b3..892687f38 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -402,6 +402,7 @@ and the rendered output using `display`: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ''' You can use three or more backticks plus a language name @@ -431,6 +432,7 @@ and the rendered output using `display`: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name for @@ -709,6 +711,7 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index a33bcda87..950ffa04b 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -146,6 +146,7 @@ We can display the guide before and after adding it to the codebase: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name @@ -356,6 +357,7 @@ We can display the guide before and after adding it to the codebase: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name @@ -574,6 +576,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name @@ -777,6 +780,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name @@ -3718,7 +3722,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) () (Right (Plain - " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|")) + " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|\n ")) , Lit () (Right (Plain "\n")) diff --git a/unison-src/transcripts/doc2.md b/unison-src/transcripts/doc2.md index 68f1a99f2..2bd2dacec 100644 --- a/unison-src/transcripts/doc2.md +++ b/unison-src/transcripts/doc2.md @@ -85,12 +85,13 @@ Table ''' Exact whitespace should be preserved across multiple updates. Don't mess with the logo! - <- Should be exactly 4 spaces to the left! _____ _ | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + Should have one full trailing newline below here: + ''' Inline '' text literal with 1 space of padding '' in the middle of a sentence. diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index a9a62e3e8..3f7af60a0 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -87,6 +87,8 @@ Table | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + Should have one full trailing newline below here: + ''' Inline '' text literal with 1 space of padding '' in the middle of a sentence. @@ -184,6 +186,8 @@ fulldoc = | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + Should have one full trailing newline below here: + ''' Inline '' text literal with 1 space of padding '' in the middle of a @@ -274,6 +278,8 @@ fulldoc = | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + Should have one full trailing newline below here: + ''' Inline '' text literal with 1 space of padding '' in the middle of a diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index e53623533..f974ed5ad 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -1180,15 +1180,36 @@ trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do -- __''' -- }} -- --- >>> trimAroundDelimiters " \n text block \n " +-- E.g. +-- ''' +-- text block ''' +-- >>> trimAroundDelimiters " \n text block " -- " text block " -- --- >>> trimAroundDelimiters "something before \n text block \nsomething after" --- "something before \n text block \nsomething after" +-- Should persist a trailing newline +-- +-- E.g. +-- # Heading +-- ''' +-- text block +-- ''' +-- >>> trimAroundDelimiters " \n text block\n " +-- " text block\n " +-- +-- Should leave leading and trailing line untouched if it contains non-whitespace, e.g.: +-- +-- ''' leading whitespace +-- text block +-- trailing whitespace: ''' +-- >>> trimAroundDelimiters " leading whitespace\n text block \ntrailing whitespace: " +-- " leading whitespace\n text block \ntrailing whitespace: " +-- +-- >>> trimAroundDelimiters " leading whitespace\n text block \ntrailing whitespace: \n \n " +-- " leading whitespace\n text block \ntrailing whitespace: \n \n " trimAroundDelimiters :: String -> String -trimAroundDelimiters txt = reverse . trim . reverse . trim $ txt - where - trim s = +trimAroundDelimiters txt = + txt + & \s -> List.breakOn "\n" s & \case (prefix, suffix) From 52c8d40b03f86133532fb277a2f6adf1c9629cff Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 30 Jan 2024 16:50:48 -0800 Subject: [PATCH 14/22] Update transcripts --- unison-src/transcripts/doc2.output.md | 3 --- 1 file changed, 3 deletions(-) diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index 3f7af60a0..62a4dd079 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -81,7 +81,6 @@ Table ''' Exact whitespace should be preserved across multiple updates. Don't mess with the logo! - <- Should be exactly 4 spaces to the left! _____ _ | | |___|_|___ ___ ___ @@ -180,7 +179,6 @@ fulldoc = ''' Exact whitespace should be preserved across multiple updates. Don't mess with the logo! - <- Should be exactly 4 spaces to the left! _____ _ | | |___|_|___ ___ ___ @@ -272,7 +270,6 @@ fulldoc = ''' Exact whitespace should be preserved across multiple updates. Don't mess with the logo! - <- Should be exactly 4 spaces to the left! _____ _ | | |___|_|___ ___ ___ From 6f21f73b222948fcb045be7c00d91e5a04f60c12 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jan 2024 10:08:02 -0800 Subject: [PATCH 15/22] Update transcripts --- .../transcripts-using-base/doc.output.md | 3 -- .../transcripts/bug-strange-closure.output.md | 6 +-- unison-syntax/src/Unison/Syntax/Lexer.hs | 52 +++++++++++-------- 3 files changed, 30 insertions(+), 31 deletions(-) diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 892687f38..24f75d7b3 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -402,7 +402,6 @@ and the rendered output using `display`: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ''' You can use three or more backticks plus a language name @@ -432,7 +431,6 @@ and the rendered output using `display`: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name for @@ -711,7 +709,6 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index 950ffa04b..a33bcda87 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -146,7 +146,6 @@ We can display the guide before and after adding it to the codebase: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name @@ -357,7 +356,6 @@ We can display the guide before and after adding it to the codebase: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name @@ -576,7 +574,6 @@ rendered = Pretty.get (docFormatConsole doc.guide) | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name @@ -780,7 +777,6 @@ rendered = Pretty.get (docFormatConsole doc.guide) | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - ``` You can use three or more backticks plus a language name @@ -3722,7 +3718,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) () (Right (Plain - " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|\n ")) + " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|")) , Lit () (Right (Plain "\n")) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index f974ed5ad..de1000a2c 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -41,6 +41,7 @@ import Data.List import Data.List qualified as List import Data.List.Extra qualified as List import Data.List.NonEmpty qualified as Nel +import Data.List.NonEmpty qualified as NonEmpty import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text @@ -1179,23 +1180,9 @@ trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do -- 👇 or here -- __''' -- }} --- --- E.g. --- ''' --- text block ''' --- >>> trimAroundDelimiters " \n text block " +-- >>> trimAroundDelimiters " \n text block \n " -- " text block " -- --- Should persist a trailing newline --- --- E.g. --- # Heading --- ''' --- text block --- ''' --- >>> trimAroundDelimiters " \n text block\n " --- " text block\n " --- -- Should leave leading and trailing line untouched if it contains non-whitespace, e.g.: -- -- ''' leading whitespace @@ -1204,17 +1191,36 @@ trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do -- >>> trimAroundDelimiters " leading whitespace\n text block \ntrailing whitespace: " -- " leading whitespace\n text block \ntrailing whitespace: " -- --- >>> trimAroundDelimiters " leading whitespace\n text block \ntrailing whitespace: \n \n " --- " leading whitespace\n text block \ntrailing whitespace: \n \n " +-- Should keep trailing newline if it's the only thing on the line, e.g.: +-- +-- ''' +-- newline below +-- +-- ''' +-- >>> trimAroundDelimiters "\nnewline below\n\n" +-- "newline below\n\n" trimAroundDelimiters :: String -> String trimAroundDelimiters txt = txt - & \s -> - List.breakOn "\n" s - & \case - (prefix, suffix) - | all isSpace prefix -> drop 1 suffix - | otherwise -> prefix <> suffix + & ( \s -> + List.breakOn "\n" s + & \case + (prefix, suffix) + | all isSpace prefix -> drop 1 suffix + | otherwise -> prefix <> suffix + ) + & ( \s -> + List.breakOnEnd "\n" s + & \case + (_prefix, "") -> s + (prefix, suffix) + | all isSpace suffix -> dropTrailingNewline prefix + | otherwise -> prefix <> suffix + ) + where + dropTrailingNewline = \case + [] -> [] + (x : xs) -> NonEmpty.init (x NonEmpty.:| xs) separated :: (Char -> Bool) -> P a -> P a separated ok p = P.try $ p <* P.lookAhead (void (P.satisfy ok) <|> P.eof) From bea34375abc4fcf3388e193e5c96e56bc0958ed6 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jan 2024 10:12:03 -0800 Subject: [PATCH 16/22] Update transcripts --- unison-src/transcripts-using-base/doc.output.md | 3 +++ unison-src/transcripts/bug-strange-closure.output.md | 6 +++++- unison-syntax/src/Unison/Syntax/Lexer.hs | 2 +- 3 files changed, 9 insertions(+), 2 deletions(-) diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 24f75d7b3..892687f38 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -402,6 +402,7 @@ and the rendered output using `display`: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ''' You can use three or more backticks plus a language name @@ -431,6 +432,7 @@ and the rendered output using `display`: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name for @@ -709,6 +711,7 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name diff --git a/unison-src/transcripts/bug-strange-closure.output.md b/unison-src/transcripts/bug-strange-closure.output.md index a33bcda87..950ffa04b 100644 --- a/unison-src/transcripts/bug-strange-closure.output.md +++ b/unison-src/transcripts/bug-strange-closure.output.md @@ -146,6 +146,7 @@ We can display the guide before and after adding it to the codebase: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name @@ -356,6 +357,7 @@ We can display the guide before and after adding it to the codebase: | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name @@ -574,6 +576,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name @@ -777,6 +780,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + ``` You can use three or more backticks plus a language name @@ -3718,7 +3722,7 @@ rendered = Pretty.get (docFormatConsole doc.guide) () (Right (Plain - " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|")) + " _____ _ \n | | |___|_|___ ___ ___ \n | | | | |_ -| . | |\n |_____|_|_|_|___|___|_|_|\n ")) , Lit () (Right (Plain "\n")) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index de1000a2c..f8aa39aeb 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -541,7 +541,7 @@ lexemes' eof = let txt = trimIndentFromVerbatimBlock (column start - 1) (trimAroundDelimiters originalText) in wrap "syntax.docVerbatim" $ wrap "syntax.docWord" $ - pure [Token (Textual (trimAroundDelimiters txt)) start stop] + pure [Token (Textual txt) start stop] else wrap "syntax.docCode" $ wrap "syntax.docWord" $ From cb974e7ae19569b0af6561a332008b5dea69c966 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jan 2024 11:27:49 -0800 Subject: [PATCH 17/22] Newlines within {{ }} for multi-line docs --- .../src/Unison/Syntax/TermPrinter.hs | 10 +++------- .../transcripts-round-trip/main.output.md | 18 ++++++++++++------ .../transcripts-using-base/doc.output.md | 6 ++++-- unison-src/transcripts/formatter.output.md | 12 ++++++++---- 4 files changed, 27 insertions(+), 19 deletions(-) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index be9d64fd1..f7bcd3a0d 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -1737,13 +1737,9 @@ prettyDoc2 :: prettyDoc2 ac tm = do ppe <- getPPE let brace p = - fmt S.DocDelimiter "{{" - <> PP.softbreak - <> p - <> PP.softbreak - <> fmt - S.DocDelimiter - "}}" + if PP.isMultiLine p + then fmt S.DocDelimiter "{{" <> PP.newline <> p <> PP.newline <> fmt S.DocDelimiter "}}" + else fmt S.DocDelimiter "{{" <> PP.softbreak <> p <> PP.softbreak <> fmt S.DocDelimiter "}}" bail tm = brace <$> pretty0 ac tm -- Finds the longest run of a character and return one bigger than that longestRun c s = diff --git a/unison-src/transcripts-round-trip/main.output.md b/unison-src/transcripts-round-trip/main.output.md index d7774d871..ce990028d 100644 --- a/unison-src/transcripts-round-trip/main.output.md +++ b/unison-src/transcripts-round-trip/main.output.md @@ -166,7 +166,8 @@ fix_2224b = cases fix_2271 : Doc2 fix_2271 = - {{ # Full doc body indented + {{ + # Full doc body indented ``` raw myVal1 = 42 @@ -179,7 +180,8 @@ fix_2271 = indented2="this is two indents" ``` - I am two spaces over }} + I am two spaces over + }} Fix_2337.f : Fix_2337 -> Boolean Fix_2337.f = cases Fix_2337 a b -> a @@ -304,10 +306,12 @@ fix_4384b = {{ {{ docExampleBlock 0 '99 }} }} fix_4384c : Doc2 fix_4384c = use Nat + - {{ {{ docExampleBlock 0 do + {{ + {{ docExampleBlock 0 do x = 1 y = 2 - x + y }} }} + x + y }} + }} fix_4384d : Doc2 fix_4384d = @@ -432,11 +436,13 @@ multiline_list = nested_fences : Doc2 nested_fences = - {{ ```` raw + {{ + ```` raw ```unison r = "boopydoo" ``` - ```` }} + ```` + }} raw_a : Text raw_a = diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index 892687f38..a9e9add88 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -553,7 +553,8 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub doc.guide : Doc2 doc.guide = - {{ # Unison computable documentation + {{ + # Unison computable documentation {{ basicFormatting }} @@ -565,7 +566,8 @@ Lastly, it's common to build longer documents including subdocuments via `{{ sub {{ nonUnisonCodeBlocks }} - {{ otherElements }} }} + {{ otherElements }} + }} .> display doc.guide diff --git a/unison-src/transcripts/formatter.output.md b/unison-src/transcripts/formatter.output.md index 904095a21..e0132020a 100644 --- a/unison-src/transcripts/formatter.output.md +++ b/unison-src/transcripts/formatter.output.md @@ -52,11 +52,13 @@ type Two = One Nat | Two Text ``` ```unison:added-by-ucm scratch.u x.doc = - {{ # Doc This is a **doc**! + {{ + # Doc This is a **doc**! term link {x} - type link {type Optional} }} + type link {type Optional} + }} x : Nat -> Nat x y = use Nat + @@ -70,11 +72,13 @@ oneLiner = {{ one liner }} -- Before explicit.doc = - {{ # Here's a top-level doc + {{ + # Here's a top-level doc With a paragraph - Or two }} + Or two + }} -- After Thing.doc = {{ A doc before an ability }} From 4752b4444e3093998ce5cd1eb1336223a3e5b578 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jan 2024 12:29:32 -0800 Subject: [PATCH 18/22] Handle lines with only whitespace. --- unison-syntax/src/Unison/Syntax/Lexer.hs | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/unison-syntax/src/Unison/Syntax/Lexer.hs b/unison-syntax/src/Unison/Syntax/Lexer.hs index f8aa39aeb..70a2a2e32 100644 --- a/unison-syntax/src/Unison/Syntax/Lexer.hs +++ b/unison-syntax/src/Unison/Syntax/Lexer.hs @@ -535,13 +535,14 @@ lexemes' eof = P.someTill P.anySingle (lit quotes) let isMultiLine = line start /= line stop if isMultiLine - then -- If it's a multi-line verbatim block we trim any whitespace representing - -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' - - let txt = trimIndentFromVerbatimBlock (column start - 1) (trimAroundDelimiters originalText) - in wrap "syntax.docVerbatim" $ - wrap "syntax.docWord" $ - pure [Token (Textual txt) start stop] + then do + let trimmed = (trimAroundDelimiters originalText) + let txt = trimIndentFromVerbatimBlock (column start - 1) trimmed + -- If it's a multi-line verbatim block we trim any whitespace representing + -- indentation from the pretty-printer. See 'trimIndentFromVerbatimBlock' + wrap "syntax.docVerbatim" $ + wrap "syntax.docWord" $ + pure [Token (Textual txt) start stop] else wrap "syntax.docCode" $ wrap "syntax.docWord" $ @@ -1170,7 +1171,14 @@ trimIndentFromVerbatimBlock :: Int -> String -> String trimIndentFromVerbatimBlock leadingSpaces txt = fromMaybe txt $ do List.intercalate "\n" <$> for (lines txt) \line -> do -- If any 'stripPrefix' fails, we fail and return the unaltered text - stripPrefix (replicate leadingSpaces ' ') line + case stripPrefix (replicate leadingSpaces ' ') line of + Just stripped -> Just stripped + Nothing -> + -- If it was a line with all white-space, just use an empty line, + -- this can happen easily in editors which trim trailing whitespace. + if all isSpace line + then Just "" + else Nothing -- Trim leading/trailing whitespace from around delimiters, e.g. -- From 1f67d095f2b6be3004f91d5b9b1a0c9d40a1ecee Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jan 2024 13:03:25 -0800 Subject: [PATCH 19/22] Add regression test for empty-lines in raw literals --- unison-src/transcripts/doc2.md | 8 +- unison-src/transcripts/doc2.output.md | 103 +++----------------------- 2 files changed, 15 insertions(+), 96 deletions(-) diff --git a/unison-src/transcripts/doc2.md b/unison-src/transcripts/doc2.md index 2bd2dacec..89ac97009 100644 --- a/unison-src/transcripts/doc2.md +++ b/unison-src/transcripts/doc2.md @@ -90,17 +90,21 @@ Table | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + + Line with no whitespace: + Should have one full trailing newline below here: ''' Inline '' text literal with 1 space of padding '' in the middle of a sentence. + }} ``` +Format it to check that everything pretty-prints in a valid way. + ```ucm .> debug.format --- Format it again to ensure multiple round-trips don't cause changes. -.> debug.format ``` diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index 62a4dd079..1b7573357 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -86,21 +86,24 @@ Table | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| + + Line with no whitespace: + Should have one full trailing newline below here: ''' Inline '' text literal with 1 space of padding '' in the middle of a sentence. + }} ``` +Format it to check that everything pretty-prints in a valid way. + ```ucm .> debug.format --- Format it again to ensure multiple round-trips don't cause changes. -.> debug.format - ``` ```unison:added-by-ucm scratch.u otherDoc : a -> Doc2 @@ -184,97 +187,9 @@ fulldoc = | | |___|_|___ ___ ___ | | | | |_ -| . | | |_____|_|_|_|___|___|_|_| - Should have one full trailing newline below here: - - ''' - - Inline '' text literal with 1 space of padding '' in the middle of a - sentence. - }} -``` - -```unison:added-by-ucm scratch.u -otherDoc : a -> Doc2 -otherDoc _ = {{ yo }} - -otherTerm : Nat -otherTerm = 99 - -fulldoc : Doc2 -fulldoc = - use Nat + - {{ - Heres some text with a soft line break - - hard line break - - Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code - block ''1 + 2'' - - # Heading - - ## Heading 2 - - Term Link: {otherTerm} - - Type Link: {type Optional} - - Term source: - - @source{term} - - Term signature: - - @signature{term} - - * List item - - Inline code: - - `` 1 + 2 `` - - '' "doesn't typecheck" + 1 '' - - [Link](https://unison-lang.org) - - ![Image](https://share-next.unison-lang.org/static/unison-logo-circle.png) - - Horizontal rule - - --- - - Video - - {{ - Special - (Embed - (Any (Video [MediaSource "test.mp4" None] [("poster", "test.png")]))) - }} - - Transclusion/evaluation: - - {{ otherDoc (a -> Word a) }} - - --- - - The following markdown features aren't supported by the Doc format yet, - but maybe will someday - - > Block quote - - Table - - | Header 1 | Header 2 | | -------- | -------- | | Cell 1 | Cell 2 | - - Indented Code block - - ''' - Exact whitespace should be preserved across multiple updates. Don't mess with the logo! - - _____ _ - | | |___|_|___ ___ ___ - | | | | |_ -| . | | - |_____|_|_|_|___|___|_|_| + + Line with no whitespace: + Should have one full trailing newline below here: ''' From db15634fdef80d286f964b425bbce62967df1ad3 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jan 2024 16:04:20 -0800 Subject: [PATCH 20/22] Rename to debug.term|type.abt --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 6 +++--- unison-src/transcripts/debug-definitions.md | 14 +++++++------- unison-src/transcripts/debug-definitions.output.md | 14 +++++++------- 3 files changed, 17 insertions(+), 17 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 9fc511ff1..c88f11378 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2278,7 +2278,7 @@ debugDumpNamespaceSimple = debugTerm :: InputPattern debugTerm = InputPattern - "debug.term" + "debug.term.abt" [] I.Hidden [("term", Required, exactDefinitionTermQueryArg)] @@ -2291,7 +2291,7 @@ debugTerm = debugTermVerbose :: InputPattern debugTermVerbose = InputPattern - "debug.term.verbose" + "debug.term.abt.verbose" [] I.Hidden [("term", Required, exactDefinitionTermQueryArg)] @@ -2304,7 +2304,7 @@ debugTermVerbose = debugType :: InputPattern debugType = InputPattern - "debug.type" + "debug.type.abt" [] I.Hidden [("type", Required, exactDefinitionTypeQueryArg)] diff --git a/unison-src/transcripts/debug-definitions.md b/unison-src/transcripts/debug-definitions.md index 1a804ee34..471748691 100644 --- a/unison-src/transcripts/debug-definitions.md +++ b/unison-src/transcripts/debug-definitions.md @@ -18,11 +18,11 @@ ability Ask a where ```ucm .> add -.> debug.term Nat.+ -.> debug.term y -.> debug.term Some -.> debug.term ask -.> debug.type Nat -.> debug.type Optional -.> debug.type Ask +.> 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 index c117f916a..cb1b14d1a 100644 --- a/unison-src/transcripts/debug-definitions.output.md +++ b/unison-src/transcripts/debug-definitions.output.md @@ -23,15 +23,15 @@ ability Ask a where x : Nat y : Nat -.> debug.term Nat.+ +.> debug.term.abt Nat.+ Builtin term: ##Nat.+ -.> debug.term y +.> 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 Some +.> debug.term.abt Some Constructor #0 of the following type: DataDeclaration @@ -61,7 +61,7 @@ ability Ask a where ] } -.> debug.term ask +.> debug.term.abt ask Constructor #0 of the following type: EffectDeclaration @@ -90,11 +90,11 @@ ability Ask a where } } -.> debug.type Nat +.> debug.type.abt Nat Builtin type: ##Nat -.> debug.type Optional +.> debug.type.abt Optional DataDeclaration { modifier = Structural @@ -123,7 +123,7 @@ ability Ask a where ] } -.> debug.type Ask +.> debug.type.abt Ask EffectDeclaration { toDataDecl = DataDeclaration From 61a05421833a12201f614de903a8573696d2777f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jan 2024 16:19:14 -0800 Subject: [PATCH 21/22] Default to single-quotes --- .../src/Unison/Syntax/TermPrinter.hs | 13 ++++++++-- .../transcripts-using-base/doc.output.md | 16 ++++++------- unison-src/transcripts/{docs.md => doc1.md} | 0 unison-src/transcripts/doc2.md | 10 +++++++- unison-src/transcripts/doc2.output.md | 24 +++++++++++++++---- 5 files changed, 48 insertions(+), 15 deletions(-) rename unison-src/transcripts/{docs.md => doc1.md} (100%) diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs index f7bcd3a0d..891047f95 100644 --- a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs +++ b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs @@ -1741,10 +1741,14 @@ prettyDoc2 ac tm = do then fmt S.DocDelimiter "{{" <> PP.newline <> p <> PP.newline <> fmt S.DocDelimiter "}}" else fmt S.DocDelimiter "{{" <> PP.softbreak <> p <> PP.softbreak <> fmt S.DocDelimiter "}}" bail tm = brace <$> pretty0 ac tm + contains :: Char -> Pretty SyntaxText -> Bool + contains c p = + PP.toPlainUnbroken (PP.syntaxToColor p) + & elem c -- Finds the longest run of a character and return one bigger than that longestRun c s = case filter (\s -> take 2 s == [c, c]) $ - group (PP.toPlainUnbroken $ PP.syntaxToColor s) of + List.group (PP.toPlainUnbroken $ PP.syntaxToColor s) of [] -> 2 x -> 1 + maximum (map length x) oneMore c inner = replicate (longestRun c inner) c @@ -1778,7 +1782,12 @@ prettyDoc2 ac tm = do pure $ PP.text t (toDocCode ppe -> Just d) -> do inner <- rec d - let quotes = PP.string $ oneMore '\'' inner + let quotes = + -- Prefer ` if there aren't any in the inner text, + -- otherwise use one more than the longest run of ' in the inner text + if contains '`' inner + then PP.string $ oneMore '\'' inner + else PP.string "`" pure $ PP.group $ quotes <> inner <> quotes (toDocJoin ppe -> Just ds) -> foldMapM rec ds (toDocItalic ppe -> Just d) -> do diff --git a/unison-src/transcripts-using-base/doc.output.md b/unison-src/transcripts-using-base/doc.output.md index a9e9add88..1d7c8a3f5 100644 --- a/unison-src/transcripts-using-base/doc.output.md +++ b/unison-src/transcripts-using-base/doc.output.md @@ -112,7 +112,7 @@ and the rendered output using `display`: section elements. Text can be **bold**, __italicized__, ~~strikethrough~~, - or ''monospaced'' (or ''monospaced''). + or `monospaced` (or `monospaced`). You can link to Unison terms, types, and external URLs: @@ -122,7 +122,7 @@ and the rendered output using `display`: [a named term link]({Some}). Term links are handy for linking to other documents! - You can use ''{{ .. }}'' to escape out to regular Unison + You can use `{{ .. }}` to escape out to regular Unison syntax, for instance {{ docWord "__not bold__" }}. This is useful for creating documents programmatically or just including other documents. @@ -164,9 +164,9 @@ and the rendered output using `display`: ## Bulleted lists - Bulleted lists can use ''+'', ''-'', or ''*'' for the - bullets (though the choice will be normalized away by - the pretty-printer). They can be nested, to any depth: + Bulleted lists can use `+`, `-`, or `*` for the bullets + (though the choice will be normalized away by the + pretty-printer). They can be nested, to any depth: * A * B @@ -331,9 +331,9 @@ and the rendered output using `display`: You can include typechecked code snippets inline, for instance: - * {{ docExample 2 '(f x -> f x + sqr 1) }} - the ''2'' + * {{ docExample 2 '(f x -> f x + sqr 1) }} - the `2` says to ignore the first two arguments when - rendering. In richer renderers, the ''sqr'' link will + rendering. In richer renderers, the `sqr` link will be clickable. * If your snippet expression is just a single function application, you can put it in double backticks, like @@ -456,7 +456,7 @@ and the rendered output using `display`: {{ There are also asides, callouts, tables, tooltips, and more. These don't currently have special syntax; just use the - ''{{ }}'' syntax to call these functions directly. + `{{ }}` syntax to call these functions directly. @signatures{docAside, docCallout, docBlockquote, docTooltip, docTable} diff --git a/unison-src/transcripts/docs.md b/unison-src/transcripts/doc1.md similarity index 100% rename from unison-src/transcripts/docs.md rename to unison-src/transcripts/doc1.md diff --git a/unison-src/transcripts/doc2.md b/unison-src/transcripts/doc2.md index 89ac97009..278cc8f49 100644 --- a/unison-src/transcripts/doc2.md +++ b/unison-src/transcripts/doc2.md @@ -20,7 +20,15 @@ soft line break hard line break -Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block ''1 + 2'' +Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block `1 + 2` + +Should print with appropriate fences for the contents: + +`No fancy quotes` + +'' There are `backticks` in here '' + +''' There are `backticks` and ''quotes'' in here ''' # Heading diff --git a/unison-src/transcripts/doc2.output.md b/unison-src/transcripts/doc2.output.md index 1b7573357..e303b639a 100644 --- a/unison-src/transcripts/doc2.output.md +++ b/unison-src/transcripts/doc2.output.md @@ -16,7 +16,15 @@ soft line break hard line break -Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block ''1 + 2'' +Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code block `1 + 2` + +Should print with appropriate fences for the contents: + +`No fancy quotes` + +'' There are `backticks` in here '' + +''' There are `backticks` and ''quotes'' in here ''' # Heading @@ -121,7 +129,15 @@ fulldoc = hard line break Here's a cool **BOLD** __italic__ ~~strikethrough~~ thing with an inline code - block ''1 + 2'' + block `1 + 2` + + Should print with appropriate fences for the contents: + + `No fancy quotes` + + '' There are `backticks` in here '' + + ''' There are `backticks` and ''quotes'' in here ''' # Heading @@ -145,7 +161,7 @@ fulldoc = `` 1 + 2 `` - '' "doesn't typecheck" + 1 '' + ` "doesn't typecheck" + 1 ` [Link](https://unison-lang.org) @@ -194,7 +210,7 @@ fulldoc = ''' - Inline '' text literal with 1 space of padding '' in the middle of a + Inline ` text literal with 1 space of padding ` in the middle of a sentence. }} ``` From 9b261b831f1a065f76280d83f6b7cc1e8973c1e9 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jan 2024 16:30:41 -0800 Subject: [PATCH 22/22] Transcript output --- unison-src/transcripts/{docs.output.md => doc1.output.md} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename unison-src/transcripts/{docs.output.md => doc1.output.md} (100%) diff --git a/unison-src/transcripts/docs.output.md b/unison-src/transcripts/doc1.output.md similarity index 100% rename from unison-src/transcripts/docs.output.md rename to unison-src/transcripts/doc1.output.md