Improve pre-empty-case situation

generic-deriving.cabal

@@ -119,6 +119,7 @@ library
                         Generics.Deriving.Monoid.Internal
                         Generics.Deriving.Semigroup.Internal
                         Generics.Deriving.TH.Internal
+                        Generics.Deriving.Absurd
                         Paths_generic_deriving
   if flag(base-4-9)
     build-depends:      base >= 4.9 && < 5

src/Generics/Deriving/Absurd.hs

@@ -0,0 +1,24 @@
+{-# language CPP #-}
+#if __GLASGOW_HASKELL__ >= 708
+{-# language EmptyCase #-}
+#endif
+module Generics.Deriving.Absurd where
+import GHC.Generics
+#if __GLASGOW_HASKELL__ < 708
+import GHC.Conc (pseq)
+#endif
+
+absurd1 :: V1 a -> b
+absurd1 x =
+#if __GLASGOW_HASKELL__ >= 708
+  case x of {}
+#else
+  -- Using pseq instead of seq or a bang pattern guarantees
+  -- that the impossible error will never be reached.
+  pseq x impossible
+#endif
+{-# INLINE absurd1 #-}
+
+impossible :: a
+impossible = error "Utterly impossible"
+{-# NOINLINE impossible #-}

src/Generics/Deriving/Functor.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -13,10 +12,6 @@
 {-# LANGUAGE PolyKinds #-}
 #endif
 
-#if __GLASGOW_HASKELL__ >= 708
-{-# LANGUAGE EmptyCase #-}
-#endif
-
 #if __GLASGOW_HASKELL__ >= 710
 {-# LANGUAGE Safe #-}
 #elif __GLASGOW_HASKELL__ >= 701
@@ -69,6 +64,8 @@ import qualified Data.Semigroup as Semigroup (First, Last)
 import           Data.Semigroup (Arg, Max, Min, WrappedMonoid)
 #endif
 
+import           Generics.Deriving.Absurd (absurd1)
+
 --------------------------------------------------------------------------------
 -- Generic fmap
 --------------------------------------------------------------------------------
@@ -77,12 +74,7 @@ class GFunctor' f where
   gmap' :: (a -> b) -> f a -> f b
 
 instance GFunctor' V1 where
-  gmap' _ x = case x of
-#if __GLASGOW_HASKELL__ >= 708
-                {}
-#else
-                !_ -> error "Void gmap"
-#endif
+  gmap' _ x = absurd1 x
 
 instance GFunctor' U1 where
   gmap' _ U1 = U1

src/Generics/Deriving/Show.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -12,10 +11,6 @@
 {-# LANGUAGE Trustworthy #-}
 #endif
 
-#if __GLASGOW_HASKELL__ >= 708
-{-# LANGUAGE EmptyCase #-}
-#endif
-
 module Generics.Deriving.Show (
   -- * Generic show class
     GShow(..)
@@ -42,6 +37,7 @@ import           Foreign.ForeignPtr (ForeignPtr)
 import           Foreign.Ptr
 
 import           Generics.Deriving.Base
+import           Generics.Deriving.Absurd (absurd1)
 
 import           GHC.Exts hiding (Any)
 
@@ -91,12 +87,7 @@ class GShow' f where
   isNullary = error "generic show (isNullary): unnecessary case"
 
 instance GShow' V1 where
-  gshowsPrec' _ _ x = case x of
-#if __GLASGOW_HASKELL__ >= 708
-                        {}
-#else
-                        !_ -> error "Void gshowsPrec"
-#endif
+  gshowsPrec' _ _ x = absurd1 x
 
 instance GShow' U1 where
   gshowsPrec' _ _ U1 = id

src/Generics/Deriving/Traversable.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -13,10 +12,6 @@
 {-# LANGUAGE PolyKinds #-}
 #endif
 
-#if __GLASGOW_HASKELL__ >= 708
-{-# LANGUAGE EmptyCase #-}
-#endif
-
 #if __GLASGOW_HASKELL__ >= 710
 {-# LANGUAGE Safe #-}
 #elif __GLASGOW_HASKELL__ >= 701
@@ -46,6 +41,7 @@ import           Data.Monoid (Dual)
 import           Generics.Deriving.Base
 import           Generics.Deriving.Foldable
 import           Generics.Deriving.Functor
+import           Generics.Deriving.Absurd
 
 #if MIN_VERSION_base(4,4,0)
 import           Data.Complex (Complex)
@@ -81,12 +77,7 @@ class GTraversable' t where
   gtraverse' :: Applicative f => (a -> f b) -> t a -> f (t b)
 
 instance GTraversable' V1 where
-  gtraverse' _ x = pure $ case x of
-#if __GLASGOW_HASKELL__ >= 708
-                            {}
-#else
-                            !_ -> error "Void gtraverse"
-#endif
+  gtraverse' _ x = absurd1 x
 
 instance GTraversable' U1 where
   gtraverse' _ U1 = pure U1