From 9a0350a669a2e3b0f1473de2596f1ebef44d3958 Mon Sep 17 00:00:00 2001 From: Paul Chiusano Date: Tue, 19 Nov 2019 11:28:23 -0500 Subject: [PATCH] Address PR comments --- .../src/Unison/Codebase/Editor/HandleInput.hs | 5 +-- .../src/Unison/CommandLine/DisplayValues.hs | 33 +++++++++++-------- .../src/Unison/HashQualified.hs | 16 +++++++++ .../src/Unison/PrettyPrintEnv.hs | 8 +++-- unison-src/transcripts/docs.output.md | 16 ++++----- unison-src/transcripts/merges.output.md | 12 +++---- 6 files changed, 58 insertions(+), 32 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs b/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs index 4009655f5..6a62c1865 100644 --- a/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs +++ b/parser-typechecker/src/Unison/Codebase/Editor/HandleInput.hs @@ -1360,14 +1360,15 @@ loop = do doDisplay :: Var v => OutputLocation -> Names -> Referent -> Action' m v () doDisplay outputLoc names r = do let tm = Term.fromReferent External r - ppe <- PPE.suffixifiedPPE <$> prettyPrintEnvDecl names + ppe <- prettyPrintEnvDecl names latestFile' <- use latestFile let loc = case outputLoc of ConsoleLocation -> Nothing FileLocation path -> Just path LatestFileLocation -> fmap fst latestFile' <|> Just "scratch.u" - evalTerm r = fmap ErrorUtil.hush . eval $ Evaluate1 ppe (Term.ref External r) + evalTerm r = fmap ErrorUtil.hush . eval $ + Evaluate1 (PPE.suffixifiedPPE ppe) (Term.ref External r) loadTerm (Reference.DerivedId r) = eval $ LoadTerm r loadTerm _ = pure Nothing loadDecl (Reference.DerivedId r) = eval $ LoadType r diff --git a/parser-typechecker/src/Unison/CommandLine/DisplayValues.hs b/parser-typechecker/src/Unison/CommandLine/DisplayValues.hs index 8fdba4547..af8a295b8 100644 --- a/parser-typechecker/src/Unison/CommandLine/DisplayValues.hs +++ b/parser-typechecker/src/Unison/CommandLine/DisplayValues.hs @@ -24,49 +24,54 @@ import qualified Unison.Util.SyntaxText as S type Pretty = P.Pretty P.ColorText displayTerm :: (Var v, Monad m) - => PPE.PrettyPrintEnv + => PPE.PrettyPrintEnvDecl -> (Reference -> m (Maybe (AnnotatedTerm v a))) -> (Referent -> m (Maybe (Type v a))) -> (Reference -> m (Maybe (AnnotatedTerm v a))) -> (Reference -> m (Maybe (DD.Decl v a))) -> AnnotatedTerm v a -> m Pretty -displayTerm ppe terms typeOf eval types tm = case tm of +displayTerm pped terms typeOf eval types tm = case tm of -- todo: can dispatch on other things with special rendering Term.Ref' r -> eval r >>= \case - Nothing -> pure $ termName ppe (Referent.Ref r) - Just tm -> displayDoc ppe terms typeOf eval types tm - _ -> displayDoc ppe terms typeOf eval types tm + Nothing -> pure $ termName (PPE.suffixifiedPPE pped) (Referent.Ref r) + Just tm -> displayDoc pped terms typeOf eval types tm + _ -> displayDoc pped terms typeOf eval types tm displayDoc :: (Var v, Monad m) - => PPE.PrettyPrintEnv + => PPE.PrettyPrintEnvDecl -> (Reference -> m (Maybe (AnnotatedTerm v a))) -> (Referent -> m (Maybe (Type v a))) -> (Reference -> m (Maybe (AnnotatedTerm v a))) -> (Reference -> m (Maybe (DD.Decl v a))) -> AnnotatedTerm v a -> m Pretty -displayDoc ppe terms typeOf evaluated types t = go t +displayDoc pped terms typeOf evaluated types t = go t where go (DD.DocJoin docs) = foldMap id <$> traverse go docs go (DD.DocBlob txt) = pure $ P.paragraphyText txt - go (DD.DocLink (DD.LinkTerm (Term.TermLink' r))) = pure $ P.underline (termName ppe r) - go (DD.DocLink (DD.LinkType (Term.TypeLink' r))) = pure $ P.underline (typeName ppe r) + go (DD.DocLink (DD.LinkTerm (Term.TermLink' r))) = + pure $ P.underline (termName (PPE.suffixifiedPPE pped) r) + go (DD.DocLink (DD.LinkType (Term.TypeLink' r))) = + pure $ P.underline (typeName (PPE.suffixifiedPPE pped) r) go (DD.DocSource (DD.LinkTerm (Term.TermLink' r))) = prettyTerm terms r go (DD.DocSource (DD.LinkType (Term.TypeLink' r))) = prettyType r go (DD.DocSignature (Term.TermLink' r)) = prettySignature r go (DD.DocEvaluate (Term.TermLink' r)) = prettyTerm evaluated r - go tm = pure $ TP.pretty ppe tm + go tm = pure $ TP.pretty (PPE.suffixifiedPPE pped) tm prettySignature r = typeOf r >>= \case - Nothing -> pure $ termName ppe r - Just typ -> pure $ P.group $ TypePrinter.prettySignatures ppe [(PPE.termName ppe r, typ)] + Nothing -> pure $ termName (PPE.unsuffixifiedPPE pped) r + Just typ -> pure . P.group $ + TypePrinter.prettySignatures + (PPE.suffixifiedPPE pped) + [(PPE.termName (PPE.unsuffixifiedPPE pped) r, typ)] prettyTerm terms r = case r of Referent.Ref (Reference.Builtin _) -> prettySignature r - Referent.Ref ref -> terms ref >>= \case + Referent.Ref ref -> let ppe = PPE.declarationPPE pped ref in terms ref >>= \case Nothing -> pure $ "😶 Missing term source for: " <> termName ppe r Just tm -> pure . P.syntaxToColor $ P.group $ TP.prettyBinding ppe (PPE.termName ppe r) tm Referent.Con r _ _ -> prettyType r - prettyType r = types r >>= \case + prettyType r = let ppe = PPE.declarationPPE pped r in types r >>= \case Nothing -> pure $ "😶 Missing type source for: " <> typeName ppe r Just ty -> pure . P.syntaxToColor $ P.group $ DP.prettyDecl ppe r (PPE.typeName ppe r) ty diff --git a/parser-typechecker/src/Unison/HashQualified.hs b/parser-typechecker/src/Unison/HashQualified.hs index d19c82ca5..c19900a4f 100644 --- a/parser-typechecker/src/Unison/HashQualified.hs +++ b/parser-typechecker/src/Unison/HashQualified.hs @@ -4,6 +4,7 @@ module Unison.HashQualified where import Unison.Prelude hiding (fromString) +import Data.List ( sortOn ) import Data.Maybe ( fromJust ) import qualified Data.Text as Text @@ -40,6 +41,21 @@ toName = \case HashQualified name _ -> Just name HashOnly _ -> Nothing +-- Sort the list of names by length of segments: smaller number of +-- segments is listed first. NameOnly < Hash qualified < Hash only +-- +-- Examples: +-- [foo.bar.baz, bar.baz] -> [bar.baz, foo.bar.baz] +-- [#a29dj2k91, foo.bar.baz] -> [foo.bar.baz, #a29dj2k91] +-- [foo.bar#abc, foo.bar] -> [foo.bar, foo.bar#abc] +-- [.foo.bar, foo.bar] -> [foo.bar, .foo.bar] +sortByLength :: [HashQualified' Name] -> [HashQualified' Name] +sortByLength hs = sortOn f hs where + f (NameOnly n) = (countDots n, 0, Left n) + f (HashQualified n _h) = (countDots n, 1, Left n) + f (HashOnly h) = (maxBound, 0, Right h) + countDots n = Text.count "." (Text.dropEnd 1 (Name.toText n)) + hasName, hasHash :: HashQualified -> Bool hasName = isJust . toName hasHash = isJust . toHash diff --git a/parser-typechecker/src/Unison/PrettyPrintEnv.hs b/parser-typechecker/src/Unison/PrettyPrintEnv.hs index 2d620119c..ad66699f7 100644 --- a/parser-typechecker/src/Unison/PrettyPrintEnv.hs +++ b/parser-typechecker/src/Unison/PrettyPrintEnv.hs @@ -11,7 +11,6 @@ import Unison.Names3 ( Names ) import Unison.Reference ( Reference ) import Unison.Referent ( Referent ) import Unison.Util.List (safeHead) -import Data.List (sortOn) import qualified Data.Map as Map import qualified Unison.HashQualified as HQ import qualified Unison.Name as Name @@ -39,7 +38,7 @@ fromNames :: Int -> Names -> PrettyPrintEnv fromNames len names = PrettyPrintEnv terms' types' where terms' r = shortestName . Set.map HQ'.toHQ $ (Names.termName len r names) types' r = shortestName . Set.map HQ'.toHQ $ (Names.typeName len r names) - shortestName ns = safeHead $ sortOn (length . HQ.toString) (toList ns) + shortestName ns = safeHead . traceShowId $ HQ.sortByLength (toList ns) fromSuffixNames :: Int -> Names -> PrettyPrintEnv fromSuffixNames len names = fromNames len (Names.suffixify names) @@ -51,6 +50,11 @@ fromNamesDecl len names = -- A pair of PrettyPrintEnvs: -- - suffixifiedPPE uses the shortest unique suffix -- - unsuffixifiedPPE uses the shortest full name +-- +-- Generally, we want declarations LHS (the `x` in `x = 23`) to use the +-- unsuffixified names, so the LHS is an accurate description of where in the +-- namespace the definition lives. For everywhere else, we can use the +-- suffixified version. data PrettyPrintEnvDecl = PrettyPrintEnvDecl { unsuffixifiedPPE :: PrettyPrintEnv, suffixifiedPPE :: PrettyPrintEnv diff --git a/unison-src/transcripts/docs.output.md b/unison-src/transcripts/docs.output.md index 336834a25..9144dba93 100644 --- a/unison-src/transcripts/docs.output.md +++ b/unison-src/transcripts/docs.output.md @@ -153,14 +153,14 @@ Now that documentation is linked to the definition. We can view it if we like: ## Examples: - ex1 = builtin.List.take 0 [1, 2, 3, 4, 5] + List.take.ex1 = builtin.List.take 0 [1, 2, 3, 4, 5] 🔽 - ex1 = [] + List.take.ex1 = [] - ex2 = builtin.List.take 2 [1, 2, 3, 4, 5] + List.take.ex2 = builtin.List.take 2 [1, 2, 3, 4, 5] 🔽 - ex2 = [1, 2] + List.take.ex2 = [1, 2] ``` Or there's also a convenient function, `docs`, which shows the `Doc` values that are linked to a definition. It's implemented in terms of `links` and `display`: @@ -174,13 +174,13 @@ Or there's also a convenient function, `docs`, which shows the `Doc` values that ## Examples: - ex1 = builtin.List.take 0 [1, 2, 3, 4, 5] + List.take.ex1 = builtin.List.take 0 [1, 2, 3, 4, 5] 🔽 - ex1 = [] + List.take.ex1 = [] - ex2 = builtin.List.take 2 [1, 2, 3, 4, 5] + List.take.ex2 = builtin.List.take 2 [1, 2, 3, 4, 5] 🔽 - ex2 = [1, 2] + List.take.ex2 = [1, 2] ``` diff --git a/unison-src/transcripts/merges.output.md b/unison-src/transcripts/merges.output.md index 787b63b88..08e1c1c86 100644 --- a/unison-src/transcripts/merges.output.md +++ b/unison-src/transcripts/merges.output.md @@ -244,8 +244,8 @@ master.frobnicate n = n + 1 .> view master.y - master.y : Text - master.y = "updated y" + feature2.y : Text + feature2.y = "updated y" .> view master.frobnicate @@ -291,13 +291,13 @@ And notice that `y` has the most recent value, and that `z` and `frobnicate` bot ```ucm .> view master.y - master.y : Text - master.y = "updated y" + feature2.y : Text + feature2.y = "updated y" .> view master.z - master.z : Nat - master.z = 99 + feature2.z : Nat + feature2.z = 99 .> view master.frobnicate