Tweak error messages. Add a test case.

parser-typechecker/src/Unison/PrintError.hs

@@ -469,9 +469,16 @@ renderTypeError e env src curPath = case e of
       ]
   AbilityEqFailure {..} ->
     mconcat
-      [ "I could not solve an ability equation when checking the expression ",
+      [ "I found an ability mismatch when checking the expression ",
         describeStyle ErrorSite,
         "\n\n",
+        showSourceMaybes
+          src
+          [ (,Type1) <$> rangeForAnnotated tlhs,
+            (,Type2) <$> rangeForAnnotated trhs,
+            (,ErrorSite) <$> rangeForAnnotated abilityCheckFailureSite
+          ],
+        "\n\n",
         Pr.wrap $
           mconcat
             [ "When trying to match ",
@@ -481,12 +488,12 @@ renderTypeError e env src curPath = case e of
               case (lhs, rhs) of
                 ([], _) ->
                   mconcat
-                    [ "The right hand side contained extra abilities: ",
+                    [ "the right hand side contained extra abilities: ",
                       style Type2 $ "{" <> commas (renderType' env) rhs <> "}"
                     ]
                 (_, []) ->
                   mconcat
-                    [ "The left hand side contained extra abilities: ",
+                    [ "the left hand side contained extra abilities: ",
                       style Type1 $ "{" <> commas (renderType' env) lhs <> "}"
                     ]
                 _ ->
@@ -499,45 +506,45 @@ renderTypeError e env src curPath = case e of
                     ]
             ],
         "\n\n",
-        annotatedAsErrorSite src abilityCheckFailureSite,
         debugSummary note
       ]
   AbilityEqFailureFromAp {..} ->
     mconcat
-      [ "I could not solve an ability equation when checking the application below.",
-        "\n\n",
-        Pr.wrap $
-          mconcat
-            [ "When trying to match ",
-              style Type1 $ renderType' env tlhs,
-              " with ",
-              style Type2 $ renderType' env trhs,
-              case (lhs, rhs) of
-                ([], _) ->
-                  mconcat
-                    [ "The right hand side contained extra abilities: ",
-                      style Type2 $ "{" <> commas (renderType' env) rhs <> "}"
-                    ]
-                (_, []) ->
-                  mconcat
-                    [ "The left hand side contained extra abilities: ",
-                      style Type1 $ "{" <> commas (renderType' env) lhs <> "}"
-                    ]
-                _ ->
-                  mconcat
-                    [ " I could not make ",
-                      style Type1 $ "{" <> commas (renderType' env) lhs <> "}",
-                      " on the left compatible with ",
-                      style Type2 $ "{" <> commas (renderType' env) rhs <> "}",
-                      " on the right."
-                    ]
-            ],
+      [ "I found an ability mismatch when checking the application",
         "\n\n",
         showSourceMaybes
           src
           [ (,Type1) <$> rangeForAnnotated expectedSite,
             (,Type2) <$> rangeForAnnotated mismatchSite
           ],
+        "\n\n",
+        Pr.wrap $
+          mconcat
+            [ "When trying to match ",
+              style Type1 $ renderType' env tlhs,
+              " with ",
+              style Type2 $ renderType' env trhs,
+              case (lhs, rhs) of
+                ([], _) ->
+                  mconcat
+                    [ "the right hand side contained extra abilities: ",
+                      style Type2 $ "{" <> commas (renderType' env) rhs <> "}"
+                    ]
+                (_, []) ->
+                  mconcat
+                    [ "the left hand side contained extra abilities: ",
+                      style Type1 $ "{" <> commas (renderType' env) lhs <> "}"
+                    ]
+                _ ->
+                  mconcat
+                    [ " I could not make ",
+                      style Type1 $ "{" <> commas (renderType' env) lhs <> "}",
+                      " on the left compatible with ",
+                      style Type2 $ "{" <> commas (renderType' env) rhs <> "}",
+                      " on the right."
+                    ]
+            ],
+        "\n\n",
         debugSummary note
       ]
   UnguardedLetRecCycle vs locs _ ->

unison-src/transcripts/fix3037.md

@@ -16,3 +16,17 @@ pureRunner = Runner base.force
 runner : Runner {IO}
 runner = pureRunner
 ```
+
+Application version:
+
+```unison:error
+structural type A g = A (forall a. '{g} a ->{} a)
+
+anA : A {}
+anA = A base.force
+
+h : A {IO} -> ()
+h _ = ()
+
+> h anA
+```

unison-src/transcripts/fix3037.output.md

@@ -15,12 +15,46 @@ runner = pureRunner
 
 ```ucm
 
-  I could not solve an ability equation when checking the expression in red
+  I found an ability mismatch when checking the expression in red
   
-  When trying to match Runner {} with Runner {IO} The right hand
+      3 | pureRunner : Runner {}
+      4 | pureRunner = Runner base.force
+      5 | 
+      6 | -- this compiles, but shouldn't the effect type parameter on Runner be invariant?
+      7 | runner : Runner {IO}
+      8 | runner = pureRunner
+  
+  
+  When trying to match Runner {} with Runner {IO} the right hand
   side contained extra abilities: {IO}
   
-      8 | runner = pureRunner
+  
+
+```
+Application version:
+
+```unison
+structural type A g = A (forall a. '{g} a ->{} a)
+
+anA : A {}
+anA = A base.force
+
+h : A {IO} -> ()
+h _ = ()
+
+> h anA
+```
+
+```ucm
+
+  I found an ability mismatch when checking the application
+  
+      9 | > h anA
+  
+  
+  When trying to match A {} with A {IO} the right hand side
+  contained extra abilities: {IO}
+  
   
 
 ```