Compare commits
No commits in common. "97e5d9e61c8ad34680729a41251d806aa6bf1645" and "2b2a048197f8a371a975c7c7e0853ff1c2d72c98" have entirely different histories.
97e5d9e61c
...
2b2a048197
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -14,7 +14,6 @@ module Database.PostgreSQL.Opium.FromRow
|
|||||||
-- * FromRow
|
-- * FromRow
|
||||||
( FromRow (..)
|
( FromRow (..)
|
||||||
-- * Internal
|
-- * Internal
|
||||||
, ColumnTable
|
|
||||||
, toListColumnTable
|
, toListColumnTable
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -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
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user