Compare commits

..

No commits in common. "97e5d9e61c8ad34680729a41251d806aa6bf1645" and "2b2a048197f8a371a975c7c7e0853ff1c2d72c98" have entirely different histories.

4 changed files with 14 additions and 60 deletions

View File

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

View File

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

View File

@ -14,7 +14,6 @@ module Database.PostgreSQL.Opium.FromRow
-- * FromRow -- * FromRow
( FromRow (..) ( FromRow (..)
-- * Internal -- * Internal
, ColumnTable
, toListColumnTable , toListColumnTable
) where ) where

View File

@ -137,41 +137,17 @@ spec = do
rows `shouldBe` Right [Person "paul" 25, Person "albus" 103] rows `shouldBe` Right [Person "paul" 25, Person "albus" 103]
it "Fails for invalid queries" $ \conn -> do it "Fails for invalid queries" $ \conn -> do
rows <- Opium.fetch_ @Person @[] "MRTLBRNFT" conn rows <- Opium.fetch_ @Person "MRTLBRNFT" conn
rows `shouldSatisfy` isLeft rows `shouldSatisfy` isLeft
it "Fails for unexpected NULLs" $ \conn -> do 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")) rows `shouldBe` Left (Opium.ErrorUnexpectedNull (Opium.ErrorPosition 0 "name"))
it "Fails for the wrong column type" $ \conn -> do 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) rows `shouldBe` Left (Opium.ErrorInvalidOid "age" $ LibPQ.Oid 25)
it "Works for the readme regression example" $ \conn -> 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 <- 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 } 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