Move record member counting out of FromRow' into its own type family

lib/Database/PostgreSQL/Opium.hs

@@ -1,10 +1,6 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Database.PostgreSQL.Opium

lib/Database/PostgreSQL/Opium/FromRow.hs

@@ -83,6 +83,17 @@ instance {-# OVERLAPPABLE #-} (FromField t, KnownSymbol nameSym) => GetColumnTab
 instance {-# OVERLAPPING #-} (KnownSymbol nameSym, FromField t) => GetColumnTable' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 (Maybe t))) where
   getColumnTable' Proxy = checkColumn @t Proxy $ symbolVal @nameSym Proxy
 
+-- | Number of members in the generic representation of a record type (doesn't support sum types).
+type family NumberOfMembers f where
+  -- The data type itself has as many members as the type that it defines.
+  NumberOfMembers (M1 D _ f) = NumberOfMembers f
+  -- The constructor has as many members as the type that it contains.
+  NumberOfMembers (M1 C _ f) = NumberOfMembers f
+  -- A product type has as many types as its subtypes have together.
+  NumberOfMembers (f :*: g) = NumberOfMembers f + NumberOfMembers g
+  -- A selector has/is exactly one member.
+  NumberOfMembers (M1 S _ f) = 1
+
 -- | State kept for a call to 'fromRow'.
 data FromRowCtx = FromRowCtx
   Result -- ^ Obtained from 'LibPQ.execParams'.
@@ -91,28 +102,18 @@ data FromRowCtx = FromRowCtx
 data FRProxy (n :: Nat) (f :: Type -> Type) = FRProxy
 
 class FromRow' (n :: Nat) (f :: Type -> Type) where
-  type Members f :: Nat
-
   fromRow' :: FRProxy n f -> FromRowCtx -> Row -> ExceptT Error IO (f p)
 
 instance FromRow' n f => FromRow' n (M1 D c f) where
-  type Members (M1 D c f) = Members f
-
   fromRow' FRProxy ctx row = M1 <$> fromRow' @n FRProxy ctx row
 
 instance FromRow' n f => FromRow' n (M1 C c f) where
-  type Members (M1 C c f) = Members f
-
   fromRow' FRProxy ctx row = M1 <$> fromRow' @n FRProxy ctx row
 
-instance (FromRow' n f, FromRow' (n + Members f) g) => FromRow' n (f :*: g) where
+instance (FromRow' n f, FromRow' (n + NumberOfMembers f) g) => FromRow' n (f :*: g) where
-  type Members (f :*: g) = Members f + Members g
+  fromRow' FRProxy ctx row = (:*:) <$> fromRow' @n FRProxy ctx row <*> fromRow' @(n + NumberOfMembers f) FRProxy ctx row
-
-  fromRow' FRProxy ctx row = (:*:) <$> fromRow' @n FRProxy ctx row <*> fromRow' @(n + Members f) FRProxy ctx row
 
 instance {-# OVERLAPPABLE #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
-  type Members (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) = 1
-
   fromRow' FRProxy = decodeField memberIndex nameText $ \row ->
     maybe (Left $ ErrorUnexpectedNull $ ErrorPosition row nameText) Right
     where
@@ -120,8 +121,6 @@ instance {-# OVERLAPPABLE #-} (KnownNat n, KnownSymbol nameSym, FromField t) =>
       nameText = Text.pack $ symbolVal @nameSym Proxy
 
 instance {-# OVERLAPPING #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 (Maybe t))) where
-  type Members (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 (Maybe t))) = 1
-
   fromRow' FRProxy = decodeField memberIndex nameText $ const pure
     where
       memberIndex = fromIntegral $ natVal @n Proxy

opium.cabal

@@ -52,7 +52,7 @@ build-type:         Simple
 -- extra-source-files:
 
 common warnings
-    ghc-options: -Wall
+    ghc-options: -Wall -Wextra
 
 library
     -- Import common warning flags.