8000 Prepared statement cache works · postgres-haskell/postgres-wire@b0b7d42 · GitHub
[go: up one dir, main page]
Skip to content

Commit b0b7d42

Browse files
VyacheslavHashovVyacheslavHashov
committed
Prepared statement cache works
1 parent f1c7ab2 commit b0b7d42

File tree

3 files changed

+44
-5
lines changed

3 files changed

+44
-5
lines changed

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

Lines changed: 17 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -27,11 +27,25 @@ sendBatch :: Connection -> [Query] -> IO ()
2727
sendBatch conn = traverse_ sendSingle
2828
where
2929
s = connRawConnection conn
30-
sname = StatementName ""
30+
storage = connStatementStorage conn
3131
pname = PortalName ""
3232
sendSingle q = do
33-
sendMessage s $
34-
Parse sname (StatementSQL $ qStatement q) (fst <$> qValues q)
33+
let stmtSQL = StatementSQL $ qStatement q
34+
sname <- case qCachePolicy q of
35+
AlwaysCache -> do
36+
mName <- lookupStatement storage stmtSQL
37+
case mName of
38+
Nothing -> do
39+
newName <- storeStatement storage stmtSQL
40+
sendMessage s $
41+
Parse newName stmtSQL (fst <$> qValues q)
42+
pure newName
43+
Just name -> pure name
44+
NeverCache -> do
45+
let newName = defaultStatementName
46+
sendMessage s $
47+
Parse newName stmtSQL (fst <$> qValues q)
48+
pure newName
3549
sendMessage s $
3650
Bind pname sname (qParamsFormat q) (snd <$> qValues q)
3751
(qResultFormat q)

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

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -24,8 +24,8 @@ newStatementStorage = StatementStorage <$> H.new <*> newIORef 0
2424
lookupStatement :: StatementStorage -> StatementSQL -> IO (Maybe StatementName)
2525
lookupStatement (StatementStorage table _) = H.lookup table
2626

27-
storageStatement :: StatementStorage -> StatementSQL -> IO StatementName
28-
storageStatement (StatementStorage table counter) stmt = do
27+
storeStatement :: StatementStorage -> StatementSQL -> IO StatementName
28+
storeStatement (StatementStorage table counter) stmt = do
2929
n <- readIORef counter
3030
writeIORef counter $ n + 1
3131
let name = StatementName . pack $ show n
@@ -35,3 +35,6 @@ storageStatement (StatementStorage table counter) stmt = do
3535
getCacheSize :: StatementStorage -> IO Word
3636
getCacheSize (StatementStorage _ counter) = readIORef counter
3737

38+
defaultStatementName :: StatementName
39+
defaultStatementName = StatementName ""
40+

‎tests/Driver.hs

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ testDriver = testGroup "Driver"
3131
, testCase "Describe empty statement" testDescribeStatementEmpty
3232
, testCase "SimpleQuery" testSimpleQuery
3333
, testCase "SimpleAndExtendedQuery" testSimpleAndExtendedQuery
34+
, testCase "PreparedStatementCache" testPreparedStatementCache
3435
]
3536

3637
makeQuery1 :: B.ByteString -> Query
@@ -198,3 +199,24 @@ testSimpleAndExtendedQuery = withConnection $ \c -> do
198199
r <- fromMessage <$> readNextData c
199200
r @=? d
200201

202+
-- | Test that cache of statements works.
203+
testPreparedStatementCache :: IO ()
204+
testPreparedStatementCache = withConnection $ \c -> do
205+
let a = 7
206+
b = 2
207+
sendBatchAndSync c [ makeQuery1 (BS.pack (show a))
208+
, makeQuery1 (BS.pack (show b))
209+
, makeQuery2 (BS.pack (show a)) (BS.pack (show b))]
210+
readReadyForQuery c
211+
r1 <- fromMessage <$> readNextData c
212+
r2 <- fromMessage <$> readNextData c
213+
r3 <- fromMessage <$> readNextData c
214+
215+
BS.pack (show a) @=? r1
216+
BS.pack (show b) @=? r2
217+
BS.pack (show $ a + b) @=? r3
218+
219+
size <- getCacheSize $ connStatementStorage c
220+
-- 2 different statements were send
221+
2 @=? size
222+

0 commit comments

Comments
 (0)
0