First attempt at a better over-application error.

Author: ChrisPenner

parser-typechecker/package.yaml

@@ -11,6 +11,7 @@ library:
       other-modules: Paths_unison_parser_typechecker
 
   dependencies:
+    - recover-rtti
     - ListLike
     - aeson
     - async

parser-typechecker/src/Unison/PrintError.hs

@@ -275,13 +275,34 @@ renderTypeError e env src = case e of
               "need to have the same type."
             ]
   NotFunctionApplication {..} ->
-    mconcat
-      [ "This looks like a function call, but with a ",
-        style Type1 (renderType' env ft),
-        " where the function should be.  Are you missing an operator?\n\n",
-        annotatedAsStyle Type1 src f,
-        debugSummary note
-      ]
+    case Type.arity ft of
+      0 ->
+        mconcat
+          [ "It looks like this expression is being called like a function\n\n",
+            annotatedAsStyle Type2 src f,
+            "\n\n but the thing being applied has the type: ",
+            style Type2 (renderType' env ft),
+            "\n\n",
+            debugSummary note
+          ]
+      arity ->
+        mconcat
+          [ "It looks like this function call\n\n",
+            annotatedAsStyle Type2 src f,
+            "\n\nis being applied to ",
+            Pr.shown (length args),
+            " arguments, but it has the type\n\n",
+            style Type2 (renderType' env ft),
+            "\n\nwhich only accepts ",
+            Pr.shown arity,
+            maybePlural " arguments" arity <> ".\n\n",
+            "Did you apply the function to too many arguments? \n\n",
+            debugSummary note
+          ]
+    where
+      maybePlural word n
+        | n == 1 = word
+        | otherwise = word <> "s"
   FunctionApplication {..} ->
     let fte = Type.removePureEffects False ft
         fteFreeVars = Set.map TypeVar.underlying $ ABT.freeVars fte

parser-typechecker/src/Unison/Typechecker/TypeError.hs

@@ -3,7 +3,9 @@
 module Unison.Typechecker.TypeError where
 
 import Data.List.NonEmpty (NonEmpty)
+import Debug.RecoverRTTI (anythingToString)
 import Unison.ABT qualified as ABT
+import Unison.Debug qualified as Debug
 import Unison.KindInference (KindError)
 import Unison.Pattern (Pattern)
 import Unison.Prelude hiding (whenM)
@@ -58,7 +60,8 @@ data TypeError v loc
   | NotFunctionApplication
       { f :: C.Term v loc,
         ft :: C.Type v loc,
-        note :: C.ErrorNote v loc
+        note :: C.ErrorNote v loc,
+        args :: [C.Term v loc]
       }
   | AbilityCheckFailure
       { ambient :: [C.Type v loc],
@@ -321,15 +324,18 @@ applyingNonFunction :: (Var v) => Ex.ErrorExtractor v loc (TypeError v loc)
 applyingNonFunction = do
   _ <- Ex.typeMismatch
   n <- Ex.errorNote
-  (f, ft) <- Ex.unique $ do
+  Debug.debugM Debug.Temp "NOTE" ("applyingNonFunction" :: Text, anythingToString n)
+  (f, ft, args) <- Ex.unique $ do
     Ex.pathStart
-    (arity0Type, _arg, _argNum) <- Ex.inSynthesizeApp
+    _synthApp <- Ex.inSynthesizeApp
     (_, f, ft, args) <- Ex.inFunctionCall
+    -- for_ funcCalls \(arity0Type, f, ft, _args) -> do
+    --   Debug.debugM Debug.Temp "applyingNonFunction" ("arity0Type: " :: Text, arity0Type, "f: " :: Text, f, "ft: " :: Text, ft, "args" :: Text, args)
     let expectedArgCount = Type.arity ft
         foundArgCount = length args
     -- unexpectedArgLoc = ABT.annotation arg
-    whenM (expectedArgCount < foundArgCount) $ pure (f, arity0Type)
-  pure $ NotFunctionApplication f (Type.cleanup ft) n
+    whenM (expectedArgCount < foundArgCount) $ pure (f, ft, args)
+  pure $ NotFunctionApplication f (Type.cleanup ft) n args
 
 -- | Want to collect this info:
 -- The `n`th argument to `f` is `foundType`, but I was expecting `expectedType`.

parser-typechecker/unison-parser-typechecker.cabal

@@ -219,6 +219,7 @@ library
     , network-uri
     , nonempty-containers
     , pretty-simple
+    , recover-rtti
     , regex-tdfa
     , semialign
     , semigroups