mirror of https://github.com/voidlizard/hbs2
introduced FileLocation
This commit is contained in:
parent
4ab17008c4
commit
79788fd134
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue