8000 Optimized sending queries · postgres-haskell/postgres-wire@2144602 · GitHub
[go: up one dir, main page]
Skip to content

Commit 2144602

Browse files
VyacheslavHashovVyacheslavHashov
committed
Optimized sending queries
1 parent 9f50853 commit 2144602

File tree

3 files changed

+43
-43
lines changed

3 files changed

+43
-43
lines changed

‎src/Database/PostgreSQL/Driver.hs

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -17,11 +17,8 @@ module Database.PostgreSQL.Driver
1717
, Oid(..)
1818
, Format(..)
1919
, CachePolicy(..)
20-
, sendBatch
2120
, sendBatchAndSync
2221
, sendBatchAndFlush
23-
, sendSync
24-
, sendFlush
2522
, readNextData
2623
, readReadyForQuery
2724
, sendSimpleQuery

‎src/Database/PostgreSQL/Driver/Connection.hs

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ import Crypto.Hash (hash, Digest, MD5)
2121
import Database.PostgreSQL.Protocol.Encoders
2222
import Database.PostgreSQL.Protocol.Decoders
2323
import Database.PostgreSQL.Protocol.Types
24-
import Database.PostgreSQL.Protocol.Store.Encode (runEncode)
24+
import Database.PostgreSQL.Protocol.Store.Encode (runEncode, Encode)
2525
import Database.PostgreSQL.Protocol.Store.Decode (runDecode)
2626

2727
import Database.PostgreSQL.Driver.Settings
@@ -303,14 +303,16 @@ defaultFilter msg = case msg of
303303
-- Low-level sending functions
304304

305305
sendStartMessage :: RawConnection -> StartMessage -> IO ()
306-
sendStartMessage rawConn msg = void $ do
307-
let smsg = runEncode $ encodeStartMessage msg
308-
rSend rawConn smsg
306+
sendStartMessage rawConn msg = void $
307+
rSend rawConn . runEncode $ encodeStartMessage msg
309308

309+
-- Only for testings and simple queries
310310
sendMessage :: RawConnection -> ClientMessage -> IO ()
311-
sendMessage rawConn msg = void $ do
312-
let smsg = runEncode $ encodeClientMessage msg
313-
rSend rawConn smsg
311+
sendMessage rawConn msg = void $
312+
rSend rawConn . runEncode $ encodeClientMessage msg
313+
314+
sendEncode :: RawConnection -> Encode -> IO ()
315+
sendEncode rawConn = void . rSend rawConn . runEncode
314316

315317
withConnectionMode
316318
:: Connection -> ConnectionMode -> (Connection -> IO a) -> IO a

‎src/Database/PostgreSQL/Driver/Query.hs

Lines changed: 34 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,12 @@ module Database.PostgreSQL.Driver.Query where
22

33
import Control.Concurrent.Chan.Unagi
44
import Data.Foldable
5+
import Data.Monoid
56
import qualified Data.Vector as V
67
import qualified Data.ByteString as B
78

89
import Database.PostgreSQL.Protocol.Encoders
10+
import Database.PostgreSQL.Protocol.Store.Encode
911
import Database.PostgreSQL.Protocol.Decoders
1012
import Database.PostgreSQL.Protocol.Types
1113

@@ -23,47 +25,45 @@ data Query = Query
2325
} deriving (Show)
2426

2527
-- | Public
26-
sendBatch :: Connection -> [Query] -> IO ()
27-
sendBatch conn = traverse_ sendSingle
28+
sendBatchAndSync :: Connection -> [Query] -> IO ()
29+
sendBatchAndSync = sendBatchEndBy Sync
30+
31+
-- | Public
32+
sendBatchAndFlush :: Connection -> [Query] -> IO ()
33+
sendBatchAndFlush = sendBatchEndBy Flush
34+
35+
-- Helper
36+
sendBatchEndBy :: ClientMessage -> Connection -> [Query] -> IO ()
37+
sendBatchEndBy msg conn qs = do
38+
batch <- constructBatch conn qs
39+
sendEncode (connRawConnection conn) $ batch <> encodeClientMessage msg
40+
41+
constructBatch :: Connection -> [Query] -> IO Encode
42+
constructBatch conn = fmap fold . traverse constructSingle
2843
where
29-
s = connRawConnection conn
3044
storage = connStatementStorage conn
3145
pname = PortalName ""
32-
sendSingle q = do
46+
constructSingle q = do
3347
let stmtSQL = StatementSQL $ qStatement q
34-
sname <- case qCachePolicy q of
48+
(sname, parseMessage) <- case qCachePolicy q of
3549
AlwaysCache -> do
3650
mName <- lookupStatement storage stmtSQL
3751
case mName of
3852
Nothing -> do
3953
newName <- storeStatement storage stmtSQL
40-
sendMessage s $
41-
Parse newName stmtSQL (fst <$> qValues q)
42-
pure newName
43-
Just name -> pure name
54+
pure (newName, encodeClientMessage $
55+
Parse newName stmtSQL (fst <$> qValues q))
56+
Just name -> pure (name, mempty)
4457
NeverCache -> do
4558
let newName = defaultStatementName
46-
sendMessage s $
47-
Parse newName stmtSQL (fst <$> qValues q)
48-
pure newName
49-
sendMessage s $
50-
Bind pname sname (qParamsFormat q) (snd <$> qValues q)
51-
(qResultFormat q)
52-
sendMessage s $ Execute pname noLimitToReceive
53-
54-
-- | Public
55-
sendBatchAndSync :: Connection -> [Query] -> IO ()
56-
sendBatchAndSync conn qs = sendBatch conn qs >> sendSync conn
57-
58-
-- | Public
59-
sendBatchAndFlush :: Connection -> [Query] -> IO ()
60-
sendBatchAndFlush conn qs = sendBatch conn qs >> sendFlush conn
61-
62-
sendSync :: Connection -> IO ()
63-
sendSync conn = sendMessage (connRawConnection conn) Sync
64-
65-
sendFlush :: Connection -> IO ()
66-
sendFlush conn = sendMessage (connRawConnection conn) Flush
59+
pure (newName, encodeClientMessage $
60+
Parse newName stmtSQL (fst <$> qValues q))
61+
let bindMessage = encodeClientMessage $
62+
Bind pname sname (qParamsFormat q) (snd <$> qValues q)
63+
(qResultFormat q)
64+
executeMessage = encodeClientMessage $
65+
Execute pname noLimitToReceive
66+
pure $ parseMessage <> bindMessage <> executeMessage
6767

6868
-- | Public
6969
readNextData :: Connection -> IO (Either Error DataMessage)
@@ -104,9 +104,10 @@ describeStatement
104104
-> B.ByteString
105105
-> IO (Either Error (V.Vector Oid, V.Vector FieldDescription))
106106
describeStatement conn stmt = do
107-
sendMessage s $ Parse sname (StatementSQL stmt) V.empty
108-
sendMessage s $ DescribeStatement sname
109-
sendMessage s Sync
107+
sendEncode s $
108+
encodeClientMessage (Parse sname (StatementSQL stmt) V.empty)
109+
<> encodeClientMessage (DescribeStatement sname)
110+
<> encodeClientMessage Sync
110111
parseMessages <$> collectBeforeReadyForQuery conn
111112
where
112113
s = connRawConnection conn

0 commit comments

Comments
 (0)
0