mirror of https://github.com/voidlizard/hbs2
NCQStorage3 -> NCQStorage
This commit is contained in:
voidlizard
parent
d71a66111a
commit
29ed5a7ecc
|
|
@ -1,10 +1,10 @@
|
|||
module HBS2.Storage.NCQ3
|
||||
( module Exported
|
||||
, ncqWithStorage3
|
||||
, ncqStorageSync3
|
||||
, ncqStorageStop3
|
||||
, ncqStorageOpen3
|
||||
, ncqStorageRun3
|
||||
, ncqWithStorage
|
||||
, ncqStorageSync
|
||||
, ncqStorageStop
|
||||
, ncqStorageOpen
|
||||
, ncqStorageRun
|
||||
, ncqPutBS
|
||||
, ncqGetEntryBS
|
||||
, IsTomb(..)
|
||||
|
|
|
|||
|
|
@ -41,8 +41,8 @@ import Control.Concurrent.STM qualified as STM
|
|||
import Control.Concurrent.STM.TSem
|
||||
import System.FileLock as FL
|
||||
|
||||
ncqStorageOpen3 :: MonadIO m => FilePath -> (NCQStorage3 -> NCQStorage3) -> m NCQStorage3
|
||||
ncqStorageOpen3 fp upd = do
|
||||
ncqStorageOpen :: MonadIO m => FilePath -> (NCQStorage -> NCQStorage) -> m NCQStorage
|
||||
ncqStorageOpen fp upd = do
|
||||
let ncqRoot = fp
|
||||
let ncqGen = 0
|
||||
let ncqFsync = 16 * megabytes
|
||||
|
|
@ -83,7 +83,7 @@ ncqStorageOpen3 fp upd = do
|
|||
ncqServiceSem <- atomically $ newTSem 1
|
||||
ncqFileLock <- newTVarIO Nothing
|
||||
|
||||
let ncq = NCQStorage3{..} & upd
|
||||
let ncq = NCQStorage{..} & upd
|
||||
|
||||
mkdir (ncqGetWorkDir ncq)
|
||||
|
||||
|
|
@ -95,24 +95,24 @@ ncqStorageOpen3 fp upd = do
|
|||
|
||||
pure ncq
|
||||
|
||||
ncqWithStorage3 :: MonadUnliftIO m => FilePath -> (NCQStorage3 -> m a) -> m a
|
||||
ncqWithStorage3 fp action = flip runContT pure do
|
||||
sto <- lift (ncqStorageOpen3 fp id)
|
||||
w <- ContT $ withAsync (ncqStorageRun3 sto) -- TODO: implement run
|
||||
ncqWithStorage :: MonadUnliftIO m => FilePath -> (NCQStorage -> m a) -> m a
|
||||
ncqWithStorage fp action = flip runContT pure do
|
||||
sto <- lift (ncqStorageOpen fp id)
|
||||
w <- ContT $ withAsync (ncqStorageRun sto)
|
||||
link w
|
||||
r <- lift (action sto)
|
||||
lift (ncqStorageStop3 sto)
|
||||
lift (ncqStorageStop sto)
|
||||
wait w
|
||||
pure r
|
||||
|
||||
-- FIXME: maybe-on-storage-closed
|
||||
ncqPutBS :: MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> Maybe NCQSectionType
|
||||
-> Maybe HashRef
|
||||
-> ByteString
|
||||
-> m HashRef
|
||||
ncqPutBS ncq@NCQStorage3{..} mtp mhref bs' = ncqOperation ncq (pure $ fromMaybe hash0 mhref) do
|
||||
ncqPutBS ncq@NCQStorage{..} mtp mhref bs' = ncqOperation ncq (pure $ fromMaybe hash0 mhref) do
|
||||
waiter <- newEmptyTMVarIO
|
||||
|
||||
let work = do
|
||||
|
|
@ -143,10 +143,10 @@ ncqPutBS ncq@NCQStorage3{..} mtp mhref bs' = ncqOperation ncq (pure $ fromMaybe
|
|||
|
||||
|
||||
ncqTryLoadState :: forall m. MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> m ()
|
||||
|
||||
ncqTryLoadState me@NCQStorage3{..} = do
|
||||
ncqTryLoadState me@NCQStorage{..} = do
|
||||
|
||||
stateFiles <- ncqListFilesBy me ( List.isPrefixOf "s-" )
|
||||
|
||||
|
|
@ -238,7 +238,7 @@ instance IsTomb Location where
|
|||
(_, Right (T, _)) -> True
|
||||
_ -> False
|
||||
|
||||
ncqGetEntryBS :: MonadUnliftIO m => NCQStorage3 -> Location -> m (Maybe ByteString)
|
||||
ncqGetEntryBS :: MonadUnliftIO m => NCQStorage -> Location -> m (Maybe ByteString)
|
||||
ncqGetEntryBS me = \case
|
||||
InMemory bs -> pure $ Just bs
|
||||
InFossil fk off size -> do
|
||||
|
|
@ -253,7 +253,7 @@ ncqEntrySize = \case
|
|||
InMemory bs -> fromIntegral (BS.length bs)
|
||||
|
||||
ncqDelEntry :: MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> HashRef
|
||||
-> m ()
|
||||
ncqDelEntry me href = do
|
||||
|
|
|
|||
|
|
@ -8,28 +8,28 @@ import System.Posix.Files qualified as PFS
|
|||
import Data.List qualified as List
|
||||
|
||||
|
||||
ncqGetFileName :: forall f . ToFileName f => NCQStorage3 -> f -> FilePath
|
||||
ncqGetFileName :: forall f . ToFileName f => NCQStorage -> f -> FilePath
|
||||
ncqGetFileName ncq fp = ncqGetWorkDir ncq </> takeFileName (toFileName fp)
|
||||
|
||||
ncqGetWorkDir :: NCQStorage3 -> FilePath
|
||||
ncqGetWorkDir NCQStorage3{..} = ncqRoot </> show ncqGen
|
||||
ncqGetWorkDir :: NCQStorage -> FilePath
|
||||
ncqGetWorkDir NCQStorage{..} = ncqRoot </> show ncqGen
|
||||
|
||||
ncqGetLockFileName :: NCQStorage3 -> FilePath
|
||||
ncqGetLockFileName :: NCQStorage -> FilePath
|
||||
ncqGetLockFileName ncq = ncqGetFileName ncq ".lock"
|
||||
|
||||
ncqGetNewFileKey :: forall f m . (ToFileName f, MonadIO m)
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> ( FileKey -> f )
|
||||
-> m FileKey
|
||||
ncqGetNewFileKey me@NCQStorage3{..} fnameOf = fix \next -> do
|
||||
ncqGetNewFileKey me@NCQStorage{..} fnameOf = fix \next -> do
|
||||
n <- atomically $ stateTVar ncqState (\e -> (e.ncqStateFileSeq , succSeq e))
|
||||
here <- doesFileExist (ncqGetFileName me (fnameOf n))
|
||||
if here then next else pure n
|
||||
where
|
||||
succSeq e = e { ncqStateFileSeq = succ e.ncqStateFileSeq }
|
||||
|
||||
ncqListFilesBy :: forall m . MonadUnliftIO m => NCQStorage3 -> (FilePath -> Bool) -> m [(POSIXTime, FileKey)]
|
||||
ncqListFilesBy me@NCQStorage3{..} filt = do
|
||||
ncqListFilesBy :: forall m . MonadUnliftIO m => NCQStorage -> (FilePath -> Bool) -> m [(POSIXTime, FileKey)]
|
||||
ncqListFilesBy me@NCQStorage{..} filt = do
|
||||
w <- dirFiles (ncqGetWorkDir me)
|
||||
<&> filter (filt . takeFileName)
|
||||
|
||||
|
|
@ -40,7 +40,7 @@ ncqListFilesBy me@NCQStorage3{..} filt = do
|
|||
pure $ List.sortOn ( Down . fst ) r
|
||||
|
||||
ncqFindMinPairOf :: forall fa m . (ToFileName fa, MonadUnliftIO m)
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> [fa]
|
||||
-> m (Maybe (NCQFileSize, fa, fa))
|
||||
ncqFindMinPairOf sto lst = do
|
||||
|
|
|
|||
|
|
@ -52,10 +52,10 @@ ncqEntryUnwrapValue v = case ncqIsMeta v of
|
|||
|
||||
|
||||
ncqFossilMergeStep :: forall m . MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> m Bool
|
||||
|
||||
ncqFossilMergeStep me@NCQStorage3{..} = withSem ncqServiceSem $ flip runContT pure $ callCC \exit -> do
|
||||
ncqFossilMergeStep me@NCQStorage{..} = withSem ncqServiceSem $ flip runContT pure $ callCC \exit -> do
|
||||
|
||||
debug "ncqFossilMergeStep"
|
||||
|
||||
|
|
@ -188,7 +188,7 @@ ncqFileTryRecover fp = do
|
|||
|
||||
|
||||
writeFiltered :: forall m . MonadIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> FilePath
|
||||
-> Fd
|
||||
-> ( Integer -> Integer -> HashRef -> ByteString -> m Bool)
|
||||
|
|
|
|||
|
|
@ -72,8 +72,8 @@ ncqLookupIndex hx (mmaped, nway) = do
|
|||
|
||||
|
||||
|
||||
ncqLocate_ :: MonadUnliftIO m => Bool -> NCQStorage3 -> HashRef -> m (Maybe Location)
|
||||
ncqLocate_ f me@NCQStorage3{..} href = ncqOperation me (pure Nothing) do
|
||||
ncqLocate_ :: MonadUnliftIO m => Bool -> NCQStorage -> HashRef -> m (Maybe Location)
|
||||
ncqLocate_ f me@NCQStorage{..} href = ncqOperation me (pure Nothing) do
|
||||
answ <- newEmptyTMVarIO
|
||||
|
||||
atomically do
|
||||
|
|
@ -82,11 +82,11 @@ ncqLocate_ f me@NCQStorage3{..} href = ncqOperation me (pure Nothing) do
|
|||
|
||||
atomically $ takeTMVar answ
|
||||
|
||||
ncqLocate :: MonadUnliftIO m => NCQStorage3 -> HashRef -> m (Maybe Location)
|
||||
ncqLocate :: MonadUnliftIO m => NCQStorage -> HashRef -> m (Maybe Location)
|
||||
ncqLocate me href = ncqOperation me (pure Nothing) do
|
||||
ncqLocate_ True me href
|
||||
|
||||
ncqIndexFile :: MonadUnliftIO m => NCQStorage3 -> DataFile FileKey -> m (Maybe FilePath)
|
||||
ncqIndexFile :: MonadUnliftIO m => NCQStorage -> DataFile FileKey -> m (Maybe FilePath)
|
||||
ncqIndexFile n fk = runMaybeT do
|
||||
|
||||
let fp = toFileName fk & ncqGetFileName n
|
||||
|
|
@ -139,7 +139,7 @@ ncqIndexFile n fk = runMaybeT do
|
|||
|
||||
|
||||
ncqIndexCompactFull :: MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> m ()
|
||||
|
||||
ncqIndexCompactFull ncq = fix \again ->
|
||||
|
|
@ -148,9 +148,9 @@ ncqIndexCompactFull ncq = fix \again ->
|
|||
False -> none
|
||||
|
||||
ncqIndexCompactStep :: MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> m Bool
|
||||
ncqIndexCompactStep me@NCQStorage3{..} = withSem ncqServiceSem $ flip runContT pure $ callCC \exit -> do
|
||||
ncqIndexCompactStep me@NCQStorage{..} = withSem ncqServiceSem $ flip runContT pure $ callCC \exit -> do
|
||||
|
||||
debug "ncqIndexCompactStep"
|
||||
|
||||
|
|
@ -203,7 +203,7 @@ ncqIndexCompactStep me@NCQStorage3{..} = withSem ncqServiceSem $ flip runContT p
|
|||
pure True
|
||||
|
||||
ncqStorageScanDataFile :: MonadIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> FilePath
|
||||
-> ( Integer -> Integer -> HashRef -> ByteString -> m () )
|
||||
-> m ()
|
||||
|
|
|
|||
|
|
@ -33,8 +33,8 @@ cacheLookupOrInsert maxSize load cacheTVar fk = do
|
|||
writeTVar cacheTVar new
|
||||
pure val
|
||||
|
||||
ncqGetCachedData :: MonadUnliftIO m => NCQStorage3 -> FileKey -> m CachedData
|
||||
ncqGetCachedData ncq@NCQStorage3{..} =
|
||||
ncqGetCachedData :: MonadUnliftIO m => NCQStorage -> FileKey -> m CachedData
|
||||
ncqGetCachedData ncq@NCQStorage{..} =
|
||||
cacheLookupOrInsert ncqMaxCachedData load ncqMMapCachedData
|
||||
where
|
||||
load fk = do
|
||||
|
|
@ -42,8 +42,8 @@ ncqGetCachedData ncq@NCQStorage3{..} =
|
|||
bs <- liftIO (mmapFileByteString path Nothing)
|
||||
pure (CachedData bs)
|
||||
|
||||
ncqGetCachedIndex :: MonadUnliftIO m => NCQStorage3 -> FileKey -> m CachedIndex
|
||||
ncqGetCachedIndex ncq@NCQStorage3{..} =
|
||||
ncqGetCachedIndex :: MonadUnliftIO m => NCQStorage -> FileKey -> m CachedIndex
|
||||
ncqGetCachedIndex ncq@NCQStorage{..} =
|
||||
cacheLookupOrInsert ncqMaxCachedIndex load ncqMMapCachedIdx
|
||||
where
|
||||
load fk = do
|
||||
|
|
@ -52,17 +52,17 @@ ncqGetCachedIndex ncq@NCQStorage3{..} =
|
|||
Nothing -> throwIO $ NCQStorageCantMapFile path
|
||||
Just (bs, nway) -> pure (CachedIndex bs nway)
|
||||
|
||||
ncqDelCachedIndexSTM :: NCQStorage3
|
||||
ncqDelCachedIndexSTM :: NCQStorage
|
||||
-> FileKey
|
||||
-> STM ()
|
||||
|
||||
ncqDelCachedIndexSTM NCQStorage3{..} fk =
|
||||
ncqDelCachedIndexSTM NCQStorage{..} fk =
|
||||
modifyTVar ncqMMapCachedIdx$ HPSQ.delete fk
|
||||
|
||||
ncqDelCachedDataSTM :: NCQStorage3
|
||||
ncqDelCachedDataSTM :: NCQStorage
|
||||
-> FileKey
|
||||
-> STM ()
|
||||
|
||||
ncqDelCachedDataSTM NCQStorage3{..} fk =
|
||||
ncqDelCachedDataSTM NCQStorage{..} fk =
|
||||
modifyTVar ncqMMapCachedData $ HPSQ.delete fk
|
||||
|
||||
|
|
|
|||
|
|
@ -9,20 +9,20 @@ import Data.HashMap.Strict qualified as HM
|
|||
import Data.Vector qualified as V
|
||||
import Control.Concurrent.STM qualified as STM
|
||||
|
||||
ncqShardIdx :: NCQStorage3 -> HashRef -> Int
|
||||
ncqShardIdx NCQStorage3{..} h =
|
||||
ncqShardIdx :: NCQStorage -> HashRef -> Int
|
||||
ncqShardIdx NCQStorage{..} h =
|
||||
fromIntegral (BS.head (coerce h)) `mod` V.length ncqMemTable
|
||||
{-# INLINE ncqShardIdx #-}
|
||||
|
||||
ncqGetShard :: NCQStorage3 -> HashRef -> Shard
|
||||
ncqGetShard ncq@NCQStorage3{..} h = ncqMemTable ! ncqShardIdx ncq h
|
||||
ncqGetShard :: NCQStorage -> HashRef -> Shard
|
||||
ncqGetShard ncq@NCQStorage{..} h = ncqMemTable ! ncqShardIdx ncq h
|
||||
{-# INLINE ncqGetShard #-}
|
||||
|
||||
|
||||
ncqLookupEntrySTM :: NCQStorage3 -> HashRef -> STM (Maybe NCQEntry)
|
||||
ncqLookupEntrySTM :: NCQStorage -> HashRef -> STM (Maybe NCQEntry)
|
||||
ncqLookupEntrySTM ncq h = readTVar (ncqGetShard ncq h) <&> HM.lookup h
|
||||
|
||||
ncqAlterEntrySTM :: NCQStorage3
|
||||
ncqAlterEntrySTM :: NCQStorage
|
||||
-> HashRef
|
||||
-> (Maybe NCQEntry -> Maybe NCQEntry)
|
||||
-> STM ()
|
||||
|
|
@ -30,11 +30,11 @@ ncqAlterEntrySTM ncq h alterFn = do
|
|||
let shard = ncqGetShard ncq h
|
||||
modifyTVar shard (HM.alter alterFn h)
|
||||
|
||||
ncqStorageSync3 :: forall m . MonadUnliftIO m => NCQStorage3 -> m ()
|
||||
ncqStorageSync3 NCQStorage3{..} = atomically $ writeTVar ncqSyncReq True
|
||||
ncqStorageSync :: forall m . MonadUnliftIO m => NCQStorage -> m ()
|
||||
ncqStorageSync NCQStorage{..} = atomically $ writeTVar ncqSyncReq True
|
||||
|
||||
ncqOperation :: MonadIO m => NCQStorage3 -> m a -> m a -> m a
|
||||
ncqOperation NCQStorage3{..} m0 m = do
|
||||
ncqOperation :: MonadIO m => NCQStorage -> m a -> m a -> m a
|
||||
ncqOperation NCQStorage{..} m0 m = do
|
||||
what <- atomically do
|
||||
alive <- readTVar ncqAlive
|
||||
stop <- readTVar ncqStopReq
|
||||
|
|
|
|||
|
|
@ -40,14 +40,14 @@ import System.IO.MMap as MMap
|
|||
import Control.Concurrent.STM qualified as STM
|
||||
import System.FileLock as FL
|
||||
|
||||
ncqStorageStop3 :: forall m . MonadUnliftIO m => NCQStorage3 -> m ()
|
||||
ncqStorageStop3 NCQStorage3{..} = do
|
||||
ncqStorageStop :: forall m . MonadUnliftIO m => NCQStorage -> m ()
|
||||
ncqStorageStop NCQStorage{..} = do
|
||||
atomically $ writeTVar ncqStopReq True
|
||||
|
||||
ncqStorageRun3 :: forall m . MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
ncqStorageRun :: forall m . MonadUnliftIO m
|
||||
=> NCQStorage
|
||||
-> m ()
|
||||
ncqStorageRun3 ncq@NCQStorage3{..} = flip runContT pure do
|
||||
ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
|
||||
ContT $ bracket setAlive (const unsetAlive)
|
||||
|
||||
ContT $ bracket none $ const $ liftIO do
|
||||
|
|
|
|||
|
|
@ -26,16 +26,16 @@ import Lens.Micro.Platform
|
|||
import Streaming.Prelude qualified as S
|
||||
|
||||
newtype StateOP a =
|
||||
StateOP { fromStateOp :: ReaderT NCQStorage3 STM a }
|
||||
deriving newtype (Functor,Applicative,Monad,MonadReader NCQStorage3)
|
||||
StateOP { fromStateOp :: ReaderT NCQStorage STM a }
|
||||
deriving newtype (Functor,Applicative,Monad,MonadReader NCQStorage)
|
||||
|
||||
{- HLINT ignore "Eta reduce"-}
|
||||
|
||||
ncqStateUpdate :: MonadIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> StateOP a
|
||||
-> m ()
|
||||
ncqStateUpdate ncq@NCQStorage3{..} action = do
|
||||
ncqStateUpdate ncq@NCQStorage{..} action = do
|
||||
s0 <- readTVarIO ncqState
|
||||
|
||||
s1 <- atomically do
|
||||
|
|
@ -52,26 +52,26 @@ ncqStateUpdate ncq@NCQStorage3{..} action = do
|
|||
|
||||
ncqStateAddDataFile :: FileKey -> StateOP ()
|
||||
ncqStateAddDataFile fk = do
|
||||
NCQStorage3{..} <- ask
|
||||
NCQStorage{..} <- ask
|
||||
StateOP $ lift do
|
||||
modifyTVar ncqState (over #ncqStateFiles (HS.insert fk))
|
||||
|
||||
ncqStateDelDataFile :: FileKey -> StateOP ()
|
||||
ncqStateDelDataFile fk = do
|
||||
sto@NCQStorage3{..} <- ask
|
||||
sto@NCQStorage{..} <- ask
|
||||
StateOP $ lift do
|
||||
modifyTVar ncqState (over #ncqStateFiles (HS.delete fk))
|
||||
ncqDelCachedDataSTM sto fk
|
||||
|
||||
ncqStateAddFact :: Fact -> StateOP ()
|
||||
ncqStateAddFact fact = do
|
||||
NCQStorage3{..} <- ask
|
||||
NCQStorage{..} <- ask
|
||||
StateOP $ lift do
|
||||
modifyTVar ncqState (over #ncqStateFacts (Set.insert fact))
|
||||
|
||||
ncqStateDelFact :: Fact -> StateOP ()
|
||||
ncqStateDelFact fact = do
|
||||
NCQStorage3{..} <- ask
|
||||
NCQStorage{..} <- ask
|
||||
StateOP $ lift do
|
||||
modifyTVar ncqState (over #ncqStateFacts (Set.delete fact))
|
||||
|
||||
|
|
@ -80,12 +80,12 @@ ncqStateAddIndexFile :: POSIXTime
|
|||
-> StateOP ()
|
||||
|
||||
ncqStateAddIndexFile ts fk = do
|
||||
NCQStorage3{..} <- ask
|
||||
NCQStorage{..} <- ask
|
||||
StateOP $ lift $ modifyTVar' ncqState (sortIndexes . over #ncqStateIndex ((Down ts, fk) :))
|
||||
|
||||
ncqStateDelIndexFile :: FileKey -> StateOP ()
|
||||
ncqStateDelIndexFile fk = do
|
||||
sto@NCQStorage3{..} <- ask
|
||||
sto@NCQStorage{..} <- ask
|
||||
StateOP $ lift do
|
||||
modifyTVar' ncqState (over #ncqStateIndex $ filter f)
|
||||
ncqDelCachedIndexSTM sto fk
|
||||
|
|
@ -97,10 +97,10 @@ sortIndexes = over #ncqStateIndex (List.sortOn fst)
|
|||
|
||||
|
||||
ncqStateCapture :: forall m . MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> m FileKey
|
||||
|
||||
ncqStateCapture me@NCQStorage3{..} = do
|
||||
ncqStateCapture me@NCQStorage{..} = do
|
||||
atomically do
|
||||
key <- readTVar ncqStateKey
|
||||
stateUse <- readTVar ncqStateUse
|
||||
|
|
@ -113,10 +113,10 @@ ncqStateCapture me@NCQStorage3{..} = do
|
|||
pure key
|
||||
|
||||
ncqStateDismiss :: forall m . MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> FileKey
|
||||
-> m ()
|
||||
ncqStateDismiss me@NCQStorage3{..} key = atomically do
|
||||
ncqStateDismiss me@NCQStorage{..} key = atomically do
|
||||
useMap <- readTVar ncqStateUse
|
||||
case HM.lookup key useMap of
|
||||
Nothing -> pure ()
|
||||
|
|
@ -127,13 +127,13 @@ ncqStateDismiss me@NCQStorage3{..} key = atomically do
|
|||
modifyTVar ncqStateUse (HM.delete key)
|
||||
|
||||
ncqWithState :: forall a m . MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> ( FileKey -> m a )
|
||||
-> m a
|
||||
ncqWithState sto = bracket (ncqStateCapture sto) (ncqStateDismiss sto)
|
||||
|
||||
readStateMay :: forall m . MonadUnliftIO m
|
||||
=> NCQStorage3
|
||||
=> NCQStorage
|
||||
-> FileKey
|
||||
-> m (Maybe NCQState)
|
||||
readStateMay sto key = fmap sortIndexes <$> do
|
||||
|
|
|
|||
|
|
@ -15,19 +15,19 @@ import System.Posix.Files qualified as PFS
|
|||
import Control.Monad.Trans.Maybe
|
||||
import Data.HashMap.Strict qualified as HM
|
||||
|
||||
ncqLiveKeysSTM :: NCQStorage3 -> STM (HashSet FileKey)
|
||||
ncqLiveKeysSTM NCQStorage3{..} = do
|
||||
ncqLiveKeysSTM :: NCQStorage -> STM (HashSet FileKey)
|
||||
ncqLiveKeysSTM NCQStorage{..} = do
|
||||
|
||||
s0 <- readTVar ncqState
|
||||
merged <- readTVar ncqStateUse <&> (s0<>) . foldMap fst . HM.elems
|
||||
|
||||
pure $ HS.fromList $ universeBi @_ @FileKey merged
|
||||
|
||||
ncqLiveKeys :: forall m . MonadIO m => NCQStorage3 -> m (HashSet FileKey)
|
||||
ncqLiveKeys :: forall m . MonadIO m => NCQStorage -> m (HashSet FileKey)
|
||||
ncqLiveKeys ncq = atomically $ ncqLiveKeysSTM ncq
|
||||
|
||||
ncqSweepFiles :: forall m . MonadUnliftIO m => NCQStorage3 -> m ()
|
||||
ncqSweepFiles me@NCQStorage3{..} = withSem ncqServiceSem do
|
||||
ncqSweepFiles :: forall m . MonadUnliftIO m => NCQStorage -> m ()
|
||||
ncqSweepFiles me@NCQStorage{..} = withSem ncqServiceSem do
|
||||
|
||||
debug "ncqSweepFiles"
|
||||
|
||||
|
|
@ -50,8 +50,8 @@ ncqSweepFiles me@NCQStorage3{..} = withSem ncqServiceSem do
|
|||
rm fn
|
||||
|
||||
|
||||
ncqSweepObsoleteStates :: forall m . MonadUnliftIO m => NCQStorage3 -> m ()
|
||||
ncqSweepObsoleteStates me@NCQStorage3{..} = withSem ncqServiceSem do
|
||||
ncqSweepObsoleteStates :: forall m . MonadUnliftIO m => NCQStorage -> m ()
|
||||
ncqSweepObsoleteStates me@NCQStorage{..} = withSem ncqServiceSem do
|
||||
debug $ "ncqSweepObsoleteStates"
|
||||
|
||||
k <- readTVarIO ncqStateKey
|
||||
|
|
|
|||
|
|
@ -71,8 +71,8 @@ data NCQState =
|
|||
}
|
||||
deriving stock (Eq,Generic,Data)
|
||||
|
||||
data NCQStorage3 =
|
||||
NCQStorage3
|
||||
data NCQStorage =
|
||||
NCQStorage
|
||||
{ ncqRoot :: FilePath
|
||||
, ncqGen :: Int
|
||||
, ncqSalt :: HashRef
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@ ncq3Tests = do
|
|||
let num = headDef 1000 [ fromIntegral n | LitIntVal n <- args ]
|
||||
g <- liftIO MWC.createSystemRandom
|
||||
runTest $ \TestEnv{..} -> do
|
||||
ncqWithStorage3 testEnvDir $ \sto -> do
|
||||
ncqWithStorage testEnvDir $ \sto -> do
|
||||
notice "start/stop ncq3 storage / write 1000 blocks"
|
||||
replicateM_ num do
|
||||
n <- liftIO $ uniformRM (1024, 256*1024) g
|
||||
|
|
@ -79,7 +79,7 @@ ncq3Tests = do
|
|||
g <- liftIO MWC.createSystemRandom
|
||||
runTest $ \TestEnv{..} -> do
|
||||
|
||||
pending <- ncqWithStorage3 testEnvDir $ \sto -> do
|
||||
pending <- ncqWithStorage testEnvDir $ \sto -> do
|
||||
notice $ "write" <+> pretty num <+> "blocks"
|
||||
replicateM_ num do
|
||||
n <- liftIO $ uniformRM (1024, 256*1024) g
|
||||
|
|
@ -98,7 +98,7 @@ ncq3Tests = do
|
|||
liftIO $ BS.appendFile dataFile bss
|
||||
|
||||
notice $ "reopen"
|
||||
ncqWithStorage3 testEnvDir $ \sto -> do
|
||||
ncqWithStorage testEnvDir $ \sto -> do
|
||||
pause @'Seconds 2
|
||||
notice $ "done"
|
||||
|
||||
|
|
@ -114,7 +114,7 @@ ncq3Tests = do
|
|||
|
||||
runTest $ \TestEnv{..} -> do
|
||||
hq <- newTQueueIO
|
||||
ncqWithStorage3 testEnvDir $ \sto -> do
|
||||
ncqWithStorage testEnvDir $ \sto -> do
|
||||
notice $ "write/lookup" <+> pretty num
|
||||
replicateM_ num do
|
||||
n <- liftIO $ uniformRM (1024, 256*1024) g
|
||||
|
|
@ -126,7 +126,7 @@ ncq3Tests = do
|
|||
writeTQueue hq h
|
||||
modifyTVar w1 succ
|
||||
|
||||
ncqWithStorage3 testEnvDir $ \sto -> do
|
||||
ncqWithStorage testEnvDir $ \sto -> do
|
||||
notice $ "reopen/lookup" <+> pretty num
|
||||
hh <- atomically $ STM.flushTQueue hq
|
||||
|
||||
|
|
@ -169,7 +169,7 @@ ncq3Tests = do
|
|||
g <- liftIO MWC.createSystemRandom
|
||||
|
||||
runTest $ \TestEnv{..} -> do
|
||||
ncqWithStorage3 testEnvDir $ \sto@NCQStorage3{..} -> do
|
||||
ncqWithStorage testEnvDir $ \sto@NCQStorage{..} -> do
|
||||
notice $ "write" <+> pretty num
|
||||
hst <- newTVarIO ( mempty :: HashSet HashRef )
|
||||
replicateM_ num do
|
||||
|
|
@ -210,7 +210,7 @@ ncq3Tests = do
|
|||
g <- liftIO MWC.createSystemRandom
|
||||
|
||||
runTest $ \TestEnv{..} -> do
|
||||
ncqWithStorage3 testEnvDir $ \sto@NCQStorage3{..} -> flip runContT pure do
|
||||
ncqWithStorage testEnvDir $ \sto@NCQStorage{..} -> flip runContT pure do
|
||||
|
||||
hst <- newTVarIO ( mempty :: HashSet HashRef )
|
||||
lostt <- newTVarIO 0
|
||||
|
|
@ -267,7 +267,7 @@ ncq3Tests = do
|
|||
g <- liftIO MWC.createSystemRandom
|
||||
|
||||
runTest $ \TestEnv{..} -> do
|
||||
ncqWithStorage3 testEnvDir $ \sto@NCQStorage3{..} -> flip runContT pure do
|
||||
ncqWithStorage testEnvDir $ \sto@NCQStorage{..} -> flip runContT pure do
|
||||
|
||||
hst <- newTVarIO ( mempty :: HashSet HashRef )
|
||||
|
||||
|
|
@ -305,12 +305,12 @@ ncq3Tests = do
|
|||
Nothing -> liftIO $ Temp.createTempDirectory "." "ncq-long-write-test"
|
||||
|
||||
|
||||
ncqWithStorage3 path $ \sto -> do
|
||||
ncqWithStorage path $ \sto -> do
|
||||
|
||||
let writtenLog = ncqGetFileName sto "written.log"
|
||||
touch writtenLog
|
||||
|
||||
race (pause @'Seconds (realToFrac seconds) >> ncqStorageStop3 sto) $ forever do
|
||||
race (pause @'Seconds (realToFrac seconds) >> ncqStorageStop sto) $ forever do
|
||||
n <- liftIO $ uniformRM (1, 256*1024) g
|
||||
s <- liftIO $ genRandomBS g n
|
||||
h <- ncqPutBS sto (Just B) Nothing s
|
||||
|
|
@ -356,7 +356,7 @@ ncq3Tests = do
|
|||
|
||||
pause @'Seconds 2
|
||||
|
||||
lift $ ncqWithStorage3 path $ \sto@NCQStorage3{..} -> do
|
||||
lift $ ncqWithStorage path $ \sto@NCQStorage{..} -> do
|
||||
let log = ncqGetFileName sto "written.log"
|
||||
hashes <- liftIO (readFile log) <&> fmap words . lines
|
||||
|
||||
|
|
@ -443,7 +443,7 @@ ncq3Tests = do
|
|||
|
||||
thashes <- newTVarIO mempty
|
||||
|
||||
ncqWithStorage3 dir $ \sto@NCQStorage3{..} -> do
|
||||
ncqWithStorage dir $ \sto -> do
|
||||
|
||||
notice $ "write+immediate delete" <+> pretty n <+> "records"
|
||||
|
||||
|
|
@ -474,7 +474,7 @@ ncq3Tests = do
|
|||
|
||||
ncqIndexCompactFull sto
|
||||
|
||||
ncqWithStorage3 dir $ \sto -> do
|
||||
ncqWithStorage dir $ \sto -> do
|
||||
-- notice "check deleted"
|
||||
hashes <- readTVarIO thashes
|
||||
|
||||
|
|
@ -498,7 +498,7 @@ ncq3Tests = do
|
|||
|
||||
thashes <- newTVarIO mempty
|
||||
|
||||
ncqWithStorage3 dir $ \sto@NCQStorage3{..} -> do
|
||||
ncqWithStorage dir $ \sto -> do
|
||||
|
||||
sizes <- replicateM n $ liftIO $ uniformRM (32*1024, 256*1024) g
|
||||
|
||||
|
|
@ -521,7 +521,7 @@ ncq3Tests = do
|
|||
|
||||
notice $ "should be deleted" <+> pretty (HS.size deleted) <+> "/" <+> pretty tnum <+> "of" <+> pretty n
|
||||
|
||||
ncqWithStorage3 dir $ \sto@NCQStorage3{..} -> do
|
||||
ncqWithStorage dir $ \sto -> do
|
||||
|
||||
notice "wait for compaction"
|
||||
|
||||
|
|
@ -544,14 +544,14 @@ ncq3Tests = do
|
|||
flip runContT pure do
|
||||
|
||||
notice $ "run 1st storage" <+> pretty testEnvDir
|
||||
sto1 <- ContT $ ncqWithStorage3 testEnvDir
|
||||
sto1 <- ContT $ ncqWithStorage testEnvDir
|
||||
|
||||
atomically $ writeTVar w 1
|
||||
|
||||
pause @'Seconds 1
|
||||
|
||||
notice $ "run 2nd storage" <+> pretty testEnvDir
|
||||
sto1 <- ContT $ ncqWithStorage3 testEnvDir
|
||||
sto1 <- ContT $ ncqWithStorage testEnvDir
|
||||
|
||||
pause @'Seconds 1
|
||||
|
||||
|
|
@ -627,7 +627,7 @@ testWriteNThreads3 ncqDir tnn n = do
|
|||
|
||||
t0 <- getTimeCoarse
|
||||
|
||||
w <- ncqWithStorage3 (ncqDir </> show tnn) $ \sto -> do
|
||||
w <- ncqWithStorage (ncqDir </> show tnn) $ \sto -> do
|
||||
ss <- liftIO $ replicateM n $ MWC.uniformRM (64*1024, 256*1024) g
|
||||
|
||||
pooledForConcurrentlyN_ tnn ss $ \len -> do
|
||||
|
|
@ -687,7 +687,7 @@ testNCQ3Lookup1 syn TestEnv{..} = do
|
|||
r <- m
|
||||
if r && i > 0 then loop (i - 1) else pure r
|
||||
|
||||
ncqWithStorage3 ncqDir $ \sto -> liftIO do
|
||||
ncqWithStorage ncqDir $ \sto -> liftIO do
|
||||
pooledForConcurrentlyN_ 8 sizes $ \size -> do
|
||||
z <- genRandomBS g size
|
||||
h <- ncqPutBS sto (Just B) Nothing z
|
||||
|
|
|
|||
Loading…
Reference in New Issue