Add Maybe as possible row container type

This commit is contained in:
Paul Brinkmeier 2024-07-03 11:12:07 +02:00
parent 56585dd5f1
commit 97e5d9e61c
3 changed files with 36 additions and 18 deletions

View File

@ -47,16 +47,20 @@ import Database.PostgreSQL.Opium.ToField (ToField (..))
import Database.PostgreSQL.Opium.ToParamList (ToParamList (..))
class RowContainer c where
extract :: FromRow a => Result -> ColumnTable -> ExceptT Error IO (c a)
extract :: FromRow a => Result -> LibPQ.Row -> ColumnTable -> ExceptT Error IO (c a)
instance RowContainer [] where
extract result columnTable = do
nRows <- liftIO $ LibPQ.ntuples result
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 columnTable = do
nRows <- liftIO $ LibPQ.ntuples result
extract result nRows columnTable = do
unless (nRows == 1) $ throwE ErrorNotExactlyOneRow
Identity <$> ExceptT (fromRow result columnTable 0)
@ -69,8 +73,9 @@ fetch
-> 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 columnTable
extract result nRows columnTable
fetch_ :: forall a c. (FromRow a, RowContainer c) => Text -> Connection -> IO (Either Error (c a))
fetch_ query = fetch query ()

View File

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

View File

@ -131,18 +131,6 @@ spec = do
rows <- Opium.fetch "SELECT count(*) AS only FROM person WHERE name = $1" (Identity ("paul" :: Text)) conn
rows `shouldBe` Right [Only (1 :: Int)]
it "Accepts exactly one row when Identity is the return type" $ \conn -> do
row <- Opium.fetch "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int) conn
row `shouldBe` Right (Identity (Only (42 :: Int)))
it "Does not accept zero rows when Identity is the return type" $ \conn -> do
row <- Opium.fetch @(Only Int) @Identity "SELECT ($1 + $2) AS only WHERE false" (17 :: Int, 25 :: Int) conn
row `shouldSatisfy` isLeft
it "Does not accept two rows when Identity is the return type" $ \conn -> do
row <- Opium.fetch @(Only Int) @Identity "SELECT $1 AS only UNION ALL SELECT $2 AS only" (17 :: Int, 25 :: Int) conn
row `shouldSatisfy` isLeft
describe "fetch_" $ do
it "Retrieves a list of rows" $ \conn -> do
rows <- Opium.fetch_ "SELECT * FROM person" conn
@ -163,3 +151,27 @@ spec = do
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 `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