Set system to aarch64-darwin

README.md

@@ -34,7 +34,7 @@ data User = User
 instance Opium.FromRow User where
 
 getUsers :: Connection -> IO (Either Opium.Error [User])
-getUsers conn = Opium.fetch_ "SELECT * FROM user" conn
+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_ query conn
+  Right (Identity x) <- Opium.fetch_ query conn
   pure x
 ```
 

flake.nix

@@ -3,7 +3,7 @@
 
   outputs = { self, nixpkgs }:
     let
-      system = "x86_64-linux";
+      system = "aarch64-darwin";
       pkgs = nixpkgs.legacyPackages.${system};
       opium = pkgs.haskellPackages.developPackage {
         root = ./.;

lib/Database/PostgreSQL/Opium.hs

@@ -26,9 +26,10 @@ module Database.PostgreSQL.Opium
   )
   where
 
-import Control.Monad (void)
+import Control.Monad (unless, void)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT)
+import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE)
+import Data.Functor.Identity (Identity (..))
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
 import Database.PostgreSQL.LibPQ
@@ -41,24 +42,42 @@ import qualified Database.PostgreSQL.LibPQ as LibPQ
 
 import Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..))
 import Database.PostgreSQL.Opium.FromField (FromField (..), RawField (..))
-import Database.PostgreSQL.Opium.FromRow (FromRow (..))
+import Database.PostgreSQL.Opium.FromRow (FromRow (..), ColumnTable)
 import Database.PostgreSQL.Opium.ToField (ToField (..))
 import Database.PostgreSQL.Opium.ToParamList (ToParamList (..))
 
--- The order of the type parameters is important, because it is more common to use type applications for providing the row type.
-fetch
-  :: forall a b. (ToParamList b, FromRow a)
-  => Text
-  -> b
-  -> Connection
-  -> IO (Either Error [a])
-fetch query params conn = runExceptT $ do
-  result <- execParams conn query params
-  columnTable <- ExceptT $ getColumnTable @a Proxy result
-  nRows <- liftIO $ LibPQ.ntuples result
+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]
 
-fetch_ :: forall a. FromRow a => Text -> Connection -> IO (Either Error [a])
+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

lib/Database/PostgreSQL/Opium/Error.hs

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

lib/Database/PostgreSQL/Opium/FromRow.hs

@@ -14,6 +14,7 @@ module Database.PostgreSQL.Opium.FromRow
   -- * FromRow
   ( FromRow (..)
   -- * Internal
+  , ColumnTable
   , toListColumnTable
   ) where
 
@@ -52,12 +53,34 @@ class FromRow a where
   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
 

test/Database/PostgreSQL/OpiumSpec.hs

@@ -122,6 +122,13 @@ spec = do
       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)
+
   describe "fetch" $ do
     it "Passes numbered parameters and retrieves a list of rows" $ \conn -> do
       rows <- Opium.fetch "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int) conn
@@ -137,17 +144,41 @@ spec = do
       rows `shouldBe` Right [Person "paul" 25, Person "albus" 103]
 
     it "Fails for invalid queries" $ \conn -> do
-      rows <- Opium.fetch_ @Person "MRTLBRNFT" conn
+      rows <- Opium.fetch_ @Person @[] "MRTLBRNFT" conn
       rows `shouldSatisfy` isLeft
 
     it "Fails for unexpected NULLs" $ \conn -> do
-      rows <- Opium.fetch_ @Person "SELECT NULL AS name, 0 AS age" conn
+      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 "SELECT 'quby' AS name, 'indeterminate' AS age" conn
+      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 "SELECT regr_intercept(score, age) AS t, regr_slope(score, age) AS m FROM person" conn
+      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