{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeApplications      #-}

{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- This is a compatible interface with @HDBC-postgresql@'s @Database.HDBC.PostgreSQL@ except 'Config'.
--
-- Prepared statements are closed when some requests come once 'Statement's are GCed, because HDBC doesn't have "close" interface.
module Database.HDBC.PostgreSQL.Pure
  ( -- * Connection
    Config (..)
  , Connection (config)
  , Pure.Address (..)
  , withConnection
  , connect
    -- * Transaction
  , begin
  ) where

import qualified Database.PostgreSQL.Pure.Internal.Connection     as Pure
import qualified Database.PostgreSQL.Pure.Internal.Data           as Pure
import qualified Database.PostgreSQL.Pure.Internal.Exception      as Pure
import qualified Database.PostgreSQL.Pure.Internal.MonadFail      as MonadFail
import qualified Database.PostgreSQL.Pure.Internal.Parser         as Pure
import qualified Database.PostgreSQL.Pure.List                    as Pure
import qualified Database.PostgreSQL.Pure.Oid                     as Oid
import qualified Database.PostgreSQL.Simple.Time.Internal.Parser  as TimeParser
import qualified Database.PostgreSQL.Simple.Time.Internal.Printer as TimeBuilder

import           Paths_postgresql_pure                            (version)

import           Database.HDBC                                    (IConnection (clone, commit, dbServerVer, dbTransactionSupport, describeTable, disconnect, getTables, hdbcClientVer, hdbcDriverName, prepare, proxiedClientName, proxiedClientVer, rollback, run, runRaw),
                                                                   SqlColDesc (SqlColDesc, colDecDigits, colNullable, colOctetLength, colSize, colType),
                                                                   SqlError (SqlError, seErrorMsg, seNativeError, seState),
                                                                   SqlTypeId, throwSqlError)
import           Database.HDBC.ColTypes                           (SqlInterval (SqlIntervalSecondT), SqlTypeId (SqlBigIntT, SqlBitT, SqlCharT, SqlDateT, SqlDecimalT, SqlDoubleT, SqlFloatT, SqlIntervalT, SqlTimeT, SqlTimeWithZoneT, SqlTimestampT, SqlTimestampWithZoneT, SqlUnknownT, SqlVarBinaryT, SqlVarCharT))
import           Database.HDBC.Statement                          (SqlValue (SqlBool, SqlByteString, SqlChar, SqlDiffTime, SqlDouble, SqlInt32, SqlInt64, SqlInteger, SqlLocalDate, SqlLocalTime, SqlLocalTimeOfDay, SqlNull, SqlPOSIXTime, SqlRational, SqlString, SqlUTCTime, SqlWord32, SqlWord64, SqlZonedLocalTimeOfDay, SqlZonedTime),
                                                                   Statement (Statement, describeResult, execute, executeMany, executeRaw, fetchRow, finish, getColumnNames, originalQuery))

import           Control.Concurrent                               (MVar, modifyMVar_, newMVar)
import           Control.Exception.Safe                           (Exception (displayException, fromException, toException),
                                                                   impureThrow, try)
import           Control.Monad                                    (unless, void, (<=<))
import qualified Data.ByteString                                  as BS
import qualified Data.ByteString.Builder                          as BSB
import qualified Data.ByteString.Builder.Prim                     as BSBP
import qualified Data.ByteString.Lazy                             as BSL
import qualified Data.ByteString.Short                            as BSS
import qualified Data.ByteString.UTF8                             as BSU
import           Data.Convertible                                 (Convertible (safeConvert), convert)
import           Data.Default.Class                               (Default (def))
import           Data.Foldable                                    (for_)
import           Data.Int                                         (Int32, Int64)
import           Data.IORef                                       (IORef, mkWeakIORef, newIORef, readIORef, writeIORef)
import qualified Data.Map.Strict                                  as M
import           Data.Maybe                                       (fromMaybe)
import           Data.Scientific                                  (FPFormat (Exponent), Scientific, formatScientific,
                                                                   fromRationalRepetend)
import           Data.String                                      (IsString (fromString))
import           Data.Time                                        (DiffTime, NominalDiffTime, TimeOfDay, TimeZone, utc,
                                                                   zonedTimeToUTC)
import           Data.Traversable                                 (for)
import           Data.Tuple.Only                                  (Only (Only))
import           Data.Typeable                                    (Typeable, cast)
import           Data.Version                                     (showVersion)
import           Data.Word                                        (Word32, Word64)
import           Database.PostgreSQL.Placeholder.Convert          (convertQuestionMarkStyleToDollarSignStyle,
                                                                   splitQueries)
import           GHC.Records                                      (HasField (getField))
import qualified PostgreSQL.Binary.Decoding                       as BD
import qualified PostgreSQL.Binary.Encoding                       as BE

#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail                               (MonadFail)
#endif

-- | A configuration of a connection.
--
-- Default configuration is 'def', which is following.
--
-- >>> address def
-- AddressResolved 127.0.0.1:5432
-- >>> user def
-- "postgres"
-- >>> password def
-- ""
-- >>> database def
-- ""
-- >>> sendingBufferSize def
-- 4096
-- >>> receptionBufferSize def
-- 4096
--
-- @
-- encodeString def = \\code -> case code of \"UTF8\" -> 'pure' . 'BSU.fromString'; _ -> 'const' $ 'fail' $ "unexpected character code: " <> 'show' code
-- decodeString def = \\code -> case code of \"UTF8\" -> 'pure' . 'BSU.toString'; _ -> 'const' $ 'fail' $ "unexpected character code: " <> 'show' code
-- @
data Config =
  Config
    { Config -> Address
address             :: Pure.Address
    , Config -> String
user                :: String
    , Config -> String
password            :: String
    , Config -> String
database            :: String
    , Config -> Int
sendingBufferSize   :: Int -- ^ in byte
    , Config -> Int
receptionBufferSize :: Int -- ^ in byte
    , Config -> ShortByteString -> StringEncoder
encodeString        :: BSS.ShortByteString -> Pure.StringEncoder
    , Config -> ShortByteString -> StringDecoder
decodeString        :: BSS.ShortByteString -> Pure.StringDecoder
    }

instance Show Config where
  show :: Config -> String
show Config { Address
address :: Address
$sel:address:Config :: Config -> Address
address, String
user :: String
$sel:user:Config :: Config -> String
user, String
password :: String
$sel:password:Config :: Config -> String
password, String
database :: String
$sel:database:Config :: Config -> String
database, Int
sendingBufferSize :: Int
$sel:sendingBufferSize:Config :: Config -> Int
sendingBufferSize, Int
receptionBufferSize :: Int
$sel:receptionBufferSize:Config :: Config -> Int
receptionBufferSize } =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
"Config { address = "
      , Address -> String
forall a. Show a => a -> String
show Address
address
      , String
", user = "
      , ShowS
forall a. Show a => a -> String
show String
user
      , String
", password = "
      , ShowS
forall a. Show a => a -> String
show String
password
      , String
", database = "
      , ShowS
forall a. Show a => a -> String
show String
database
      , String
", sendingBufferSize = "
      , Int -> String
forall a. Show a => a -> String
show Int
sendingBufferSize
      , String
", receptionBufferSize = "
      , Int -> String
forall a. Show a => a -> String
show Int
receptionBufferSize
      , String
", encodeString = <function>, decodeString = <function> }"
      ]

instance Default Config where
  def :: Config
def =
    let Pure.Config { Address
$sel:address:Config :: Config -> Address
address :: Address
address, String
$sel:user:Config :: Config -> String
user :: String
user, String
$sel:password:Config :: Config -> String
password :: String
password, String
$sel:database:Config :: Config -> String
database :: String
database, Int
$sel:sendingBufferSize:Config :: Config -> Int
sendingBufferSize :: Int
sendingBufferSize, Int
$sel:receptionBufferSize:Config :: Config -> Int
receptionBufferSize :: Int
receptionBufferSize } = Config
forall a. Default a => a
def
    in
      Config :: Address
-> String
-> String
-> String
-> Int
-> Int
-> (ShortByteString -> StringEncoder)
-> (ShortByteString -> StringDecoder)
-> Config
Config
        { Address
address :: Address
$sel:address:Config :: Address
address
        , String
user :: String
$sel:user:Config :: String
user
        , String
password :: String
$sel:password:Config :: String
password
        , String
database :: String
$sel:database:Config :: String
database
        , Int
sendingBufferSize :: Int
$sel:sendingBufferSize:Config :: Int
sendingBufferSize
        , Int
receptionBufferSize :: Int
$sel:receptionBufferSize:Config :: Int
receptionBufferSize
        , $sel:encodeString:Config :: ShortByteString -> StringEncoder
encodeString = \ShortByteString
code -> case ShortByteString
code of ShortByteString
"UTF8" -> ByteString -> Either String ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> (String -> ByteString) -> StringEncoder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BSU.fromString; ShortByteString
_ -> Either String ByteString -> StringEncoder
forall a b. a -> b -> a
const (Either String ByteString -> StringEncoder)
-> Either String ByteString -> StringEncoder
forall a b. (a -> b) -> a -> b
$ StringEncoder
forall (m :: * -> *) a. MonadFail m => String -> m a
fail StringEncoder -> StringEncoder
forall a b. (a -> b) -> a -> b
$ String
"unexpected character code: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> String
forall a. Show a => a -> String
show ShortByteString
code
        , $sel:decodeString:Config :: ShortByteString -> StringDecoder
decodeString = \ShortByteString
code -> case ShortByteString
code of ShortByteString
"UTF8" -> String -> Either String String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String String)
-> (ByteString -> String) -> StringDecoder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSU.toString; ShortByteString
_ -> Either String String -> StringDecoder
forall a b. a -> b -> a
const (Either String String -> StringDecoder)
-> Either String String -> StringDecoder
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"unexpected character code: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> String
forall a. Show a => a -> String
show ShortByteString
code
        }

-- | PostgreSQL connection.
data Connection =
  Connection
    { Connection -> Connection
connection                    :: Pure.Connection
    , Connection -> IORef Word
statementCounter              :: IORef Word
    , Connection -> MVar [PreparedStatement]
unnecessaryPreparedStatements :: MVar [Pure.PreparedStatement] -- To accumulate unnecessary prepared statements
                                                                     -- to dispose them when some requests come,
                                                                     -- because HDBC doesn't have a interface to close statements.
    , Connection -> Config
config                        :: Config
    }

-- | Bracket function for a connection.
withConnection :: Config -> (Connection -> IO a) -> IO a
withConnection :: Config -> (Connection -> IO a) -> IO a
withConnection config :: Config
config@Config { Address
address :: Address
$sel:address:Config :: Config -> Address
address, String
user :: String
$sel:user:Config :: Config -> String
user, String
password :: String
$sel:password:Config :: Config -> String
password, String
database :: String
$sel:database:Config :: Config -> String
database, Int
sendingBufferSize :: Int
$sel:sendingBufferSize:Config :: Config -> Int
sendingBufferSize, Int
receptionBufferSize :: Int
$sel:receptionBufferSize:Config :: Config -> Int
receptionBufferSize } Connection -> IO a
f =
  Config -> (Connection -> IO a) -> IO a
forall a. Config -> (Connection -> IO a) -> IO a
Pure.withConnection Config :: Address -> String -> String -> String -> Int -> Int -> Config
Pure.Config { Address
address :: Address
$sel:address:Config :: Address
address, String
user :: String
$sel:user:Config :: String
user, String
password :: String
$sel:password:Config :: String
password, String
database :: String
$sel:database:Config :: String
database, Int
sendingBufferSize :: Int
$sel:sendingBufferSize:Config :: Int
sendingBufferSize, Int
receptionBufferSize :: Int
$sel:receptionBufferSize:Config :: Int
receptionBufferSize } ((Connection -> IO a) -> IO a) -> (Connection -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Connection
c -> do
    IO
  ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
   TransactionState)
-> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO
   ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
    TransactionState)
 -> IO ())
-> IO
     ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
      TransactionState)
-> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> ExecutedProcedure ()
-> IO (MessageResult (ExecutedProcedure ()), TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
c ExecutedProcedure ()
Pure.begin
    Connection
conn <- Connection
-> IORef Word -> MVar [PreparedStatement] -> Config -> Connection
Connection Connection
c (IORef Word -> MVar [PreparedStatement] -> Config -> Connection)
-> IO (IORef Word)
-> IO (MVar [PreparedStatement] -> Config -> Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0 IO (MVar [PreparedStatement] -> Config -> Connection)
-> IO (MVar [PreparedStatement]) -> IO (Config -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PreparedStatement] -> IO (MVar [PreparedStatement])
forall a. a -> IO (MVar a)
newMVar [] IO (Config -> Connection) -> IO Config -> IO Connection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config
    Connection -> IO a
f Connection
conn

-- | To connect to the server.
connect :: Config -> IO Connection
connect :: Config -> IO Connection
connect config :: Config
config@Config { Address
address :: Address
$sel:address:Config :: Config -> Address
address, String
user :: String
$sel:user:Config :: Config -> String
user, String
password :: String
$sel:password:Config :: Config -> String
password, String
database :: String
$sel:database:Config :: Config -> String
database, Int
sendingBufferSize :: Int
$sel:sendingBufferSize:Config :: Config -> Int
sendingBufferSize, Int
receptionBufferSize :: Int
$sel:receptionBufferSize:Config :: Config -> Int
receptionBufferSize } = do
  Connection
c <- Config -> IO Connection
Pure.connect Config :: Address -> String -> String -> String -> Int -> Int -> Config
Pure.Config { Address
address :: Address
$sel:address:Config :: Address
address, String
user :: String
$sel:user:Config :: String
user, String
password :: String
$sel:password:Config :: String
password, String
database :: String
$sel:database:Config :: String
database, Int
sendingBufferSize :: Int
$sel:sendingBufferSize:Config :: Int
sendingBufferSize, Int
receptionBufferSize :: Int
$sel:receptionBufferSize:Config :: Int
receptionBufferSize }
  IO
  ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
   TransactionState)
-> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO
   ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
    TransactionState)
 -> IO ())
-> IO
     ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
      TransactionState)
-> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> ExecutedProcedure ()
-> IO (MessageResult (ExecutedProcedure ()), TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
c ExecutedProcedure ()
Pure.begin
  Connection
-> IORef Word -> MVar [PreparedStatement] -> Config -> Connection
Connection Connection
c (IORef Word -> MVar [PreparedStatement] -> Config -> Connection)
-> IO (IORef Word)
-> IO (MVar [PreparedStatement] -> Config -> Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0 IO (MVar [PreparedStatement] -> Config -> Connection)
-> IO (MVar [PreparedStatement]) -> IO (Config -> Connection)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PreparedStatement] -> IO (MVar [PreparedStatement])
forall a. a -> IO (MVar a)
newMVar [] IO (Config -> Connection) -> IO Config -> IO Connection
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config

instance IConnection Connection where
  disconnect :: Connection -> IO ()
disconnect = Connection -> IO ()
Pure.disconnect (Connection -> IO ())
-> (Connection -> Connection) -> Connection -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Connection
connection

  commit :: Connection -> IO ()
commit hc :: Connection
hc@Connection { Connection
connection :: Connection
$sel:connection:Connection :: Connection -> Connection
connection } =
    IO () -> IO ()
forall a. IO a -> IO a
convertException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
      IO
  (((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
    (PreparedStatement, Portal, Executed (), Maybe ErrorFields)),
   TransactionState)
-> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO
   (((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
     (PreparedStatement, Portal, Executed (), Maybe ErrorFields)),
    TransactionState)
 -> IO ())
-> IO
     (((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
       (PreparedStatement, Portal, Executed (), Maybe ErrorFields)),
      TransactionState)
-> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> (ExecutedProcedure (), ExecutedProcedure ())
-> IO
     (MessageResult (ExecutedProcedure (), ExecutedProcedure ()),
      TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (ExecutedProcedure ()
Pure.commit, ExecutedProcedure ()
Pure.begin)

  rollback :: Connection -> IO ()
rollback hc :: Connection
hc@Connection { Connection
connection :: Connection
$sel:connection:Connection :: Connection -> Connection
connection } =
    IO () -> IO ()
forall a. IO a -> IO a
convertException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
      IO
  (((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
    (PreparedStatement, Portal, Executed (), Maybe ErrorFields)),
   TransactionState)
-> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO
   (((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
     (PreparedStatement, Portal, Executed (), Maybe ErrorFields)),
    TransactionState)
 -> IO ())
-> IO
     (((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
       (PreparedStatement, Portal, Executed (), Maybe ErrorFields)),
      TransactionState)
-> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> (ExecutedProcedure (), ExecutedProcedure ())
-> IO
     (MessageResult (ExecutedProcedure (), ExecutedProcedure ()),
      TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (ExecutedProcedure ()
Pure.rollback, ExecutedProcedure ()
Pure.begin)

  run :: Connection -> String -> [SqlValue] -> IO Integer
run hc :: Connection
hc@Connection { $sel:connection:Connection :: Connection -> Connection
connection = connection :: Connection
connection@Pure.Connection { BackendParameters
$sel:parameters:Connection :: Connection -> BackendParameters
parameters :: BackendParameters
parameters }, $sel:config:Connection :: Connection -> Config
config = Config { ShortByteString -> StringEncoder
encodeString :: ShortByteString -> StringEncoder
$sel:encodeString:Config :: Config -> ShortByteString -> StringEncoder
encodeString, ShortByteString -> StringDecoder
decodeString :: ShortByteString -> StringDecoder
$sel:decodeString:Config :: Config -> ShortByteString -> StringDecoder
decodeString } } String
query [SqlValue]
values =
    IO Integer -> IO Integer
forall a. IO a -> IO a
convertException (IO Integer -> IO Integer) -> IO Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ do
      Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
      ShortByteString
charCode <- BackendParameters -> IO ShortByteString
forall (m :: * -> *).
MonadFail m =>
BackendParameters -> m ShortByteString
lookupClientEncoding BackendParameters
parameters
      let
        encode :: StringEncoder
encode = ShortByteString -> StringEncoder
encodeString ShortByteString
charCode
        decode :: StringDecoder
decode = ShortByteString -> StringDecoder
decodeString ShortByteString
charCode
        queryQS :: BS.ByteString
        queryQS :: ByteString
queryQS = String -> ByteString
forall a. IsString a => String -> a
fromString String
query
        queryDS :: Query
queryDS =
          case ByteString -> Either String ByteString
forall (m :: * -> *). MonadFail m => ByteString -> m ByteString
convertQuestionMarkStyleToDollarSignStyle ByteString
queryQS of
            Right ByteString
q -> ByteString -> Query
Pure.Query ByteString
q
            Left String
err -> RequestBuildingFailed -> Query
forall e a. Exception e => e -> a
impureThrow (RequestBuildingFailed -> Query) -> RequestBuildingFailed -> Query
forall a b. (a -> b) -> a -> b
$ String -> RequestBuildingFailed
RequestBuildingFailed (String -> RequestBuildingFailed)
-> String -> RequestBuildingFailed
forall a b. (a -> b) -> a -> b
$ String
"conversion from question mark style to dollar sign style: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err
      PreparedStatement
ps <- Connection
-> PreparedStatementProcedure
-> IO (MessageResult PreparedStatementProcedure)
forall m. Message m => Connection -> m -> IO (MessageResult m)
Pure.flush Connection
connection (PreparedStatementProcedure
 -> IO (MessageResult PreparedStatementProcedure))
-> PreparedStatementProcedure
-> IO (MessageResult PreparedStatementProcedure)
forall a b. (a -> b) -> a -> b
$ PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
Pure.parse PreparedStatementName
"" Query
queryDS ((Word, Word) -> Either (Word, Word) ([Oid], [Oid])
forall a b. a -> Either a b
Left (Word
0, Word
0)) -- footnote [1]
      let
        pProc :: PortalProcedure
pProc = Either String PortalProcedure -> PortalProcedure
forceBind (Either String PortalProcedure -> PortalProcedure)
-> Either String PortalProcedure -> PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> [SqlValue]
-> PreparedStatement
-> Either String PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Pure.bind PortalName
"" FormatCode
Pure.TextFormat FormatCode
Pure.TextFormat BackendParameters
parameters StringEncoder
encode [SqlValue]
values PreparedStatement
ps
        eProc :: ExecutedProcedure ()
eProc = Word -> StringDecoder -> PortalProcedure -> ExecutedProcedure ()
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Pure.execute @_ @() Word
0 StringDecoder
decode PortalProcedure
pProc
      (PreparedStatement
_, Portal
_, Executed ()
e, Maybe ErrorFields
_) <- Connection
-> ExecutedProcedure ()
-> IO (MessageResult (ExecutedProcedure ()))
forall m. Message m => Connection -> m -> IO (MessageResult m)
Pure.flush Connection
connection ExecutedProcedure ()
eProc
      Integer -> IO Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ ExecuteResult -> Integer
resultCount (ExecuteResult -> Integer) -> ExecuteResult -> Integer
forall a b. (a -> b) -> a -> b
$ Executed () -> ExecuteResult
forall r. Executed r -> ExecuteResult
Pure.result Executed ()
e

  runRaw :: Connection -> String -> IO ()
runRaw hc :: Connection
hc@Connection { $sel:connection:Connection :: Connection -> Connection
connection = connection :: Connection
connection@Pure.Connection { BackendParameters
parameters :: BackendParameters
$sel:parameters:Connection :: Connection -> BackendParameters
parameters }, $sel:config:Connection :: Connection -> Config
config = Config { ShortByteString -> StringEncoder
encodeString :: ShortByteString -> StringEncoder
$sel:encodeString:Config :: Config -> ShortByteString -> StringEncoder
encodeString, ShortByteString -> StringDecoder
decodeString :: ShortByteString -> StringDecoder
$sel:decodeString:Config :: Config -> ShortByteString -> StringDecoder
decodeString } } String
query =
    IO () -> IO ()
forall a. IO a -> IO a
convertException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
      ShortByteString
charCode <- BackendParameters -> IO ShortByteString
forall (m :: * -> *).
MonadFail m =>
BackendParameters -> m ShortByteString
lookupClientEncoding BackendParameters
parameters
      let
        encode :: StringEncoder
encode = ShortByteString -> StringEncoder
encodeString ShortByteString
charCode
        decode :: StringDecoder
decode = ShortByteString -> StringDecoder
decodeString ShortByteString
charCode
        queries :: [ByteString]
queries = ByteString -> [ByteString]
splitQueries (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString String
query
      [ByteString]
-> (ByteString
    -> IO (PreparedStatement, Portal, Executed (), Maybe ErrorFields))
-> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ByteString]
queries ((ByteString
  -> IO (PreparedStatement, Portal, Executed (), Maybe ErrorFields))
 -> IO ())
-> (ByteString
    -> IO (PreparedStatement, Portal, Executed (), Maybe ErrorFields))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \ByteString
q -> do
        PreparedStatement
ps <- Connection
-> PreparedStatementProcedure
-> IO (MessageResult PreparedStatementProcedure)
forall m. Message m => Connection -> m -> IO (MessageResult m)
Pure.flush Connection
connection (PreparedStatementProcedure
 -> IO (MessageResult PreparedStatementProcedure))
-> PreparedStatementProcedure
-> IO (MessageResult PreparedStatementProcedure)
forall a b. (a -> b) -> a -> b
$ PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
Pure.parse PreparedStatementName
"" (ByteString -> Query
Pure.Query ByteString
q) ((Word, Word) -> Either (Word, Word) ([Oid], [Oid])
forall a b. a -> Either a b
Left (Word
0, Word
0)) -- footnote [1]
        Connection
-> ExecutedProcedure ()
-> IO (MessageResult (ExecutedProcedure ()))
forall m. Message m => Connection -> m -> IO (MessageResult m)
Pure.flush Connection
connection (ExecutedProcedure () -> IO (MessageResult (ExecutedProcedure ())))
-> ExecutedProcedure ()
-> IO (MessageResult (ExecutedProcedure ()))
forall a b. (a -> b) -> a -> b
$ Word -> StringDecoder -> PortalProcedure -> ExecutedProcedure ()
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Pure.execute @_ @() Word
0 StringDecoder
decode (PortalProcedure -> ExecutedProcedure ())
-> PortalProcedure -> ExecutedProcedure ()
forall a b. (a -> b) -> a -> b
$ Either String PortalProcedure -> PortalProcedure
forceBind (Either String PortalProcedure -> PortalProcedure)
-> Either String PortalProcedure -> PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> [SqlValue]
-> PreparedStatement
-> Either String PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Pure.bind PortalName
"" FormatCode
Pure.TextFormat FormatCode
Pure.TextFormat BackendParameters
parameters StringEncoder
encode ([] :: [SqlValue]) PreparedStatement
ps

  prepare :: Connection -> String -> IO Statement
prepare hc :: Connection
hc@Connection { $sel:connection:Connection :: Connection -> Connection
connection = connection :: Connection
connection@Pure.Connection { BackendParameters
parameters :: BackendParameters
$sel:parameters:Connection :: Connection -> BackendParameters
parameters }, IORef Word
statementCounter :: IORef Word
$sel:statementCounter:Connection :: Connection -> IORef Word
statementCounter, MVar [PreparedStatement]
unnecessaryPreparedStatements :: MVar [PreparedStatement]
$sel:unnecessaryPreparedStatements:Connection :: Connection -> MVar [PreparedStatement]
unnecessaryPreparedStatements, $sel:config:Connection :: Connection -> Config
config = Config { ShortByteString -> StringEncoder
encodeString :: ShortByteString -> StringEncoder
$sel:encodeString:Config :: Config -> ShortByteString -> StringEncoder
encodeString, ShortByteString -> StringDecoder
decodeString :: ShortByteString -> StringDecoder
$sel:decodeString:Config :: Config -> ShortByteString -> StringDecoder
decodeString } } String
query =
    IO Statement -> IO Statement
forall a. IO a -> IO a
convertException (IO Statement -> IO Statement) -> IO Statement -> IO Statement
forall a b. (a -> b) -> a -> b
$ do
      Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
      Word
count <- IORef Word -> IO Word
incrementCounter IORef Word
statementCounter
      IORef Word
portalCounter <- Word -> IO (IORef Word)
forall a. a -> IO (IORef a)
newIORef Word
0
      ShortByteString
charCode <- BackendParameters -> IO ShortByteString
forall (m :: * -> *).
MonadFail m =>
BackendParameters -> m ShortByteString
lookupClientEncoding BackendParameters
parameters
      let
        encode :: StringEncoder
encode = ShortByteString -> StringEncoder
encodeString ShortByteString
charCode
        decode :: StringDecoder
decode = ShortByteString -> StringDecoder
decodeString ShortByteString
charCode
        encodeIO :: String -> IO ByteString
encodeIO = Either String ByteString -> IO ByteString
forall (m :: * -> *) a. MonadFail m => Either String a -> m a
MonadFail.fromEither (Either String ByteString -> IO ByteString)
-> StringEncoder -> String -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringEncoder
encode :: String -> IO BS.ByteString
        decodeIO :: ByteString -> IO String
decodeIO = Either String String -> IO String
forall (m :: * -> *) a. MonadFail m => Either String a -> m a
MonadFail.fromEither (Either String String -> IO String)
-> StringDecoder -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringDecoder
decode :: BS.ByteString -> IO String
      ByteString
queryBS <- String -> IO ByteString
encodeIO String
query
      let
        queryDS :: Query
queryDS =
          case ByteString -> Either String ByteString
forall (m :: * -> *). MonadFail m => ByteString -> m ByteString
convertQuestionMarkStyleToDollarSignStyle ByteString
queryBS of
            Right ByteString
q -> ByteString -> Query
Pure.Query ByteString
q
            Left String
err -> RequestBuildingFailed -> Query
forall e a. Exception e => e -> a
impureThrow (RequestBuildingFailed -> Query) -> RequestBuildingFailed -> Query
forall a b. (a -> b) -> a -> b
$ String -> RequestBuildingFailed
RequestBuildingFailed (String -> RequestBuildingFailed)
-> String -> RequestBuildingFailed
forall a b. (a -> b) -> a -> b
$ String
"conversion from question mark style to dollar sign style: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err
      ByteString
countBS <- String -> IO ByteString
encodeIO (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show Word
count
      let
        psName :: PreparedStatementName
psName = ByteString -> PreparedStatementName
Pure.PreparedStatementName (ByteString -> PreparedStatementName)
-> ByteString -> PreparedStatementName
forall a b. (a -> b) -> a -> b
$ ByteString
countBS ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
": " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
queryBS
      (PreparedStatement
preparedStatement, TransactionState
_) <- Connection
-> PreparedStatementProcedure
-> IO (MessageResult PreparedStatementProcedure, TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (PreparedStatementProcedure
 -> IO (MessageResult PreparedStatementProcedure, TransactionState))
-> PreparedStatementProcedure
-> IO (MessageResult PreparedStatementProcedure, TransactionState)
forall a b. (a -> b) -> a -> b
$ PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
Pure.parse PreparedStatementName
psName Query
queryDS ((Word, Word) -> Either (Word, Word) ([Oid], [Oid])
forall a b. a -> Either a b
Left (Word
0, Word
0)) -- footnote [1]
      IORef [(Maybe [SqlValue], Portal)]
portalsRef <- [(Maybe [SqlValue], Portal)]
-> IO (IORef [(Maybe [SqlValue], Portal)])
forall a. a -> IO (IORef a)
newIORef [] :: IO (IORef [(Maybe [SqlValue], Pure.Portal)])
      IORef ()
alive <- () -> IO (IORef ())
forall a. a -> IO (IORef a)
newIORef () -- see the document of 'keepPreparedStatementAlive'
      let
        execute :: [SqlValue] -> IO Integer
        execute :: [SqlValue] -> IO Integer
execute [SqlValue]
values =
          IO Integer -> IO Integer
forall a. IO a -> IO a
convertException (IO Integer -> IO Integer) -> IO Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ do
            Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
            IO ()
finish'
            Word
count <- IORef Word -> IO Word
incrementCounter IORef Word
portalCounter
            ByteString
countBS <- String -> IO ByteString
encodeIO (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show Word
count
            let
              pName :: PortalName
pName =
                case PreparedStatementName
psName of
                  Pure.PreparedStatementName ByteString
n -> ByteString -> PortalName
Pure.PortalName (ByteString -> PortalName) -> ByteString -> PortalName
forall a b. (a -> b) -> a -> b
$ ByteString
countBS ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
": " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
n
            ((PreparedStatement
_, Portal
p, Executed [SqlValue]
e, Maybe ErrorFields
_), TransactionState
_) <- Connection
-> ExecutedProcedure [SqlValue]
-> IO
     (MessageResult (ExecutedProcedure [SqlValue]), TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (ExecutedProcedure [SqlValue]
 -> IO
      (MessageResult (ExecutedProcedure [SqlValue]), TransactionState))
-> ExecutedProcedure [SqlValue]
-> IO
     (MessageResult (ExecutedProcedure [SqlValue]), TransactionState)
forall a b. (a -> b) -> a -> b
$ Word
-> StringDecoder -> PortalProcedure -> ExecutedProcedure [SqlValue]
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Pure.execute Word
1 StringDecoder
decode (PortalProcedure -> ExecutedProcedure [SqlValue])
-> PortalProcedure -> ExecutedProcedure [SqlValue]
forall a b. (a -> b) -> a -> b
$ Either String PortalProcedure -> PortalProcedure
forceBind (Either String PortalProcedure -> PortalProcedure)
-> Either String PortalProcedure -> PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> [SqlValue]
-> PreparedStatement
-> Either String PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Pure.bind PortalName
pName FormatCode
Pure.TextFormat FormatCode
Pure.TextFormat BackendParameters
parameters StringEncoder
encode [SqlValue]
values PreparedStatement
preparedStatement
            IO ()
keepPreparedStatementAlive
            IORef [(Maybe [SqlValue], Portal)]
-> [(Maybe [SqlValue], Portal)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Maybe [SqlValue], Portal)]
portalsRef ([(Maybe [SqlValue], Portal)] -> IO ())
-> [(Maybe [SqlValue], Portal)] -> IO ()
forall a b. (a -> b) -> a -> b
$
              case Executed [SqlValue] -> ExecuteResult
forall r. Executed r -> ExecuteResult
Pure.result Executed [SqlValue]
e of
                ExecuteResult
Pure.ExecuteSuspended -> [([SqlValue] -> Maybe [SqlValue]
forall a. a -> Maybe a
Just ([SqlValue] -> Maybe [SqlValue]) -> [SqlValue] -> Maybe [SqlValue]
forall a b. (a -> b) -> a -> b
$ [[SqlValue]] -> [SqlValue]
forall a. [a] -> a
head ([[SqlValue]] -> [SqlValue]) -> [[SqlValue]] -> [SqlValue]
forall a b. (a -> b) -> a -> b
$ Executed [SqlValue] -> [[SqlValue]]
forall r. Executed r -> [r]
Pure.records Executed [SqlValue]
e, Portal
p)]
                ExecuteResult
_                     -> []
            Integer -> IO Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ ExecuteResult -> Integer
resultCount (ExecuteResult -> Integer) -> ExecuteResult -> Integer
forall a b. (a -> b) -> a -> b
$ Executed [SqlValue] -> ExecuteResult
forall r. Executed r -> ExecuteResult
Pure.result Executed [SqlValue]
e

        executeRaw :: IO ()
        executeRaw :: IO ()
executeRaw = IO Integer -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Integer -> IO ()) -> IO Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ [SqlValue] -> IO Integer
execute []

        executeMany :: [[SqlValue]] -> IO ()
        executeMany :: [[SqlValue]] -> IO ()
executeMany [[SqlValue]]
valuess =
          IO () -> IO ()
forall a. IO a -> IO a
convertException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
            IO ()
finish'
            [ExecutedProcedure [SqlValue]]
eProcs <-
              [[SqlValue]]
-> ([SqlValue] -> IO (ExecutedProcedure [SqlValue]))
-> IO [ExecutedProcedure [SqlValue]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [[SqlValue]]
valuess (([SqlValue] -> IO (ExecutedProcedure [SqlValue]))
 -> IO [ExecutedProcedure [SqlValue]])
-> ([SqlValue] -> IO (ExecutedProcedure [SqlValue]))
-> IO [ExecutedProcedure [SqlValue]]
forall a b. (a -> b) -> a -> b
$ \[SqlValue]
values -> do
                Word
count <- IORef Word -> IO Word
incrementCounter IORef Word
portalCounter
                ByteString
countBS <- String -> IO ByteString
encodeIO (String -> IO ByteString) -> String -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Word -> String
forall a. Show a => a -> String
show Word
count
                let
                  pName :: PortalName
pName =
                    case PreparedStatementName
psName of
                      Pure.PreparedStatementName ByteString
n -> ByteString -> PortalName
Pure.PortalName (ByteString -> PortalName) -> ByteString -> PortalName
forall a b. (a -> b) -> a -> b
$ ByteString
countBS ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
": " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
n
                ExecutedProcedure [SqlValue] -> IO (ExecutedProcedure [SqlValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExecutedProcedure [SqlValue] -> IO (ExecutedProcedure [SqlValue]))
-> ExecutedProcedure [SqlValue]
-> IO (ExecutedProcedure [SqlValue])
forall a b. (a -> b) -> a -> b
$ Word
-> StringDecoder -> PortalProcedure -> ExecutedProcedure [SqlValue]
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Pure.execute Word
1 StringDecoder
decode (PortalProcedure -> ExecutedProcedure [SqlValue])
-> PortalProcedure -> ExecutedProcedure [SqlValue]
forall a b. (a -> b) -> a -> b
$ Either String PortalProcedure -> PortalProcedure
forceBind (Either String PortalProcedure -> PortalProcedure)
-> Either String PortalProcedure -> PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> [SqlValue]
-> PreparedStatement
-> Either String PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Pure.bind PortalName
pName FormatCode
Pure.TextFormat FormatCode
Pure.TextFormat BackendParameters
parameters StringEncoder
encode [SqlValue]
values PreparedStatement
preparedStatement
            ([(PreparedStatement, Portal, Executed [SqlValue],
  Maybe ErrorFields)]
rs, TransactionState
_) <- Connection
-> [ExecutedProcedure [SqlValue]]
-> IO
     (MessageResult [ExecutedProcedure [SqlValue]], TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection [ExecutedProcedure [SqlValue]]
eProcs
            IO ()
keepPreparedStatementAlive
            IORef [(Maybe [SqlValue], Portal)]
-> [(Maybe [SqlValue], Portal)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Maybe [SqlValue], Portal)]
portalsRef ([(Maybe [SqlValue], Portal)] -> IO ())
-> [(Maybe [SqlValue], Portal)] -> IO ()
forall a b. (a -> b) -> a -> b
$
              [[(Maybe [SqlValue], Portal)]] -> [(Maybe [SqlValue], Portal)]
forall a. Monoid a => [a] -> a
mconcat ([[(Maybe [SqlValue], Portal)]] -> [(Maybe [SqlValue], Portal)])
-> [[(Maybe [SqlValue], Portal)]] -> [(Maybe [SqlValue], Portal)]
forall a b. (a -> b) -> a -> b
$
                (((PreparedStatement, Portal, Executed [SqlValue],
  Maybe ErrorFields)
 -> [(Maybe [SqlValue], Portal)])
-> [(PreparedStatement, Portal, Executed [SqlValue],
     Maybe ErrorFields)]
-> [[(Maybe [SqlValue], Portal)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PreparedStatement, Portal, Executed [SqlValue],
  Maybe ErrorFields)]
rs) (((PreparedStatement, Portal, Executed [SqlValue],
   Maybe ErrorFields)
  -> [(Maybe [SqlValue], Portal)])
 -> [[(Maybe [SqlValue], Portal)]])
-> ((PreparedStatement, Portal, Executed [SqlValue],
     Maybe ErrorFields)
    -> [(Maybe [SqlValue], Portal)])
-> [[(Maybe [SqlValue], Portal)]]
forall a b. (a -> b) -> a -> b
$ \(PreparedStatement
_, Portal
p, Executed [SqlValue]
e, Maybe ErrorFields
_) ->
                  case Executed [SqlValue] -> ExecuteResult
forall r. Executed r -> ExecuteResult
Pure.result Executed [SqlValue]
e of
                    ExecuteResult
Pure.ExecuteSuspended -> [([SqlValue] -> Maybe [SqlValue]
forall a. a -> Maybe a
Just ([SqlValue] -> Maybe [SqlValue]) -> [SqlValue] -> Maybe [SqlValue]
forall a b. (a -> b) -> a -> b
$ [[SqlValue]] -> [SqlValue]
forall a. [a] -> a
head ([[SqlValue]] -> [SqlValue]) -> [[SqlValue]] -> [SqlValue]
forall a b. (a -> b) -> a -> b
$ Executed [SqlValue] -> [[SqlValue]]
forall r. Executed r -> [r]
Pure.records Executed [SqlValue]
e, Portal
p)]
                    ExecuteResult
_                     -> [(Maybe [SqlValue], Portal)]
forall a. Monoid a => a
mempty

        finish :: IO ()
        finish :: IO ()
finish =
          IO () -> IO ()
forall a. IO a -> IO a
convertException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
            IO ()
finish'
            IO ()
keepPreparedStatementAlive
            IORef [(Maybe [SqlValue], Portal)]
-> [(Maybe [SqlValue], Portal)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Maybe [SqlValue], Portal)]
portalsRef []

        finish' :: IO ()
        finish' :: IO ()
finish' = do
          [(Maybe [SqlValue], Portal)]
ps <- IORef [(Maybe [SqlValue], Portal)]
-> IO [(Maybe [SqlValue], Portal)]
forall a. IORef a -> IO a
readIORef IORef [(Maybe [SqlValue], Portal)]
portalsRef
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Maybe [SqlValue], Portal)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Maybe [SqlValue], Portal)]
ps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ([()], TransactionState) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ([()], TransactionState) -> IO ())
-> IO ([()], TransactionState) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> [CloseProcedure]
-> IO (MessageResult [CloseProcedure], TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection ([CloseProcedure]
 -> IO (MessageResult [CloseProcedure], TransactionState))
-> [CloseProcedure]
-> IO (MessageResult [CloseProcedure], TransactionState)
forall a b. (a -> b) -> a -> b
$ Portal -> CloseProcedure
forall p. Close p => p -> CloseProcedure
Pure.close (Portal -> CloseProcedure)
-> ((Maybe [SqlValue], Portal) -> Portal)
-> (Maybe [SqlValue], Portal)
-> CloseProcedure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [SqlValue], Portal) -> Portal
forall a b. (a, b) -> b
snd ((Maybe [SqlValue], Portal) -> CloseProcedure)
-> [(Maybe [SqlValue], Portal)] -> [CloseProcedure]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe [SqlValue], Portal)]
ps

        fetchRow :: IO (Maybe [SqlValue])
        fetchRow :: IO (Maybe [SqlValue])
fetchRow =
          IO (Maybe [SqlValue]) -> IO (Maybe [SqlValue])
forall a. IO a -> IO a
convertException (IO (Maybe [SqlValue]) -> IO (Maybe [SqlValue]))
-> IO (Maybe [SqlValue]) -> IO (Maybe [SqlValue])
forall a b. (a -> b) -> a -> b
$ do
            Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
            [(Maybe [SqlValue], Portal)]
ps <- IORef [(Maybe [SqlValue], Portal)]
-> IO [(Maybe [SqlValue], Portal)]
forall a. IORef a -> IO a
readIORef IORef [(Maybe [SqlValue], Portal)]
portalsRef
            case [(Maybe [SqlValue], Portal)]
ps of
              (Just [SqlValue]
r, Portal
p):[(Maybe [SqlValue], Portal)]
ps -> do
                IORef [(Maybe [SqlValue], Portal)]
-> [(Maybe [SqlValue], Portal)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Maybe [SqlValue], Portal)]
portalsRef ((Maybe [SqlValue]
forall a. Maybe a
Nothing, Portal
p)(Maybe [SqlValue], Portal)
-> [(Maybe [SqlValue], Portal)] -> [(Maybe [SqlValue], Portal)]
forall a. a -> [a] -> [a]
:[(Maybe [SqlValue], Portal)]
ps)
                Maybe [SqlValue] -> IO (Maybe [SqlValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [SqlValue] -> IO (Maybe [SqlValue]))
-> Maybe [SqlValue] -> IO (Maybe [SqlValue])
forall a b. (a -> b) -> a -> b
$ [SqlValue] -> Maybe [SqlValue]
forall a. a -> Maybe a
Just [SqlValue]
r
              (Maybe [SqlValue]
Nothing, Portal
p):[(Maybe [SqlValue], Portal)]
ps -> do
                ((PreparedStatement
_, Portal
_, Executed [SqlValue]
e, Maybe ErrorFields
_), TransactionState
_) <- Connection
-> ExecutedProcedure [SqlValue]
-> IO
     (MessageResult (ExecutedProcedure [SqlValue]), TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (ExecutedProcedure [SqlValue]
 -> IO
      (MessageResult (ExecutedProcedure [SqlValue]), TransactionState))
-> ExecutedProcedure [SqlValue]
-> IO
     (MessageResult (ExecutedProcedure [SqlValue]), TransactionState)
forall a b. (a -> b) -> a -> b
$ Word -> StringDecoder -> Portal -> ExecutedProcedure [SqlValue]
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Pure.execute Word
1 StringDecoder
decode Portal
p
                IO ()
keepPreparedStatementAlive
                case Executed [SqlValue] -> ExecuteResult
forall r. Executed r -> ExecuteResult
Pure.result Executed [SqlValue]
e of
                  ExecuteResult
Pure.ExecuteSuspended ->
                    Maybe [SqlValue] -> IO (Maybe [SqlValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [SqlValue] -> IO (Maybe [SqlValue]))
-> Maybe [SqlValue] -> IO (Maybe [SqlValue])
forall a b. (a -> b) -> a -> b
$ [SqlValue] -> Maybe [SqlValue]
forall a. a -> Maybe a
Just ([SqlValue] -> Maybe [SqlValue]) -> [SqlValue] -> Maybe [SqlValue]
forall a b. (a -> b) -> a -> b
$ [[SqlValue]] -> [SqlValue]
forall a. [a] -> a
head ([[SqlValue]] -> [SqlValue]) -> [[SqlValue]] -> [SqlValue]
forall a b. (a -> b) -> a -> b
$ Executed [SqlValue] -> [[SqlValue]]
forall r. Executed r -> [r]
Pure.records Executed [SqlValue]
e
                  ExecuteResult
_ -> do
                    IO ((), TransactionState) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), TransactionState) -> IO ())
-> IO ((), TransactionState) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> CloseProcedure
-> IO (MessageResult CloseProcedure, TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (CloseProcedure
 -> IO (MessageResult CloseProcedure, TransactionState))
-> CloseProcedure
-> IO (MessageResult CloseProcedure, TransactionState)
forall a b. (a -> b) -> a -> b
$ Portal -> CloseProcedure
forall p. Close p => p -> CloseProcedure
Pure.close Portal
p
                    IO ()
keepPreparedStatementAlive
                    IORef [(Maybe [SqlValue], Portal)]
-> [(Maybe [SqlValue], Portal)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Maybe [SqlValue], Portal)]
portalsRef [(Maybe [SqlValue], Portal)]
ps
                    Maybe [SqlValue] -> IO (Maybe [SqlValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [SqlValue]
forall a. Maybe a
Nothing
              [] -> Maybe [SqlValue] -> IO (Maybe [SqlValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [SqlValue]
forall a. Maybe a
Nothing

        getColumnNames :: IO [String]
        getColumnNames :: IO [String]
getColumnNames =
          IO [String] -> IO [String]
forall a. IO a -> IO a
convertException (IO [String] -> IO [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ do
            Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
            [IO String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO String] -> IO [String]) -> [IO String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> IO String
decodeIO (ByteString -> IO String)
-> (ColumnInfo -> ByteString) -> ColumnInfo -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "name" r a => r -> a
getField @"name" (ColumnInfo -> IO String) -> [ColumnInfo] -> [IO String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PreparedStatement -> [ColumnInfo]
Pure.resultInfos PreparedStatement
preparedStatement

        originalQuery :: String
        originalQuery :: String
originalQuery = String
query

        describeResult :: IO [(String, SqlColDesc)]
        describeResult :: IO [(String, SqlColDesc)]
describeResult =
          IO [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. IO a -> IO a
convertException (IO [(String, SqlColDesc)] -> IO [(String, SqlColDesc)])
-> IO [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a b. (a -> b) -> a -> b
$ do
            Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
            let
              columnInfos :: [ColumnInfo]
columnInfos = PreparedStatement -> [ColumnInfo]
Pure.resultInfos PreparedStatement
preparedStatement
              psProc :: PreparedStatementProcedure
psProc = PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
Pure.parse PreparedStatementName
"attr" Query
"SELECT attnotnull FROM pg_attribute WHERE attrelid = $1 AND attnum = $2" (([Oid], [Oid]) -> Either (Word, Word) ([Oid], [Oid])
forall a b. b -> Either a b
Right ([Oid
Oid.oid, Oid
Oid.int2], [Oid
Oid.bool]))
            (PreparedStatement
ps, TransactionState
_) <- Connection
-> PreparedStatementProcedure
-> IO (MessageResult PreparedStatementProcedure, TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection PreparedStatementProcedure
psProc
            [(String, SqlColDesc)]
results <-
              [ColumnInfo]
-> (ColumnInfo -> IO (String, SqlColDesc))
-> IO [(String, SqlColDesc)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ColumnInfo]
columnInfos ((ColumnInfo -> IO (String, SqlColDesc))
 -> IO [(String, SqlColDesc)])
-> (ColumnInfo -> IO (String, SqlColDesc))
-> IO [(String, SqlColDesc)]
forall a b. (a -> b) -> a -> b
$ \Pure.ColumnInfo { ByteString
$sel:name:ColumnInfo :: ColumnInfo -> ByteString
name :: ByteString
name, Oid
$sel:tableOid:ColumnInfo :: ColumnInfo -> Oid
tableOid :: Oid
tableOid, AttributeNumber
$sel:attributeNumber:ColumnInfo :: ColumnInfo -> AttributeNumber
attributeNumber :: AttributeNumber
attributeNumber, Oid
$sel:typeOid:ColumnInfo :: ColumnInfo -> Oid
typeOid :: Oid
typeOid, TypeLength
$sel:typeLength:ColumnInfo :: ColumnInfo -> TypeLength
typeLength :: TypeLength
typeLength, TypeModifier
$sel:typeModifier:ColumnInfo :: ColumnInfo -> TypeModifier
typeModifier :: TypeModifier
typeModifier } -> do
                ((PreparedStatement
_, Portal
_, Executed (Only Bool)
e, Maybe ErrorFields
_), TransactionState
_) <- Connection
-> ExecutedProcedure (Only Bool)
-> IO
     (MessageResult (ExecutedProcedure (Only Bool)), TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (ExecutedProcedure (Only Bool)
 -> IO
      (MessageResult (ExecutedProcedure (Only Bool)), TransactionState))
-> ExecutedProcedure (Only Bool)
-> IO
     (MessageResult (ExecutedProcedure (Only Bool)), TransactionState)
forall a b. (a -> b) -> a -> b
$ Word
-> StringDecoder
-> PortalProcedure
-> ExecutedProcedure (Only Bool)
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Pure.execute Word
1 StringDecoder
decode (PortalProcedure -> ExecutedProcedure (Only Bool))
-> PortalProcedure -> ExecutedProcedure (Only Bool)
forall a b. (a -> b) -> a -> b
$ Either String PortalProcedure -> PortalProcedure
forceBind (Either String PortalProcedure -> PortalProcedure)
-> Either String PortalProcedure -> PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> (Oid, AttributeNumber)
-> PreparedStatement
-> Either String PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Pure.bind PortalName
"" FormatCode
Pure.TextFormat FormatCode
Pure.TextFormat BackendParameters
parameters StringEncoder
encode (Oid
tableOid, AttributeNumber
attributeNumber) PreparedStatement
ps
                let
                  (Only Bool
attnotnull) = [Only Bool] -> Only Bool
forall a. [a] -> a
head ([Only Bool] -> Only Bool) -> [Only Bool] -> Only Bool
forall a b. (a -> b) -> a -> b
$ Executed (Only Bool) -> [Only Bool]
forall r. Executed r -> [r]
Pure.records Executed (Only Bool)
e
                  (Maybe Int
colSize, Maybe Int
colDecDigits) = Oid -> TypeLength -> TypeModifier -> (Maybe Int, Maybe Int)
columnSize Oid
typeOid TypeLength
typeLength TypeModifier
typeModifier
                String
nameStr <- ByteString -> IO String
decodeIO ByteString
name
                (String, SqlColDesc) -> IO (String, SqlColDesc)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  ( String
nameStr
                  , SqlColDesc :: SqlTypeId
-> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Bool -> SqlColDesc
SqlColDesc
                      { colType :: SqlTypeId
colType = Oid -> SqlTypeId
forall a b. Convertible a b => a -> b
convert Oid
typeOid
                      , Maybe Int
colSize :: Maybe Int
colSize :: Maybe Int
colSize
                      , colOctetLength :: Maybe Int
colOctetLength = Maybe Int
forall a. Maybe a
Nothing
                      , Maybe Int
colDecDigits :: Maybe Int
colDecDigits :: Maybe Int
colDecDigits
                      , colNullable :: Maybe Bool
colNullable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
attnotnull
                      }
                  )
            IO ((), TransactionState) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), TransactionState) -> IO ())
-> IO ((), TransactionState) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> CloseProcedure
-> IO (MessageResult CloseProcedure, TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (CloseProcedure
 -> IO (MessageResult CloseProcedure, TransactionState))
-> CloseProcedure
-> IO (MessageResult CloseProcedure, TransactionState)
forall a b. (a -> b) -> a -> b
$ PreparedStatement -> CloseProcedure
forall p. Close p => p -> CloseProcedure
Pure.close PreparedStatement
ps
            IO ()
keepPreparedStatementAlive
            [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(String, SqlColDesc)]
results

        -- The GHC optimiser make 'Statement's be GCed in advance of exiting those scopes.
        -- To prevent it, insert 'readIORef's at the end of actions.
        -- Finalisers of 'IORef's are set, instead of ones of 'Statement's.
        -- See: https://github.com/snoyberg/http-client/pull/352
        keepPreparedStatementAlive :: IO ()
        keepPreparedStatementAlive :: IO ()
keepPreparedStatementAlive = IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef () -> IO ()
forall a. IORef a -> IO a
readIORef IORef ()
alive

        statement :: Statement
statement =
          Statement :: ([SqlValue] -> IO Integer)
-> IO ()
-> ([[SqlValue]] -> IO ())
-> IO ()
-> IO (Maybe [SqlValue])
-> IO [String]
-> String
-> IO [(String, SqlColDesc)]
-> Statement
Statement
            { [SqlValue] -> IO Integer
execute :: [SqlValue] -> IO Integer
execute :: [SqlValue] -> IO Integer
execute
            , IO ()
executeRaw :: IO ()
executeRaw :: IO ()
executeRaw
            , [[SqlValue]] -> IO ()
executeMany :: [[SqlValue]] -> IO ()
executeMany :: [[SqlValue]] -> IO ()
executeMany
            , IO ()
finish :: IO ()
finish :: IO ()
finish
            , IO (Maybe [SqlValue])
fetchRow :: IO (Maybe [SqlValue])
fetchRow :: IO (Maybe [SqlValue])
fetchRow
            , IO [String]
getColumnNames :: IO [String]
getColumnNames :: IO [String]
getColumnNames
            , String
originalQuery :: String
originalQuery :: String
originalQuery
            , IO [(String, SqlColDesc)]
describeResult :: IO [(String, SqlColDesc)]
describeResult :: IO [(String, SqlColDesc)]
describeResult
            }

      -- set up a finaliser
      IO (Weak (IORef ())) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Weak (IORef ())) -> IO ()) -> IO (Weak (IORef ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef () -> IO () -> IO (Weak (IORef ()))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
mkWeakIORef IORef ()
alive (IO () -> IO (Weak (IORef ()))) -> IO () -> IO (Weak (IORef ()))
forall a b. (a -> b) -> a -> b
$ MVar [PreparedStatement]
-> ([PreparedStatement] -> IO [PreparedStatement]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [PreparedStatement]
unnecessaryPreparedStatements (([PreparedStatement] -> IO [PreparedStatement]) -> IO ())
-> ([PreparedStatement] -> IO [PreparedStatement]) -> IO ()
forall a b. (a -> b) -> a -> b
$ [PreparedStatement] -> IO [PreparedStatement]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PreparedStatement] -> IO [PreparedStatement])
-> ([PreparedStatement] -> [PreparedStatement])
-> [PreparedStatement]
-> IO [PreparedStatement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PreparedStatement
preparedStatementPreparedStatement -> [PreparedStatement] -> [PreparedStatement]
forall a. a -> [a] -> [a]
:)
      Statement -> IO Statement
forall (f :: * -> *) a. Applicative f => a -> f a
pure Statement
statement

  clone :: Connection -> IO Connection
clone hc :: Connection
hc@Connection { Config
config :: Config
$sel:config:Connection :: Connection -> Config
config } =
    IO Connection -> IO Connection
forall a. IO a -> IO a
convertException (IO Connection -> IO Connection) -> IO Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ do
      Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
      Config -> IO Connection
connect Config
config

  hdbcDriverName :: Connection -> String
hdbcDriverName Connection
_ = String
"postgresql"

  hdbcClientVer :: Connection -> String
hdbcClientVer Connection
_ = Version -> String
showVersion Version
version

  proxiedClientName :: Connection -> String
proxiedClientName = Connection -> String
forall conn. IConnection conn => conn -> String
hdbcDriverName

  proxiedClientVer :: Connection -> String
proxiedClientVer = Connection -> String
forall conn. IConnection conn => conn -> String
hdbcClientVer

  dbServerVer :: Connection -> String
dbServerVer Connection { $sel:connection:Connection :: Connection -> Connection
connection = Pure.Connection { BackendParameters
parameters :: BackendParameters
$sel:parameters:Connection :: Connection -> BackendParameters
parameters }, $sel:config:Connection :: Connection -> Config
config = Config { ShortByteString -> StringDecoder
decodeString :: ShortByteString -> StringDecoder
$sel:decodeString:Config :: Config -> ShortByteString -> StringDecoder
decodeString } } =
    String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ do
      ShortByteString
serverVersion <- ShortByteString -> BackendParameters -> Maybe ShortByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ShortByteString
"server_version" BackendParameters
parameters
      StringDecoder
decode <- ShortByteString -> StringDecoder
decodeString (ShortByteString -> StringDecoder)
-> Maybe ShortByteString -> Maybe StringDecoder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackendParameters -> Maybe ShortByteString
forall (m :: * -> *).
MonadFail m =>
BackendParameters -> m ShortByteString
lookupClientEncoding BackendParameters
parameters
      Either String String -> Maybe String
forall (m :: * -> *) a. MonadFail m => Either String a -> m a
MonadFail.fromEither (Either String String -> Maybe String)
-> Either String String -> Maybe String
forall a b. (a -> b) -> a -> b
$ StringDecoder
decode StringDecoder -> StringDecoder
forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
BSS.fromShort ShortByteString
serverVersion

  dbTransactionSupport :: Connection -> Bool
dbTransactionSupport Connection
_ = Bool
True

  getTables :: Connection -> IO [String]
getTables hc :: Connection
hc@Connection { $sel:connection:Connection :: Connection -> Connection
connection = connection :: Connection
connection@Pure.Connection { BackendParameters
parameters :: BackendParameters
$sel:parameters:Connection :: Connection -> BackendParameters
parameters }, $sel:config:Connection :: Connection -> Config
config = Config { ShortByteString -> StringEncoder
encodeString :: ShortByteString -> StringEncoder
$sel:encodeString:Config :: Config -> ShortByteString -> StringEncoder
encodeString, ShortByteString -> StringDecoder
decodeString :: ShortByteString -> StringDecoder
$sel:decodeString:Config :: Config -> ShortByteString -> StringDecoder
decodeString } } =
    IO [String] -> IO [String]
forall a. IO a -> IO a
convertException (IO [String] -> IO [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ do
      Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
      ShortByteString
charCode <- BackendParameters -> IO ShortByteString
forall (m :: * -> *).
MonadFail m =>
BackendParameters -> m ShortByteString
lookupClientEncoding BackendParameters
parameters
      let
        encode :: StringEncoder
encode = ShortByteString -> StringEncoder
encodeString ShortByteString
charCode
        decode :: StringDecoder
decode = ShortByteString -> StringDecoder
decodeString ShortByteString
charCode
        decodeIO :: ByteString -> IO String
decodeIO = Either String String -> IO String
forall (m :: * -> *) a. MonadFail m => Either String a -> m a
MonadFail.fromEither (Either String String -> IO String)
-> StringDecoder -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringDecoder
decode :: BS.ByteString -> IO String
        q :: Pure.Query
        q :: Query
q = Query
"SELECT table_name FROM information_schema.tables WHERE table_schema != 'pg_catalog' AND table_schema != 'information_schema'"
      ((PreparedStatement
_, Portal
_, Executed (Only SqlIdentifier)
e, Maybe ErrorFields
_), TransactionState
_) <- Connection
-> ExecutedProcedure (Only SqlIdentifier)
-> IO
     (MessageResult (ExecutedProcedure (Only SqlIdentifier)),
      TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (ExecutedProcedure (Only SqlIdentifier)
 -> IO
      (MessageResult (ExecutedProcedure (Only SqlIdentifier)),
       TransactionState))
-> ExecutedProcedure (Only SqlIdentifier)
-> IO
     (MessageResult (ExecutedProcedure (Only SqlIdentifier)),
      TransactionState)
forall a b. (a -> b) -> a -> b
$ Word
-> StringDecoder
-> PortalProcedure
-> ExecutedProcedure (Only SqlIdentifier)
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Pure.execute Word
0 StringDecoder
decode (PortalProcedure -> ExecutedProcedure (Only SqlIdentifier))
-> PortalProcedure -> ExecutedProcedure (Only SqlIdentifier)
forall a b. (a -> b) -> a -> b
$ Either String PortalProcedure -> PortalProcedure
forceBind (Either String PortalProcedure -> PortalProcedure)
-> Either String PortalProcedure -> PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> ()
-> PreparedStatementProcedure
-> Either String PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Pure.bind PortalName
"" FormatCode
Pure.TextFormat FormatCode
Pure.TextFormat BackendParameters
parameters StringEncoder
encode () (PreparedStatementProcedure -> Either String PortalProcedure)
-> PreparedStatementProcedure -> Either String PortalProcedure
forall a b. (a -> b) -> a -> b
$ PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
Pure.parse PreparedStatementName
"" Query
q (([Oid], [Oid]) -> Either (Word, Word) ([Oid], [Oid])
forall a b. b -> Either a b
Right ([], [Oid
Oid.sqlIdentifier]))
      [IO String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO String] -> IO [String]) -> [IO String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> IO String
decodeIO (ByteString -> IO String)
-> (Only SqlIdentifier -> ByteString)
-> Only SqlIdentifier
-> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Only (Pure.SqlIdentifier ByteString
str)) -> ByteString
str) (Only SqlIdentifier -> IO String)
-> [Only SqlIdentifier] -> [IO String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Executed (Only SqlIdentifier) -> [Only SqlIdentifier]
forall r. Executed r -> [r]
Pure.records Executed (Only SqlIdentifier)
e

  describeTable :: Connection -> String -> IO [(String, SqlColDesc)]
describeTable hc :: Connection
hc@Connection { $sel:connection:Connection :: Connection -> Connection
connection = connection :: Connection
connection@Pure.Connection { BackendParameters
parameters :: BackendParameters
$sel:parameters:Connection :: Connection -> BackendParameters
parameters }, $sel:config:Connection :: Connection -> Config
config = Config { ShortByteString -> StringEncoder
encodeString :: ShortByteString -> StringEncoder
$sel:encodeString:Config :: Config -> ShortByteString -> StringEncoder
encodeString, ShortByteString -> StringDecoder
decodeString :: ShortByteString -> StringDecoder
$sel:decodeString:Config :: Config -> ShortByteString -> StringDecoder
decodeString } } String
tableName =
    IO [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a. IO a -> IO a
convertException (IO [(String, SqlColDesc)] -> IO [(String, SqlColDesc)])
-> IO [(String, SqlColDesc)] -> IO [(String, SqlColDesc)]
forall a b. (a -> b) -> a -> b
$ do
      Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
      ShortByteString
charCode <- BackendParameters -> IO ShortByteString
forall (m :: * -> *).
MonadFail m =>
BackendParameters -> m ShortByteString
lookupClientEncoding BackendParameters
parameters
      let
        encode :: StringEncoder
encode = ShortByteString -> StringEncoder
encodeString ShortByteString
charCode
        decode :: StringDecoder
decode = ShortByteString -> StringDecoder
decodeString ShortByteString
charCode
        decodeIO :: ByteString -> IO String
decodeIO = Either String String -> IO String
forall (m :: * -> *) a. MonadFail m => Either String a -> m a
MonadFail.fromEither (Either String String -> IO String)
-> StringDecoder -> ByteString -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringDecoder
decode :: BS.ByteString -> IO String
        q :: Pure.Query
        q :: Query
q = Query
"SELECT attname, atttypid, attlen, atttypmod, attnotnull FROM pg_attribute, pg_class, pg_namespace WHERE attnum > 0 AND attisdropped IS FALSE AND attrelid = pg_class.oid AND relnamespace = pg_namespace.oid AND relname = $1 ORDER BY attnum"
      ((PreparedStatement
_, Portal
_, Executed (ByteString, Oid, AttributeNumber, TypeModifier, Bool)
e, Maybe ErrorFields
_), TransactionState
_) <-
        Connection
-> ExecutedProcedure
     (ByteString, Oid, AttributeNumber, TypeModifier, Bool)
-> IO
     (MessageResult
        (ExecutedProcedure
           (ByteString, Oid, AttributeNumber, TypeModifier, Bool)),
      TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection (ExecutedProcedure
   (ByteString, Oid, AttributeNumber, TypeModifier, Bool)
 -> IO
      (MessageResult
         (ExecutedProcedure
            (ByteString, Oid, AttributeNumber, TypeModifier, Bool)),
       TransactionState))
-> ExecutedProcedure
     (ByteString, Oid, AttributeNumber, TypeModifier, Bool)
-> IO
     (MessageResult
        (ExecutedProcedure
           (ByteString, Oid, AttributeNumber, TypeModifier, Bool)),
      TransactionState)
forall a b. (a -> b) -> a -> b
$ Word
-> StringDecoder
-> PortalProcedure
-> ExecutedProcedure
     (ByteString, Oid, AttributeNumber, TypeModifier, Bool)
forall p result.
(Execute p, FromRecord result) =>
Word -> StringDecoder -> p -> ExecutedProcedure result
Pure.execute Word
0 StringDecoder
decode (PortalProcedure
 -> ExecutedProcedure
      (ByteString, Oid, AttributeNumber, TypeModifier, Bool))
-> PortalProcedure
-> ExecutedProcedure
     (ByteString, Oid, AttributeNumber, TypeModifier, Bool)
forall a b. (a -> b) -> a -> b
$ Either String PortalProcedure -> PortalProcedure
forceBind (Either String PortalProcedure -> PortalProcedure)
-> Either String PortalProcedure -> PortalProcedure
forall a b. (a -> b) -> a -> b
$ PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> Only String
-> PreparedStatementProcedure
-> Either String PortalProcedure
forall ps param (m :: * -> *).
(Bind ps, ToRecord param, MonadFail m) =>
PortalName
-> FormatCode
-> FormatCode
-> BackendParameters
-> StringEncoder
-> param
-> ps
-> m PortalProcedure
Pure.bind PortalName
"" FormatCode
Pure.TextFormat FormatCode
Pure.TextFormat BackendParameters
parameters StringEncoder
encode (String -> Only String
forall a. a -> Only a
Only String
tableName) (PreparedStatementProcedure -> Either String PortalProcedure)
-> PreparedStatementProcedure -> Either String PortalProcedure
forall a b. (a -> b) -> a -> b
$ PreparedStatementName
-> Query
-> Either (Word, Word) ([Oid], [Oid])
-> PreparedStatementProcedure
Pure.parse PreparedStatementName
"" Query
q (([Oid], [Oid]) -> Either (Word, Word) ([Oid], [Oid])
forall a b. b -> Either a b
Right ([Oid
Oid.name], [Oid
Oid.name, Oid
Oid.oid, Oid
Oid.int2, Oid
Oid.int4, Oid
Oid.bool]))
      [(ByteString, Oid, AttributeNumber, TypeModifier, Bool)]
-> ((ByteString, Oid, AttributeNumber, TypeModifier, Bool)
    -> IO (String, SqlColDesc))
-> IO [(String, SqlColDesc)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Executed (ByteString, Oid, AttributeNumber, TypeModifier, Bool)
-> [(ByteString, Oid, AttributeNumber, TypeModifier, Bool)]
forall r. Executed r -> [r]
Pure.records Executed (ByteString, Oid, AttributeNumber, TypeModifier, Bool)
e) (((ByteString, Oid, AttributeNumber, TypeModifier, Bool)
  -> IO (String, SqlColDesc))
 -> IO [(String, SqlColDesc)])
-> ((ByteString, Oid, AttributeNumber, TypeModifier, Bool)
    -> IO (String, SqlColDesc))
-> IO [(String, SqlColDesc)]
forall a b. (a -> b) -> a -> b
$ \(ByteString
attname, Oid
atttypid, AttributeNumber
attlen, TypeModifier
atttypmod, Bool
attnotnull) -> do
        let
          typeLength :: TypeLength
typeLength = case AttributeNumber
attlen of { (-1) -> TypeLength
Pure.VariableLength ; AttributeNumber
_ -> AttributeNumber -> TypeLength
Pure.FixedLength AttributeNumber
attlen }
          (Maybe Int
colSize, Maybe Int
colDecDigits) = Oid -> TypeLength -> TypeModifier -> (Maybe Int, Maybe Int)
columnSize Oid
atttypid TypeLength
typeLength TypeModifier
atttypmod
        String
attnameBS <- ByteString -> IO String
decodeIO ByteString
attname
        (String, SqlColDesc) -> IO (String, SqlColDesc)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( String
attnameBS
          , SqlColDesc :: SqlTypeId
-> Maybe Int -> Maybe Int -> Maybe Int -> Maybe Bool -> SqlColDesc
SqlColDesc
              { colType :: SqlTypeId
colType = Oid -> SqlTypeId
forall a b. Convertible a b => a -> b
convert Oid
atttypid
              , Maybe Int
colSize :: Maybe Int
colSize :: Maybe Int
colSize
              , colOctetLength :: Maybe Int
colOctetLength = Maybe Int
forall a. Maybe a
Nothing
              , Maybe Int
colDecDigits :: Maybe Int
colDecDigits :: Maybe Int
colDecDigits
              , colNullable :: Maybe Bool
colNullable = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
attnotnull
              }
          )

-- | To send @BEGIN@ SQL statement.
begin :: Connection -> IO ()
begin :: Connection -> IO ()
begin hc :: Connection
hc@Connection { Connection
connection :: Connection
$sel:connection:Connection :: Connection -> Connection
connection } =
  IO () -> IO ()
forall a. IO a -> IO a
convertException (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Connection -> IO ()
closeUnnecessaryPreparedStatements Connection
hc
    IO
  ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
   TransactionState)
-> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO
   ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
    TransactionState)
 -> IO ())
-> IO
     ((PreparedStatement, Portal, Executed (), Maybe ErrorFields),
      TransactionState)
-> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> ExecutedProcedure ()
-> IO (MessageResult (ExecutedProcedure ()), TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection ExecutedProcedure ()
Pure.begin

columnSize :: Pure.Oid -> Pure.TypeLength -> Pure.TypeModifier -> (Maybe Int, Maybe Int)
columnSize :: Oid -> TypeLength -> TypeModifier -> (Maybe Int, Maybe Int)
columnSize Oid
typeOid TypeLength
Pure.VariableLength TypeModifier
typeModifier
  | Oid
typeOid Oid -> [Oid] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Oid
Oid.bpchar, Oid
Oid.varchar] = (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ TypeModifier -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral TypeModifier
typeModifier Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4, Maybe Int
forall a. Maybe a
Nothing) -- minus header size
  | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.numeric = let (Int
p, Int
q) = (TypeModifier -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral TypeModifier
typeModifier Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
16 :: Int) :: Int) in (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
p, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
q)
  | Bool
otherwise = (Maybe Int
forall a. Maybe a
Nothing, Maybe Int
forall a. Maybe a
Nothing)
columnSize Oid
_ (Pure.FixedLength AttributeNumber
l) TypeModifier
_ = (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ AttributeNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral AttributeNumber
l, Maybe Int
forall a. Maybe a
Nothing)

forceBind :: Either String Pure.PortalProcedure -> Pure.PortalProcedure
forceBind :: Either String PortalProcedure -> PortalProcedure
forceBind (Right PortalProcedure
a)  = PortalProcedure
a
forceBind (Left String
err) = RequestBuildingFailed -> PortalProcedure
forall e a. Exception e => e -> a
impureThrow (RequestBuildingFailed -> PortalProcedure)
-> RequestBuildingFailed -> PortalProcedure
forall a b. (a -> b) -> a -> b
$ String -> RequestBuildingFailed
RequestBuildingFailed String
err

incrementCounter :: IORef Word -> IO Word
incrementCounter :: IORef Word -> IO Word
incrementCounter IORef Word
ref = do
  Word
n <- IORef Word -> IO Word
forall a. IORef a -> IO a
readIORef IORef Word
ref
  IORef Word -> Word -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Word
ref (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1)
  Word -> IO Word
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word
n

closeUnnecessaryPreparedStatements :: Connection -> IO ()
closeUnnecessaryPreparedStatements :: Connection -> IO ()
closeUnnecessaryPreparedStatements Connection { Connection
connection :: Connection
$sel:connection:Connection :: Connection -> Connection
connection, MVar [PreparedStatement]
unnecessaryPreparedStatements :: MVar [PreparedStatement]
$sel:unnecessaryPreparedStatements:Connection :: Connection -> MVar [PreparedStatement]
unnecessaryPreparedStatements } =
  MVar [PreparedStatement]
-> ([PreparedStatement] -> IO [PreparedStatement]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar [PreparedStatement]
unnecessaryPreparedStatements (([PreparedStatement] -> IO [PreparedStatement]) -> IO ())
-> ([PreparedStatement] -> IO [PreparedStatement]) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[PreparedStatement]
pss -> do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PreparedStatement] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PreparedStatement]
pss) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ([()], TransactionState) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ([()], TransactionState) -> IO ())
-> IO ([()], TransactionState) -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection
-> [CloseProcedure]
-> IO (MessageResult [CloseProcedure], TransactionState)
forall m.
Message m =>
Connection -> m -> IO (MessageResult m, TransactionState)
Pure.sync Connection
connection ([CloseProcedure]
 -> IO (MessageResult [CloseProcedure], TransactionState))
-> [CloseProcedure]
-> IO (MessageResult [CloseProcedure], TransactionState)
forall a b. (a -> b) -> a -> b
$ PreparedStatement -> CloseProcedure
forall p. Close p => p -> CloseProcedure
Pure.close (PreparedStatement -> CloseProcedure)
-> [PreparedStatement] -> [CloseProcedure]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PreparedStatement]
pss
    [PreparedStatement] -> IO [PreparedStatement]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

convertException :: IO a -> IO a
convertException :: IO a -> IO a
convertException IO a
a = do
  Either Exception a
r <- IO a -> IO (Either Exception a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try IO a
a
  case Either Exception a
r of
    Right a
v -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
    Left Exception
e -> SqlError -> IO a
forall a. SqlError -> IO a
throwSqlError (SqlError -> IO a) -> SqlError -> IO a
forall a b. (a -> b) -> a -> b
$ SqlError :: String -> Int -> String -> SqlError
SqlError { seState :: String
seState = String
"", seNativeError :: Int
seNativeError = -Int
1, seErrorMsg :: String
seErrorMsg = Exception -> String
forall e. Exception e => e -> String
displayException (Exception
e :: Pure.Exception) }

newtype RequestBuildingFailed = RequestBuildingFailed { RequestBuildingFailed -> String
message :: String } deriving (Int -> RequestBuildingFailed -> ShowS
[RequestBuildingFailed] -> ShowS
RequestBuildingFailed -> String
(Int -> RequestBuildingFailed -> ShowS)
-> (RequestBuildingFailed -> String)
-> ([RequestBuildingFailed] -> ShowS)
-> Show RequestBuildingFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestBuildingFailed] -> ShowS
$cshowList :: [RequestBuildingFailed] -> ShowS
show :: RequestBuildingFailed -> String
$cshow :: RequestBuildingFailed -> String
showsPrec :: Int -> RequestBuildingFailed -> ShowS
$cshowsPrec :: Int -> RequestBuildingFailed -> ShowS
Show, ReadPrec [RequestBuildingFailed]
ReadPrec RequestBuildingFailed
Int -> ReadS RequestBuildingFailed
ReadS [RequestBuildingFailed]
(Int -> ReadS RequestBuildingFailed)
-> ReadS [RequestBuildingFailed]
-> ReadPrec RequestBuildingFailed
-> ReadPrec [RequestBuildingFailed]
-> Read RequestBuildingFailed
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestBuildingFailed]
$creadListPrec :: ReadPrec [RequestBuildingFailed]
readPrec :: ReadPrec RequestBuildingFailed
$creadPrec :: ReadPrec RequestBuildingFailed
readList :: ReadS [RequestBuildingFailed]
$creadList :: ReadS [RequestBuildingFailed]
readsPrec :: Int -> ReadS RequestBuildingFailed
$creadsPrec :: Int -> ReadS RequestBuildingFailed
Read, RequestBuildingFailed -> RequestBuildingFailed -> Bool
(RequestBuildingFailed -> RequestBuildingFailed -> Bool)
-> (RequestBuildingFailed -> RequestBuildingFailed -> Bool)
-> Eq RequestBuildingFailed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestBuildingFailed -> RequestBuildingFailed -> Bool
$c/= :: RequestBuildingFailed -> RequestBuildingFailed -> Bool
== :: RequestBuildingFailed -> RequestBuildingFailed -> Bool
$c== :: RequestBuildingFailed -> RequestBuildingFailed -> Bool
Eq, Typeable)

instance Exception RequestBuildingFailed where
  toException :: RequestBuildingFailed -> SomeException
toException = Exception -> SomeException
forall e. Exception e => e -> SomeException
toException (Exception -> SomeException)
-> (RequestBuildingFailed -> Exception)
-> RequestBuildingFailed
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestBuildingFailed -> Exception
forall e. Exception e => e -> Exception
Pure.Exception
  fromException :: SomeException -> Maybe RequestBuildingFailed
fromException = (\(Pure.Exception e
e) -> e -> Maybe RequestBuildingFailed
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e) (Exception -> Maybe RequestBuildingFailed)
-> (SomeException -> Maybe Exception)
-> SomeException
-> Maybe RequestBuildingFailed
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< SomeException -> Maybe Exception
forall e. Exception e => SomeException -> Maybe e
fromException

instance Pure.FromField SqlValue where
  fromField :: StringDecoder -> ColumnInfo -> Maybe ByteString -> m SqlValue
fromField StringDecoder
_ ColumnInfo
_ Maybe ByteString
Nothing = SqlValue -> m SqlValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlValue
SqlNull
  fromField StringDecoder
decode info :: ColumnInfo
info@Pure.ColumnInfo { Oid
typeOid :: Oid
$sel:typeOid:ColumnInfo :: ColumnInfo -> Oid
typeOid } Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.char
    = Char -> SqlValue
SqlChar (Char -> SqlValue) -> m Char -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m Char
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> [Oid] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Oid
Oid.bpchar, Oid
Oid.varchar, Oid
Oid.text, Oid
Oid.name]
    = ByteString -> SqlValue
SqlByteString (ByteString -> SqlValue) -> m ByteString -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m ByteString
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> [Oid] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Oid
Oid.int2, Oid
Oid.int4]
    = TypeModifier -> SqlValue
SqlInt32 (TypeModifier -> SqlValue) -> m TypeModifier -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m TypeModifier
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.int8
    = Int64 -> SqlValue
SqlInt64 (Int64 -> SqlValue) -> m Int64 -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m Int64
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.bool
    = Bool -> SqlValue
SqlBool (Bool -> SqlValue) -> m Bool -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m Bool
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> [Oid] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Oid
Oid.float4, Oid
Oid.float8]
    = Double -> SqlValue
SqlDouble (Double -> SqlValue) -> m Double -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m Double
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.numeric
    = Rational -> SqlValue
SqlRational (Rational -> SqlValue)
-> (Scientific -> Rational) -> Scientific -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Real Scientific => Scientific -> Rational
forall a. Real a => a -> Rational
toRational @Scientific (Scientific -> SqlValue) -> m Scientific -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m Scientific
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.date
    = Day -> SqlValue
SqlLocalDate (Day -> SqlValue) -> m Day -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m Day
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.time
    = TimeOfDay -> SqlValue
SqlLocalTimeOfDay (TimeOfDay -> SqlValue) -> m TimeOfDay -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m TimeOfDay
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.timetz
    = (TimeOfDay -> TimeZone -> SqlValue)
-> (TimeOfDay, TimeZone) -> SqlValue
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TimeOfDay -> TimeZone -> SqlValue
SqlZonedLocalTimeOfDay ((TimeOfDay, TimeZone) -> SqlValue)
-> m (TimeOfDay, TimeZone) -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder
-> ColumnInfo -> Maybe ByteString -> m (TimeOfDay, TimeZone)
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.timestamp
    = LocalTime -> SqlValue
SqlLocalTime (LocalTime -> SqlValue) -> m LocalTime -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m LocalTime
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.timestamptz
    = UTCTime -> SqlValue
SqlUTCTime (UTCTime -> SqlValue) -> m UTCTime -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m UTCTime
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.interval
    = NominalDiffTime -> SqlValue
SqlDiffTime (NominalDiffTime -> SqlValue)
-> (DiffTime -> NominalDiffTime) -> DiffTime -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime)
-> (DiffTime -> Rational) -> DiffTime -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Real DiffTime => DiffTime -> Rational
forall a. Real a => a -> Rational
toRational @DiffTime (DiffTime -> SqlValue) -> m DiffTime -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m DiffTime
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.oid
    = TypeModifier -> SqlValue
SqlInt32 (TypeModifier -> SqlValue)
-> (Oid -> TypeModifier) -> Oid -> SqlValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Oid.Oid TypeModifier
n) -> TypeModifier
n) (Oid -> SqlValue) -> m Oid -> m SqlValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StringDecoder -> ColumnInfo -> Maybe ByteString -> m Oid
forall a (m :: * -> *).
(FromField a, MonadFail m) =>
StringDecoder -> ColumnInfo -> Maybe ByteString -> m a
Pure.fromField StringDecoder
decode ColumnInfo
info Maybe ByteString
v
    | Bool
otherwise = String -> m SqlValue
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SqlValue) -> String -> m SqlValue
forall a b. (a -> b) -> a -> b
$ String
"unsupported type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Oid -> String
forall a. Show a => a -> String
show Oid
typeOid

instance Pure.ToField SqlValue where
  toField :: BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> SqlValue
-> m (Maybe ByteString)
toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlString String
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> String
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format String
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlByteString ByteString
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> ByteString
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format ByteString
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlWord32 Word32
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> TypeModifier
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (TypeModifier -> m (Maybe ByteString))
-> TypeModifier -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Word32 -> TypeModifier
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int32 Word32
v -- may get overflow
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlWord64 Word64
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Int64
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (Int64 -> m (Maybe ByteString)) -> Int64 -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Int64 Word64
v -- may get overflow
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlInt32 TypeModifier
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> TypeModifier
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format TypeModifier
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlInt64 Int64
v)
    | TypeModifier -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TypeModifier
forall a. Bounded a => a
minBound :: Int32) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
v Bool -> Bool -> Bool
&& Int64
v Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= TypeModifier -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (TypeModifier
forall a. Bounded a => a
maxBound :: Int32) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> TypeModifier
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (Int64 -> TypeModifier
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v :: Int32)
    | Bool
otherwise = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Int64
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format Int64
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlInteger Integer
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Scientific
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (Scientific -> m (Maybe ByteString))
-> Scientific -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger @Scientific Integer
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlChar Char
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> String
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format [Char
v]
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlBool Bool
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Bool
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format Bool
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlDouble Double
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Double
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format Double
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlRational Rational
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Rational
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format Rational
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlLocalDate Day
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Day
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format Day
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlLocalTimeOfDay TimeOfDay
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> TimeOfDay
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format TimeOfDay
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlZonedLocalTimeOfDay TimeOfDay
t TimeZone
tz) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (TimeOfDay
t, TimeZone
tz)
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlLocalTime LocalTime
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> LocalTime
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format LocalTime
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlZonedTime ZonedTime
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> UTCTime
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (UTCTime -> m (Maybe ByteString))
-> UTCTime -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlUTCTime UTCTime
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> UTCTime
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format UTCTime
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlDiffTime NominalDiffTime
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> DiffTime
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (DiffTime -> m (Maybe ByteString))
-> DiffTime -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Fractional DiffTime => Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational @DiffTime (Rational -> DiffTime) -> Rational -> DiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational @NominalDiffTime NominalDiffTime
v
  toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format (SqlPOSIXTime NominalDiffTime
v) = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> NominalDiffTime
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
oid FormatCode
format NominalDiffTime
v
  toField BackendParameters
_ StringEncoder
_ Maybe Oid
_ FormatCode
Pure.TextFormat SqlValue
SqlNull = Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
  toField BackendParameters
_ StringEncoder
_ Maybe Oid
_ FormatCode
_ SqlValue
_ = String -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unsupported" -- SqlEpochTime and SqlTimeDiff are deprecated

-- | Security risk of DoS attack.
--
-- You should convert 'Rational' to 'Scientific' with 'fromRationalRepetend' in the user side.
-- If the rational value is computed to repeating decimals like 1/3 = 0.3333., this consumes a lot of memories.
-- This is provided because of the HDBC compatibility.
instance Pure.ToField Rational where
  toField :: BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Rational
-> m (Maybe ByteString)
toField BackendParameters
_ StringEncoder
encode Maybe Oid
Nothing FormatCode
format Rational
v =
    let
      s :: Scientific
s =
        case Maybe Int
-> Rational
-> Either (Scientific, Rational) (Scientific, Maybe Int)
fromRationalRepetend Maybe Int
forall a. Maybe a
Nothing Rational
v of
          Left (Scientific
s, Rational
_)  -> Scientific
s
          Right (Scientific
s, Maybe Int
_) -> Scientific
s
    in
      case FormatCode
format of
        FormatCode
Pure.TextFormat   -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> m ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String ByteString -> m ByteString
forall (m :: * -> *) a. MonadFail m => Either String a -> m a
MonadFail.fromEither (StringEncoder
encode StringEncoder -> StringEncoder
forall a b. (a -> b) -> a -> b
$ FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Exponent Maybe Int
forall a. Maybe a
Nothing Scientific
s)
        FormatCode
Pure.BinaryFormat -> Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> m (Maybe ByteString))
-> Maybe ByteString -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
BE.encodingBytes (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Scientific -> Encoding
BE.numeric Scientific
s
  toField BackendParameters
backendParams StringEncoder
encode (Just Oid
o) FormatCode
f Rational
v | Oid
o Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.numeric = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> Rational
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
forall a. Maybe a
Nothing FormatCode
f Rational
v
                                            | Bool
otherwise = String -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Maybe ByteString)) -> String -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String
"type mismatch (ToField): OID: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Oid -> String
forall a. Show a => a -> String
show Oid
o String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", Haskell: Rational"

resultCount :: Pure.ExecuteResult -> Integer
resultCount :: ExecuteResult -> Integer
resultCount ExecuteResult
e =
  Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$
    case ExecuteResult
e of
      Pure.ExecuteComplete CommandTag
tag ->
        case CommandTag
tag of
          Pure.InsertTag Oid
_ Int
n  -> Int
n
          Pure.DeleteTag Int
n    -> Int
n
          Pure.UpdateTag Int
n    -> Int
n
          Pure.SelectTag Int
_    -> Int
0
          Pure.MoveTag Int
n      -> Int
n
          Pure.FetchTag Int
n     -> Int
n
          Pure.CopyTag Int
n      -> Int
n
          CommandTag
Pure.CreateTableTag -> Int
0
          CommandTag
Pure.DropTableTag   -> Int
0
          CommandTag
Pure.BeginTag       -> Int
0
          CommandTag
Pure.CommitTag      -> Int
0
          CommandTag
Pure.RollbackTag    -> Int
0
          CommandTag
Pure.SetTag         -> Int
0
      ExecuteResult
Pure.ExecuteEmptyQuery -> Int
0
      ExecuteResult
Pure.ExecuteSuspended -> Int
0

instance Convertible Pure.Oid SqlTypeId where
  safeConvert :: Oid -> ConvertResult SqlTypeId
safeConvert Oid
oid | Oid
oid Oid -> [Oid] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Oid
Oid.int2, Oid
Oid.int4, Oid
Oid.int8] = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlBigIntT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.numeric = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlDecimalT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.float4 = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlFloatT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.float8 = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlDoubleT
                  | Oid
oid Oid -> [Oid] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Oid
Oid.char, Oid
Oid.bpchar] = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlCharT
                  | Oid
oid Oid -> [Oid] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Oid
Oid.varchar, Oid
Oid.text] = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlVarCharT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.bytea = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlVarBinaryT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.timestamp = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlTimestampT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.timestamptz = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlTimestampWithZoneT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.date = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlDateT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.time = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlTimeT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.timetz = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlTimeWithZoneT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.interval = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlTypeId -> ConvertResult SqlTypeId)
-> SqlTypeId -> ConvertResult SqlTypeId
forall a b. (a -> b) -> a -> b
$ SqlInterval -> SqlTypeId
SqlIntervalT SqlInterval
SqlIntervalSecondT
                  | Oid
oid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.bool = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlTypeId
SqlBitT
                  | Bool
otherwise = SqlTypeId -> ConvertResult SqlTypeId
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SqlTypeId -> ConvertResult SqlTypeId)
-> SqlTypeId -> ConvertResult SqlTypeId
forall a b. (a -> b) -> a -> b
$ String -> SqlTypeId
SqlUnknownT (String -> SqlTypeId) -> String -> SqlTypeId
forall a b. (a -> b) -> a -> b
$ Oid -> String
forall a. Show a => a -> String
show Oid
oid

lookupClientEncoding :: MonadFail m => Pure.BackendParameters -> m BSS.ShortByteString
lookupClientEncoding :: BackendParameters -> m ShortByteString
lookupClientEncoding BackendParameters
params =
  case ShortByteString -> BackendParameters -> Maybe ShortByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ShortByteString
"client_encoding" BackendParameters
params of
    Maybe ShortByteString
Nothing   -> String -> m ShortByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"\"client_encoding\" backend parameter not found"
    Just ShortByteString
code -> ShortByteString -> m ShortByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortByteString
code

instance Pure.FromField (TimeOfDay, TimeZone) where
  fromField :: StringDecoder
-> ColumnInfo -> Maybe ByteString -> m (TimeOfDay, TimeZone)
fromField StringDecoder
_ Pure.ColumnInfo { Oid
typeOid :: Oid
$sel:typeOid:ColumnInfo :: ColumnInfo -> Oid
typeOid, FormatCode
$sel:formatCode:ColumnInfo :: ColumnInfo -> FormatCode
formatCode :: FormatCode
Pure.formatCode } (Just ByteString
v)
    | Oid
typeOid Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.timetz
    = case FormatCode
formatCode of
        FormatCode
Pure.TextFormat   -> Parser (TimeOfDay, TimeZone)
-> ByteString -> m (TimeOfDay, TimeZone)
forall (m :: * -> *) a.
MonadFail m =>
Parser a -> ByteString -> m a
Pure.attoparsecParser ((,) (TimeOfDay -> TimeZone -> (TimeOfDay, TimeZone))
-> Parser ByteString TimeOfDay
-> Parser ByteString (TimeZone -> (TimeOfDay, TimeZone))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString TimeOfDay
TimeParser.timeOfDay Parser ByteString (TimeZone -> (TimeOfDay, TimeZone))
-> Parser ByteString TimeZone -> Parser (TimeOfDay, TimeZone)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TimeZone -> Maybe TimeZone -> TimeZone
forall a. a -> Maybe a -> a
fromMaybe TimeZone
utc (Maybe TimeZone -> TimeZone)
-> Parser ByteString (Maybe TimeZone) -> Parser ByteString TimeZone
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Maybe TimeZone)
TimeParser.timeZone)) ByteString
v
        FormatCode
Pure.BinaryFormat -> Value (TimeOfDay, TimeZone)
-> ByteString -> m (TimeOfDay, TimeZone)
forall (m :: * -> *) a. MonadFail m => Value a -> ByteString -> m a
Pure.valueParser Value (TimeOfDay, TimeZone)
BD.timetz_int ByteString
v
  fromField StringDecoder
_ Pure.ColumnInfo { Oid
typeOid :: Oid
$sel:typeOid:ColumnInfo :: ColumnInfo -> Oid
typeOid } Maybe ByteString
_ = String -> m (TimeOfDay, TimeZone)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (TimeOfDay, TimeZone))
-> String -> m (TimeOfDay, TimeZone)
forall a b. (a -> b) -> a -> b
$ String
"type mismatch (FromField): OID: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Oid -> String
forall a. Show a => a -> String
show Oid
typeOid String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", Haskell: (TimeOfDay, TimeZone)"

instance Pure.ToField (TimeOfDay, TimeZone) where
  toField :: BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
toField BackendParameters
_ StringEncoder
_ Maybe Oid
Nothing FormatCode
Pure.TextFormat = Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> m (Maybe ByteString))
-> ((TimeOfDay, TimeZone) -> Maybe ByteString)
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> ((TimeOfDay, TimeZone) -> ByteString)
-> (TimeOfDay, TimeZone)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> ((TimeOfDay, TimeZone) -> ByteString)
-> (TimeOfDay, TimeZone)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString)
-> ((TimeOfDay, TimeZone) -> Builder)
-> (TimeOfDay, TimeZone)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundedPrim (TimeOfDay, TimeZone)
-> (TimeOfDay, TimeZone) -> Builder
forall a. BoundedPrim a -> a -> Builder
BSBP.primBounded (BoundedPrim TimeOfDay
TimeBuilder.timeOfDay BoundedPrim TimeOfDay
-> BoundedPrim TimeZone -> BoundedPrim (TimeOfDay, TimeZone)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BSBP.>*< BoundedPrim TimeZone
TimeBuilder.timeZone)
  toField BackendParameters
backendParams StringEncoder
_ Maybe Oid
Nothing FormatCode
Pure.BinaryFormat =
    case ShortByteString -> BackendParameters -> Maybe ShortByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ShortByteString
"integer_datetimes" BackendParameters
backendParams of
      Maybe ShortByteString
Nothing    -> m (Maybe ByteString)
-> (TimeOfDay, TimeZone) -> m (Maybe ByteString)
forall a b. a -> b -> a
const (m (Maybe ByteString)
 -> (TimeOfDay, TimeZone) -> m (Maybe ByteString))
-> m (Maybe ByteString)
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not found \"integer_datetimes\" backend parameter"
      Just ShortByteString
"on"  -> Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> m (Maybe ByteString))
-> ((TimeOfDay, TimeZone) -> Maybe ByteString)
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> ((TimeOfDay, TimeZone) -> ByteString)
-> (TimeOfDay, TimeZone)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
BE.encodingBytes (Encoding -> ByteString)
-> ((TimeOfDay, TimeZone) -> Encoding)
-> (TimeOfDay, TimeZone)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeOfDay, TimeZone) -> Encoding
BE.timetz_int
      Just ShortByteString
"off" -> Maybe ByteString -> m (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> m (Maybe ByteString))
-> ((TimeOfDay, TimeZone) -> Maybe ByteString)
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> ((TimeOfDay, TimeZone) -> ByteString)
-> (TimeOfDay, TimeZone)
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding -> ByteString
BE.encodingBytes (Encoding -> ByteString)
-> ((TimeOfDay, TimeZone) -> Encoding)
-> (TimeOfDay, TimeZone)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeOfDay, TimeZone) -> Encoding
BE.timetz_float
      Just ShortByteString
v     -> m (Maybe ByteString)
-> (TimeOfDay, TimeZone) -> m (Maybe ByteString)
forall a b. a -> b -> a
const (m (Maybe ByteString)
 -> (TimeOfDay, TimeZone) -> m (Maybe ByteString))
-> m (Maybe ByteString)
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Maybe ByteString)) -> String -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String
"\"integer_datetimes\" has unrecognized value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> String
forall a. Show a => a -> String
show ShortByteString
v
  toField BackendParameters
backendParams StringEncoder
encode (Just Oid
o) FormatCode
f | Oid
o Oid -> Oid -> Bool
forall a. Eq a => a -> a -> Bool
== Oid
Oid.timetz = BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
forall a (m :: * -> *).
(ToField a, MonadFail m) =>
BackendParameters
-> StringEncoder
-> Maybe Oid
-> FormatCode
-> a
-> m (Maybe ByteString)
Pure.toField BackendParameters
backendParams StringEncoder
encode Maybe Oid
forall a. Maybe a
Nothing FormatCode
f
                                          | Bool
otherwise = m (Maybe ByteString)
-> (TimeOfDay, TimeZone) -> m (Maybe ByteString)
forall a b. a -> b -> a
const (m (Maybe ByteString)
 -> (TimeOfDay, TimeZone) -> m (Maybe ByteString))
-> m (Maybe ByteString)
-> (TimeOfDay, TimeZone)
-> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String -> m (Maybe ByteString)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (Maybe ByteString)) -> String -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String
"type mismatch (ToField): OID: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Oid -> String
forall a. Show a => a -> String
show Oid
o String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", Haskell: (TimeOfDay, TimeZone))"

-- Footnote
-- [1] Dirty hack: The numbers 0 and 0 are not used, when the prepared statement procedure is not given to "bind".