Special error for underapplied functions

Author: ChrisPenner

parser-typechecker/src/Unison/PrintError.hs

@@ -73,6 +73,7 @@ import Unison.Util.AnnotatedText qualified as AT
 import Unison.Util.ColorText (Color)
 import Unison.Util.ColorText qualified as Color
 import Unison.Util.Monoid (intercalateMap)
+import Unison.Util.Monoid qualified as Monoid
 import Unison.Util.Pretty (ColorText, Pretty)
 import Unison.Util.Pretty qualified as Pr
 import Unison.Util.Range (Range (..), startingLine)
@@ -274,6 +275,62 @@ renderTypeError e env src = case e of
               " expression ",
               "need to have the same type."
             ]
+  FunctionUnderApplied {..} ->
+    mconcat
+      [ Pr.lines
+          [ "I found a value  of type:  " <> style Type1 (renderType' env foundLeaf),
+            "where I expected to find:  " <> style Type2 (renderType' env expectedLeaf),
+            "it looks like it might be a function application that's just missing these arguments:\n\n",
+            Monoid.intercalateMap ", " (style Type1 . renderType' env) needArgs
+          ],
+        "\n\n",
+        showSourceMaybes
+          src
+          [ -- these are overwriting the colored ranges for some reason?
+            --   (,Color.ForceShow) <$> rangeForAnnotated mismatchSite
+            -- , (,Color.ForceShow) <$> rangeForType foundType
+            -- , (,Color.ForceShow) <$> rangeForType expectedType
+            -- ,
+            (,Type1) . startingLine <$> (rangeForAnnotated mismatchSite),
+            (,Type2) <$> rangeForAnnotated expectedLeaf
+          ],
+        fromOverHere'
+          src
+          [styleAnnotated Type1 foundLeaf]
+          [styleAnnotated Type2 expectedLeaf],
+        unitHint,
+        intLiteralSyntaxTip mismatchSite expectedType,
+        debugNoteLoc
+          . mconcat
+          $ [ "\nloc debug:",
+              "\n  mismatchSite: ",
+              annotatedToEnglish mismatchSite,
+              "\n     foundType: ",
+              annotatedToEnglish foundType,
+              "\n     foundLeaf: ",
+              annotatedToEnglish foundLeaf,
+              "\n  expectedType: ",
+              annotatedToEnglish expectedType,
+              "\n  expectedLeaf: ",
+              annotatedToEnglish expectedLeaf,
+              "\n"
+            ],
+        debugSummary note
+      ]
+    where
+      unitHintMsg =
+        "\nHint: Actions within a block must have type "
+          <> style Type2 (renderType' env expectedLeaf)
+          <> ".\n"
+          <> "      Use "
+          <> style Type1 "_ = <expr>"
+          <> " to ignore a result."
+      unitHint = if giveUnitHint then unitHintMsg else ""
+      giveUnitHint = case expectedType of
+        Type.Ref' u | u == unitRef -> case mismatchSite of
+          Term.Let1Named' v _ _ -> Var.isAction v
+          _ -> False
+        _ -> False
   NotFunctionApplication {..} ->
     case Type.arity ft of
       0 ->

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

@@ -11,6 +11,7 @@ import Unison.Type (Type)
 import Unison.Type qualified as Type
 import Unison.Typechecker.Context qualified as C
 import Unison.Typechecker.Extractor qualified as Ex
+import Unison.Typechecker.TypeVar (lowerType)
 import Unison.Util.Monoid (whenM)
 import Unison.Var (Var)
 import Prelude hiding (all, and, or)
@@ -61,6 +62,15 @@ data TypeError v loc
         note :: C.ErrorNote v loc,
         args :: [C.Term v loc]
       }
+  | FunctionUnderApplied
+      { foundType :: C.Type v loc, -- overallType1
+        expectedType :: C.Type v loc, -- overallType2
+        foundLeaf :: C.Type v loc, -- leaf1
+        expectedLeaf :: C.Type v loc, -- leaf2
+        mismatchSite :: C.Term v loc,
+        note :: C.ErrorNote v loc,
+        needArgs :: [Type v loc]
+      }
   | AbilityCheckFailure
       { ambient :: [C.Type v loc],
         requested :: [C.Type v loc],
@@ -242,9 +252,27 @@ generalMismatch = do
   n <- Ex.errorNote
   mismatchSite <- Ex.innermostTerm
   ((foundLeaf, expectedLeaf), (foundType, expectedType)) <- firstLastSubtype
+  let mayNeedArgs = findUnderApplication foundLeaf expectedLeaf
+  -- If the found type is a function, and the result of that function matches the expected type,
+  -- it's likely we're missing some arguments from a function.
+
   case Type.cleanups [sub foundType, sub expectedType, sub foundLeaf, sub expectedLeaf] of
-    [ft, et, fl, el] -> pure $ Mismatch ft et fl el mismatchSite n
+    [ft, et, fl, el] ->
+      case mayNeedArgs of
+        Just needArgs ->
+          pure $ FunctionUnderApplied ft et fl el mismatchSite n (lowerType <$> needArgs)
+        Nothing ->
+          pure $ Mismatch ft et fl el mismatchSite n
     _ -> error "generalMismatch: Mismatched type binding"
+  where
+    findUnderApplication found expected
+      | Right True <- C.isSubtype found expected = pure []
+      | otherwise =
+          case found of
+            Type.Arrow' i o -> (i :) <$> findUnderApplication o expected
+            Type.ForallNamed' _ body -> findUnderApplication body expected
+            Type.Effect' _ inner -> findUnderApplication inner expected
+            _ -> Nothing
 
 and,
   or,

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

@@ -278,6 +278,7 @@ analyseNotes fileUri ppe src notes = do
               TypeError.Mismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
               TypeError.BooleanMismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
               TypeError.ExistentialMismatch {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
+              TypeError.FunctionUnderApplied {mismatchSite} -> singleRange $ ABT.annotation mismatchSite
               TypeError.FunctionApplication {f} -> singleRange $ ABT.annotation f
               TypeError.NotFunctionApplication {f} -> singleRange $ ABT.annotation f
               TypeError.AbilityCheckFailure {abilityCheckFailureSite} -> singleRange abilityCheckFailureSite