Bump version

README.md

@@ -33,8 +33,8 @@ data User = User
 
 instance Opium.FromRow User where
 
-getUsers :: Connection -> IO (Either Opium.Error [Users])
-getUsers conn = Opium.fetch_ conn "SELECT * FROM user"
+getUsers :: Connection -> IO (Either Opium.Error [User])
+getUsers = Opium.fetch_ "SELECT * FROM user"
 ```
 
 The `Opium.FromRow` instance is implemented generically for all product types ("records"). It looks up the field name in the query result and decodes the column value using `Opium.FromField`.
@@ -51,7 +51,7 @@ instance Opium.FromRow ScoreByAge where
 getScoreByAge :: Connection -> IO ScoreByAge
 getScoreByAge conn = do
   let query = "SELECT regr_intercept(score, age) AS t, regr_slope(score, age) AS m FROM user"
-  Right [x] <- Opium.fetch_ conn query
+  Right (Identity x) <- Opium.fetch_ query conn
   pure x
 ```
 
@@ -74,4 +74,13 @@ getScoreByAge conn = do
 - [ ] Implement JSON decoding
 - [ ] Implement (anonymous) composite types
 - [ ] Catch [UnicodeException](https://hackage.haskell.org/package/text-2.1/docs/Data-Text-Encoding-Error.html#t:UnicodeException) when decoding text
+    - This might not be necessary if Postgres guarantees us that having a textual OID on a field means that the field is encoded correctly.
 - [ ] Implement array decoding
+- [ ] Better docs and structure for `FromRow` module
+- [ ] Lexer for PostgreSQL that replaces $name by $1, $2, etc.
+- [ ] Tutorial
+    - [ ] Rationale
+    - [ ] `FromRow`
+    - [ ] Custom `FromField` impls
+- [ ] Improve type errors when trying to `instance` a type that isn't a record (e.g. sum type)
+- [ ] Improve documentation for `fromRow` module

flake.lock

@@ -1,23 +1,59 @@
 {
   "nodes": {
-    "nixpkgs": {
+    "flake-utils": {
+      "inputs": {
+        "systems": "systems"
+      },
       "locked": {
-        "lastModified": 1681753173,
-        "narHash": "sha256-MrGmzZWLUqh2VstoikKLFFIELXm/lsf/G9U9zR96VD4=",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "0a4206a51b386e5cda731e8ac78d76ad924c7125",
+        "lastModified": 1731533236,
+        "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
         "type": "github"
       },
       "original": {
-        "id": "nixpkgs",
-        "type": "indirect"
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1752536923,
+        "narHash": "sha256-fdgPZR7VFSSRIQKOJLcs3qCJBWM64Uak0gAGtWTYAd8=",
+        "owner": "nixos",
+        "repo": "nixpkgs",
+        "rev": "c665e4d918eda5d78a175ed8d300809c44932160",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nixos",
+        "ref": "release-25.05",
+        "repo": "nixpkgs",
+        "type": "github"
       }
     },
     "root": {
       "inputs": {
+        "flake-utils": "flake-utils",
         "nixpkgs": "nixpkgs"
       }
+    },
+    "systems": {
+      "locked": {
+        "lastModified": 1681028828,
+        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+        "owner": "nix-systems",
+        "repo": "default",
+        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-systems",
+        "repo": "default",
+        "type": "github"
+      }
     }
   },
   "root": "root",

flake.nix

@@ -1,35 +1,29 @@
 {
   description = "An opionated Postgres library";
 
-  outputs = { self, nixpkgs }:
+  inputs.nixpkgs.url = "github:nixos/nixpkgs/release-25.05";
+  inputs.flake-utils.url = "github:numtide/flake-utils";
+
+  outputs = { self, nixpkgs, flake-utils }: flake-utils.lib.eachDefaultSystem (system:
     let
-      pkgs = nixpkgs.legacyPackages.x86_64-linux;
-    in {
-      apps.x86_64-linux.cabal = {
-        type = "app";
-        program = "${nixpkgs.legacyPackages.x86_64-linux.cabal-install}/bin/cabal";
-      };
-      devShells.x86_64-linux.default = pkgs.mkShell {
-        packages = [
+      pkgs = import nixpkgs { inherit system; };
+      opium = pkgs.haskellPackages.developPackage {
+        root = ./.;
+        modifier = drv:
+          pkgs.haskell.lib.addBuildTools drv [
             pkgs.cabal-install
             pkgs.haskellPackages.implicit-hie
-          (pkgs.ghc.withPackages (hp: with hp; [
-            attoparsec
-            containers
-            bytestring
-            hspec
-            postgresql-libpq
-            text
-            time
-            transformers
-            vector
-          ]))
-
             pkgs.haskell-language-server
           ];
-        shellHook = ''
-          PS1="<opium> ''${PS1}"
-        '';
       };
+    in {
+      packages.opium = pkgs.haskell.lib.overrideCabal opium {
+        # Currently the tests require a running Postgres instance.
+        # This is not automated yet, so don't export the tests.
+        doCheck = false;
       };
+
+      devShells.default = opium.env;
+    }
+  );
 }

lib/Database/PostgreSQL/Opium.hs

@@ -1,53 +1,98 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
 
 module Database.PostgreSQL.Opium
-  ( ColumnTable
-  , Error (..)
-  , ErrorPosition (..)
-  , FromField (..)
-  , FromRow (..)
-  , RawField (..)
+    -- * Connection Management
+  ( Connection
+  , ConnectionError
+  , connect
+  , close
+    -- * Queries
+    --
+    -- Functions for performing queries. @fetch@ retrieves rows, @execute@ doesn't.
+    -- The 'Connection' parameter comes last to facilitate currying for implicitly passing in the connection, e.g. from some framework's connection pool.
+    --
+    -- | TODO: Add @newtype Query = Query Text@ with @IsString@ instance to make constructing query strings at run time harder.
   , fetch
   , fetch_
-  , toListColumnTable
+  , execute
+  , execute_
+    -- * Classes to Implement
+  , FromRow (..)
+  , FromField (..)
+  , ToParamList (..)
+  , ToField (..)
+    -- * Utility Stuff
+  , Error (..)
+  , ErrorPosition (..)
+  , RawField (..)
   )
   where
 
+import Control.Monad (unless, void)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT)
-import Data.ByteString (ByteString)
-import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
+import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE)
+import Data.Functor.Identity (Identity (..))
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
-import Data.Vector (Vector)
-import Database.PostgreSQL.LibPQ
-  ( Column
-  , Connection
-  , Oid
-  , Result
-  , Row
-  )
-import GHC.Generics (C, D, Generic, K1 (..), M1 (..), Meta (..), Rec0, Rep, S, to, (:*:) (..))
-import GHC.TypeLits (KnownSymbol, symbolVal)
+import Database.PostgreSQL.LibPQ (Result)
 
-import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Encoding
-import qualified Data.Vector as Vector
 import qualified Database.PostgreSQL.LibPQ as LibPQ
 
+import Database.PostgreSQL.Opium.Connection (Connection, ConnectionError, connect, close, withRawConnection)
 import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
-import Database.PostgreSQL.Opium.FromField (FromField (..), fromField, RawField (..))
+import Database.PostgreSQL.Opium.FromField (FromField (..), RawField (..))
+import Database.PostgreSQL.Opium.FromRow (FromRow (..), ColumnTable)
+import Database.PostgreSQL.Opium.ToField (ToField (..))
 import Database.PostgreSQL.Opium.ToParamList (ToParamList (..))
 
+class RowContainer c where
+  extract :: FromRow a => Result -> LibPQ.Row -> ColumnTable -> ExceptT Error IO (c a)
+
+instance RowContainer [] where
+  extract result nRows columnTable = do
+    mapM (ExceptT . fromRow result columnTable) [0..nRows - 1]
+
+instance RowContainer Maybe where
+  extract result nRows columnTable
+    | nRows == 0 = pure Nothing
+    | nRows == 1 = Just <$> ExceptT (fromRow result columnTable 0)
+    | otherwise = throwE ErrorMoreThanOneRow
+
+instance RowContainer Identity where
+  extract result nRows columnTable = do
+    unless (nRows == 1) $ throwE ErrorNotExactlyOneRow
+    Identity <$> ExceptT (fromRow result columnTable 0)
+
+-- The order of the type parameters is important, because it is more common to use type applications for providing the row type and row container type.
+fetch
+  :: forall a b c. (ToParamList c, FromRow a, RowContainer b)
+  => Text
+  -> c
+  -> Connection
+  -> IO (Either Error (b a))
+fetch query params conn = runExceptT $ do
+  result <- execParams conn query params
+  nRows <- liftIO $ LibPQ.ntuples result
+  columnTable <- ExceptT $ getColumnTable @a Proxy result
+  extract result nRows columnTable
+
+fetch_ :: forall a c. (FromRow a, RowContainer c) => Text -> Connection -> IO (Either Error (c a))
+fetch_ query = fetch query ()
+
+execute
+  :: forall a. ToParamList a
+  => Text
+  -> a
+  -> Connection
+  -> IO (Either Error ())
+execute query params conn = runExceptT $ void $ execParams conn query params
+
+execute_ :: Text -> Connection -> IO (Either Error ())
+execute_ query = execute query ()
+
 execParams
   :: ToParamList a
   => Connection
@@ -55,137 +100,23 @@ execParams
   -> a
   -> ExceptT Error IO Result
 execParams conn query params = do
-  let queryBytes = Encoding.encodeUtf8 query
-  liftIO (LibPQ.execParams conn queryBytes (toParamList params) LibPQ.Binary) >>= \case
-    Nothing ->
-      except $ Left ErrorNoResult
-    Just result -> do
+  -- Actually run the query while locking the connection.
+  mbResult <- ExceptT runQuery
+  -- Check whether the result is valid or nah.
+  result <- mbResult `orThrow` ErrorNoResult
   status <- liftIO $ LibPQ.resultStatus result
   mbMessage <- liftIO $ LibPQ.resultErrorMessage result
   case mbMessage of
     Just "" -> pure result
     Nothing -> pure result
-        Just message -> except $ Left $ ErrorInvalidResult status $ Encoding.decodeUtf8 message
+    Just message -> throwE $ ErrorInvalidResult status $ Encoding.decodeUtf8 message
 
-fetch
-  :: forall a b. (ToParamList a, FromRow b)
-  => Connection
-  -> Text
-  -> a
-  -> IO (Either Error [b])
-fetch conn query params = runExceptT $ do
-  result <- execParams conn query params
-  columnTable <- ExceptT $ getColumnTable @b Proxy result
-  nRows <- liftIO $ LibPQ.ntuples result
-  mapM (ExceptT . fromRow result columnTable) [0..nRows - 1]
-
-fetch_ :: forall a. FromRow a => Connection -> Text -> IO (Either Error [a])
-fetch_ conn query = fetch conn query ()
-
-newtype ColumnTable = ColumnTable (Vector (Column, Oid))
-  deriving (Eq, Show)
-
-newColumnTable :: [(Column, Oid)] -> ColumnTable
-newColumnTable = ColumnTable . Vector.fromList
-
-indexColumnTable :: ColumnTable -> Int -> (Column, Oid)
-indexColumnTable (ColumnTable v) i = v `Vector.unsafeIndex` i
-
-toListColumnTable :: ColumnTable -> [(Column, Oid)]
-toListColumnTable (ColumnTable v) = Vector.toList v
-
-class FromRow a where
-  getColumnTable :: Proxy a -> Result -> IO (Either Error ColumnTable)
-  default getColumnTable :: (Generic a, GetColumnTable' (Rep a)) => Proxy a -> Result -> IO (Either Error ColumnTable)
-  getColumnTable Proxy = runExceptT . fmap newColumnTable . getColumnTable' @(Rep a) Proxy
-
-  fromRow :: Result -> ColumnTable -> Row -> IO (Either Error a)
-  default fromRow :: (Generic a, FromRow' (Rep a)) => Result -> ColumnTable -> Row -> IO (Either Error a)
-  fromRow result columnTable row = do
-    iRef <- newIORef 0
-    runExceptT $ to <$> fromRow' (FromRowCtx result columnTable iRef) row
-
-class GetColumnTable' f where
-  getColumnTable' :: Proxy (f p) -> Result -> ExceptT Error IO [(Column, Oid)]
-
-instance GetColumnTable' f => GetColumnTable' (M1 D c f) where
-  getColumnTable' Proxy = getColumnTable' @f Proxy
-
-instance GetColumnTable' f => GetColumnTable' (M1 C c f) where
-  getColumnTable' Proxy = getColumnTable' @f Proxy
-
-instance (GetColumnTable' f, GetColumnTable' g) => GetColumnTable' (f :*: g) where
-  getColumnTable' Proxy result =
-    (++) <$> getColumnTable' @f Proxy result <*> getColumnTable' @g Proxy result
-
-checkColumn :: forall a. FromField a => Proxy a -> String -> Result -> ExceptT Error IO [(Column, Oid)]
-checkColumn Proxy nameStr result = do
-  column <- ExceptT $ maybe (Left $ ErrorMissingColumn nameText) Right <$> LibPQ.fnumber result name
-  oid <- liftIO $ LibPQ.ftype result column
-  if validOid @a Proxy oid then
-    pure [(column, oid)]
-  else
-    except $ Left $ ErrorInvalidOid nameText oid
   where
-    nameText = Text.pack nameStr
-    name = Encoding.encodeUtf8 nameText
+    orThrow (Just x) _ = pure x
+    orThrow Nothing  e = throwE e
 
-instance {-# OVERLAPPABLE #-} (FromField t, KnownSymbol nameSym) => GetColumnTable' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
-  getColumnTable' Proxy = checkColumn @t Proxy $ symbolVal @nameSym Proxy
-
-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
-
-data FromRowCtx = FromRowCtx Result ColumnTable (IORef Int)
-
-class FromRow' f where
-  fromRow' :: FromRowCtx -> Row -> ExceptT Error IO (f p)
-
-instance FromRow' f => FromRow' (M1 D c f) where
-  fromRow' ctx row = M1 <$> fromRow' ctx row
-
-instance FromRow' f => FromRow' (M1 C c f) where
-  fromRow' ctx row = M1 <$> fromRow' ctx row
-
-instance (FromRow' f, FromRow' g) => FromRow' (f :*: g) where
-  fromRow' ctx row = do
-    y <- fromRow' ctx row
-    z <- fromRow' ctx row
-    pure $ y :*: z
-
-decodeField
-  :: FromField t
-  => Text
-  -> (Row -> Maybe t -> Either Error t')
-  -> FromRowCtx
-  -> Row
-  -> ExceptT Error IO (M1 S m (Rec0 t') p)
-decodeField nameText g (FromRowCtx result columnTable iRef) row = do
-  i <- liftIO $ readIORef iRef
-  liftIO $ modifyIORef' iRef (+1)
-  let (column, oid) = columnTable `indexColumnTable` i
-  mbField <- liftIO $ LibPQ.getvalue result row column
-  mbValue <- except $ getValue oid mbField
-  value <- except $ g row mbValue
-  pure $ M1 $ K1 value
-  where
-    getValue :: FromField u => LibPQ.Oid -> Maybe ByteString -> Either Error (Maybe u)
-    getValue oid = maybe (Right Nothing) $ \field ->
-      mapLeft
-        (ErrorInvalidField (ErrorPosition row nameText) oid field)
-        (Just <$> fromField field)
-
-mapLeft :: (b -> c) -> Either b a -> Either c a
-mapLeft f (Left l) = Left $ f l
-mapLeft _ (Right r) = Right r
-
-instance {-# OVERLAPPABLE #-} (FromField t, KnownSymbol nameSym) => FromRow' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
-  fromRow' = decodeField nameText $ \row ->
-    maybe (Left $ ErrorUnexpectedNull $ ErrorPosition row nameText) Right
-    where
-      nameText = Text.pack $ symbolVal @nameSym Proxy
-
-instance {-# OVERLAPPING #-} (KnownSymbol nameSym, FromField t) => FromRow' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 (Maybe t))) where
-  fromRow' = decodeField nameText $ const pure
-    where
-      nameText = Text.pack $ symbolVal @nameSym Proxy
+    queryBytes = Encoding.encodeUtf8 query
+    runQuery =
+      flip withRawConnection conn $ \mbRawConn -> runExceptT $ do
+        rawConn <- mbRawConn `orThrow` ErrorConnectionClosed
+        liftIO $ LibPQ.execParams rawConn queryBytes (toParamList params) LibPQ.Binary

lib/Database/PostgreSQL/Opium/Connection.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.PostgreSQL.Opium.Connection
+  ( Connection
+  , ConnectionError
+  , unsafeWithRawConnection
+  , withRawConnection
+  , connect
+  , close
+  ) where
+
+import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, withMVar)
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Database.PostgreSQL.LibPQ (ConnStatus (..))
+import GHC.Stack (HasCallStack)
+
+import qualified Data.Text.Encoding as Encoding
+import qualified Database.PostgreSQL.LibPQ as LibPQ
+
+newtype Connection = Connection
+  { rawConnection :: MVar (Maybe LibPQ.Connection)
+  }
+
+newtype ConnectionError = ConnectionError Text
+  deriving (Show)
+
+withRawConnection
+  :: HasCallStack
+  => (Maybe LibPQ.Connection -> IO a)
+  -> Connection
+  -> IO a
+withRawConnection f conn = withMVar conn.rawConnection f
+
+unsafeWithRawConnection
+  :: HasCallStack
+  => (LibPQ.Connection -> IO a)
+  -> Connection
+  -> IO a
+unsafeWithRawConnection f = withRawConnection $ \case
+  Nothing -> error "raw connection is missing! perhaps the connection was already closed."
+  Just rawConn -> f rawConn
+
+connect :: Text -> IO (Either ConnectionError Connection)
+connect connectionString = do
+  -- Appending the client_encoding setting overrides any previous setting in the connection string.
+  -- We set the client encoding here to make sure we can use it below for decoding connection
+  -- error messages.
+  rawConn <- LibPQ.connectdb $ Encoding.encodeUtf8 $ connectionString <> " client_encoding=UTF8"
+  status <- LibPQ.status rawConn
+  if status == ConnectionOk then
+    Right . Connection <$> newMVar (Just rawConn)
+  else do
+    rawError <- fromMaybe "" <$> LibPQ.errorMessage rawConn
+    pure $ Left $ ConnectionError $ Encoding.decodeUtf8Lenient rawError
+
+close :: Connection -> IO ()
+close conn = modifyMVar_ conn.rawConnection $ \case
+  Just rawConn -> do
+    LibPQ.finish rawConn
+    pure Nothing
+  Nothing ->
+    pure Nothing

lib/Database/PostgreSQL/Opium/Error.hs

@@ -17,6 +17,9 @@ data Error
   | ErrorInvalidOid Text Oid
   | ErrorUnexpectedNull ErrorPosition
   | ErrorInvalidField ErrorPosition Oid ByteString String
+  | ErrorNotExactlyOneRow
+  | ErrorMoreThanOneRow
+  | ErrorConnectionClosed
   deriving (Eq, Show)
 
 instance Exception Error where

lib/Database/PostgreSQL/Opium/FromField.hs

@@ -61,7 +61,7 @@ instance FromField ByteString where
 -- | See https://www.postgresql.org/docs/current/datatype-character.html.
 -- Accepts @text@, @character@ and @character varying@.
 instance FromField Text where
-  validOid Proxy = eq Oid.text \/ eq Oid.character \/ eq Oid.characterVarying
+  validOid Proxy = eq Oid.name \/ eq Oid.text \/ eq Oid.character \/ eq Oid.characterVarying
   parseField = Encoding.decodeUtf8 <$> AP.takeByteString
 
 -- Accepts @text@, @character@ and @character varying@.

lib/Database/PostgreSQL/Opium/FromRow.hs

@@ -0,0 +1,187 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Database.PostgreSQL.Opium.FromRow
+  -- * FromRow
+  ( FromRow (..)
+  -- * Internal
+  , ColumnTable
+  , toListColumnTable
+  ) where
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT)
+import Data.ByteString (ByteString)
+import Data.Bifunctor (first)
+import Data.Kind (Type)
+import Data.Proxy (Proxy (..))
+import Data.Text (Text)
+import Data.Vector (Vector)
+import Database.PostgreSQL.LibPQ
+  ( Column
+  , Oid
+  , Result
+  , Row
+  )
+import GHC.Generics (Generic, C, D, K1 (..), M1 (..), Meta (..), Rec0, Rep, S, to, (:*:) (..))
+import GHC.TypeLits (KnownNat, KnownSymbol, Nat, natVal, symbolVal, type (+))
+
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Encoding
+import qualified Data.Vector as Vector
+import qualified Database.PostgreSQL.LibPQ as LibPQ
+
+import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
+import Database.PostgreSQL.Opium.FromField (FromField (..), fromField)
+
+class FromRow a where
+  getColumnTable :: Proxy a -> Result -> IO (Either Error ColumnTable)
+  default getColumnTable :: (Generic a, GetColumnTable' (Rep a)) => Proxy a -> Result -> IO (Either Error ColumnTable)
+  getColumnTable Proxy = runExceptT . fmap newColumnTable . getColumnTable' @(Rep a) Proxy
+
+  fromRow :: Result -> ColumnTable -> Row -> IO (Either Error a)
+  default fromRow :: (Generic a, FromRow' 0 (Rep a)) => Result -> ColumnTable -> Row -> IO (Either Error a)
+  fromRow result columnTable row =
+    runExceptT $ to <$> fromRow' @0 FRProxy (FromRowCtx result columnTable) row
+
+instance
+  ( Generic a
+  , GetColumnTable' (Rep a)
+  , FromRow' 0 (Rep a)
+  , Generic b
+  , GetColumnTable' (Rep b)
+  , FromRow' (NumberOfMembers (Rep a)) (Rep b)
+  ) => FromRow (a, b) where
+  getColumnTable Proxy result = runExceptT $ do
+    ctA <- newColumnTable <$> getColumnTable' @(Rep a) Proxy result
+    ctB <- newColumnTable <$> getColumnTable' @(Rep b) Proxy result
+    pure $ ctA `concatColumnTables` ctB
+
+  fromRow result ct row = runExceptT $ do
+    x <- to <$> fromRow' @0 FRProxy (FromRowCtx result ct) row
+    y <- to <$> fromRow' @(NumberOfMembers (Rep a)) FRProxy (FromRowCtx result ct) row
+    pure (x, y)
+
+newtype ColumnTable = ColumnTable (Vector (Column, Oid))
+  deriving (Eq, Show)
+
+newColumnTable :: [(Column, Oid)] -> ColumnTable
+newColumnTable = ColumnTable . Vector.fromList
+
+concatColumnTables :: ColumnTable -> ColumnTable -> ColumnTable
+concatColumnTables (ColumnTable a) (ColumnTable b) =
+  ColumnTable $ a <> b
+
+indexColumnTable :: ColumnTable -> Int -> (Column, Oid)
+indexColumnTable (ColumnTable v) i = v `Vector.unsafeIndex` i
+
+toListColumnTable :: ColumnTable -> [(Column, Oid)]
+toListColumnTable (ColumnTable v) = Vector.toList v
+
+class GetColumnTable' f where
+  getColumnTable' :: Proxy (f p) -> Result -> ExceptT Error IO [(Column, Oid)]
+
+instance GetColumnTable' f => GetColumnTable' (M1 D c f) where
+  getColumnTable' Proxy = getColumnTable' @f Proxy
+
+instance GetColumnTable' f => GetColumnTable' (M1 C c f) where
+  getColumnTable' Proxy = getColumnTable' @f Proxy
+
+instance (GetColumnTable' f, GetColumnTable' g) => GetColumnTable' (f :*: g) where
+  getColumnTable' Proxy result =
+    (++) <$> getColumnTable' @f Proxy result <*> getColumnTable' @g Proxy result
+
+instance {-# OVERLAPPABLE #-} (FromField t, KnownSymbol nameSym) => GetColumnTable' (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
+  getColumnTable' Proxy = checkColumn @t Proxy $ symbolVal @nameSym Proxy
+
+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 members 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'.
+  ColumnTable -- ^ 'Vector' of expected columns indices and OIDs.
+
+-- Specialized proxy type to be used instead of `Proxy (n, f)`
+data FRProxy (n :: Nat) (f :: Type -> Type) = FRProxy
+
+class FromRow' (n :: Nat) (f :: Type -> Type) where
+  fromRow' :: FRProxy n f -> FromRowCtx -> Row -> ExceptT Error IO (f p)
+
+instance FromRow' n f => FromRow' n (M1 D c f) where
+  fromRow' FRProxy ctx row =
+    M1 <$> fromRow' @n FRProxy ctx row
+
+instance FromRow' n f => FromRow' n (M1 C c f) where
+  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 {-# OVERLAPPABLE #-} (KnownNat n, KnownSymbol nameSym, FromField t) => FromRow' n (M1 S ('MetaSel ('Just nameSym) nu ns dl) (Rec0 t)) where
+  fromRow' FRProxy = decodeField memberIndex nameText $ \row ->
+    maybe (Left $ ErrorUnexpectedNull $ ErrorPosition row nameText) Right
+    where
+      memberIndex = fromIntegral $ natVal @n Proxy
+      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
+  fromRow' FRProxy = decodeField memberIndex nameText $ const pure
+    where
+      memberIndex = fromIntegral $ natVal @n Proxy
+      nameText = Text.pack $ symbolVal @nameSym Proxy
+
+checkColumn :: forall a. FromField a => Proxy a -> String -> Result -> ExceptT Error IO [(Column, Oid)]
+checkColumn Proxy nameStr result = do
+  column <- ExceptT $ maybe (Left $ ErrorMissingColumn nameText) Right <$> LibPQ.fnumber result name
+  oid <- liftIO $ LibPQ.ftype result column
+  if validOid @a Proxy oid then
+    pure [(column, oid)]
+  else
+    except $ Left $ ErrorInvalidOid nameText oid
+  where
+    nameText = Text.pack nameStr
+    name = Encoding.encodeUtf8 nameText
+
+decodeField
+  :: FromField t
+  => Int
+  -> Text
+  -> (Row -> Maybe t -> Either Error t')
+  -> FromRowCtx
+  -> Row
+  -> ExceptT Error IO (M1 S m (Rec0 t') p)
+decodeField memberIndex nameText g (FromRowCtx result columnTable) row = do
+  let (column, oid) = columnTable `indexColumnTable` memberIndex
+  mbField <- liftIO $ LibPQ.getvalue result row column
+  mbValue <- except $ fromFieldIfPresent oid mbField
+  value <- except $ g row mbValue
+  pure $ M1 $ K1 value
+  where
+    fromFieldIfPresent :: FromField u => LibPQ.Oid -> Maybe ByteString -> Either Error (Maybe u)
+    fromFieldIfPresent oid = maybe (Right Nothing) $ \field ->
+      first
+        (ErrorInvalidField (ErrorPosition row nameText) oid field)
+        (Just <$> fromField field)

lib/Database/PostgreSQL/Opium/Oid.hs

@@ -9,6 +9,9 @@ bytea = Oid 17
 
 -- string types
 
+name :: Oid
+name = Oid 19
+
 text :: Oid
 text = Oid 25
 

opium.cabal

@@ -20,7 +20,7 @@ name:               opium
 -- PVP summary:     +-+------- breaking API changes
 --                  | | +----- non-breaking API additions
 --                  | | | +--- code changes with no API change
-version:            0.1.0.0
+version:            1.1.0.0
 
 -- A short (one-line) description of the package.
 -- synopsis:
@@ -52,7 +52,7 @@ build-type:         Simple
 -- extra-source-files:
 
 common warnings
-    ghc-options: -Wall
+    ghc-options: -Wall -Wextra
 
 library
     -- Import common warning flags.
@@ -62,11 +62,15 @@ library
     exposed-modules:
         Database.PostgreSQL.Opium,
         Database.PostgreSQL.Opium.FromField,
+        Database.PostgreSQL.Opium.FromRow,
+        Database.PostgreSQL.Opium.Connection,
+        Database.PostgreSQL.Opium.ToField
 
     -- Modules included in this library but not exported.
     other-modules:
         Database.PostgreSQL.Opium.Error,
-        Database.PostgreSQL.Opium.Oid
+        Database.PostgreSQL.Opium.Oid,
+        Database.PostgreSQL.Opium.ToParamList
 
     -- LANGUAGE extensions used by modules in this package.
     -- other-extensions:
@@ -114,13 +118,15 @@ test-suite opium-test
     other-modules:
         SpecHook,
         Database.PostgreSQL.OpiumSpec,
-        Database.PostgreSQL.Opium.FromFieldSpec
+        Database.PostgreSQL.Opium.FromFieldSpec,
+        Database.PostgreSQL.Opium.FromRowSpec
 
     -- Test dependencies.
     build-depends:
         base,
         opium,
         bytestring,
+        containers,
         hspec,
         postgresql-libpq,
         time,

test/Database/PostgreSQL/Opium/FromFieldSpec.hs

@@ -14,7 +14,6 @@ import Data.Time
   , timeOfDayToTime
   )
 import Data.Text (Text)
-import Database.PostgreSQL.LibPQ (Connection)
 import Database.PostgreSQL.Opium (FromRow)
 import GHC.Generics (Generic)
 import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
@@ -113,15 +112,15 @@ newtype ARawField = ARawField
 
 instance FromRow ARawField where
 
-shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> Text -> [a] -> IO ()
+shouldFetch :: (Eq a, FromRow a, Show a) => Opium.Connection -> Text -> [a] -> IO ()
 shouldFetch conn query expectedRows = do
-  actualRows <- Opium.fetch_ conn query
+  actualRows <- Opium.fetch_ query conn
   actualRows `shouldBe` Right expectedRows
 
 (/\) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
 p /\ q = \x -> p x && q x
 
-spec :: SpecWith Connection
+spec :: SpecWith Opium.Connection
 spec = do
   describe "FromField Int" $ do
     it "Decodes smallint" $ \conn -> do
@@ -213,15 +212,15 @@ spec = do
       shouldFetch conn "SELECT 4.2::real AS float" [AFloat 4.2]
 
     it "Decodes NaN::real" $ \conn -> do
-      Right [AFloat value] <- Opium.fetch_ conn "SELECT 'NaN'::real AS float"
+      Right [AFloat value] <- Opium.fetch_ "SELECT 'NaN'::real AS float" conn
       value `shouldSatisfy` isNaN
 
     it "Decodes Infinity::real" $ \conn -> do
-      Right [AFloat value] <- Opium.fetch_ conn "SELECT 'Infinity'::real AS float"
+      Right [AFloat value] <- Opium.fetch_ "SELECT 'Infinity'::real AS float" conn
       value `shouldSatisfy` (isInfinite /\ (> 0))
 
     it "Decodes -Infinity::real" $ \conn -> do
-      Right [AFloat value] <- Opium.fetch_ conn "SELECT '-Infinity'::real AS float"
+      Right [AFloat value] <- Opium.fetch_ "SELECT '-Infinity'::real AS float" conn
       value `shouldSatisfy` (isInfinite /\ (< 0))
 
   describe "FromField Double" $ do
@@ -229,22 +228,22 @@ spec = do
       shouldFetch conn "SELECT 4.2::double precision AS double" [ADouble 4.2]
 
     it "Decodes NaN::double precision" $ \conn -> do
-      Right [ADouble value] <- Opium.fetch_ conn "SELECT 'NaN'::double precision AS double"
+      Right [ADouble value] <- Opium.fetch_ "SELECT 'NaN'::double precision AS double" conn
       value `shouldSatisfy` isNaN
 
     it "Decodes Infinity::double precision" $ \conn -> do
-      Right [ADouble value] <- Opium.fetch_ conn "SELECT 'Infinity'::double precision AS double"
+      Right [ADouble value] <- Opium.fetch_ "SELECT 'Infinity'::double precision AS double" conn
       value `shouldSatisfy` (isInfinite /\ (> 0))
 
     it "Decodes -Infinity::double precision" $ \conn -> do
-      Right [ADouble value] <- Opium.fetch_ conn "SELECT '-Infinity'::double precision AS double"
+      Right [ADouble value] <- Opium.fetch_ "SELECT '-Infinity'::double precision AS double" conn
       value `shouldSatisfy` (isInfinite /\ (< 0))
 
     it "Decodes {inf,-inf}::double precision" $ \conn -> do
-      Right [ADouble value0] <- Opium.fetch_ conn "SELECT 'inf'::double precision AS double"
+      Right [ADouble value0] <- Opium.fetch_ "SELECT 'inf'::double precision AS double" conn
       value0 `shouldSatisfy` (isInfinite /\ (> 0))
 
-      Right [ADouble value1] <- Opium.fetch_ conn "SELECT '-inf'::double precision AS double"
+      Right [ADouble value1] <- Opium.fetch_ "SELECT '-inf'::double precision AS double" conn
       value1 `shouldSatisfy` (isInfinite /\ (< 0))
 
   describe "FromField Bool" $ do

test/Database/PostgreSQL/Opium/FromRowSpec.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Database.PostgreSQL.Opium.FromRowSpec (spec) where
+
+import Data.ByteString (ByteString)
+import Data.Proxy (Proxy (..))
+import Test.Hspec (SpecWith, aroundWith, describe, it, shouldBe)
+
+import qualified Database.PostgreSQL.LibPQ as LibPQ
+
+import Database.PostgreSQL.Opium.Connection (unsafeWithRawConnection)
+import Database.PostgreSQL.OpiumSpec (ManyFields (..), MaybeTest (..), Person (..), Only (..))
+
+import qualified Database.PostgreSQL.Opium as Opium
+import qualified Database.PostgreSQL.Opium.FromRow as Opium.FromRow
+
+shouldHaveColumns
+  :: Opium.FromRow a
+  => Proxy a
+  -> LibPQ.Connection
+  -> ByteString
+  -> [LibPQ.Column]
+  -> IO ()
+shouldHaveColumns proxy conn query expectedColumns = do
+  Just result <- LibPQ.execParams conn query [] LibPQ.Binary
+  columnTable <- Opium.getColumnTable proxy result
+  let actualColumns = fmap (map fst . Opium.FromRow.toListColumnTable) columnTable
+  actualColumns `shouldBe` Right expectedColumns
+
+-- These test the mapping from Result to ColumnTable/FromRow instances.
+  -- They use the raw LibPQ connection for retrieving the Results.
+spec :: SpecWith Opium.Connection
+spec = aroundWith unsafeWithRawConnection $ do
+  describe "getColumnTable" $ do
+    it "Gets the column table for a result" $ \conn -> do
+      shouldHaveColumns @Person Proxy conn
+        "SELECT name, age FROM person"
+        [0, 1]
+
+    it "Gets the numbers right for funky configurations" $ \conn -> do
+      shouldHaveColumns @Person Proxy conn
+        "SELECT age, name FROM person"
+        [1, 0]
+
+      shouldHaveColumns @Person Proxy conn
+        "SELECT 0 AS a, 1 AS b, 2 AS c, age, 4 AS d, name FROM person"
+        [5, 3]
+
+    it "Fails for missing columns" $ \conn -> do
+      Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Binary
+      columnTable <- Opium.getColumnTable @Person Proxy result
+      columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name")
+
+  describe "fromRow" $ do
+    it "Decodes rows in a Result" $ \conn -> do
+      Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Binary
+      Right columnTable <- Opium.getColumnTable @Person Proxy result
+
+      row0 <- Opium.fromRow @Person result columnTable 0
+      row0 `shouldBe` Right (Person "paul" 25)
+
+      row1 <- Opium.fromRow @Person result columnTable 1
+      row1 `shouldBe` Right (Person "albus" 103)
+
+    it "Decodes NULL into Nothing for Maybes" $ \conn -> do
+      Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Binary
+      Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
+
+      row <- Opium.fromRow result columnTable 0
+      row `shouldBe` Right (MaybeTest Nothing)
+
+    it "Decodes values into Just for Maybes" $ \conn -> do
+      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Binary
+      Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
+
+      row <- Opium.fromRow result columnTable 0
+      row `shouldBe` Right (MaybeTest $ Just "abc")
+
+    it "Works for many fields" $ \conn -> do
+      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Binary
+      Right columnTable <- Opium.getColumnTable @ManyFields Proxy result
+
+      row <- Opium.fromRow result columnTable 0
+      row `shouldBe` Right (ManyFields "abc" 42 1.0 "test" True)
+
+    it "Decodes multiple records into a tuple" $ \conn -> do
+      Just result <- LibPQ.execParams conn "SELECT 'albus' AS name, 123 AS age, 42 AS only" [] LibPQ.Binary
+      Right columnTable <- Opium.getColumnTable @(Person, Only Int) Proxy result
+
+      row <- Opium.fromRow @(Person, Only Int) result columnTable 0
+      row `shouldBe` Right (Person "albus" 123, Only 42)

test/Database/PostgreSQL/OpiumSpec.hs

@@ -4,13 +4,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
-module Database.PostgreSQL.OpiumSpec (spec) where
+module Database.PostgreSQL.OpiumSpec (ManyFields (..), MaybeTest (..), Person (..), Only (..), spec) where
 
-import Data.ByteString (ByteString)
+import Data.Either (isLeft)
 import Data.Functor.Identity (Identity (..))
-import Data.Proxy (Proxy (..))
 import Data.Text (Text)
-import Database.PostgreSQL.LibPQ (Connection)
 import GHC.Generics (Generic)
 import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
 
@@ -47,109 +45,69 @@ data ScoreByAge = ScoreByAge
 
 instance Opium.FromRow ScoreByAge where
 
-data Only a = Only
+newtype Only a = Only
   { only :: a
   } deriving (Eq, Generic, Show)
 
 instance Opium.FromField a => Opium.FromRow (Only a) where
 
-isLeft :: Either a b -> Bool
-isLeft (Left _) = True
-isLeft _ = False
-
-shouldHaveColumns
-  :: Opium.FromRow a
-  => Proxy a
-  -> Connection
-  -> ByteString
-  -> [LibPQ.Column]
-  -> IO ()
-shouldHaveColumns proxy conn query expectedColumns = do
-  Just result <- LibPQ.execParams conn query [] LibPQ.Binary
-  columnTable <- Opium.getColumnTable proxy result
-  let actualColumns = fmap (map fst . Opium.toListColumnTable) columnTable
-  actualColumns `shouldBe` Right expectedColumns
-
-spec :: SpecWith Connection
+spec :: SpecWith Opium.Connection
 spec = do
-  describe "getColumnTable" $ do
-    it "Gets the column table for a result" $ \conn -> do
-      shouldHaveColumns @Person Proxy conn
-        "SELECT name, age FROM person"
-        [0, 1]
-
-    it "Gets the numbers right for funky configurations" $ \conn -> do
-      shouldHaveColumns @Person Proxy conn
-        "SELECT age, name FROM person"
-        [1, 0]
-
-      shouldHaveColumns @Person Proxy conn
-        "SELECT 0 AS a, 1 AS b, 2 AS c, age, 4 AS d, name FROM person"
-        [5, 3]
-
-    it "Fails for missing columns" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Binary
-      columnTable <- Opium.getColumnTable @Person Proxy result
-      columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name")
-
-  describe "fromRow" $ do
-    it "Decodes rows in a Result" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Binary
-      Right columnTable <- Opium.getColumnTable @Person Proxy result
-
-      row0 <- Opium.fromRow @Person result columnTable 0
-      row0 `shouldBe` Right (Person "paul" 25)
-
-      row1 <- Opium.fromRow @Person result columnTable 1
-      row1 `shouldBe` Right (Person "albus" 103)
-
-    it "Decodes NULL into Nothing for Maybes" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Binary
-      Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
-
-      row <- Opium.fromRow result columnTable 0
-      row `shouldBe` Right (MaybeTest Nothing)
-
-    it "Decodes values into Just for Maybes" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Binary
-      Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result
-
-      row <- Opium.fromRow result columnTable 0
-      row `shouldBe` Right (MaybeTest $ Just "abc")
-
-    it "Works for many fields" $ \conn -> do
-      Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Binary
-      Right columnTable <- Opium.getColumnTable @ManyFields Proxy result
-
-      row <- Opium.fromRow result columnTable 0
-      row `shouldBe` Right (ManyFields "abc" 42 1.0 "test" True)
-
   describe "fetch" $ do
     it "Passes numbered parameters and retrieves a list of rows" $ \conn -> do
-      rows <- Opium.fetch conn "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int)
+      rows <- Opium.fetch "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int) conn
       rows `shouldBe` Right [Only (42 :: Int)]
 
     it "Uses Identity to pass single parameters" $ \conn -> do
-      rows <- Opium.fetch conn "SELECT count(*) AS only FROM person WHERE name = $1" $ Identity ("paul" :: Text)
+      rows <- Opium.fetch "SELECT count(*) AS only FROM person WHERE name = $1" (Identity ("paul" :: Text)) conn
       rows `shouldBe` Right [Only (1 :: Int)]
 
   describe "fetch_" $ do
     it "Retrieves a list of rows" $ \conn -> do
-      rows <- Opium.fetch_ conn "SELECT * FROM person"
+      rows <- Opium.fetch_ "SELECT * FROM person" conn
       rows `shouldBe` Right [Person "paul" 25, Person "albus" 103]
 
     it "Fails for invalid queries" $ \conn -> do
-      rows <- Opium.fetch_ @Person conn "MRTLBRNFT"
+      rows <- Opium.fetch_ @Person @[] "MRTLBRNFT" conn
       rows `shouldSatisfy` isLeft
 
     it "Fails for unexpected NULLs" $ \conn -> do
-      rows <- Opium.fetch_ @Person conn "SELECT NULL AS name, 0 AS age"
+      rows <- Opium.fetch_ @Person @[] "SELECT NULL AS name, 0 AS age" conn
       rows `shouldBe` Left (Opium.ErrorUnexpectedNull (Opium.ErrorPosition 0 "name"))
 
     it "Fails for the wrong column type" $ \conn -> do
-      rows <- Opium.fetch_ @Person conn "SELECT 'quby' AS name, 'indeterminate' AS age"
+      rows <- Opium.fetch_ @Person @[] "SELECT 'quby' AS name, 'indeterminate' AS age" conn
       rows `shouldBe` Left (Opium.ErrorInvalidOid "age" $ LibPQ.Oid 25)
 
     it "Works for the readme regression example" $ \conn -> do
-      rows <- Opium.fetch_ @ScoreByAge conn "SELECT regr_intercept(score, age) AS t, regr_slope(score, age) AS m FROM person"
+      rows <- Opium.fetch_ @ScoreByAge @[] "SELECT regr_intercept(score, age) AS t, regr_slope(score, age) AS m FROM person" conn
       rows `shouldSatisfy` \case { (Right [ScoreByAge _ _]) -> True; _ -> False }
+
+    it "Accepts exactly one row when Identity is the row container type" $ \conn -> do
+      row <- Opium.fetch_ "SELECT 42 AS only" conn
+      row `shouldBe` Right (Identity (Only (42 :: Int)))
+
+    it "Does not accept zero rows when Identity is the row container type" $ \conn -> do
+      row <- Opium.fetch_ @(Only Int) @Identity "SELECT 42 AS only WHERE false" conn
+      row `shouldSatisfy` isLeft
+
+    it "Does not accept two rows when Identity is the row container type" $ \conn -> do
+      row <- Opium.fetch_ @(Only Int) @Identity "SELECT 17 AS only UNION ALL SELECT 25 AS only" conn
+      row `shouldSatisfy` isLeft
+
+    it "Accepts zero rows when Maybe is the row container type" $ \conn -> do
+      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 17 AS only WHERE false" conn
+      row `shouldBe` Right Nothing
+
+    it "Accepts one row when Maybe is the row container type" $ \conn -> do
+      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 42 AS only" conn
+      row `shouldBe` Right (Just (Only 42))
+
+    it "Does not accept two rows when Maybe is the row container type" $ \conn -> do
+      row <- Opium.fetch_ @(Only Int) @Maybe "SELECT 17 AS only UNION ALL SELECT 25 AS only" conn
+      row `shouldSatisfy` isLeft
+
+  describe "close" $ do
+    it "Does not crash when called twice on the same connection" $ \conn -> do
+      Opium.close conn
+      Opium.close conn

test/SpecHook.hs

@@ -3,16 +3,15 @@
 module SpecHook (hook) where
 
 import Control.Exception (bracket)
-import Database.PostgreSQL.LibPQ (Connection)
 import System.Environment (lookupEnv)
 import Test.Hspec (Spec, SpecWith, around)
 import Text.Printf (printf)
 
 import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Encoding
-import qualified Database.PostgreSQL.LibPQ as LibPQ
 
-setupConnection :: IO Connection
+import qualified Database.PostgreSQL.Opium as Opium
+
+setupConnection :: IO Opium.Connection
 setupConnection = do
   Just dbUser <- lookupEnv "DB_USER"
   Just dbPass <- lookupEnv "DB_PASS"
@@ -20,24 +19,17 @@ setupConnection = do
   Just dbPort <- lookupEnv "DB_PORT"
 
   let dsn = printf "host=localhost user=%s password=%s dbname=%s port=%s" dbUser dbPass dbName dbPort
-  conn <- LibPQ.connectdb $ Encoding.encodeUtf8 $ Text.pack dsn
-  _ <- LibPQ.setClientEncoding conn "UTF8"
+  Right conn <- Opium.connect $ Text.pack dsn
 
-  _ <- LibPQ.exec conn "CREATE TABLE person (name TEXT NOT NULL, age INT NOT NULL, score DOUBLE PRECISION NOT NULL, motto TEXT)"
-  _ <- LibPQ.exec conn "INSERT INTO person VALUES ('paul', 25, 30), ('albus', 103, 50.42)"
+  Right _ <- Opium.execute_ "DROP TABLE IF EXISTS person" conn
+  Right _ <- Opium.execute_ "CREATE TABLE person (name TEXT NOT NULL, age INT NOT NULL, score DOUBLE PRECISION NOT NULL, motto TEXT)" conn
+  Right _ <- Opium.execute_ "INSERT INTO person VALUES ('paul', 25, 30), ('albus', 103, 50.42)" conn
 
   pure conn
 
-teardownConnection :: Connection -> IO ()
+teardownConnection :: Opium.Connection -> IO ()
 teardownConnection conn = do
-  _ <- LibPQ.exec conn "DROP TABLE person"
-  LibPQ.finish conn
+  Opium.close conn
 
-class SpecInput a where
-  hook :: SpecWith a -> Spec
-
-instance SpecInput Connection where
-  hook = around $ bracket setupConnection teardownConnection
-
-instance SpecInput () where
-  hook = id
+hook :: SpecWith Opium.Connection -> Spec
+hook = around $ bracket setupConnection teardownConnection