mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-11-22 01:52:45 +03:00
Add the resetting of the registry in case of errors
This commit is contained in:
parent
8c3685e6a9
commit
6bb52d0574
@ -2,6 +2,7 @@ module Hasql.PreparedStatementRegistry
|
|||||||
( PreparedStatementRegistry,
|
( PreparedStatementRegistry,
|
||||||
new,
|
new,
|
||||||
update,
|
update,
|
||||||
|
reset,
|
||||||
LocalKey (..),
|
LocalKey (..),
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
@ -9,7 +10,7 @@ where
|
|||||||
import ByteString.StrictBuilder qualified as B
|
import ByteString.StrictBuilder qualified as B
|
||||||
import Data.HashTable.IO qualified as A
|
import Data.HashTable.IO qualified as A
|
||||||
import Hasql.LibPq14 qualified as Pq
|
import Hasql.LibPq14 qualified as Pq
|
||||||
import Hasql.Prelude hiding (lookup)
|
import Hasql.Prelude hiding (lookup, reset)
|
||||||
|
|
||||||
data PreparedStatementRegistry
|
data PreparedStatementRegistry
|
||||||
= PreparedStatementRegistry !(A.BasicHashTable LocalKey ByteString) !(IORef Word)
|
= PreparedStatementRegistry !(A.BasicHashTable LocalKey ByteString) !(IORef Word)
|
||||||
@ -42,6 +43,15 @@ update localKey onNewRemoteKey onOldRemoteKey (PreparedStatementRegistry table c
|
|||||||
old =
|
old =
|
||||||
onOldRemoteKey
|
onOldRemoteKey
|
||||||
|
|
||||||
|
reset :: PreparedStatementRegistry -> IO ()
|
||||||
|
reset (PreparedStatementRegistry table counter) = do
|
||||||
|
-- TODO: This is a temporary measure.
|
||||||
|
-- We should just move to a pure implementation.
|
||||||
|
do
|
||||||
|
entries <- A.toList table
|
||||||
|
forM_ entries \(k, _) -> A.delete table k
|
||||||
|
writeIORef counter 0
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- Local statement key.
|
-- Local statement key.
|
||||||
data LocalKey
|
data LocalKey
|
||||||
|
@ -11,6 +11,7 @@ import Hasql.IO qualified as IO
|
|||||||
import Hasql.LibPq14 qualified as Pq
|
import Hasql.LibPq14 qualified as Pq
|
||||||
import Hasql.Pipeline.Core qualified as Pipeline
|
import Hasql.Pipeline.Core qualified as Pipeline
|
||||||
import Hasql.Prelude
|
import Hasql.Prelude
|
||||||
|
import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry
|
||||||
import Hasql.Statement qualified as Statement
|
import Hasql.Statement qualified as Statement
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
@ -29,11 +30,13 @@ run (Session impl) connection =
|
|||||||
runExceptT $ runReaderT impl connection
|
runExceptT $ runReaderT impl connection
|
||||||
handler =
|
handler =
|
||||||
case connection of
|
case connection of
|
||||||
Connection.Connection pqConnVar _ _ ->
|
Connection.Connection pqConnVar _ registry ->
|
||||||
withMVar pqConnVar \pqConn ->
|
withMVar pqConnVar \pqConn ->
|
||||||
Pq.transactionStatus pqConn >>= \case
|
Pq.transactionStatus pqConn >>= \case
|
||||||
Pq.TransIdle -> pure ()
|
Pq.TransIdle -> pure ()
|
||||||
_ -> Pq.reset pqConn
|
_ -> do
|
||||||
|
PreparedStatementRegistry.reset registry
|
||||||
|
Pq.reset pqConn
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
-- Possibly a multi-statement query,
|
-- Possibly a multi-statement query,
|
||||||
|
Loading…
Reference in New Issue
Block a user