Work-around for Effect annotations bug. (#3789)

* Failing effect list annotation tests

* Workaround for incorrect effect issues

unison-cli/src/Unison/LSP/Queries.hs

@@ -174,7 +174,11 @@ findSmallestEnclosingType pos typ
             ABT.Tm f -> case f of
               Type.Ref {} -> Just typ
               Type.Arrow a b -> findSmallestEnclosingType pos a <|> findSmallestEnclosingType pos b
-              Type.Effect a b -> findSmallestEnclosingType pos a <|> findSmallestEnclosingType pos b
+              Type.Effect effs rhs ->
+                -- There's currently a bug in the annotations for effects which cause them to
+                -- span larger than they should. As  a workaround for now we just make sure to
+                -- search the RHS before the effects.
+                findSmallestEnclosingType pos rhs <|> findSmallestEnclosingType pos effs
               Type.App a b -> findSmallestEnclosingType pos a <|> findSmallestEnclosingType pos b
               Type.Forall r -> findSmallestEnclosingType pos r
               Type.Ann a _kind -> findSmallestEnclosingType pos a

unison-cli/tests/Unison/Test/LSP.hs

@@ -110,6 +110,45 @@ term = let
         True,
         Left (Term.Boolean True)
       ),
+      ( "Test annotations for types with arrows",
+        [here|
+structural type Thing = This | That
+
+term : Thing -> Thing -> Thi^ng
+term a b = This
+        |],
+        True,
+        Right (Type.Ref (Reference.unsafeFromText "#6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0"))
+      ),
+      ( "Test annotations for types with effects",
+        [here|
+unique ability Foo a where
+    foo : a
+
+unique ability Bar b where
+    bar : b
+
+structural type Thing = This | That
+
+term : (Thing -> {Foo a, Bar b} Th^ing) -> {Foo a, Bar b} Thing
+term f = f This
+        |],
+        True,
+        Right (Type.Ref (Reference.unsafeFromText "#6kbe32g06nqg93cqub6ohqc4ql4o49ntgnunifds0t75qre6lacnbsr3evn8bkivj68ecbvmhkbak4dbg4fqertcpgb396rmo34tnh0"))
+      ),
+      ( "Test annotations for effects themselves",
+        [here|
+structural ability Foo a where
+    foo : a
+
+structural type Thing = This | That
+
+term : () -> {F^oo a} Thing
+term _ = This
+        |],
+        True,
+        Right (Type.Ref (Reference.unsafeFromText "#h4uhcub76va4tckj1iccnsb07rh0fhgpigqapb4jh5n07s0tugec4nm2vikuv973mab7oh4ne07o6armcnnl7mbfjtb4imphgrjgimg"))
+      ),
       -- ( "Test annotations for blocks with destructuring binds",
       --   [here|
       -- term = let

unison-core/src/Unison/Type.hs

@@ -279,7 +279,7 @@ mvarRef = Reference.Builtin "MVar"
 tvarRef = Reference.Builtin "TVar"
 
 ticketRef :: Reference
-ticketRef  = Reference.Builtin "Ref.Ticket"
+ticketRef = Reference.Builtin "Ref.Ticket"
 
 promiseRef :: Reference
 promiseRef = Reference.Builtin "Promise"