Take exhaustiveness checking into consideration when using MonadFailDesugaring

Consider the following code:

import Data.List.NonEmpty (NonEmpty (..))

foo :: Monad m => m (NonEmpty a) -> m a
foo m = do
    (x :| _) <- m
    pure x

It works completely fine on GHC 8.6.1 and doesn't require MonadFail constraint because NonEmpty has only single constructor so there're no other cases in pattern-matching. Howewer, if I rewrite this code using -XPatternSynonyms with {-# COMPLETE #-} pragma, it doesn't work anymore.

{-# LANGUAGE PatternSynonyms #-}

import Data.List.NonEmpty (NonEmpty (..))

newtype Foo a = Foo (NonEmpty a)

pattern (:||) :: a -> [a] -> Foo a
pattern x :|| xs <- Foo (x :| xs)
{-# COMPLETE (:||) #-}

foo :: Monad m => m (Foo a) -> m a
foo m = do
    (x :|| _) <- m
    pure x

And I see the following error:

    • Could not deduce (Control.Monad.Fail.MonadFail m)
        arising from a do statement
        with the failable pattern ‘(x :|| _)’
      from the context: MonadFoo m
        bound by the type signature for:
                   foo :: forall (m :: * -> *) a. MonadFoo m => m (Foo a) -> m a
        at /Users/fenx/haskell/sandbox/Fail.hs:13:1-37
      Possible fix:
        add (Control.Monad.Fail.MonadFail m) to the context of
          the type signature for:
            foo :: forall (m :: * -> *) a. MonadFoo m => m (Foo a) -> m a
    • In a stmt of a 'do' block: (x :|| _) <- m
      In the expression:
        do (x :|| _) <- m
           pure x
      In an equation for ‘foo’:
          foo m
            = do (x :|| _) <- m
                 pure x
   |
15 |     (x :|| _) <- m
   |     ^^^^^^^^^^^^^^

Trac metadata

Trac field	Value
Version	8.6.1
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Compiler
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture