module Database.Persist.SqlBackend.Internal.StatementCache where

import Data.Text (Text)
import Database.Persist.SqlBackend.Internal.Statement

-- | A statement cache used to lookup statements that have already been prepared
-- for a given query.
--
-- @since 2.13.3
data StatementCache = StatementCache
    { StatementCache -> StatementCacheKey -> IO (Maybe Statement)
statementCacheLookup :: StatementCacheKey -> IO (Maybe Statement)
    , StatementCache -> StatementCacheKey -> Statement -> IO ()
statementCacheInsert :: StatementCacheKey -> Statement -> IO ()
    , StatementCache -> IO ()
statementCacheClear :: IO ()
    , StatementCache -> IO Int
statementCacheSize :: IO Int
    }

newtype StatementCacheKey = StatementCacheKey { StatementCacheKey -> Text
cacheKey :: Text }
-- Wrapping around this to allow for more efficient keying mechanisms
-- in the future, perhaps.

-- | Construct a `StatementCacheKey` from a raw SQL query.
mkCacheKeyFromQuery :: Text -> StatementCacheKey
mkCacheKeyFromQuery :: Text -> StatementCacheKey
mkCacheKeyFromQuery = Text -> StatementCacheKey
StatementCacheKey