fix namespace directive + type link case

parser-typechecker/src/Unison/Syntax/TermParser.hs

@@ -123,12 +123,15 @@ typeLink' :: (Monad m, Var v) => P v m (L.Token TypeReference)
 typeLink' = findUniqueType =<< hqPrefixId
 
 findUniqueType :: (Monad m, Var v) => L.Token (HQ.HashQualified Name) -> P v m (L.Token TypeReference)
-findUniqueType id = do
-  ns <- asks names
-  case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of
-    s
-      | Set.size s == 1 -> pure $ const (Set.findMin s) <$> id
-      | otherwise -> customFailure $ UnknownType id s
+findUniqueType id =
+  resolveToLocalNamespacedType id >>= \case
+    Nothing -> do
+      ns <- asks names
+      case Names.lookupHQType Names.IncludeSuffixes (L.payload id) ns of
+        s
+          | Set.size s == 1 -> pure (Set.findMin s <$ id)
+          | otherwise -> customFailure $ UnknownType id s
+    Just ref -> pure (ref <$ id)
 
 termLink' :: (Monad m, Var v) => P v m (L.Token Referent)
 termLink' = do
@@ -160,6 +163,23 @@ link = termLink <|> typeLink
       tok <- termLink'
       pure $ Term.termLink (ann tok) (L.payload tok)
 
+resolveToLocalNamespacedType :: (Monad m, Ord v) => L.Token (HQ.HashQualified Name) -> P v m (Maybe TypeReference)
+resolveToLocalNamespacedType tok =
+  case L.payload tok of
+    HQ.NameOnly name ->
+      asks maybeNamespace >>= \case
+        Nothing -> pure Nothing
+        Just namespace -> do
+          localNames <- asks localNamespacePrefixedTypesAndConstructors
+          pure case Names.lookupHQType Names.ExactName (HQ.NameOnly (Name.joinDot namespace name)) localNames of
+            refs
+              | Set.null refs -> Nothing
+              -- 2+ name case is impossible: we looked up exact names in the locally-bound names. Two bindings
+              -- with the same name would have been a parse error. So, just take the minimum element from the set,
+              -- which we know is a singleton.
+              | otherwise -> Just (Set.findMin refs)
+    _ -> pure Nothing
+
 -- We disallow type annotations and lambdas,
 -- just function application and operators
 blockTerm :: (Monad m, Var v) => TermP v m

unison-src/transcripts/namespace-directive.md

@@ -41,8 +41,8 @@ reference to the name `factorial` within the body of `factorial` is a recursive
 namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the
 bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone).
 
-Here are a few more examples demonstrating that type names, constructor names, and generated record accessor names are
-all properly handled.
+Here are a few more examples demonstrating that type names, constructor names, generated record accessor names, and
+type links are all properly handled.
 
 ```unison
 type longer.foo.Foo = Bar
@@ -66,10 +66,13 @@ refersToBar = cases
 
 refersToQux baz =
   Baz.qux baz + Baz.qux baz
+
+hasTypeLink =
+  {{ {type Foo} }}
 ```
 
 ```ucm
 scratch/main> add
-scratch/main> view RefersToFoo refersToBar refersToQux
+scratch/main> view RefersToFoo refersToBar refersToQux hasTypeLink
 scratch/main> todo
 ```

unison-src/transcripts/namespace-directive.output.md

@@ -84,8 +84,8 @@ reference to the name `factorial` within the body of `factorial` is a recursive
 namespace directive, exact-name-match-wins semantics) or an ambiguous reference (bad, as would be the case if the
 bindings were expanded to `foo.factorial` and `foo.longer.evil.factorial`, but the variables left alone).
 
-Here are a few more examples demonstrating that type names, constructor names, and generated record accessor names are
-all properly handled.
+Here are a few more examples demonstrating that type names, constructor names, generated record accessor names, and
+type links are all properly handled.
 
 ``` unison
 type longer.foo.Foo = Bar
@@ -136,6 +136,9 @@ refersToBar = cases
 
 refersToQux baz =
   Baz.qux baz + Baz.qux baz
+
+hasTypeLink =
+  {{ {type Foo} }}
 ```
 
 ``` ucm
@@ -156,6 +159,7 @@ refersToQux baz =
                            -> foo.Baz
                            ->{g} foo.Baz
       foo.Baz.qux.set    : Nat -> foo.Baz -> foo.Baz
+      foo.hasTypeLink    : Doc2
       foo.refersToBar    : foo.Foo -> Nat
       foo.refersToQux    : foo.Baz -> Nat
 
@@ -173,13 +177,17 @@ scratch/main> add
                          -> foo.Baz
                          ->{g} foo.Baz
     foo.Baz.qux.set    : Nat -> foo.Baz -> foo.Baz
+    foo.hasTypeLink    : Doc2
     foo.refersToBar    : foo.Foo -> Nat
     foo.refersToQux    : foo.Baz -> Nat
 
-scratch/main> view RefersToFoo refersToBar refersToQux
+scratch/main> view RefersToFoo refersToBar refersToQux hasTypeLink
 
   type foo.RefersToFoo = RefersToFoo foo.Foo
   
+  foo.hasTypeLink : Doc2
+  foo.hasTypeLink = {{ {type foo.Foo} }}
+  
   foo.refersToBar : foo.Foo -> Nat
   foo.refersToBar = cases foo.Foo.Bar -> 17