Detect missing 'do' and provide a hint

Author: ChrisPenner

parser-typechecker/src/Unison/PrintError.hs

@@ -64,6 +64,7 @@ import Unison.Syntax.TermPrinter qualified as TermPrinter
 import Unison.Term qualified as Term
 import Unison.Type (Type)
 import Unison.Type qualified as Type
+import Unison.Typechecker qualified as Typechecker
 import Unison.Typechecker.Context qualified as C
 import Unison.Typechecker.TypeError
 import Unison.Typechecker.TypeVar qualified as TypeVar
@@ -369,7 +370,7 @@ renderTypeError e env src = case e of
   Mismatch {..} ->
     mconcat
       [ Pr.lines
-          [ "I found a value of type:  " <> style Type1 (renderType' env foundLeaf),
+          [ "I found a value of type:   " <> style Type1 (renderType' env foundLeaf),
             "where I expected to find:  " <> style Type2 (renderType' env expectedLeaf)
           ],
         "\n\n",
@@ -387,6 +388,7 @@ renderTypeError e env src = case e of
           src
           [styleAnnotated Type1 foundLeaf]
           [styleAnnotated Type2 expectedLeaf],
+        missingDelayHint,
         unitHint,
         intLiteralSyntaxTip mismatchSite expectedType,
         debugNoteLoc
@@ -407,6 +409,20 @@ renderTypeError e env src = case e of
         debugSummary note
       ]
     where
+      missingDelayHint = case Typechecker.isMismatchMissingDelay foundType expectedType of
+        Nothing -> ""
+        Just (Left _) ->
+          Pr.lines
+            [ "I expected the expression to be delayed, but it was not.",
+              "Are you missing a `do`?"
+            ]
+        Just (Right _) ->
+          Pr.lines
+            [ "",
+              "I didn't expect this expression to be delayed, but it was.",
+              "Are you using a `do` where you don't need one,",
+              "or are you missing a `()` to force an expression?"
+            ]
       unitHintMsg =
         "\nHint: Actions within a block must have type "
           <> style Type2 (renderType' env expectedLeaf)

parser-typechecker/src/Unison/Typechecker.hs

@@ -10,6 +10,7 @@ module Unison.Typechecker
     isEqual,
     isSubtype,
     fitsScheme,
+    isMismatchMissingDelay,
     Env (..),
     Notes (..),
     Resolution (..),
@@ -38,6 +39,7 @@ import Data.Text qualified as Text
 import Data.Tuple qualified as Tuple
 import Unison.ABT qualified as ABT
 import Unison.Blank qualified as B
+import Unison.Builtin.Decls qualified as BuiltinDecls
 import Unison.Codebase.BuiltinAnnotation (BuiltinAnnotation)
 import Unison.Name qualified as Name
 import Unison.Prelude
@@ -48,6 +50,7 @@ import Unison.Syntax.Name qualified as Name (unsafeParseText, unsafeParseVar)
 import Unison.Term (Term)
 import Unison.Term qualified as Term
 import Unison.Type (Type)
+import Unison.Type qualified as Type
 import Unison.Typechecker.Context qualified as Context
 import Unison.Typechecker.TypeLookup qualified as TL
 import Unison.Typechecker.TypeVar qualified as TypeVar
@@ -405,3 +408,13 @@ wellTyped ppe env term = go <$> runResultT (synthesize ppe Context.PatternMatchC
 -- `forall a b . a -> b -> a` to be different types
 -- equals :: Var v => Type v -> Type v -> Bool
 -- equals t1 t2 = isSubtype t1 t2 && isSubtype t2 t1
+
+-- | Checks if the mismatch between two types is due to a missing delay, if so returns a tag for which type is
+-- missing the delay
+isMismatchMissingDelay :: (Var v) => Type v loc -> Type v loc -> Maybe (Either (Type v loc) (Type v loc))
+isMismatchMissingDelay typeA typeB
+  | isSubtype (Type.arrow () (Type.ref () BuiltinDecls.unitRef) (typeA $> ())) (typeB $> ()) =
+      Just (Left typeA)
+  | isSubtype (ABT.tm (ABT.tm (Type.Ref BuiltinDecls.unitRef) `Type.Arrow` (typeB $> ()))) (typeA $> ()) =
+      Just (Right typeB)
+  | otherwise = Nothing

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

@@ -62,6 +62,7 @@ import Unison.Syntax.Name qualified as Name
 import Unison.Syntax.Parser qualified as Parser
 import Unison.Syntax.TypePrinter qualified as TypePrinter
 import Unison.Term qualified as Term
+import Unison.Typechecker qualified as Typechecker
 import Unison.Typechecker.Context qualified as Context
 import Unison.Typechecker.TypeError qualified as TypeError
 import Unison.UnisonFile qualified as UF
@@ -224,7 +225,12 @@ analyseNotes codebase fileUri ppe src notes = do
     Result.TypeError errNote@(Context.ErrorNote {cause}) -> do
       let typeErr = TypeError.typeErrorFromNote errNote
           ranges = case typeErr of
-            TypeError.Mismatch {mismatchSite} -> leafNodeRanges "mismatch" mismatchSite
+            TypeError.Mismatch {mismatchSite, foundType, expectedType}
+              | -- If it's a delay mismatch, the error is likely with the block definition (e.g. missing 'do') so we highlight the whole block.
+                Just _ <- Typechecker.isMismatchMissingDelay foundType expectedType ->
+                  singleRange $ ABT.annotation mismatchSite
+              -- Otherwise we highlight the leafe nodes of the block
+              | otherwise -> leafNodeRanges "mismatch" mismatchSite
             TypeError.BooleanMismatch {mismatchSite} -> leafNodeRanges "mismatch" mismatchSite
             TypeError.ExistentialMismatch {mismatchSite} -> leafNodeRanges "mismatch" mismatchSite
             TypeError.FunctionApplication {f} -> singleRange $ ABT.annotation f