Report invalid extension types during canonicalization

Closes #2541

compiler/can/src/annotation.rs

@@ -375,7 +375,8 @@ fn can_annotation_help(
         As(
             loc_inner,
             _spaces,
-            alias_header @ TypeHeader {
+            alias_header
+            @ TypeHeader {
                 name,
                 vars: loc_vars,
             },
@@ -520,19 +521,16 @@ fn can_annotation_help(
         }
 
         Record { fields, ext } => {
-            let ext_type = match ext {
+            let ext_type = can_extension_type(
-                Some(loc_ann) => can_annotation_help(
+                env,
-                    env,
+                scope,
-                    &loc_ann.value,
+                var_store,
-                    region,
+                introduced_variables,
-                    scope,
+                local_aliases,
-                    var_store,
+                references,
-                    introduced_variables,
+                ext,
-                    local_aliases,
+                roc_problem::can::ExtensionTypeKind::Record,
-                    references,
+            );
-                ),
-                None => Type::EmptyRec,
-            };
 
             if fields.is_empty() {
                 match ext {
@@ -561,19 +559,16 @@ fn can_annotation_help(
             }
         }
         TagUnion { tags, ext, .. } => {
-            let ext_type = match ext {
+            let ext_type = can_extension_type(
-                Some(loc_ann) => can_annotation_help(
+                env,
-                    env,
+                scope,
-                    &loc_ann.value,
+                var_store,
-                    loc_ann.region,
+                introduced_variables,
-                    scope,
+                local_aliases,
-                    var_store,
+                references,
-                    introduced_variables,
+                ext,
-                    local_aliases,
+                roc_problem::can::ExtensionTypeKind::TagUnion,
-                    references,
+            );
-                ),
-                None => Type::EmptyTagUnion,
-            };
 
             if tags.is_empty() {
                 match ext {
@@ -644,6 +639,74 @@ fn can_annotation_help(
     }
 }
 
+#[allow(clippy::too_many_arguments)]
+fn can_extension_type<'a>(
+    env: &mut Env,
+    scope: &mut Scope,
+    var_store: &mut VarStore,
+    introduced_variables: &mut IntroducedVariables,
+    local_aliases: &mut SendMap<Symbol, Alias>,
+    references: &mut MutSet<Symbol>,
+    opt_ext: &Option<&Loc<TypeAnnotation<'a>>>,
+    ext_problem_kind: roc_problem::can::ExtensionTypeKind,
+) -> Type {
+    fn valid_record_ext_type(typ: &Type) -> bool {
+        // Include erroneous types so that we don't overreport errors.
+        matches!(
+            typ,
+            Type::EmptyRec | Type::Record(..) | Type::Variable(..) | Type::Erroneous(..)
+        )
+    }
+    fn valid_tag_ext_type(typ: &Type) -> bool {
+        matches!(
+            typ,
+            Type::EmptyTagUnion | Type::TagUnion(..) | Type::Variable(..) | Type::Erroneous(..)
+        )
+    }
+
+    use roc_problem::can::ExtensionTypeKind;
+
+    let (empty_ext_type, valid_extension_type): (_, fn(&Type) -> bool) = match ext_problem_kind {
+        ExtensionTypeKind::Record => (Type::EmptyRec, valid_record_ext_type),
+        ExtensionTypeKind::TagUnion => (Type::EmptyTagUnion, valid_tag_ext_type),
+    };
+
+    match opt_ext {
+        Some(loc_ann) => {
+            let ext_type = can_annotation_help(
+                env,
+                &loc_ann.value,
+                loc_ann.region,
+                scope,
+                var_store,
+                introduced_variables,
+                local_aliases,
+                references,
+            );
+            if valid_extension_type(&ext_type) {
+                ext_type
+            } else {
+                // Report an error but mark the extension variable to be inferred
+                // so that we're as permissive as possible.
+                //
+                // THEORY: invalid extension types can appear in this position. Otherwise
+                // they would be caught as errors during unification.
+                env.problem(roc_problem::can::Problem::InvalidExtensionType {
+                    region: loc_ann.region,
+                    kind: ext_problem_kind,
+                });
+
+                let var = var_store.fresh();
+
+                introduced_variables.insert_inferred(var);
+
+                Type::Variable(var)
+            }
+        }
+        None => empty_ext_type,
+    }
+}
+
 pub fn instantiate_and_freshen_alias_type(
     var_store: &mut VarStore,
     introduced_variables: &mut IntroducedVariables,

compiler/problem/src/can.rs

@@ -84,6 +84,16 @@ pub enum Problem {
         def_region: Region,
         differing_recursion_region: Region,
     },
+    InvalidExtensionType {
+        region: Region,
+        kind: ExtensionTypeKind,
+    },
+}
+
+#[derive(Clone, Debug, PartialEq)]
+pub enum ExtensionTypeKind {
+    Record,
+    TagUnion,
 }
 
 #[derive(Clone, Debug, PartialEq)]

reporting/src/error/canonicalize.rs

@@ -1,7 +1,9 @@
 use roc_collections::all::MutSet;
 use roc_module::ident::{Ident, Lowercase, ModuleName};
 use roc_problem::can::PrecedenceProblem::BothNonAssociative;
-use roc_problem::can::{BadPattern, FloatErrorKind, IntErrorKind, Problem, RuntimeError};
+use roc_problem::can::{
+    BadPattern, ExtensionTypeKind, FloatErrorKind, IntErrorKind, Problem, RuntimeError,
+};
 use roc_region::all::{LineColumn, LineColumnRegion, LineInfo, Loc, Region};
 use std::path::PathBuf;
 
@@ -33,6 +35,7 @@ const OPAQUE_NOT_DEFINED: &str = "OPAQUE TYPE NOT DEFINED";
 const OPAQUE_DECLARED_OUTSIDE_SCOPE: &str = "OPAQUE TYPE DECLARED OUTSIDE SCOPE";
 const OPAQUE_NOT_APPLIED: &str = "OPAQUE TYPE NOT APPLIED";
 const OPAQUE_OVER_APPLIED: &str = "OPAQUE TYPE APPLIED TO TOO MANY ARGS";
+const INVALID_EXTENSION_TYPE: &str = "INVALID_EXTENSION_TYPE";
 
 pub fn can_problem<'b>(
     alloc: &'b RocDocAllocator<'b>,
@@ -492,6 +495,34 @@ pub fn can_problem<'b>(
             title = NESTED_DATATYPE.to_string();
             severity = Severity::RuntimeError;
         }
+
+        Problem::InvalidExtensionType { region, kind } => {
+            let (kind_str, can_only_contain) = match kind {
+                ExtensionTypeKind::Record => ("record", "a type variable or another record"),
+                ExtensionTypeKind::TagUnion => {
+                    ("tag union", "a type variable or another tag union")
+                }
+            };
+
+            doc = alloc.stack(vec![
+                alloc.concat(vec![
+                    alloc.reflow("This "),
+                    alloc.text(kind_str),
+                    alloc.reflow(" extension type is invalid:"),
+                ]),
+                alloc.region(lines.convert_region(region)),
+                alloc.concat(vec![
+                    alloc.note("A "),
+                    alloc.reflow(kind_str),
+                    alloc.reflow(" extension variable can only contain "),
+                    alloc.reflow(can_only_contain),
+                    alloc.reflow("."),
+                ]),
+            ]);
+
+            title = INVALID_EXTENSION_TYPE.to_string();
+            severity = Severity::RuntimeError;
+        }
     };
 
     Report {

reporting/tests/test_reporting.rs

@@ -8515,4 +8515,54 @@ I need all branches in an `if` to have the same type!
             ),
         )
     }
+
+    #[test]
+    fn invalid_record_extension_type() {
+        report_problem_as(
+            indoc!(
+                r#"
+                f : { x : Nat }U32
+                f
+                "#
+            ),
+            indoc!(
+                r#"
+                ── INVALID_EXTENSION_TYPE ──────────────────────────────────────────────────────
+
+                This record extension type is invalid:
+
+                1│  f : { x : Nat }U32
+                                   ^^^
+
+                Note: A record extension variable can only contain a type variable or
+                another record.
+                "#
+            ),
+        )
+    }
+
+    #[test]
+    fn invalid_tag_extension_type() {
+        report_problem_as(
+            indoc!(
+                r#"
+                f : [ A ]U32
+                f
+                "#
+            ),
+            indoc!(
+                r#"
+                ── INVALID_EXTENSION_TYPE ──────────────────────────────────────────────────────
+
+                This tag union extension type is invalid:
+
+                1│  f : [ A ]U32
+                             ^^^
+
+                Note: A tag union extension variable can only contain a type variable
+                or another tag union.
+                "#
+            ),
+        )
+    }
 }