Fix #17112

The `mkOneConFull` function of the pattern match checker used to try to
guess the type arguments of the data type's type constructor by looking
at the ambient type of the match. This doesn't work well for Pattern
Synonyms, where the result type isn't even necessarily a TyCon
application, and it shows in #11336 and #17112.

Also the effort seems futile; why try to try hard when the type checker
has already done the hard lifting? After this patch, we instead supply
the type constructors arguments as an argument to the function and
lean on the type-annotated AST.

2 files changed, 34 insertions, 0 deletions

diff --git a/testsuite/tests/pmcheck/should_compile/T17112.hs b/testsuite/tests/pmcheck/should_compile/T17112.hs
new file mode 100644
index 0000000000..a6755f71fc
--- /dev/null
+++ b/testsuite/tests/pmcheck/should_compile/T17112.hs
@@ -0,0 +1,32 @@
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FunctionalDependencies #-}
+
+import Data.Functor.Identity
+
+data HideArg f where
+  HideArg :: f a -> HideArg f
+
+data family App :: tF -> tF
+data instance App f x = App1 (f x)
+
+class WrappedIn s a | s -> a where
+  unwrap :: s -> a
+
+instance WrappedIn (App f a) (f a) where
+  unwrap (App1 fa) = fa
+
+pattern Unwrapped :: WrappedIn s a => a -> s
+pattern Unwrapped x <- (unwrap -> x)
+{-# COMPLETE Unwrapped :: App #-}
+
+boom :: HideArg (App Identity) -> Bool
+boom (HideArg (Unwrapped (Identity _))) = True
+
+main :: IO ()
+main = print ":("
diff --git a/testsuite/tests/pmcheck/should_compile/all.T b/testsuite/tests/pmcheck/should_compile/all.T
index 5fe7d9edd1..87874f81c8 100644
--- a/testsuite/tests/pmcheck/should_compile/all.T
+++ b/testsuite/tests/pmcheck/should_compile/all.T
@@ -76,6 +76,8 @@ test('T15884', expect_broken(15884), compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 test('T16289', normal, compile,
      ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
+test('T17112', normal, compile,
+     ['-fwarn-incomplete-patterns -fwarn-overlapping-patterns'])
 
 # Other tests
 test('pmc001', [], compile,