Fix some -Wx-partial warnings

These were uncovered by GHC 9.8, where -Wx-partial is included in -Wall.

deriving-compat.cabal

@@ -148,6 +148,7 @@ library
     cpp-options:       "-DNEW_FUNCTOR_CLASSES"
   else
     build-depends:     base                >= 4.3   && < 4.9
+                     , semigroups          >= 0.6   && < 0.21
 
   if flag(template-haskell-2-11)
     build-depends:     template-haskell    >= 2.11  && < 2.22

src/Data/Bounded/Deriving/Internal.hs

@@ -20,6 +20,8 @@ module Data.Bounded.Deriving.Internal (
     ) where
 
 import Data.Deriving.Internal
+import qualified Data.List.NonEmpty as NE
+import Data.List.NonEmpty (NonEmpty(..))
 
 import Language.Haskell.TH.Datatype
 import Language.Haskell.TH.Lib
@@ -90,7 +92,7 @@ makeBoundedFun bf name = do
 -- given constructors. All constructors must be from the same type.
 makeBoundedFunForCons :: BoundedFun -> Name -> [ConstructorInfo] -> Q Exp
 makeBoundedFunForCons _  _      [] = noConstructorsError
-makeBoundedFunForCons bf tyName cons
+makeBoundedFunForCons bf tyName (con:cons')
     | not (isProduct || isEnumeration)
     = enumerationOrProductError $ nameBase tyName
     | isEnumeration
@@ -102,9 +104,12 @@ makeBoundedFunForCons bf tyName cons
     isProduct     = isProductType cons
     isEnumeration = isEnumerationType cons
 
+    cons :: NonEmpty ConstructorInfo
+    cons = con :| cons'
+
     con1, conN :: Q Exp
-    con1 = conE $ constructorName $ head cons
-    conN = conE $ constructorName $ last cons
+    con1 = conE $ constructorName con
+    conN = conE $ constructorName $ NE.last cons
 
     pickCon :: Q Exp
     pickCon = case bf of
@@ -114,7 +119,7 @@ makeBoundedFunForCons bf tyName cons
     pickConApp :: Q Exp
     pickConApp = appsE
                $ pickCon
-               : map varE (replicate (conArity $ head cons) (boundedFunName bf))
+               : map varE (replicate (conArity con) (boundedFunName bf))
 
 -------------------------------------------------------------------------------
 -- Class-specific constants

src/Data/Deriving/Internal.hs

@@ -42,6 +42,7 @@ import           Data.Functor.Classes
                    )
 #endif
 import qualified Data.List as List
+import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Map as Map
 import           Data.Map (Map)
 import           Data.Maybe
@@ -824,15 +825,14 @@ conArity :: ConstructorInfo -> Int
 conArity (ConstructorInfo { constructorFields = tys }) = length tys
 
 -- | Returns 'True' if it's a datatype with exactly one, non-existential constructor.
-isProductType :: [ConstructorInfo] -> Bool
-isProductType [con] = null (constructorVars con)
-isProductType _     = False
+isProductType :: NonEmpty ConstructorInfo -> Bool
+isProductType (con :| []) = null (constructorVars con)
+isProductType _           = False
 
 -- | Returns 'True' if it's a datatype with one or more nullary, non-GADT
 -- constructors.
-isEnumerationType :: [ConstructorInfo] -> Bool
-isEnumerationType cons@(_:_) = all (App.liftA2 (&&) isNullaryCon isVanillaCon) cons
-isEnumerationType _          = False
+isEnumerationType :: NonEmpty ConstructorInfo -> Bool
+isEnumerationType cons = F.all (App.liftA2 (&&) isNullaryCon isVanillaCon) cons
 
 -- | Returns 'False' if we're dealing with existential quantification or GADTs.
 isVanillaCon :: ConstructorInfo -> Bool

src/Data/Enum/Deriving/Internal.hs

@@ -22,6 +22,7 @@ module Data.Enum.Deriving.Internal (
     ) where
 
 import Data.Deriving.Internal
+import Data.List.NonEmpty (NonEmpty(..))
 
 import Language.Haskell.TH.Datatype
 import Language.Haskell.TH.Lib
@@ -116,7 +117,7 @@ makeEnumFun ef name = do
 -- given constructors. All constructors must be from the same type.
 makeEnumFunForCons :: EnumFun -> Name -> Type -> [ConstructorInfo] -> Q Exp
 makeEnumFunForCons _  _      _  [] = noConstructorsError
-makeEnumFunForCons ef tyName ty cons
+makeEnumFunForCons ef tyName ty (con:cons')
     | not $ isEnumerationType cons
     = enumerationError tyNameBase
     | otherwise = case ef of
@@ -173,6 +174,9 @@ makeEnumFunForCons ef tyName ty cons
     tyNameBase :: String
     tyNameBase = nameBase tyName
 
+    cons :: NonEmpty ConstructorInfo
+    cons = con :| cons'
+
     maxTagExpr :: Q Exp
     maxTagExpr = integerE (length cons - 1) `sigE` conT intTypeName
 

src/Data/Ix/Deriving/Internal.hs

@@ -19,6 +19,7 @@ module Data.Ix.Deriving.Internal (
     ) where
 
 import Data.Deriving.Internal
+import Data.List.NonEmpty (NonEmpty(..))
 
 import Language.Haskell.TH.Datatype
 import Language.Haskell.TH.Lib
@@ -95,7 +96,7 @@ makeIxFun ixf name = do
 -- given constructors. All constructors must be from the same type.
 makeIxFunForCons :: IxFun -> Name -> Type -> [ConstructorInfo] -> Q Exp
 makeIxFunForCons _   _      _  [] = noConstructorsError
-makeIxFunForCons ixf tyName ty cons
+makeIxFunForCons ixf tyName ty (con:cons')
     | not (isProduct || isEnumeration)
     = enumerationOrProductError $ nameBase tyName
     | isEnumeration
@@ -144,10 +145,7 @@ makeIxFunForCons ixf tyName ty cons
                     ]
 
     | otherwise -- It's a product type
-    = do let con :: ConstructorInfo
-             con = head cons
-
-             conName :: Name
+    = do let conName :: Name
              conName = constructorName con
 
              conFields :: Int
@@ -204,6 +202,9 @@ makeIxFunForCons ixf tyName ty cons
                mkInRange a b c = varE inRangeValName `appE` tupE [varE a, varE b]
                                                      `appE` varE c
   where
+    cons :: NonEmpty ConstructorInfo
+    cons = con :| cons'
+
     isProduct, isEnumeration :: Bool
     isProduct     = isProductType cons
     isEnumeration = isEnumerationType cons

src/Data/Ord/Deriving/Internal.hs

@@ -39,6 +39,8 @@ module Data.Ord.Deriving.Internal (
 
 import           Data.Deriving.Internal
 import           Data.List (partition)
+import qualified Data.List.NonEmpty as NE
+import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Map as Map
 import           Data.Map (Map)
 
@@ -277,10 +279,6 @@ makeOrdFunForCons oFun instTypes cons = do
         singleConType :: Bool
         singleConType = isSingleton cons
 
-        firstConName, lastConName :: Name
-        firstConName = constructorName $ head cons
-        lastConName  = constructorName $ last cons
-
         -- Alternatively, we could look these up from dataConTagMap, but this
         -- is slightly faster due to the lack of Map lookups.
         firstTag, lastTag :: Int
@@ -290,22 +288,30 @@ makeOrdFunForCons oFun instTypes cons = do
         dataConTagMap :: Map Name Int
         dataConTagMap = Map.fromList $ zip (map constructorName cons) [0..]
 
-        ordMatches :: ConstructorInfo -> Q Match
-        ordMatches = makeOrdFunForCon oFun v2 v2Hash tvMap singleConType
-                                      firstTag firstConName lastTag lastConName
-                                      dataConTagMap
-
         ordFunRhs :: Q Exp
-        ordFunRhs
-          | null cons
-          = conE eqDataName
+        ordFunRhs =
+          case cons of
+            [] -> conE eqDataName
+            c:cs -> ordFunRhsNonEmptyCons (c :| cs)
+
+        ordFunRhsNonEmptyCons :: NonEmpty ConstructorInfo -> Q Exp
+        ordFunRhsNonEmptyCons cs@(c :| _)
           | length nullaryCons <= 2
-          = caseE (varE v1) $ map ordMatches cons
+          = caseE (varE v1) $ map ordMatches $ NE.toList cs
           | null nonNullaryCons
           = mkTagCmp
           | otherwise
           = caseE (varE v1) $ map ordMatches nonNullaryCons
                 ++ [match wildP (normalB mkTagCmp) []]
+          where
+            firstConName, lastConName :: Name
+            firstConName = constructorName c
+            lastConName  = constructorName $ NE.last cs
+
+            ordMatches :: ConstructorInfo -> Q Match
+            ordMatches = makeOrdFunForCon oFun v2 v2Hash tvMap singleConType
+                                          firstTag firstConName lastTag lastConName
+                                          dataConTagMap
 
         mkTagCmp :: Q Exp
         mkTagCmp = untagExpr [(v1, v1Hash), (v2, v2Hash)] $