{-# 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)
data MkStatementCache = MkStatementCache
{ MkStatementCache -> StatementCacheKey -> IO (Maybe Statement)
statementCacheLookup :: StatementCacheKey -> IO (Maybe Statement)
, MkStatementCache -> StatementCacheKey -> Statement -> IO ()
statementCacheInsert :: StatementCacheKey -> Statement -> IO ()
, MkStatementCache -> IO ()
statementCacheClear :: IO ()
, MkStatementCache -> IO Int
statementCacheSize :: IO Int
}
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
}
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)
.. }