packages feed

pqi-ffi (empty) → 0.0.1.0

raw patch · 7 files changed

+487/−0 lines, 7 filesdep +basedep +bytestringdep +hspec

Dependencies added: base, bytestring, hspec, postgresql-libpq, pqi, pqi-conformance, pqi-ffi

Files

+ CHANGELOG.md view
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2026, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,20 @@+# pqi-ffi++[![Hackage](https://img.shields.io/hackage/v/pqi-ffi.svg)](https://hackage.haskell.org/package/pqi-ffi)+[![Continuous Haddock](https://img.shields.io/badge/haddock-master-blue)](https://nikita-volkov.github.io/pqi-ffi/)++The FFI adapter for [`pqi`](https://github.com/nikita-volkov/pqi),+backed by [`postgresql-libpq`](https://hackage.haskell.org/package/postgresql-libpq)+(a binding to the C `libpq` library).++`Pqi.Ffi.Connection` wraps a C-backed `PGconn` and provides an+`IsConnection` instance whose every method is a near-mechanical delegation to+the matching `Database.PostgreSQL.LibPQ` function. The only work is converting+between this family's portable types (OIDs as `Word32`, indices as `Int32`,+the shared enums) and `postgresql-libpq`'s C-specific newtypes.++This adapter is the **fidelity reference** for the `pqi` family: it is the+oracle against which all other adapters are tested. The+[`pqi-conformance`](https://github.com/nikita-volkov/pqi-conformance) suite+runs every operation on both the candidate adapter and this one, asserts+byte-identical output, and thereby defines what "correct" means for the family.
+ pqi-ffi.cabal view
@@ -0,0 +1,109 @@+cabal-version: 3.0+name: pqi-ffi+version: 0.0.1.0+category: Database, PostgreSQL+synopsis: FFI adapter for pqi, backed by postgresql-libpq+description:+  A @pqi@ adapter implemented as a thin pass-through over the+  @postgresql-libpq@ package, which binds the C @libpq@ library. Use this+  adapter when you want the fidelity of the reference C implementation; it is+  also the oracle that the @pqi-native@ adapter is tested against.++homepage: https://github.com/nikita-volkov/pqi-ffi+bug-reports: https://github.com/nikita-volkov/pqi-ffi/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2026, Nikita Volkov+license: MIT+license-file: LICENSE+extra-doc-files:+  CHANGELOG.md+  LICENSE+  README.md++source-repository head+  type: git+  location: https://github.com/nikita-volkov/pqi-ffi++common base+  default-language: Haskell2010+  default-extensions:+    ApplicativeDo+    BangPatterns+    BinaryLiterals+    BlockArguments+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveTraversable+    DerivingStrategies+    DerivingVia+    DuplicateRecordFields+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    LambdaCase+    LiberalTypeSynonyms+    MagicHash+    MultiParamTypeClasses+    MultiWayIf+    NamedFieldPuns+    NoFieldSelectors+    NoImplicitPrelude+    NoMonomorphismRestriction+    NumericUnderscores+    OverloadedRecordDot+    OverloadedStrings+    ParallelListComp+    PatternGuards+    QuasiQuotes+    RankNTypes+    RecordWildCards+    ScopedTypeVariables+    StandaloneDeriving+    StrictData+    TemplateHaskell+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    UnboxedTuples+    ViewPatterns++common test+  import: base+  ghc-options:+    -threaded+    -with-rtsopts=-N++library+  import: base+  hs-source-dirs: src/library+  exposed-modules:+    Pqi.Ffi++  other-modules:+    Pqi.Ffi.Prelude++  build-depends:+    base >=4.11 && <5,+    bytestring >=0.10 && <0.13,+    postgresql-libpq >=0.11 && <0.12,+    pqi ^>=0,++test-suite ffi-test+  import: test+  type: exitcode-stdio-1.0+  hs-source-dirs: src/test+  main-is: Spec.hs+  build-depends:+    base >=4.11 && <5,+    hspec >=2.11 && <2.12,+    pqi-conformance,+    pqi-ffi,
+ src/library/Pqi/Ffi.hs view
@@ -0,0 +1,295 @@+-- | The FFI adapter, backed by @postgresql-libpq@.+--+-- 'Connection' wraps the C-backed @PGconn@.+--+-- Each method is a near-mechanical delegation to the matching+-- @Database.PostgreSQL.LibPQ@ function, with the only work being the+-- conversion between this family's portable types (OIDs as 'Word32', indices+-- as 'Int32', the shared enums) and @postgresql-libpq@'s C-specific newtypes.+module Pqi.Ffi+  ( Connection,+  )+where++import qualified Database.PostgreSQL.LibPQ as Pq+import qualified Pqi+import Pqi.Ffi.Prelude++-- | A handle to a PostgreSQL connection backed by the C @libpq@ library.+newtype Connection = Connection Pq.Connection++-- | A result handle backed by a C @PGresult@.+newtype Result = Result Pq.Result++-- | A cancellation handle backed by a C @PGcancel@.+newtype Cancel = Cancel Pq.Cancel++instance Pqi.IsResult Result where+  resultStatus (Result r) = fromExecStatus <$> Pq.resultStatus r+  resultErrorMessage (Result r) = Pq.resultErrorMessage r+  resultErrorField (Result r) field = Pq.resultErrorField r (toFieldCode field)+  unsafeFreeResult (Result r) = Pq.unsafeFreeResult r+  ntuples (Result r) = fromRow <$> Pq.ntuples r+  nfields (Result r) = fromColumn <$> Pq.nfields r+  fname (Result r) column = Pq.fname r (toColumn column)+  fnumber (Result r) name = fmap fromColumn <$> Pq.fnumber r name+  ftable (Result r) column = fromOid <$> Pq.ftable r (toColumn column)+  ftablecol (Result r) column = fromColumn <$> Pq.ftablecol r (toColumn column)+  fformat (Result r) column = fromFormat <$> Pq.fformat r (toColumn column)+  ftype (Result r) column = fromOid <$> Pq.ftype r (toColumn column)+  fmod (Result r) column = Pq.fmod r (toColumn column)+  fsize (Result r) column = Pq.fsize r (toColumn column)+  getvalue (Result r) row column = Pq.getvalue r (toRow row) (toColumn column)+  getvalue' (Result r) row column = Pq.getvalue' r (toRow row) (toColumn column)+  getisnull (Result r) row column = Pq.getisnull r (toRow row) (toColumn column)+  getlength (Result r) row column = Pq.getlength r (toRow row) (toColumn column)+  nparams (Result r) = fromIntegral <$> Pq.nparams r+  paramtype (Result r) index = fromOid <$> Pq.paramtype r (fromIntegral index)+  cmdStatus (Result r) = Pq.cmdStatus r+  cmdTuples (Result r) = Pq.cmdTuples r++instance Pqi.IsCancel Cancel where+  cancel (Cancel handle) = Pq.cancel handle++instance Pqi.IsConnection Connection where+  type ResultOf Connection = Result+  type CancelOf Connection = Cancel++  connectdb conninfo = Connection <$> Pq.connectdb conninfo+  connectStart conninfo = Connection <$> Pq.connectStart conninfo+  connectPoll (Connection c) = fromPollingStatus <$> Pq.connectPoll c+  newNullConnection = Connection <$> Pq.newNullConnection+  isNullConnection (Connection c) = Pq.isNullConnection c+  finish (Connection c) = Pq.finish c+  reset (Connection c) = Pq.reset c+  resetStart (Connection c) = Pq.resetStart c+  resetPoll (Connection c) = fromPollingStatus <$> Pq.resetPoll c+  db (Connection c) = Pq.db c+  user (Connection c) = Pq.user c+  pass (Connection c) = Pq.pass c+  host (Connection c) = Pq.host c+  port (Connection c) = Pq.port c+  options (Connection c) = Pq.options c+  status (Connection c) = fromConnStatus <$> Pq.status c+  transactionStatus (Connection c) = fromTransactionStatus <$> Pq.transactionStatus c+  parameterStatus (Connection c) name = Pq.parameterStatus c name+  protocolVersion (Connection c) = Pq.protocolVersion c+  serverVersion (Connection c) = Pq.serverVersion c+  errorMessage (Connection c) = Pq.errorMessage c+  socket (Connection c) = Pq.socket c+  backendPID (Connection c) = fromIntegral <$> Pq.backendPID c+  connectionNeedsPassword (Connection c) = Pq.connectionNeedsPassword c+  connectionUsedPassword (Connection c) = Pq.connectionUsedPassword c++  exec (Connection c) sql =+    fmap Result <$> Pq.exec c sql+  execParams (Connection c) sql params resultFormat =+    fmap Result <$> Pq.execParams c sql (fmap (fmap toParam) params) (toFormat resultFormat)+  prepare (Connection c) name sql paramTypes =+    fmap Result <$> Pq.prepare c name sql (fmap (fmap toOid) paramTypes)+  execPrepared (Connection c) name params resultFormat =+    fmap Result <$> Pq.execPrepared c name (fmap (fmap toBoundParam) params) (toFormat resultFormat)+  describePrepared (Connection c) name =+    fmap Result <$> Pq.describePrepared c name+  describePortal (Connection c) name =+    fmap Result <$> Pq.describePortal c name++  escapeStringConn (Connection c) = Pq.escapeStringConn c+  escapeByteaConn (Connection c) = Pq.escapeByteaConn c+  escapeIdentifier (Connection c) = Pq.escapeIdentifier c++  sendQuery (Connection c) sql = Pq.sendQuery c sql+  sendQueryParams (Connection c) sql params resultFormat =+    Pq.sendQueryParams c sql (fmap (fmap toParam) params) (toFormat resultFormat)+  sendPrepare (Connection c) name sql paramTypes =+    Pq.sendPrepare c name sql (fmap (fmap toOid) paramTypes)+  sendQueryPrepared (Connection c) name params resultFormat =+    Pq.sendQueryPrepared c name (fmap (fmap toBoundParam) params) (toFormat resultFormat)+  sendDescribePrepared (Connection c) name = Pq.sendDescribePrepared c name+  sendDescribePortal (Connection c) name = Pq.sendDescribePortal c name+  getResult (Connection c) = fmap Result <$> Pq.getResult c+  consumeInput (Connection c) = Pq.consumeInput c+  isBusy (Connection c) = Pq.isBusy c+  setnonblocking (Connection c) nonBlocking = Pq.setnonblocking c nonBlocking+  isnonblocking (Connection c) = Pq.isnonblocking c+  setSingleRowMode (Connection c) = Pq.setSingleRowMode c+  flush (Connection c) = fromFlushStatus <$> Pq.flush c++  pipelineStatus (Connection c) = fromPipelineStatus <$> Pq.pipelineStatus c+  enterPipelineMode (Connection c) = Pq.enterPipelineMode c+  exitPipelineMode (Connection c) = Pq.exitPipelineMode c+  pipelineSync (Connection c) = Pq.pipelineSync c+  sendFlushRequest (Connection c) = Pq.sendFlushRequest c++  getCancel (Connection c) = fmap Cancel <$> Pq.getCancel c++  notifies (Connection c) = fmap fromNotify <$> Pq.notifies c+  disableNoticeReporting (Connection c) = Pq.disableNoticeReporting c+  enableNoticeReporting (Connection c) = Pq.enableNoticeReporting c+  getNotice (Connection c) = Pq.getNotice c++  putCopyData (Connection c) value = fromCopyInResult <$> Pq.putCopyData c value+  putCopyEnd (Connection c) reason = fromCopyInResult <$> Pq.putCopyEnd c reason+  getCopyData (Connection c) nonBlocking = fromCopyOutResult <$> Pq.getCopyData c nonBlocking++  loCreat (Connection c) = fmap fromOid <$> Pq.loCreat c+  loCreate (Connection c) oid = fmap fromOid <$> Pq.loCreate c (toOid oid)+  loImport (Connection c) path = fmap fromOid <$> Pq.loImport c path+  loImportWithOid (Connection c) path oid = fmap fromOid <$> Pq.loImportWithOid c path (toOid oid)+  loExport (Connection c) oid path = Pq.loExport c (toOid oid) path+  loOpen (Connection c) oid mode = fmap fromLibPQLoFd <$> Pq.loOpen c (toOid oid) mode+  loWrite (Connection c) fd value = Pq.loWrite c (toLibPQLoFd fd) value+  loRead (Connection c) fd len = Pq.loRead c (toLibPQLoFd fd) len+  loSeek (Connection c) fd mode offset = Pq.loSeek c (toLibPQLoFd fd) mode offset+  loTell (Connection c) fd = Pq.loTell c (toLibPQLoFd fd)+  loTruncate (Connection c) fd len = Pq.loTruncate c (toLibPQLoFd fd) len+  loClose (Connection c) fd = Pq.loClose c (toLibPQLoFd fd)+  loUnlink (Connection c) oid = Pq.loUnlink c (toOid oid)++  clientEncoding (Connection c) = Pq.clientEncoding c+  setClientEncoding (Connection c) encoding = Pq.setClientEncoding c encoding+  setErrorVerbosity (Connection c) verbosity =+    fromVerbosity <$> Pq.setErrorVerbosity c (toVerbosity verbosity)++-- * Type conversions++toParam :: (Word32, ByteString, Pqi.Format) -> (Pq.Oid, ByteString, Pq.Format)+toParam (oid, value, format) = (toOid oid, value, toFormat format)++toBoundParam :: (ByteString, Pqi.Format) -> (ByteString, Pq.Format)+toBoundParam (value, format) = (value, toFormat format)++toOid :: Word32 -> Pq.Oid+toOid = Pq.Oid . fromIntegral++fromOid :: Pq.Oid -> Word32+fromOid (Pq.Oid value) = fromIntegral value++toRow :: Int32 -> Pq.Row+toRow = Pq.toRow++fromRow :: Pq.Row -> Int32+fromRow = fromIntegral . fromEnum++toColumn :: Int32 -> Pq.Column+toColumn = Pq.toColumn++fromColumn :: Pq.Column -> Int32+fromColumn = fromIntegral . fromEnum++toLibPQLoFd :: Int32 -> Pq.LoFd+toLibPQLoFd = Pq.LoFd . fromIntegral++fromLibPQLoFd :: Pq.LoFd -> Int32+fromLibPQLoFd (Pq.LoFd fd) = fromIntegral fd++fromNotify :: Pq.Notify -> Pqi.Notify+fromNotify notification =+  Pqi.Notify+    { Pqi.relname = Pq.notifyRelname notification,+      Pqi.bePid = fromIntegral (Pq.notifyBePid notification),+      Pqi.extra = Pq.notifyExtra notification+    }++toFormat :: Pqi.Format -> Pq.Format+toFormat = \case+  Pqi.Text -> Pq.Text+  Pqi.Binary -> Pq.Binary++fromFormat :: Pq.Format -> Pqi.Format+fromFormat = \case+  Pq.Text -> Pqi.Text+  Pq.Binary -> Pqi.Binary++fromExecStatus :: Pq.ExecStatus -> Pqi.ExecStatus+fromExecStatus = \case+  Pq.EmptyQuery -> Pqi.EmptyQuery+  Pq.CommandOk -> Pqi.CommandOk+  Pq.TuplesOk -> Pqi.TuplesOk+  Pq.CopyOut -> Pqi.CopyOut+  Pq.CopyIn -> Pqi.CopyIn+  Pq.CopyBoth -> Pqi.CopyBoth+  Pq.BadResponse -> Pqi.BadResponse+  Pq.NonfatalError -> Pqi.NonfatalError+  Pq.FatalError -> Pqi.FatalError+  Pq.SingleTuple -> Pqi.SingleTuple+  Pq.PipelineSync -> Pqi.PipelineSync+  Pq.PipelineAbort -> Pqi.PipelineAbort++fromConnStatus :: Pq.ConnStatus -> Pqi.ConnStatus+fromConnStatus = \case+  Pq.ConnectionOk -> Pqi.ConnectionOk+  Pq.ConnectionBad -> Pqi.ConnectionBad+  Pq.ConnectionStarted -> Pqi.ConnectionStarted+  Pq.ConnectionMade -> Pqi.ConnectionMade+  Pq.ConnectionAwaitingResponse -> Pqi.ConnectionAwaitingResponse+  Pq.ConnectionAuthOk -> Pqi.ConnectionAuthOk+  Pq.ConnectionSetEnv -> Pqi.ConnectionSetEnv+  Pq.ConnectionSSLStartup -> Pqi.ConnectionSSLStartup++fromTransactionStatus :: Pq.TransactionStatus -> Pqi.TransactionStatus+fromTransactionStatus = \case+  Pq.TransIdle -> Pqi.TransIdle+  Pq.TransActive -> Pqi.TransActive+  Pq.TransInTrans -> Pqi.TransInTrans+  Pq.TransInError -> Pqi.TransInError+  Pq.TransUnknown -> Pqi.TransUnknown++fromPollingStatus :: Pq.PollingStatus -> Pqi.PollingStatus+fromPollingStatus = \case+  Pq.PollingFailed -> Pqi.PollingFailed+  Pq.PollingReading -> Pqi.PollingReading+  Pq.PollingWriting -> Pqi.PollingWriting+  Pq.PollingOk -> Pqi.PollingOk++fromPipelineStatus :: Pq.PipelineStatus -> Pqi.PipelineStatus+fromPipelineStatus = \case+  Pq.PipelineOn -> Pqi.PipelineOn+  Pq.PipelineOff -> Pqi.PipelineOff+  Pq.PipelineAborted -> Pqi.PipelineAborted++fromFlushStatus :: Pq.FlushStatus -> Pqi.FlushStatus+fromFlushStatus = \case+  Pq.FlushOk -> Pqi.FlushOk+  Pq.FlushFailed -> Pqi.FlushFailed+  Pq.FlushWriting -> Pqi.FlushWriting++fromCopyInResult :: Pq.CopyInResult -> Pqi.CopyInResult+fromCopyInResult = \case+  Pq.CopyInOk -> Pqi.CopyInOk+  Pq.CopyInError -> Pqi.CopyInError+  Pq.CopyInWouldBlock -> Pqi.CopyInWouldBlock++fromCopyOutResult :: Pq.CopyOutResult -> Pqi.CopyOutResult+fromCopyOutResult = \case+  Pq.CopyOutRow value -> Pqi.CopyOutRow value+  Pq.CopyOutWouldBlock -> Pqi.CopyOutWouldBlock+  Pq.CopyOutDone -> Pqi.CopyOutDone+  Pq.CopyOutError -> Pqi.CopyOutError++toVerbosity :: Pqi.Verbosity -> Pq.Verbosity+toVerbosity = \case+  Pqi.ErrorsTerse -> Pq.ErrorsTerse+  Pqi.ErrorsDefault -> Pq.ErrorsDefault+  Pqi.ErrorsVerbose -> Pq.ErrorsVerbose++fromVerbosity :: Pq.Verbosity -> Pqi.Verbosity+fromVerbosity = \case+  Pq.ErrorsTerse -> Pqi.ErrorsTerse+  Pq.ErrorsDefault -> Pqi.ErrorsDefault+  Pq.ErrorsVerbose -> Pqi.ErrorsVerbose++toFieldCode :: Pqi.FieldCode -> Pq.FieldCode+toFieldCode = \case+  Pqi.DiagSeverity -> Pq.DiagSeverity+  Pqi.DiagSqlstate -> Pq.DiagSqlstate+  Pqi.DiagMessagePrimary -> Pq.DiagMessagePrimary+  Pqi.DiagMessageDetail -> Pq.DiagMessageDetail+  Pqi.DiagMessageHint -> Pq.DiagMessageHint+  Pqi.DiagStatementPosition -> Pq.DiagStatementPosition+  Pqi.DiagInternalPosition -> Pq.DiagInternalPosition+  Pqi.DiagInternalQuery -> Pq.DiagInternalQuery+  Pqi.DiagContext -> Pq.DiagContext+  Pqi.DiagSourceFile -> Pq.DiagSourceFile+  Pqi.DiagSourceLine -> Pq.DiagSourceLine+  Pqi.DiagSourceFunction -> Pq.DiagSourceFunction
+ src/library/Pqi/Ffi/Prelude.hs view
@@ -0,0 +1,27 @@+module Pqi.Ffi.Prelude+  ( module Exports,+  )+where++import Control.Applicative as Exports+import Control.Monad as Exports+import Data.Bool as Exports+import Data.ByteString as Exports (ByteString)+import Data.Either as Exports+import Data.Eq as Exports+import Data.Foldable as Exports+import Data.Function as Exports+import Data.Functor as Exports+import Data.Int as Exports+import Data.Maybe as Exports+import Data.Ord as Exports+import Data.Traversable as Exports+import Data.Word as Exports+import System.IO as Exports (IO)+import Text.Show as Exports+import Prelude as Exports+  ( Enum (..),+    Integral (..),+    Num (..),+    fromIntegral,+  )
+ src/test/Spec.hs view
@@ -0,0 +1,14 @@+-- | The FFI adapter's conformance test suite: a single delegate to+-- 'Pqi.Conformance.specs', which brings up a throwaway PostgreSQL+-- container, runs the full differential battery against the FFI reference,+-- and tears the container down again.+module Main (main) where++import Data.Proxy (Proxy (..))+import Pqi.Conformance (specs)+import Pqi.Ffi (Connection)+import Test.Hspec+import Prelude++main :: IO ()+main = hspec (specs (Proxy @Connection))