Make profunctors -Wincomplete-uni-patterns–clean

[RyanGlScott]

I discovered recently that profunctors will emit warnings when built with -Wincomplete-uni-patterns:

[ 7 of 16] Compiling Data.Profunctor.Choice ( src/Data/Profunctor/Choice.hs, interpreted )

src/Data/Profunctor/Choice.hs:200:45: warning: [-Wincomplete-uni-patterns]
    Pattern match(es) are non-exhaustive
    In a lambda abstraction: Patterns not matched: (Right _)
    |
200 |   proextract (TambaraSum p)   = dimap Left (\(Left a) -> a) p
    |                                             ^^^^^^^^^^^^^^

src/Data/Profunctor/Choice.hs:241:32: warning: [-Wincomplete-uni-patterns]
    Pattern match(es) are non-exhaustive
    In a lambda abstraction: Patterns not matched: (Right _)
    |
241 | untambaraSum f p = dimap Left (\(Left a) -> a) $ runTambaraSum $ f p
    |                                ^^^^^^^^^^^^^^

src/Data/Profunctor/Choice.hs:268:28: warning: [-Wincomplete-uni-patterns]
    Pattern match(es) are non-exhaustive
    In a lambda abstraction: Patterns not matched: (Right _)
    |
268 |   proreturn p = PastroSum (\(Left a)-> a) p Left
    |                            ^^^^^^^^^^^^^

Each -Wincomplete-uni-patterns violation is of a similar nature: GHC is expecting something of type forall a. Either a b0 -> a (where b0 is a skolem type variable quantified by a rank-n field, such as the field in the TambaraSum constructor), so profunctors cuts corners and just uses a quick-and-dirty (\(Left a) -> a) solution. Under most cirumstances, it would be impossible for a function of type forall a. Either a b0 -> a to ever have Right as an argument, but this is possible in Haskell due to ⊥. Here is an example that shows where things go wrong:

module Main where

import Data.Profunctor.Choice
import Data.Profunctor.Monad

f :: TambaraSum (->) Bool Bool
f = TambaraSum $ \x ->
  case x of
    Left  _ -> Right $ error "boom"
    Right r -> Right r

main :: IO ()
main = print $ proextract f True

Unsurprisingly, this program will throw an error at runtime. What is surprising is the exact error it throws. Rather than throwing a "boom" error, this program will fail due to proextract not being exhaustive:

λ> main
*** Exception: src/Data/Profunctor/Choice.hs:200:45-58: Non-exhaustive patterns in lambda

One way to avoid this is to tweak proextract and friends so that it defines a case for Right. For example, here is what a repaired version of proextract might look like:

instance ProfunctorComonad TambaraSum where
  proextract (TambaraSum p) = dimap Left port p
    where
      port :: Either a b -> a
      port (Left a)   = a
      port (Right !_) = error "unreachable"

The only way to supply port with a non-Left argument is to pass it ⊥ or Right ⊥, and port's definition ensures that the bottoms are evaluated in either case. Now the original program will throw a "boom" error, as expected:

λ> main
*** Exception: boom

[RyanGlScott]

Actually, you don't even need to use error "unreachable". This also works:

instance ProfunctorComonad TambaraSum where
  proextract (TambaraSum p) = dimap Left port p
    where
      port :: Either a Void -> a
      port = either id absurd

I like this solution even more. Patch incoming.