lib/Database/PostgreSQL/Opium.hs

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

lib/Database/PostgreSQL/Opium/FromRow.hs

@@ -83,17 +83,6 @@ 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'.
@@ -102,18 +91,28 @@ 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 + NumberOfMembers f) g) => FromRow' n (f :*: g) where
-  fromRow' FRProxy ctx row = (:*:) <$> fromRow' @n FRProxy ctx row <*> fromRow' @(n + NumberOfMembers f) FRProxy ctx row
+instance (FromRow' n f, FromRow' (n + Members 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 + 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
@@ -121,6 +120,8 @@ 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 -Wextra
+    ghc-options: -Wall
 
 library
     -- Import common warning flags.