Skip to content

Commit d0f3021

Browse files
aryairaniaryairani
authored
Merge pull request #6036 from unisonweb/cp/syntax-text-fqn
2 parents a560274 + b3019d8 commit d0f3021

File tree

16 files changed

+221
-56
lines changed

16 files changed

+221
-56
lines changed

‎lib/unison-pretty-printer/src/Unison/Util/ColorText.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -179,8 +179,8 @@ defaultColors = \case
179179
ST.BooleanLiteral -> Nothing
180180
ST.Blank -> Nothing
181181
ST.Var -> Nothing
182-
ST.TypeReference _ -> Nothing
183-
ST.TermReference _ -> Nothing
182+
ST.TypeReference {} -> Nothing
183+
ST.TermReference {} -> Nothing
184184
ST.Op _ -> Nothing
185185
ST.Unit -> Nothing
186186
ST.AbilityBraces -> Just HiPurple

‎lib/unison-pretty-printer/src/Unison/Util/SyntaxText.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,8 @@ data Element r
1818
| BooleanLiteral
1919
| Blank
2020
| Var
21-
| TypeReference r
22-
| TermReference (Referent' r)
21+
| TypeReference (Maybe Name {- fqn, if it has one -}) r
22+
| TermReference (Maybe Name {- fqn, if it has one -}) (Referent' r)
2323
| Op SeqOp
2424
| AbilityBraces
2525
| -- let|handle|in|where|match|with|cases|->|if|then|else|and|or

‎parser-typechecker/src/Unison/PrettyPrintEnv.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,9 @@ module Unison.PrettyPrintEnv
33
patterns,
44
patternName,
55
terms,
6+
termFQN,
67
types,
8+
typeFQN,
79
allTermNames,
810
allTypeNames,
911
termName,
@@ -58,6 +60,12 @@ terms ppe = fmap snd . listToMaybe . termNames ppe
5860
types :: PrettyPrintEnv -> Reference -> Maybe (HQ'.HashQualified Name)
5961
types ppe = fmap snd . listToMaybe . typeNames ppe
6062

63+
termFQN :: PrettyPrintEnv -> Referent -> Maybe Name
64+
termFQN ppe = fmap (HQ'.toName . fst) . listToMaybe . termNames ppe
65+
66+
typeFQN :: PrettyPrintEnv -> Reference -> Maybe Name
67+
typeFQN ppe = fmap (HQ'.toName . fst) . listToMaybe . typeNames ppe
68+
6169
termNameOrHashOnly :: PrettyPrintEnv -> Referent -> HQ.HashQualified Name
6270
termNameOrHashOnly ppe r = maybe (HQ.fromReferent r) HQ'.toHQ $ terms ppe r
6371

‎parser-typechecker/src/Unison/Syntax/DeclPrinter.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -112,7 +112,7 @@ prettyPattern ::
112112
Pretty SyntaxText
113113
prettyPattern env ctorType namespace ref =
114114
styleHashQualified''
115-
(fmt (S.TermReference conRef))
115+
(fmt (S.TermReference (PPE.termFQN env conRef) conRef))
116116
( let strip =
117117
case HQ.toName namespace of
118118
Nothing -> id
@@ -164,9 +164,9 @@ prettyDataDecl (PrettyPrintEnvDecl unsuffixifiedPPE suffixifiedPPE) guid r name
164164
(fmt S.DelimiterChar "," <> " " `P.orElse` "\n ")
165165
(field <$> zip fieldNames (init ts))
166166
<> fmt S.DelimiterChar " }"
167-
field (fname, typ) =
167+
field (fname, typ) = do
168168
P.group $
169-
fmt (S.TypeReference r) (prettyName fname)
169+
fmt (S.TypeReference (PPE.typeFQN suffixifiedPPE r) r) (prettyName fname)
170170
<> fmt S.TypeAscriptionColon " :"
171171
`P.hang` runPretty suffixifiedPPE (TypePrinter.prettyRaw Map.empty (-1) typ)
172172
header = prettyDataHeader guid name dd <> fmt S.DelimiterChar (" = " `P.orElse` "\n = ")

‎parser-typechecker/src/Unison/Syntax/TermPrinter.hs‎

Lines changed: 18 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -234,19 +234,19 @@ pretty0
234234
Ref' r -> do
235235
env <- ask
236236
let name = elideFQN im $ PrettyPrintEnv.termName env.ppe (Referent.Ref r)
237-
pure . parenIfInfix name ic $ styleHashQualified'' (fmt $ S.TermReference (Referent.Ref r)) name
237+
pure . parenIfInfix name ic $ styleHashQualified'' (fmt $ S.TermReference (PrettyPrintEnv.termFQN env.ppe (Referent.Ref r)) (Referent.Ref r)) name
238238
TermLink' r -> do
239239
env <- ask
240240
let name = elideFQN im $ PrettyPrintEnv.termName env.ppe r
241241
pure . paren (p >= Application) $
242242
fmt S.LinkKeyword "termLink "
243-
<> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TermReference r) name)
243+
<> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TermReference (PrettyPrintEnv.termFQN env.ppe r) r) name)
244244
TypeLink' r -> do
245245
env <- ask
246246
let name = elideFQN im $ PrettyPrintEnv.typeName env.ppe r
247247
pure . paren (p >= Application) $
248248
fmt S.LinkKeyword "typeLink "
249-
<> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TypeReference r) name)
249+
<> parenIfInfix name ic (styleHashQualified'' (fmt $ S.TypeReference (PrettyPrintEnv.typeFQN env.ppe r) r) name)
250250
Ann' tm t -> do
251251
tm' <- pretty0 (ac Application Normal im doc) tm
252252
tp' <- TypePrinter.pretty0 im 0 t
@@ -289,12 +289,12 @@ pretty0
289289
env <- ask
290290
let name = elideFQN im $ PrettyPrintEnv.termName env.ppe conRef
291291
conRef = Referent.Con ref CT.Data
292-
pure $ styleHashQualified'' (fmt $ S.TermReference conRef) name
292+
pure $ styleHashQualified'' (fmt $ S.TermReference (PrettyPrintEnv.termFQN env.ppe conRef) conRef) name
293293
Request' ref -> do
294294
env <- ask
295295
let name = elideFQN im $ PrettyPrintEnv.termName env.ppe conRef
296296
conRef = Referent.Con ref CT.Effect
297-
pure $ styleHashQualified'' (fmt $ S.TermReference conRef) name
297+
pure $ styleHashQualified'' (fmt $ S.TermReference (PrettyPrintEnv.termFQN env.ppe conRef) conRef) name
298298
Handle' h body -> do
299299
pb <- pretty0 (ac Annotation Block im doc) body
300300
ph <- pretty0 (ac Annotation Block im doc) h
@@ -340,7 +340,8 @@ pretty0
340340
pure . paren (p > Control) $
341341
fmt S.ControlKeyword "do" `hang` PP.lines (uses <> [PP.indentNAfterNewline indent px])
342342
List' xs -> do
343-
let listLink p = fmt (S.TypeReference Type.listRef) p
343+
env <- ask
344+
let listLink p = fmt (S.TypeReference (PrettyPrintEnv.typeFQN env.ppe Type.listRef) Type.listRef) p
344345
let comma = listLink ", " `PP.orElse` ("\n" <> listLink ", ")
345346
pelems <- traverse (fmap (PP.indentNAfterNewline 2) . pretty0 (ac Annotation Normal im doc)) xs
346347
let open = listLink "[" `PP.orElse` listLink "[ "
@@ -543,13 +544,14 @@ pretty0
543544
let conRef = DD.pairCtorRef
544545
env <- ask
545546
let name = elideFQN im (PrettyPrintEnv.termName env.ppe conRef)
546-
let pair = parenIfInfix name ic $ styleHashQualified'' (fmt (S.TermReference conRef)) name
547+
let pair = parenIfInfix name ic $ styleHashQualified'' (fmt (S.TermReference (PrettyPrintEnv.termFQN env.ppe conRef) conRef)) name
547548
x' <- pretty0 (ac Application Normal im doc) x
548549
pure . paren (p >= Application) $
549550
pair
550-
`PP.hang` PP.spaced [x', fmt (S.TermReference DD.unitCtorRef) "()"]
551+
`PP.hang` PP.spaced [x', fmt (S.TermReference (PrettyPrintEnv.termFQN env.ppe DD.unitCtorRef) DD.unitCtorRef) "()"]
551552
(TupleTerm' xs, _) -> do
552-
let tupleLink p = fmt (S.TypeReference DD.pairRef) p
553+
env <- ask
554+
let tupleLink p = fmt (S.TypeReference (PrettyPrintEnv.typeFQN env.ppe DD.pairRef) DD.pairRef) p
553555
let comma = tupleLink ", " `PP.orElse` ("\n" <> tupleLink ", ")
554556
pelems <- traverse (fmap (PP.indentNAfterNewline 2) . goNormal Annotation) xs
555557
let clist = PP.sep comma pelems
@@ -744,7 +746,7 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of
744746
let (pats_printed, tail_vs) = patterns Bottom vs pats
745747
in (PP.parenthesizeCommas pats_printed, tail_vs)
746748
Pattern.Constructor _ ref [] ->
747-
(styleHashQualified'' (fmt $ S.TermReference conRef) name, vs)
749+
(styleHashQualified'' (fmt $ S.TermReference (PrettyPrintEnv.termFQN n conRef) conRef) name, vs)
748750
where
749751
name = elideFQN im $ PrettyPrintEnv.termName n conRef
750752
conRef = Referent.Con ref CT.Data
@@ -753,7 +755,7 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of
753755
name = elideFQN im $ PrettyPrintEnv.termName n conRef
754756
conRef = Referent.Con ref CT.Data
755757
in ( paren (p >= Application) $
756-
styleHashQualified'' (fmt $ S.TermReference conRef) name
758+
styleHashQualified'' (fmt $ S.TermReference (PrettyPrintEnv.termFQN n conRef) conRef) name
757759
`PP.hang` pats_printed,
758760
tail_vs
759761
)
@@ -774,7 +776,7 @@ prettyPattern n c@AmbientContext {imports = im} p vs patt = case patt of
774776
in ( PP.group
775777
( PP.sep " " . PP.nonEmpty $
776778
[ fmt S.DelimiterChar "{",
777-
styleHashQualified'' (fmt (S.TermReference conRef)) name,
779+
styleHashQualified'' (fmt (S.TermReference (PrettyPrintEnv.termFQN n conRef) conRef)) name,
778780
pats_printed,
779781
fmt S.ControlKeyword "->",
780782
k_pat_printed,
@@ -1121,9 +1123,9 @@ prettyDoc n im term =
11211123
go (DD.DocJoin segs) = foldMap go segs
11221124
go (DD.DocBlob txt) = PP.paragraphyText (escaped txt)
11231125
go (DD.DocLink (DD.LinkTerm (TermLink' r))) =
1124-
curlyRef . fmt (S.TermReference r) $ fmtTerm r
1126+
curlyRef . fmt (S.TermReference (PrettyPrintEnv.termFQN n r) r) $ fmtTerm r
11251127
go (DD.DocLink (DD.LinkType (TypeLink' r))) =
1126-
curlyRef $ fmt S.DocKeyword (l "type ") <> fmt (S.TypeReference r) (fmtType r)
1128+
curlyRef $ fmt S.DocKeyword (l "type ") <> fmt (S.TypeReference (PrettyPrintEnv.typeFQN n r) r) (fmtType r)
11271129
go (DD.DocSource (DD.LinkTerm (TermLink' r))) =
11281130
atKeyword "source" $ fmtTerm r
11291131
go (DD.DocSource (DD.LinkType (TypeLink' r))) =
@@ -2060,8 +2062,8 @@ prettyDoc2 ac tm = do
20602062
tm -> bail tm
20612063
where
20622064
im = imports ac
2063-
tyName r = styleHashQualified'' (fmt $ S.TypeReference r) . elideFQN im $ PrettyPrintEnv.typeName env.ppe r
2064-
tmName r = styleHashQualified'' (fmt $ S.TermReference r) . elideFQN im $ PrettyPrintEnv.termName env.ppe r
2065+
tyName r = styleHashQualified'' (fmt $ S.TypeReference (PrettyPrintEnv.typeFQN env.ppe r) r) . elideFQN im $ PrettyPrintEnv.typeName env.ppe r
2066+
tmName r = styleHashQualified'' (fmt $ S.TermReference (PrettyPrintEnv.termFQN env.ppe r) r) . elideFQN im $ PrettyPrintEnv.termName env.ppe r
20652067
rec = go hdr
20662068
sepBlankline = intercalateMapM "\n\n" rec
20672069
case tm of

‎parser-typechecker/src/Unison/Syntax/TypePrinter.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -99,7 +99,7 @@ prettyRaw im p tp = go im p tp
9999
-- Would be nice to use a different SyntaxHighlights color if the reference is an ability.
100100
Ref' r -> do
101101
env <- ask
102-
pure $ styleHashQualified'' (fmt $ S.TypeReference r) $ elideFQN im (PrettyPrintEnv.typeName env.ppe r)
102+
pure $ styleHashQualified'' (fmt $ S.TypeReference (PrettyPrintEnv.typeFQN env.ppe r) r) $ elideFQN im (PrettyPrintEnv.typeName env.ppe r)
103103
Cycle' _ _ -> pure $ fromString "bug: TypeParser does not currently emit Cycle"
104104
Abs' _ -> pure $ fromString "bug: TypeParser does not currently emit Abs"
105105
Ann' _ _ -> pure $ fromString "bug: TypeParser does not currently emit Ann"
@@ -205,7 +205,7 @@ prettySignaturesST ppe ts =
205205
PP.align . runPretty ppe $ traverse (\(r, hq, typ) -> (name r hq,) <$> sig typ) ts
206206
where
207207
name r hq =
208-
styleHashQualified'' (fmt $ S.TermReference r) hq
208+
styleHashQualified'' (fmt $ S.TermReference (PrettyPrintEnv.termFQN ppe r) r) hq
209209
sig typ = do
210210
t <- pretty0 Map.empty (-1) typ
211211
let col = fmt S.TypeAscriptionColon ": "

‎unison-cli/src/Unison/CommandLine/DisplayValues.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -345,13 +345,13 @@ displayDoc pped terms typeOf evaluated types = go
345345
termName :: PPE.PrettyPrintEnv -> Referent -> Pretty
346346
termName ppe r =
347347
P.syntaxToColor $
348-
NP.styleHashQualified'' (NP.fmt $ S.TermReference r) name
348+
NP.styleHashQualified'' (NP.fmt $ S.TermReference (PPE.termFQN ppe r) r) name
349349
where
350350
name = PPE.termName ppe r
351351

352352
typeName :: PPE.PrettyPrintEnv -> Reference -> Pretty
353353
typeName ppe r =
354354
P.syntaxToColor $
355-
NP.styleHashQualified'' (NP.fmt $ S.TypeReference r) name
355+
NP.styleHashQualified'' (NP.fmt $ S.TypeReference (PPE.typeFQN ppe r) r) name
356356
where
357357
name = PPE.typeName ppe r

‎unison-share-api/src/Unison/Server/Backend/DefinitionDiff.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -176,10 +176,10 @@ semanticLinewiseDiff (AnnotatedText lhs) (AnnotatedText rhs) =
176176
where
177177
elementHash :: Syntax.Element -> Maybe Syntax.UnisonHash
178178
elementHash = \case
179-
Syntax.TypeReference hash -> Just hash
180-
Syntax.TermReference hash -> Just hash
181-
Syntax.DataConstructorReference hash -> Just hash
182-
Syntax.AbilityConstructorReference hash -> Just hash
179+
Syntax.TypeReference _fqn hash -> Just hash
180+
Syntax.TermReference _fqn hash -> Just hash
181+
Syntax.DataConstructorReference _fqn hash -> Just hash
182+
Syntax.AbilityConstructorReference _fqn hash -> Just hash
183183
_ -> Nothing
184184

185185
-- Collapse subsequent chunks of the same kind of diff into one chunk.

‎unison-share-api/src/Unison/Server/Doc.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -193,9 +193,9 @@ renderDoc pped doc = renderSpecial <$> doc
193193
ELink ref ->
194194
let ppe = PPE.suffixifiedPPE pped
195195
tm :: Referent -> P.Pretty SSyntaxText
196-
tm r = (NP.styleHashQualified'' (NP.fmt (S.TermReference r)) . PPE.termName ppe) r
196+
tm r = (NP.styleHashQualified'' (NP.fmt (S.TermReference (PPE.termFQN ppe r) r)) . PPE.termName ppe) r
197197
ty :: Reference -> P.Pretty SSyntaxText
198-
ty r = (NP.styleHashQualified'' (NP.fmt (S.TypeReference r)) . PPE.typeName ppe) r
198+
ty r = (NP.styleHashQualified'' (NP.fmt (S.TypeReference (PPE.typeFQN ppe r) r)) . PPE.typeName ppe) r
199199
in Link $ case ref of
200200
Left trm -> source trm
201201
Right ld -> case ld of
@@ -232,7 +232,7 @@ renderDoc pped doc = renderSpecial <$> doc
232232
BuiltinDecl r ->
233233
let name =
234234
formatPretty
235-
. NP.styleHashQualified (NP.fmt (S.TypeReference r))
235+
. NP.styleHashQualified (NP.fmt (S.TypeReference (PPE.typeFQN suffixifiedPPE r) r))
236236
. PPE.typeName suffixifiedPPE
237237
$ r
238238
in [Type (Reference.toText r, DO.BuiltinObject name)]

‎unison-share-api/src/Unison/Server/Syntax.hs‎

Lines changed: 25 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ import Unison.Reference (Reference)
2222
import Unison.Reference qualified as Reference
2323
import Unison.Referent qualified as Referent
2424
import Unison.Syntax.HashQualified qualified as HashQualified (toText)
25-
import Unison.Syntax.Name qualified as Name (unsafeParseText)
25+
import Unison.Syntax.Name qualified as Name
2626
import Unison.Syntax.NameSegment qualified as NameSegment (toEscapedText)
2727
import Unison.Util.AnnotatedText
2828
( AnnotatedText (..),
@@ -78,8 +78,8 @@ convertElement = \case
7878
SyntaxText.BooleanLiteral -> BooleanLiteral
7979
SyntaxText.Blank -> Blank
8080
SyntaxText.Var -> Var
81-
SyntaxText.TermReference r -> TermReference $ Referent.toText r
82-
SyntaxText.TypeReference r -> TypeReference $ Reference.toText r
81+
SyntaxText.TermReference fqn r -> TermReference (Name.toText <$> fqn) (Referent.toText r)
82+
SyntaxText.TypeReference fqn r -> TypeReference (Name.toText <$> fqn) (Reference.toText r)
8383
SyntaxText.Op s -> Op s
8484
SyntaxText.AbilityBraces -> AbilityBraces
8585
SyntaxText.ControlKeyword -> ControlKeyword
@@ -105,6 +105,9 @@ type UnisonHash = Text
105105

106106
type HashQualifiedName = Text
107107

108+
-- Fully qualified name, without a hash.
109+
type FQN = Text
110+
108111
-- | The elements of the Unison grammar, for syntax highlighting purposes
109112
data Element
110113
= NumericLiteral
@@ -114,10 +117,10 @@ data Element
114117
| BooleanLiteral
115118
| Blank
116119
| Var
117-
| TypeReference UnisonHash
118-
| DataConstructorReference UnisonHash
119-
| AbilityConstructorReference UnisonHash
120-
| TermReference UnisonHash
120+
| TypeReference (Maybe FQN) UnisonHash
121+
| DataConstructorReference (Maybe FQN) UnisonHash
122+
| AbilityConstructorReference (Maybe FQN) UnisonHash
123+
| TermReference (Maybe FQN) UnisonHash
121124
| Op SeqOp
122125
| -- | Constructor Are these even used?
123126
-- | Request
@@ -162,11 +165,11 @@ instance ToJSON Element where
162165
BooleanLiteral -> object ["tag" .= String "BooleanLiteral"]
163166
Blank -> object ["tag" .= String "Blank"]
164167
Var -> object ["tag" .= String "Var"]
165-
TypeReference r -> object ["tag" .= String "TypeReference", "contents" .= r]
166-
DataConstructorReference r ->
167-
object ["tag" .= String "DataConstructorReference", "contents" .= r]
168-
AbilityConstructorReference r -> object ["tag" .= String "AbilityConstructorReference", "contents" .= r]
169-
TermReference r -> object ["tag" .= String "TermReference", "contents" .= r]
168+
TypeReference fqn r -> object ["tag" .= String "TypeReference", "contents" .= r, "fqn" .= fqn]
169+
DataConstructorReference fqn r ->
170+
object ["tag" .= String "DataConstructorReference", "contents" .= r, "fqn" .= fqn]
171+
AbilityConstructorReference fqn r -> object ["tag" .= String "AbilityConstructorReference", "contents" .= r, "fqn" .= fqn]
172+
TermReference fqn r -> object ["tag" .= String "TermReference", "contents" .= r, "fqn" .= fqn]
170173
Op s -> object ["tag" .= String "Op", "contents" .= s]
171174
AbilityBraces -> object ["tag" .= String "AbilityBraces"]
172175
ControlKeyword -> object ["tag" .= String "ControlKeyword"]
@@ -199,10 +202,10 @@ instance FromJSON Element where
199202
"BooleanLiteral" -> pure BooleanLiteral
200203
"Blank" -> pure Blank
201204
"Var" -> pure Var
202-
"TypeReference" -> TypeReference <$> obj .: "contents"
203-
"DataConstructorReference" -> DataConstructorReference <$> obj .: "contents"
204-
"AbilityConstructorReference" -> AbilityConstructorReference <$> obj .: "contents"
205-
"TermReference" -> TermReference <$> obj .: "contents"
205+
"TypeReference" -> TypeReference <$> obj .:? "fqn" <*> obj .: "contents"
206+
"DataConstructorReference" -> DataConstructorReference <$> obj .:? "fqn" <*> obj .: "contents"
207+
"AbilityConstructorReference" -> AbilityConstructorReference <$> obj .:? "fqn" <*> obj .: "contents"
208+
"TermReference" -> TermReference <$> obj .:? "fqn" <*> obj .: "contents"
206209
"Op" -> Op <$> obj .: "contents"
207210
"AbilityBraces" -> pure AbilityBraces
208211
"ControlKeyword" -> pure ControlKeyword
@@ -238,8 +241,8 @@ reference :: SyntaxSegment -> Maybe UnisonHash
238241
reference (Segment _ el) =
239242
let reference' el' =
240243
case el' of
241-
TermReference r -> Just r
242-
TypeReference r -> Just r
244+
TermReference _fqn r -> Just r
245+
TypeReference _fqn r -> Just r
243246
HashQualifier r -> Just r
244247
_ -> Nothing
245248
in el >>= reference'
@@ -278,13 +281,13 @@ segmentToHtml (Segment sText element) =
278281

279282
ref =
280283
case el of
281-
TypeReference h ->
284+
TypeReference _fqn h ->
282285
Just (h, "type")
283-
TermReference h ->
286+
TermReference _fqn h ->
284287
Just (h, "term")
285-
AbilityConstructorReference h ->
288+
AbilityConstructorReference _fqn h ->
286289
Just (h, "ability-constructor")
287-
DataConstructorReference h ->
290+
DataConstructorReference _fqn h ->
288291
Just (h, "data-constructor")
289292
_ ->
290293
Nothing

0 commit comments

Comments
 (0)