mirror of https://github.com/voidlizard/hbs2
69 lines
2.0 KiB
Haskell
69 lines
2.0 KiB
Haskell
{-# Language RecordWildCards #-}
|
|
module HBS2.Storage.NCQ2.Internal.Probes where
|
|
|
|
import HBS2.Prelude
|
|
import HBS2.Hash
|
|
import HBS2.Data.Types.Refs
|
|
import HBS2.System.Logger.Simple.ANSI
|
|
import HBS2.Misc.PrettyStuff
|
|
|
|
import HBS2.Data.Log.Structured.NCQ
|
|
|
|
import HBS2.Storage.NCQ2.Internal.Types
|
|
import HBS2.Storage.NCQ.Types
|
|
|
|
import Control.Monad.Trans.Maybe
|
|
import Data.Coerce
|
|
import Data.HashMap.Strict qualified as HM
|
|
import Data.List qualified as List
|
|
import Data.Maybe
|
|
import Data.Vector ((!))
|
|
import Data.Vector qualified as V
|
|
import Lens.Micro.Platform
|
|
import System.Random.MWC qualified as MWC
|
|
import UnliftIO
|
|
|
|
ncqKeyNumIntersectionProbe :: MonadUnliftIO m => NCQStorage2 -> m ()
|
|
ncqKeyNumIntersectionProbe me@NCQStorage2{..} = useVersion me $ const $ void $ runMaybeT do
|
|
|
|
-- Фильтруем pending
|
|
files0 <- lift (ncqListTrackedFiles me)
|
|
let files = V.toList $ V.filter (isNotPending . view _2) files0
|
|
|
|
when (length files < 2) mzero
|
|
|
|
(a,b) <- liftIO $ fix \next -> do
|
|
i <- MWC.uniformRM (0, length files - 1) ncqRndGen
|
|
j <- MWC.uniformRM (0, length files - 1) ncqRndGen
|
|
if i == j then next else pure (files !! min i j, files !! max i j)
|
|
|
|
let fka = view _1 a
|
|
let fkb = view _1 b
|
|
let key = FactKey $ coerce $ hashObject @HbSync $ serialise $ List.sort [fka, fkb]
|
|
|
|
known <- lift (readTVarIO ncqFacts <&> HM.member key)
|
|
when known mzero
|
|
|
|
let fIndexA = ncqGetFileName me (toFileName (IndexFile fka))
|
|
let fIndexB = ncqGetFileName me (toFileName (IndexFile fkb))
|
|
|
|
idxPair' <- liftIO $ try @_ @IOException do
|
|
(,) <$> nwayHashMMapReadOnly fIndexA
|
|
<*> nwayHashMMapReadOnly fIndexB
|
|
|
|
((bs1,n1),(bs2,n2)) <- case idxPair' of
|
|
Right (Just x, Just y) -> pure (x,y)
|
|
_ -> warn ("can't load index pair" <+> pretty (fka, fkb)) >> mzero
|
|
|
|
n <- liftIO $ do
|
|
ref <- newTVarIO 0
|
|
nwayHashScanAll n1 bs1 $ \_ k _ -> do
|
|
here <- ncqLookupIndex (coerce k) (bs2,n2)
|
|
when (isJust here) $ atomically $ modifyTVar' ref (+1)
|
|
readTVarIO ref
|
|
|
|
debug $ yellow "ncqKeyNumIntersectionProbe"
|
|
<+> pretty fka <+> pretty fkb <+> pretty n
|
|
|
|
|