Compare commits
7
Commits
2fddc958b9
..
main
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
4db509c1b5 | ||
|
|
af16429d82 | ||
|
|
42398e71bb | ||
|
|
1c32e4244e | ||
|
|
9e9e0204bb | ||
|
|
b39da29d13 | ||
|
|
3379fa9df7 |
@@ -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;
|
|
||||||
}
|
}
|
||||||
);
|
);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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.
|
||||||
|
|||||||
@@ -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,15 +12,24 @@ 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
|
||||||
=> (Maybe LibPQ.Connection -> IO a)
|
=> (Maybe LibPQ.Connection -> IO a)
|
||||||
@@ -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
|
||||||
|
|||||||
@@ -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)
|
||||||
|
|
||||||
|
|||||||
@@ -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
@@ -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
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user