Handle FunctionOrTagUnion types in exhaustiveness checking

We should treat FunctionOrTagUnion types as tag unions for the purposes
of exhautiveness checking.

Closes #4994

crates/compiler/can/src/exhaustive.rs

@@ -10,9 +10,10 @@ use roc_module::ident::{Lowercase, TagIdIntType, TagName};
 use roc_module::symbol::Symbol;
 use roc_region::all::{Loc, Region};
 use roc_types::subs::{
-    Content, FlatType, GetSubsSlice, RedundantMark, Subs, SubsFmtContent, Variable,
+    Content, FlatType, GetSubsSlice, RedundantMark, SortedTagsIterator, Subs, SubsFmtContent,
+    Variable,
 };
-use roc_types::types::AliasKind;
+use roc_types::types::{gather_tags_unsorted_iter, AliasKind};
 
 pub use roc_exhaustive::Context as ExhaustiveContext;
 
@@ -145,9 +146,7 @@ fn index_var(
                 var = *structure;
             }
             Content::Structure(structure) => match structure {
-                FlatType::Func(_, _, _) | FlatType::FunctionOrTagUnion(_, _, _) => {
+                FlatType::Func(_, _, _) => return Err(TypeError),
-                    return Err(TypeError)
-                }
                 FlatType::Apply(Symbol::LIST_LIST, args) => {
                     match (subs.get_subs_slice(*args), ctor) {
                         ([elem_var], IndexCtor::List) => {
@@ -208,6 +207,19 @@ fn index_var(
                     let vars = opt_vars.expect("constructor must be known in the indexable type if we are exhautiveness checking");
                     return Ok(vars);
                 }
+                FlatType::FunctionOrTagUnion(tags, _, _) => {
+                    let tag_ctor = match ctor {
+                        IndexCtor::Tag(name) => name,
+                        _ => {
+                            internal_error!("constructor in a tag union must be tag")
+                        }
+                    };
+
+                    let tags = subs.get_subs_slice(*tags);
+                    debug_assert!(tags.contains(tag_ctor), "constructor must be known in the indexable type if we are exhautiveness checking");
+
+                    return Ok(vec![]);
+                }
                 FlatType::EmptyRecord => {
                     debug_assert!(matches!(ctor, IndexCtor::Record(..)));
                     // If there are optional record fields we don't unify them, but we need to
@@ -616,9 +628,31 @@ fn convert_tag(subs: &Subs, whole_var: Variable, this_tag: &TagName) -> (Union,
 
     use {Content::*, FlatType::*};
 
-    match dealias_tag(subs, content) {
+    let (sorted_tags, ext) = match dealias_tag(subs, content) {
         Structure(TagUnion(tags, ext) | RecursiveTagUnion(_, tags, ext)) => {
             let (sorted_tags, ext) = tags.sorted_iterator_and_ext(subs, *ext);
+            (sorted_tags, ext)
+        }
+        Structure(FunctionOrTagUnion(tags, _, ext)) => {
+            let (ext_tags, ext) = gather_tags_unsorted_iter(subs, Default::default(), *ext)
+                .unwrap_or_else(|_| {
+                    internal_error!("Content is not a tag union: {:?}", subs.dbg(whole_var))
+                });
+            let mut all_tags: Vec<(TagName, &[Variable])> = Vec::with_capacity(tags.len());
+            for tag in subs.get_subs_slice(*tags) {
+                all_tags.push((tag.clone(), &[]));
+            }
+            for (tag, vars) in ext_tags {
+                debug_assert!(vars.is_empty());
+                all_tags.push((tag.clone(), &[]));
+            }
+            (Box::new(all_tags.into_iter()) as SortedTagsIterator, ext)
+        }
+        _ => internal_error!(
+            "Content is not a tag union: {:?}",
+            SubsFmtContent(content, subs)
+        ),
+    };
 
     let mut num_tags = sorted_tags.len();
 
@@ -669,12 +703,6 @@ fn convert_tag(subs: &Subs, whole_var: Variable, this_tag: &TagName) -> (Union,
 
     (union, my_tag_id)
 }
-        _ => internal_error!(
-            "Content is not a tag union: {:?}",
-            SubsFmtContent(content, subs)
-        ),
-    }
-}
 
 pub fn dealias_tag<'a>(subs: &'a Subs, content: &'a Content) -> &'a Content {
     use Content::*;

crates/reporting/tests/test_reporting.rs

@@ -13073,4 +13073,48 @@ I recommend using camelCase. It's the standard style in Roc code!
     Tip: `Natural` does not implement `Encoding`.
     "###
     );
+
+    test_report!(
+        exhaustiveness_check_function_or_tag_union_issue_4994,
+        indoc!(
+            r#"
+            app "test" provides [main] to "./platform"
+
+            x : U8
+
+            ifThenCase =
+                when x is
+                    0 -> Red
+                    1 -> Yellow
+                    2 -> Purple
+                    3 -> Zulip
+                    _ -> Green
+
+            main =
+                when ifThenCase is
+                    Red -> "red"
+                    Green -> "green"
+                    Yellow -> "yellow"
+                    Zulip -> "zulip"
+            "#
+        ),
+        @r###"
+    ── UNSAFE PATTERN ──────────────────────────────────────── /code/proj/Main.roc ─
+
+    This `when` does not cover all the possibilities:
+
+    14│>      when ifThenCase is
+    15│>          Red -> "red"
+    16│>          Green -> "green"
+    17│>          Yellow -> "yellow"
+    18│>          Zulip -> "zulip"
+
+    Other possibilities include:
+
+        Purple
+        _
+
+    I would have to crash if I saw one of those! Add branches for them!
+    "###
+    );
 }