paul/opium
1
0
Fork 0
Code Issues 3 Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: paul:main
Branches Tags
paul:main
paul:aarch64-darwin
paul:feature/more-instances
paul:1.0.0.0
..
compare: paul:aarch64-darwin
Branches Tags
paul:main
paul:aarch64-darwin
paul:feature/more-instances
paul:1.0.0.0

No commits in common. "main" and "aarch64-darwin" have entirely different histories.
main ... aarch64-da

12 changed files with 132 additions and 250 deletions
Show Stats Expand all files Collapse all files

48
flake.lock generated
View File

@ -1,59 +1,23 @@
{ {
"nodes": { "nodes": {
"flake-utils": {
"inputs": {
"systems": "systems"
},
"locked": {
"lastModified": 1731533236,
"narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
"owner": "numtide",
"repo": "flake-utils",
"rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
"type": "github"
},
"original": {
"owner": "numtide",
"repo": "flake-utils",
"type": "github"
}
},
"nixpkgs": { "nixpkgs": {
"locked": { "locked": {
"lastModified": 1752536923, "lastModified": 1719285171,
"narHash": "sha256-fdgPZR7VFSSRIQKOJLcs3qCJBWM64Uak0gAGtWTYAd8=", "narHash": "sha256-kOUKtKfYEh8h8goL/P6lKF4Jb0sXnEkFyEganzdTGvo=",
"owner": "nixos", "owner": "NixOS",
"repo": "nixpkgs", "repo": "nixpkgs",
"rev": "c665e4d918eda5d78a175ed8d300809c44932160", "rev": "cfb89a95f19bea461fc37228dc4d07b22fe617c2",
"type": "github" "type": "github"
}, },
"original": { "original": {
"owner": "nixos", "id": "nixpkgs",
"ref": "release-25.05", "type": "indirect"
"repo": "nixpkgs",
"type": "github"
} }
}, },
"root": { "root": {
"inputs": { "inputs": {
"flake-utils": "flake-utils",
"nixpkgs": "nixpkgs" "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", "root": "root",

15
flake.nix
View File

@ -1,12 +1,10 @@
{ {
description = "An opionated Postgres library"; description = "An opionated Postgres library";
inputs.nixpkgs.url = "github:nixos/nixpkgs/release-25.05"; outputs = { self, nixpkgs }:
inputs.flake-utils.url = "github:numtide/flake-utils";
outputs = { self, nixpkgs, flake-utils }: flake-utils.lib.eachDefaultSystem (system:
let let
pkgs = import nixpkgs { inherit system; }; system = "aarch64-darwin";
pkgs = nixpkgs.legacyPackages.${system};
opium = pkgs.haskellPackages.developPackage { opium = pkgs.haskellPackages.developPackage {
root = ./.; root = ./.;
modifier = drv: modifier = drv:
@ -17,13 +15,12 @@
]; ];
}; };
in { in {
packages.opium = pkgs.haskell.lib.overrideCabal opium { packages.${system}.opium = pkgs.haskell.lib.overrideCabal opium {
# Currently the tests require a running Postgres instance. # Currently the tests require a running Postgres instance.
# This is not automated yet, so don't export the tests. # This is not automated yet, so don't export the tests.
doCheck = false; doCheck = false;
}; };
devShells.default = opium.env; devShells.${system}.default = opium.env;
} };
);
} }

36
lib/Database/PostgreSQL/Opium.hs
View File

@ -1,19 +1,16 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.Opium module Database.PostgreSQL.Opium
-- * Connection Management
( Connection
, connect
, close
-- * Queries -- * Queries
-- --
-- Functions for performing queries. @fetch@ retrieves rows, @execute@ doesn't. -- 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. -- 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. -- | TODO: Add @newtype Query = Query Text@ with @IsString@ instance to make constructing query strings at run time harder.
, fetch ( fetch
, fetch_ , fetch_
, execute , execute
, execute_ , execute_
@ -31,16 +28,18 @@ module Database.PostgreSQL.Opium
import Control.Monad (unless, void) import Control.Monad (unless, void)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except (ExceptT (..), runExceptT, throwE) import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, throwE)
import Data.Functor.Identity (Identity (..)) 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 (Result) import Database.PostgreSQL.LibPQ
( Connection
, Result
)
import qualified Data.Text.Encoding as Encoding import qualified Data.Text.Encoding as Encoding
import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Database.PostgreSQL.LibPQ as LibPQ
import Database.PostgreSQL.Opium.Connection (Connection, connect, close, withRawConnection)
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 (..), ColumnTable)
@ -99,23 +98,14 @@ execParams
-> a -> a
-> ExceptT Error IO Result -> ExceptT Error IO Result
execParams conn query params = do execParams conn query params = do
-- Actually run the query while locking the connection. let queryBytes = Encoding.encodeUtf8 query
mbResult <- ExceptT runQuery liftIO (LibPQ.execParams conn queryBytes (toParamList params) LibPQ.Binary) >>= \case
-- Check whether the result is valid or nah. Nothing ->
result <- mbResult `orThrow` ErrorNoResult except $ Left ErrorNoResult
Just result -> do
status <- liftIO $ LibPQ.resultStatus result status <- liftIO $ LibPQ.resultStatus result
mbMessage <- liftIO $ LibPQ.resultErrorMessage result mbMessage <- liftIO $ LibPQ.resultErrorMessage result
case mbMessage of case mbMessage of
Just "" -> pure result Just "" -> pure result
Nothing -> pure result Nothing -> pure result
Just message -> throwE $ ErrorInvalidResult status $ Encoding.decodeUtf8 message Just message -> except $ Left $ ErrorInvalidResult status $ Encoding.decodeUtf8 message
where
orThrow (Just x) _ = pure x
orThrow Nothing e = throwE e
queryBytes = Encoding.encodeUtf8 query
runQuery =
flip withRawConnection conn $ \mbRawConn -> runExceptT $ do
rawConn <- mbRawConn `orThrow` ErrorConnectionClosed
liftIO $ LibPQ.execParams rawConn queryBytes (toParamList params) LibPQ.Binary

50
lib/Database/PostgreSQL/Opium/Connection.hs
View File

@ -1,50 +0,0 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Database.PostgreSQL.Opium.Connection
( Connection
, unsafeWithRawConnection
, withRawConnection
, connect
, close
) where
import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, withMVar)
import Data.ByteString (ByteString)
import GHC.Stack (HasCallStack)
import qualified Database.PostgreSQL.LibPQ as LibPQ
newtype Connection = Connection
{ rawConnection :: MVar (Maybe LibPQ.Connection)
}
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 :: ByteString -> IO Connection
connect connectionString = do
rawConn <- LibPQ.connectdb connectionString
Connection <$> newMVar (Just rawConn)
close :: Connection -> IO ()
close conn = modifyMVar_ conn.rawConnection $ \case
Just rawConn -> do
LibPQ.finish rawConn
pure Nothing
Nothing ->
pure Nothing

1
lib/Database/PostgreSQL/Opium/Error.hs
View File

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

2
lib/Database/PostgreSQL/Opium/FromField.hs
View File

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

3
lib/Database/PostgreSQL/Opium/Oid.hs
View File

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

6
opium.cabal
View File

@ -20,7 +20,7 @@ name: opium
-- PVP summary: +-+------- breaking API changes -- PVP summary: +-+------- breaking API changes
-- | | +----- non-breaking API additions -- | | +----- non-breaking API additions
-- | | | +--- code changes with no API change -- | | | +--- code changes with no API change
version: 1.0.0.0 version: 0.1.0.0
-- A short (one-line) description of the package. -- A short (one-line) description of the package.
-- synopsis: -- synopsis:
@ -63,7 +63,6 @@ library
Database.PostgreSQL.Opium, Database.PostgreSQL.Opium,
Database.PostgreSQL.Opium.FromField, Database.PostgreSQL.Opium.FromField,
Database.PostgreSQL.Opium.FromRow, Database.PostgreSQL.Opium.FromRow,
Database.PostgreSQL.Opium.Connection,
Database.PostgreSQL.Opium.ToField Database.PostgreSQL.Opium.ToField
-- Modules included in this library but not exported. -- Modules included in this library but not exported.
@ -118,8 +117,7 @@ test-suite opium-test
other-modules: other-modules:
SpecHook, SpecHook,
Database.PostgreSQL.OpiumSpec, Database.PostgreSQL.OpiumSpec,
Database.PostgreSQL.Opium.FromFieldSpec, Database.PostgreSQL.Opium.FromFieldSpec
Database.PostgreSQL.Opium.FromRowSpec
-- Test dependencies. -- Test dependencies.
build-depends: build-depends:

5
test/Database/PostgreSQL/Opium/FromFieldSpec.hs
View File

@ -14,6 +14,7 @@ import Data.Time
, timeOfDayToTime , timeOfDayToTime
) )
import Data.Text (Text) import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection)
import Database.PostgreSQL.Opium (FromRow) import Database.PostgreSQL.Opium (FromRow)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy) import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
@ -112,7 +113,7 @@ newtype ARawField = ARawField
instance FromRow ARawField where instance FromRow ARawField where
shouldFetch :: (Eq a, FromRow a, Show a) => Opium.Connection -> Text -> [a] -> IO () shouldFetch :: (Eq a, FromRow a, Show a) => Connection -> Text -> [a] -> IO ()
shouldFetch conn query expectedRows = do shouldFetch conn query expectedRows = do
actualRows <- Opium.fetch_ query conn actualRows <- Opium.fetch_ query conn
actualRows `shouldBe` Right expectedRows actualRows `shouldBe` Right expectedRows
@ -120,7 +121,7 @@ shouldFetch conn query expectedRows = do
(/\) :: (a -> Bool) -> (a -> Bool) -> a -> Bool (/\) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
p /\ q = \x -> p x && q x p /\ q = \x -> p x && q x
spec :: SpecWith Opium.Connection spec :: SpecWith Connection
spec = do spec = do
describe "FromField Int" $ do describe "FromField Int" $ do
it "Decodes smallint" $ \conn -> do it "Decodes smallint" $ \conn -> do

92
test/Database/PostgreSQL/Opium/FromRowSpec.hs
View File

@ -1,92 +0,0 @@
{-# 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)

85
test/Database/PostgreSQL/OpiumSpec.hs
View File

@ -4,16 +4,20 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
module Database.PostgreSQL.OpiumSpec (ManyFields (..), MaybeTest (..), Person (..), Only (..), spec) where module Database.PostgreSQL.OpiumSpec (spec) where
import Data.ByteString (ByteString)
import Data.Either (isLeft) import Data.Either (isLeft)
import Data.Functor.Identity (Identity (..)) import Data.Functor.Identity (Identity (..))
import Data.Proxy (Proxy (..))
import Data.Text (Text) import Data.Text (Text)
import Database.PostgreSQL.LibPQ (Connection)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy) import Test.Hspec (SpecWith, describe, it, shouldBe, shouldSatisfy)
import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Database.PostgreSQL.Opium as Opium import qualified Database.PostgreSQL.Opium as Opium
import qualified Database.PostgreSQL.Opium.FromRow as Opium.FromRow
data Person = Person data Person = Person
{ name :: Text { name :: Text
@ -51,8 +55,80 @@ newtype Only a = Only
instance Opium.FromField a => Opium.FromRow (Only a) where instance Opium.FromField a => Opium.FromRow (Only a) where
spec :: SpecWith Opium.Connection 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.FromRow.toListColumnTable) columnTable
actualColumns `shouldBe` Right expectedColumns
spec :: SpecWith Connection
spec = do 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)
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 describe "fetch" $ do
it "Passes numbered parameters and retrieves a list of rows" $ \conn -> 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 rows <- Opium.fetch "SELECT ($1 + $2) AS only" (17 :: Int, 25 :: Int) conn
@ -106,8 +182,3 @@ spec = do
it "Does not accept two rows when Maybe is the row container type" $ \conn -> do 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 <- Opium.fetch_ @(Only Int) @Maybe "SELECT 17 AS only UNION ALL SELECT 25 AS only" conn
row `shouldSatisfy` isLeft 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

27
test/SpecHook.hs
View File

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