7 Commits
8 changed files with 84 additions and 25 deletions
+9 -10
View File
@@ -7,7 +7,14 @@
outputs = { self, nixpkgs, flake-utils }: flake-utils.lib.eachDefaultSystem (system: outputs = { self, nixpkgs, flake-utils }: flake-utils.lib.eachDefaultSystem (system:
let let
pkgs = import nixpkgs { inherit system; }; pkgs = import nixpkgs { inherit system; };
opium = pkgs.haskellPackages.developPackage { in {
packages.opium = pkgs.haskell.lib.overrideCabal (pkgs.haskellPackages.developPackage { root = ./.; }) {
# Currently the tests require a running Postgres instance.
# This is not automated yet, so don't export the tests.
doCheck = false;
};
devShells.default = (pkgs.haskellPackages.developPackage {
root = ./.; root = ./.;
modifier = drv: modifier = drv:
pkgs.haskell.lib.addBuildTools drv [ pkgs.haskell.lib.addBuildTools drv [
@@ -15,15 +22,7 @@
pkgs.haskellPackages.implicit-hie pkgs.haskellPackages.implicit-hie
pkgs.haskell-language-server pkgs.haskell-language-server
]; ];
}; }).env;
in {
packages.opium = pkgs.haskell.lib.overrideCabal opium {
# Currently the tests require a running Postgres instance.
# This is not automated yet, so don't export the tests.
doCheck = false;
};
devShells.default = opium.env;
} }
); );
} }
+4 -3
View File
@@ -5,6 +5,7 @@
module Database.PostgreSQL.Opium module Database.PostgreSQL.Opium
-- * Connection Management -- * Connection Management
( Connection ( Connection
, ConnectionError (..)
, connect , connect
, close , close
-- * Queries -- * Queries
@@ -40,7 +41,7 @@ import Database.PostgreSQL.LibPQ (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.Connection (Connection, ConnectionError (..), 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)
@@ -58,11 +59,11 @@ instance RowContainer Maybe where
extract result nRows columnTable extract result nRows columnTable
| nRows == 0 = pure Nothing | nRows == 0 = pure Nothing
| nRows == 1 = Just <$> ExceptT (fromRow result columnTable 0) | nRows == 1 = Just <$> ExceptT (fromRow result columnTable 0)
| otherwise = throwE ErrorMoreThanOneRow | otherwise = throwE $ ErrorMoreThanOneRow $ fromEnum nRows
instance RowContainer Identity where instance RowContainer Identity where
extract result nRows columnTable = do extract result nRows columnTable = do
unless (nRows == 1) $ throwE ErrorNotExactlyOneRow unless (nRows == 1) $ throwE $ ErrorNotExactlyOneRow $ fromEnum nRows
Identity <$> ExceptT (fromRow result columnTable 0) 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. -- 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.
+24 -6
View File
@@ -1,8 +1,10 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.PostgreSQL.Opium.Connection module Database.PostgreSQL.Opium.Connection
( Connection ( Connection
, ConnectionError (..)
, unsafeWithRawConnection , unsafeWithRawConnection
, withRawConnection , withRawConnection
, connect , connect
@@ -10,14 +12,23 @@ module Database.PostgreSQL.Opium.Connection
) where ) where
import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, withMVar) import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, withMVar)
import Data.ByteString (ByteString) import Control.Exception (Exception)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Database.PostgreSQL.LibPQ (ConnStatus (..))
import GHC.Stack (HasCallStack) import GHC.Stack (HasCallStack)
import qualified Data.Text.Encoding as Encoding
import qualified Database.PostgreSQL.LibPQ as LibPQ import qualified Database.PostgreSQL.LibPQ as LibPQ
newtype Connection = Connection newtype Connection = Connection
{ rawConnection :: MVar (Maybe LibPQ.Connection) { rawConnection :: MVar (Maybe LibPQ.Connection)
} }
newtype ConnectionError = ConnectionError Text
deriving (Show)
instance Exception ConnectionError
withRawConnection withRawConnection
:: HasCallStack :: HasCallStack
@@ -35,11 +46,18 @@ unsafeWithRawConnection f = withRawConnection $ \case
Nothing -> error "raw connection is missing! perhaps the connection was already closed." Nothing -> error "raw connection is missing! perhaps the connection was already closed."
Just rawConn -> f rawConn Just rawConn -> f rawConn
connect :: ByteString -> IO Connection connect :: Text -> IO (Either ConnectionError Connection)
connect connectionString = do connect connectionString = do
rawConn <- LibPQ.connectdb connectionString -- Appending the client_encoding setting overrides any previous setting in the connection string.
-- We set the client encoding here to make sure we can use it below for decoding connection
Connection <$> newMVar (Just rawConn) -- error messages.
rawConn <- LibPQ.connectdb $ Encoding.encodeUtf8 $ connectionString <> " client_encoding=UTF8"
status <- LibPQ.status rawConn
if status == ConnectionOk then
Right . Connection <$> newMVar (Just rawConn)
else do
rawError <- fromMaybe "" <$> LibPQ.errorMessage rawConn
pure $ Left $ ConnectionError $ Encoding.decodeUtf8Lenient rawError
close :: Connection -> IO () close :: Connection -> IO ()
close conn = modifyMVar_ conn.rawConnection $ \case close conn = modifyMVar_ conn.rawConnection $ \case
+2 -2
View File
@@ -17,8 +17,8 @@ data Error
| ErrorInvalidOid Text Oid | ErrorInvalidOid Text Oid
| ErrorUnexpectedNull ErrorPosition | ErrorUnexpectedNull ErrorPosition
| ErrorInvalidField ErrorPosition Oid ByteString String | ErrorInvalidField ErrorPosition Oid ByteString String
| ErrorNotExactlyOneRow | ErrorNotExactlyOneRow Int
| ErrorMoreThanOneRow | ErrorMoreThanOneRow Int
| ErrorConnectionClosed | ErrorConnectionClosed
deriving (Eq, Show) deriving (Eq, Show)
+10
View File
@@ -7,8 +7,10 @@ module Database.PostgreSQL.Opium.ToField
import Data.Bits (Bits (..)) import Data.Bits (Bits (..))
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Int (Int32)
import Data.List (singleton) import Data.List (singleton)
import Data.Text (Text) import Data.Text (Text)
import Data.Time (Day, diffDays, fromGregorian)
import Data.Word (Word32) import Data.Word (Word32)
import Database.PostgreSQL.LibPQ (Format (..), Oid) import Database.PostgreSQL.LibPQ (Format (..), Oid)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
@@ -48,3 +50,11 @@ instance ToField Float where
instance ToField Double where instance ToField Double where
toField x = Just (Oid.doublePrecision, encodeBigEndian @Word 8 $ unsafeCoerce x, Binary) toField x = Just (Oid.doublePrecision, encodeBigEndian @Word 8 $ unsafeCoerce x, Binary)
toPostgresJulian :: Day -> Integer
toPostgresJulian date = diffDays date postgresEpoch
where
postgresEpoch = fromGregorian 2000 1 1
instance ToField Day where
toField x = Just (Oid.date, encodeBigEndian @Int32 4 $ fromIntegral $ toPostgresJulian x, Binary)
+4 -2
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: 1.1.1.0
-- A short (one-line) description of the package. -- A short (one-line) description of the package.
-- synopsis: -- synopsis:
@@ -119,13 +119,15 @@ test-suite opium-test
SpecHook, SpecHook,
Database.PostgreSQL.OpiumSpec, Database.PostgreSQL.OpiumSpec,
Database.PostgreSQL.Opium.FromFieldSpec, Database.PostgreSQL.Opium.FromFieldSpec,
Database.PostgreSQL.Opium.FromRowSpec Database.PostgreSQL.Opium.FromRowSpec,
Database.PostgreSQL.Opium.ToFieldSpec
-- Test dependencies. -- Test dependencies.
build-depends: build-depends:
base, base,
opium, opium,
bytestring, bytestring,
containers,
hspec, hspec,
postgresql-libpq, postgresql-libpq,
time, time,
@@ -0,0 +1,30 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
module Database.PostgreSQL.Opium.ToFieldSpec (spec) where
import Data.Functor.Identity (Identity (..))
import Data.Text (Text)
import Data.Time (fromGregorian)
import GHC.Generics (Generic)
import Test.Hspec (SpecWith, describe, it, shouldBe)
import qualified Database.PostgreSQL.Opium as Opium
newtype Result = Result
{ a :: Bool
} deriving (Show, Eq, Generic)
instance Opium.FromRow Result
shouldBeTrue :: Opium.ToParamList p => Opium.Connection -> Text -> p -> IO ()
shouldBeTrue conn query params = do
result <- Opium.fetch query params conn
result `shouldBe` Right (Identity (Result True))
spec :: SpecWith Opium.Connection
spec = do
describe "ToField Day" $ do
it "Encodes Day" $ \conn -> do
shouldBeTrue conn "SELECT $1 = date '1997-09-29' AS a" (Identity $ fromGregorian 1997 9 29)
shouldBeTrue conn "SELECT $1 = date '2025-07-28' AS a" (Identity $ fromGregorian 2025 7 28)
+1 -2
View File
@@ -8,7 +8,6 @@ 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 Database.PostgreSQL.Opium as Opium import qualified Database.PostgreSQL.Opium as Opium
@@ -20,7 +19,7 @@ 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 Right conn <- Opium.connect $ Text.pack dsn
Right _ <- Opium.execute_ "DROP TABLE IF EXISTS person" conn Right _ <- Opium.execute_ "DROP TABLE IF EXISTS person" conn
Right _ <- Opium.execute_ "CREATE TABLE person (name TEXT NOT NULL, age INT NOT NULL, score DOUBLE PRECISION NOT NULL, motto TEXT)" conn Right _ <- Opium.execute_ "CREATE TABLE person (name TEXT NOT NULL, age INT NOT NULL, score DOUBLE PRECISION NOT NULL, motto TEXT)" conn