introduced FileLocation

This commit is contained in:
voidlizard 2025-08-20 11:04:27 +03:00
parent 4ab17008c4
commit 79788fd134
6 changed files with 28 additions and 17 deletions

View File

@ -282,7 +282,7 @@ instance IsTomb IndexEntry where
instance IsTomb Location where
ncqIsTomb = \case
InFossil _ _ s -> ncqIsTombEntrySize s
InFossil (FileLocation _ _ s) -> ncqIsTombEntrySize s
InMemory bs -> case ncqEntryUnwrap bs of
(_, Right (T, _)) -> True
_ -> False
@ -290,7 +290,7 @@ instance IsTomb Location where
ncqGetEntryBS :: MonadUnliftIO m => NCQStorage -> Location -> m (Maybe ByteString)
ncqGetEntryBS me = \case
InMemory bs -> pure $ Just bs
InFossil fk off size -> ncqWithState me $ const do
InFossil (FileLocation fk off size) -> ncqWithState me $ const do
try @_ @SomeException (ncqGetCachedData me fk) >>= \case
Left e -> err (viaShow e) >> pure Nothing
Right (CachedData mmap) -> do
@ -298,7 +298,7 @@ ncqGetEntryBS me = \case
ncqEntrySize :: forall a . Integral a => Location -> a
ncqEntrySize = \case
InFossil _ _ size -> fromIntegral size
InFossil (FileLocation _ _ size) -> fromIntegral size
InMemory bs -> fromIntegral (BS.length bs)
ncqDelEntry :: MonadUnliftIO m

View File

@ -53,8 +53,8 @@ ncqStorageHasBlock :: MonadUnliftIO m
ncqStorageHasBlock sto h = ncqLocate sto h >>= \case
Nothing -> pure Nothing
Just (InMemory bs) -> blockSize bs
Just (InFossil _ _ size) | ncqIsTombEntrySize size -> pure Nothing
Just (InFossil _ _ size) -> do
Just (InFossil (FileLocation _ _ size)) | ncqIsTombEntrySize size -> pure Nothing
Just (InFossil (FileLocation _ _ size)) -> do
pure $ Just (ncqEntryPayloadSize (fromIntegral size))
where

View File

@ -104,7 +104,7 @@ ncqFossilMergeStep me@NCQStorage{..} = withSem ncqServiceSem $ flip runContT pu
ncqLocate_ False me k >>= \case
Nothing -> pure False
Just (InMemory{}) -> pure False
Just (InFossil fk oi si) -> do
Just (InFossil (FileLocation fk oi si)) -> do
let beWritten = fk == fik && o == fromIntegral oi
-- let c = if skip then green else id

View File

@ -132,7 +132,7 @@ ncqIndexFile n ts' fk = runMaybeT do
unless (k == emptyKey) $ atomically $ void $ runMaybeT do
NCQEntry _ tfk <- MaybeT $ ncqLookupEntrySTM n (coerce k)
fk' <- MaybeT $ readTVar tfk
guard (coerce fk == fk') -- remove only own stuff
guard (coerce fk == flKey fk') -- remove only own stuff
lift $ ncqAlterEntrySTM n (coerce k) (const Nothing)
pure dest

View File

@ -76,7 +76,7 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
for_ ncqStateIndex $ \(_, fk) -> do
CachedIndex bs nw <- lift $ ncqGetCachedIndex ncq fk
lift (ncqLookupIndex h (bs, nw)) >>= \case
Just (IndexEntry fk o s) -> answer (Just (InFossil fk o s)) >> exit ()
Just (IndexEntry fk o s) -> answer (Just (InFossil (FileLocation fk o s))) >> exit ()
Nothing -> none
-- debug $ "NOT FOUND SHIT" <+> pretty h
@ -196,8 +196,10 @@ ncqStorageRun ncq@NCQStorage{..} = flip runContT pure do
ws <- for chu $ \h -> do
atomically (ncqLookupEntrySTM ncq h) >>= \case
Just (NCQEntry bs w) -> do
atomically (writeTVar w (Just fk))
lift (appendSection fh bs)
let off = fromIntegral total'
n <- lift (appendSection fh bs)
atomically (writeTVar w (Just (FileLocation fk off (fromIntegral n))))
pure n
_ -> pure 0

View File

@ -34,21 +34,30 @@ deriving stock instance Data (IndexFile FileKey)
deriving stock instance Data (DataFile FileKey)
deriving stock instance Data (StateFile FileKey)
data FileLocation =
FileLocation
{ flKey :: !FileKey
, flOffset :: !NCQOffset
, flSize :: !NCQSize
}
deriving stock (Eq,Ord)
data Location =
InFossil {-# UNPACK #-} !FileLocation
| InMemory {-# UNPACK #-} !ByteString
data NCQEntry =
NCQEntry
{ ncqEntryData :: !ByteString
, ncqDumped :: !(TVar (Maybe FileKey))
, ncqDumped :: !(TVar (Maybe FileLocation))
}
type NCQOffset = Word64
type NCQFileSize = NCQOffset
type NCQSize = Word32
data Location =
InFossil {-# UNPACK #-} !FileKey !NCQOffset !NCQSize
| InMemory {-# UNPACK #-} !ByteString
data Fact = P PData -- pending, not indexed
deriving stock (Eq,Ord,Data)
@ -144,7 +153,7 @@ instance Semigroup NCQState where
instance Pretty Location where
pretty = \case
InFossil k o s -> parens $ "in-fossil" <+> pretty k <+> pretty o <+> pretty s
InFossil (FileLocation k o s) -> parens $ "in-fossil" <+> pretty k <+> pretty o <+> pretty s
InMemory _ -> "in-memory"
ncqMakeFossilName :: FileKey -> FilePath