2024-01-27 00:23:09 +03:00
|
|
|
module Hasql.PreparedStatementRegistry
|
2022-06-20 13:54:54 +03:00
|
|
|
( PreparedStatementRegistry,
|
|
|
|
new,
|
|
|
|
update,
|
|
|
|
LocalKey (..),
|
|
|
|
)
|
2015-11-08 21:09:42 +03:00
|
|
|
where
|
|
|
|
|
2024-04-19 07:38:30 +03:00
|
|
|
import ByteString.StrictBuilder qualified as B
|
|
|
|
import Data.HashTable.IO qualified as A
|
2024-01-27 00:23:09 +03:00
|
|
|
import Hasql.Prelude hiding (lookup)
|
2024-04-21 07:56:16 +03:00
|
|
|
import qualified Database.PostgreSQL.LibPQ as Pq
|
2015-11-08 21:09:42 +03:00
|
|
|
|
2022-06-20 13:54:54 +03:00
|
|
|
data PreparedStatementRegistry
|
|
|
|
= PreparedStatementRegistry !(A.BasicHashTable LocalKey ByteString) !(IORef Word)
|
2015-11-08 21:09:42 +03:00
|
|
|
|
2022-06-20 13:54:54 +03:00
|
|
|
{-# INLINEABLE new #-}
|
2015-11-08 21:09:42 +03:00
|
|
|
new :: IO PreparedStatementRegistry
|
|
|
|
new =
|
2016-02-26 15:26:55 +03:00
|
|
|
PreparedStatementRegistry <$> A.new <*> newIORef 0
|
|
|
|
|
2022-06-20 13:54:54 +03:00
|
|
|
{-# INLINEABLE update #-}
|
2016-02-26 15:26:55 +03:00
|
|
|
update :: LocalKey -> (ByteString -> IO (Bool, a)) -> (ByteString -> IO a) -> PreparedStatementRegistry -> IO a
|
|
|
|
update localKey onNewRemoteKey onOldRemoteKey (PreparedStatementRegistry table counter) =
|
|
|
|
lookup >>= maybe new old
|
|
|
|
where
|
|
|
|
lookup =
|
|
|
|
A.lookup table localKey
|
|
|
|
new =
|
|
|
|
readIORef counter >>= onN
|
|
|
|
where
|
|
|
|
onN n =
|
|
|
|
do
|
|
|
|
(save, result) <- onNewRemoteKey remoteKey
|
|
|
|
when save $ do
|
|
|
|
A.insert table localKey remoteKey
|
|
|
|
writeIORef counter (succ n)
|
|
|
|
return result
|
|
|
|
where
|
|
|
|
remoteKey =
|
2017-03-21 00:29:27 +03:00
|
|
|
B.builderBytes . B.asciiIntegral $ n
|
2016-02-26 15:26:55 +03:00
|
|
|
old =
|
|
|
|
onOldRemoteKey
|
|
|
|
|
2015-11-08 21:09:42 +03:00
|
|
|
-- |
|
|
|
|
-- Local statement key.
|
2022-06-20 13:54:54 +03:00
|
|
|
data LocalKey
|
2024-04-21 07:56:16 +03:00
|
|
|
= LocalKey !ByteString ![Pq.Oid]
|
2015-11-08 21:09:42 +03:00
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
instance Hashable LocalKey where
|
|
|
|
{-# INLINE hashWithSalt #-}
|
|
|
|
hashWithSalt salt (LocalKey template types) =
|
|
|
|
hashWithSalt salt template
|