{-# LANGUAGE RecordWildCards #-}
module Database.Persist.SqlBackend.StatementCache
  ( StatementCache
  , StatementCacheKey
  , mkCacheKeyFromQuery
  , MkStatementCache(..)
  , mkSimpleStatementCache
  , mkStatementCache
  ) where

import Data.Foldable
import Data.IORef
import qualified Data.Map as Map
import Database.Persist.SqlBackend.Internal.Statement
import Database.Persist.SqlBackend.Internal.StatementCache
import Data.Map (Map)
import Data.Text (Text)

-- | Configuration parameters for creating a custom statement cache
--
-- @since 2.13.3
data MkStatementCache = MkStatementCache
    { MkStatementCache -> StatementCacheKey -> IO (Maybe Statement)
statementCacheLookup :: StatementCacheKey -> IO (Maybe Statement)
    -- ^ Retrieve a statement from the cache, or return nothing if it is not found.
    --
    -- @since 2.13.3
    , MkStatementCache -> StatementCacheKey -> Statement -> IO ()
statementCacheInsert :: StatementCacheKey -> Statement -> IO ()
    -- ^ Put a new statement into the cache. An immediate lookup of
    -- the statement MUST return the inserted statement for the given
    -- cache key. Depending on the implementation, the statement cache MAY
    -- choose to evict other statements from the cache within this function.
    --
    -- @since 2.13.3
    , MkStatementCache -> IO ()
statementCacheClear :: IO ()
    -- ^ Remove all statements from the cache. Implementations of this
    -- should be sure to call `stmtFinalize` on all statements removed
    -- from the cache.
    --
    -- @since 2.13.3
    , MkStatementCache -> IO Int
statementCacheSize :: IO Int
    -- ^ Get the current size of the cache.
    --
    -- @since 2.13.3
    }


-- | Make a simple statement cache that will cache statements if they are not currently cached.
--
-- @since 2.13.3
mkSimpleStatementCache :: IORef (Map Text Statement) -> MkStatementCache
mkSimpleStatementCache :: IORef (Map Text Statement) -> MkStatementCache
mkSimpleStatementCache IORef (Map Text Statement)
stmtMap =
    MkStatementCache :: (StatementCacheKey -> IO (Maybe Statement))
-> (StatementCacheKey -> Statement -> IO ())
-> IO ()
-> IO Int
-> MkStatementCache
MkStatementCache
        { statementCacheLookup :: StatementCacheKey -> IO (Maybe Statement)
statementCacheLookup = \StatementCacheKey
sql -> Text -> Map Text Statement -> Maybe Statement
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (StatementCacheKey -> Text
cacheKey StatementCacheKey
sql) (Map Text Statement -> Maybe Statement)
-> IO (Map Text Statement) -> IO (Maybe Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map Text Statement) -> IO (Map Text Statement)
forall a. IORef a -> IO a
readIORef IORef (Map Text Statement)
stmtMap
        , statementCacheInsert :: StatementCacheKey -> Statement -> IO ()
statementCacheInsert = \StatementCacheKey
sql Statement
stmt ->
            IORef (Map Text Statement)
-> (Map Text Statement -> Map Text Statement) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef (Map Text Statement)
stmtMap (Text -> Statement -> Map Text Statement -> Map Text Statement
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (StatementCacheKey -> Text
cacheKey StatementCacheKey
sql) Statement
stmt)
        , statementCacheClear :: IO ()
statementCacheClear = do
            Map Text Statement
oldStatements <- IORef (Map Text Statement)
-> (Map Text Statement -> (Map Text Statement, Map Text Statement))
-> IO (Map Text Statement)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Map Text Statement)
stmtMap (\Map Text Statement
oldStatements -> (Map Text Statement
forall k a. Map k a
Map.empty, Map Text Statement
oldStatements))
            (Statement -> IO ()) -> Map Text Statement -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Statement -> IO ()
stmtFinalize Map Text Statement
oldStatements
        , statementCacheSize :: IO Int
statementCacheSize = Map Text Statement -> Int
forall k a. Map k a -> Int
Map.size (Map Text Statement -> Int) -> IO (Map Text Statement) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map Text Statement) -> IO (Map Text Statement)
forall a. IORef a -> IO a
readIORef IORef (Map Text Statement)
stmtMap
        }

-- | Create a statement cache.
--
-- @since 2.13.0
mkStatementCache :: MkStatementCache -> StatementCache
mkStatementCache :: MkStatementCache -> StatementCache
mkStatementCache MkStatementCache{IO Int
IO ()
StatementCacheKey -> IO (Maybe Statement)
StatementCacheKey -> Statement -> IO ()
statementCacheSize :: IO Int
statementCacheClear :: IO ()
statementCacheInsert :: StatementCacheKey -> Statement -> IO ()
statementCacheLookup :: StatementCacheKey -> IO (Maybe Statement)
statementCacheSize :: MkStatementCache -> IO Int
statementCacheClear :: MkStatementCache -> IO ()
statementCacheInsert :: MkStatementCache -> StatementCacheKey -> Statement -> IO ()
statementCacheLookup :: MkStatementCache -> StatementCacheKey -> IO (Maybe Statement)
..} = StatementCache :: (StatementCacheKey -> IO (Maybe Statement))
-> (StatementCacheKey -> Statement -> IO ())
-> IO ()
-> IO Int
-> StatementCache
StatementCache { IO Int
IO ()
StatementCacheKey -> IO (Maybe Statement)
StatementCacheKey -> Statement -> IO ()
statementCacheSize :: IO Int
statementCacheClear :: IO ()
statementCacheInsert :: StatementCacheKey -> Statement -> IO ()
statementCacheLookup :: StatementCacheKey -> IO (Maybe Statement)
statementCacheSize :: IO Int
statementCacheClear :: IO ()
statementCacheInsert :: StatementCacheKey -> Statement -> IO ()
statementCacheLookup :: StatementCacheKey -> IO (Maybe Statement)
.. }