mirror of https://github.com/voidlizard/hbs2
68 lines
2.2 KiB
Haskell
68 lines
2.2 KiB
Haskell
module HBS2.Storage.NCQ3.Internal.MMapCache where
|
|
|
|
import HBS2.Storage.NCQ3.Internal.Prelude
|
|
import HBS2.Storage.NCQ3.Internal.Types
|
|
import HBS2.Storage.NCQ3.Internal.Files
|
|
|
|
import Data.HashPSQ as HPSQ
|
|
|
|
cacheLookupOrInsert :: forall m val.
|
|
MonadUnliftIO m
|
|
=> Int -- ^ max size
|
|
-> (FileKey -> m val) -- ^ loader
|
|
-> TVar (HashPSQ FileKey CachePrio val) -- ^ the cache
|
|
-> FileKey
|
|
-> m val
|
|
cacheLookupOrInsert maxSize load cacheTVar fk = do
|
|
now <- getTimeCoarse
|
|
|
|
atomically (HPSQ.lookup fk <$> readTVar cacheTVar) >>= \case
|
|
Just (_, val) -> do
|
|
atomically $ modifyTVar' cacheTVar (HPSQ.insert fk now val)
|
|
pure val
|
|
|
|
Nothing -> do
|
|
val <- load fk
|
|
atomically do
|
|
old <- readTVar cacheTVar
|
|
let new =
|
|
if HPSQ.size old >= maxSize
|
|
then HPSQ.insert fk now val (HPSQ.deleteMin old)
|
|
else HPSQ.insert fk now val old
|
|
writeTVar cacheTVar new
|
|
pure val
|
|
|
|
ncqGetCachedData :: MonadUnliftIO m => NCQStorage -> FileKey -> m CachedData
|
|
ncqGetCachedData ncq@NCQStorage{..} =
|
|
cacheLookupOrInsert ncqMaxCachedData load ncqMMapCachedData
|
|
where
|
|
load fk = do
|
|
let path = ncqGetFileName ncq (DataFile fk)
|
|
bs <- liftIO (mmapFileByteString path Nothing)
|
|
pure (CachedData bs)
|
|
|
|
ncqGetCachedIndex :: MonadUnliftIO m => NCQStorage -> FileKey -> m CachedIndex
|
|
ncqGetCachedIndex ncq@NCQStorage{..} =
|
|
cacheLookupOrInsert ncqMaxCachedIndex load ncqMMapCachedIdx
|
|
where
|
|
load fk = do
|
|
let path = ncqGetFileName ncq (IndexFile fk)
|
|
nwayHashMMapReadOnly path >>= \case
|
|
Nothing -> throwIO $ NCQStorageCantMapFile path
|
|
Just (bs, nway) -> pure (CachedIndex bs nway)
|
|
|
|
ncqDelCachedIndexSTM :: NCQStorage
|
|
-> FileKey
|
|
-> STM ()
|
|
|
|
ncqDelCachedIndexSTM NCQStorage{..} fk =
|
|
modifyTVar ncqMMapCachedIdx$ HPSQ.delete fk
|
|
|
|
ncqDelCachedDataSTM :: NCQStorage
|
|
-> FileKey
|
|
-> STM ()
|
|
|
|
ncqDelCachedDataSTM NCQStorage{..} fk =
|
|
modifyTVar ncqMMapCachedData $ HPSQ.delete fk
|
|
|