Address PR comments

This commit is contained in:
Paul Chiusano 2019-11-19 11:28:23 -05:00
parent 00d0fc8c56
commit 9a0350a669
6 changed files with 58 additions and 32 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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]
```

View File

@ -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