module Hasql.PreparedStatementRegistry
  ( PreparedStatementRegistry,
    new,
    update,
    reset,
    LocalKey (..),
  )
where

import Hasql.Prelude hiding (lookup, reset)
import Hasql.PreparedStatementRegistry.Map (LocalKey (..))
import Hasql.PreparedStatementRegistry.Map qualified as Map

-- | Registry data structure containing a pure RegistryState wrapped in IORef
data PreparedStatementRegistry
  = PreparedStatementRegistry !(IORef Map.RegistryState)

{-# INLINEABLE new #-}
new :: IO PreparedStatementRegistry
new :: IO PreparedStatementRegistry
new =
  IORef RegistryState -> PreparedStatementRegistry
PreparedStatementRegistry (IORef RegistryState -> PreparedStatementRegistry)
-> IO (IORef RegistryState) -> IO PreparedStatementRegistry
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RegistryState -> IO (IORef RegistryState)
forall a. a -> IO (IORef a)
newIORef RegistryState
Map.empty

{-# INLINEABLE update #-}
update :: LocalKey -> (ByteString -> IO (Bool, a)) -> (ByteString -> IO a) -> PreparedStatementRegistry -> IO a
update :: forall a.
LocalKey
-> (ByteString -> IO (Bool, a))
-> (ByteString -> IO a)
-> PreparedStatementRegistry
-> IO a
update LocalKey
localKey ByteString -> IO (Bool, a)
onNewRemoteKey ByteString -> IO a
onOldRemoteKey (PreparedStatementRegistry IORef RegistryState
registryRef) = do
  RegistryState
registryState <- IORef RegistryState -> IO RegistryState
forall a. IORef a -> IO a
readIORef IORef RegistryState
registryRef
  case LocalKey -> RegistryState -> Maybe ByteString
Map.lookup LocalKey
localKey RegistryState
registryState of
    Just ByteString
remoteKey -> ByteString -> IO a
onOldRemoteKey ByteString
remoteKey
    Maybe ByteString
Nothing -> do
      let (ByteString
remoteKey, RegistryState
newState) = LocalKey -> RegistryState -> (ByteString, RegistryState)
Map.insert LocalKey
localKey RegistryState
registryState
      (Bool
save, a
result) <- ByteString -> IO (Bool, a)
onNewRemoteKey ByteString
remoteKey
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
save (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef RegistryState -> RegistryState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef RegistryState
registryRef RegistryState
newState
      return a
result

reset :: PreparedStatementRegistry -> IO ()
reset :: PreparedStatementRegistry -> IO ()
reset (PreparedStatementRegistry IORef RegistryState
registryRef) = do
  IORef RegistryState -> RegistryState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef RegistryState
registryRef RegistryState
Map.empty