From 29ed5a7ecc1caa620fb485ebd0ab80057ca269df Mon Sep 17 00:00:00 2001 From: voidlizard Date: Fri, 1 Aug 2025 14:39:29 +0300 Subject: [PATCH] NCQStorage3 -> NCQStorage --- hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs | 10 ++--- .../lib/HBS2/Storage/NCQ3/Internal.hs | 28 +++++++------- .../lib/HBS2/Storage/NCQ3/Internal/Files.hs | 18 ++++----- .../lib/HBS2/Storage/NCQ3/Internal/Fossil.hs | 6 +-- .../lib/HBS2/Storage/NCQ3/Internal/Index.hs | 16 ++++---- .../HBS2/Storage/NCQ3/Internal/MMapCache.hs | 16 ++++---- .../HBS2/Storage/NCQ3/Internal/Memtable.hs | 20 +++++----- .../lib/HBS2/Storage/NCQ3/Internal/Run.hs | 10 ++--- .../lib/HBS2/Storage/NCQ3/Internal/State.hs | 32 ++++++++-------- .../lib/HBS2/Storage/NCQ3/Internal/Sweep.hs | 14 +++---- .../lib/HBS2/Storage/NCQ3/Internal/Types.hs | 4 +- hbs2-tests/test/NCQ3.hs | 38 +++++++++---------- 12 files changed, 106 insertions(+), 106 deletions(-) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs index a81bd2ea..9240beb5 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3.hs @@ -1,10 +1,10 @@ module HBS2.Storage.NCQ3 ( module Exported - , ncqWithStorage3 - , ncqStorageSync3 - , ncqStorageStop3 - , ncqStorageOpen3 - , ncqStorageRun3 + , ncqWithStorage + , ncqStorageSync + , ncqStorageStop + , ncqStorageOpen + , ncqStorageRun , ncqPutBS , ncqGetEntryBS , IsTomb(..) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs index b0be40c1..65958661 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal.hs @@ -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 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Files.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Files.hs index 60159592..977983f6 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Files.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Files.hs @@ -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 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs index 98e2fa7e..82be1b76 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Fossil.hs @@ -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) diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs index 317a1f81..0bd26eec 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Index.hs @@ -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 () diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/MMapCache.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/MMapCache.hs index 0ba2e8ae..e35fdc75 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/MMapCache.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/MMapCache.hs @@ -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 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Memtable.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Memtable.hs index a1cef933..5deb7ef6 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Memtable.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Memtable.hs @@ -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 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs index 4c4d4b45..da63b7fc 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Run.hs @@ -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 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/State.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/State.hs index 33991fd7..ac6f0a4f 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/State.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/State.hs @@ -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 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Sweep.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Sweep.hs index 47377075..c9193f03 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Sweep.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Sweep.hs @@ -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 diff --git a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs index 055ef782..ab200932 100644 --- a/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs +++ b/hbs2-storage-ncq/lib/HBS2/Storage/NCQ3/Internal/Types.hs @@ -71,8 +71,8 @@ data NCQState = } deriving stock (Eq,Generic,Data) -data NCQStorage3 = - NCQStorage3 +data NCQStorage = + NCQStorage { ncqRoot :: FilePath , ncqGen :: Int , ncqSalt :: HashRef diff --git a/hbs2-tests/test/NCQ3.hs b/hbs2-tests/test/NCQ3.hs index 34740bec..8faedb79 100644 --- a/hbs2-tests/test/NCQ3.hs +++ b/hbs2-tests/test/NCQ3.hs @@ -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