voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, tune deleting

This commit is contained in:
Dmitry Zuikov 2024-08-06 10:15:16 +03:00
parent 93289b6e58
commit f8e3d2fdf2
1 changed files with 19 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
hbs2-sync/src/HBS2/Sync/Prelude.hs
View File

@ -482,8 +482,14 @@ runDirectory = do
D (p,e) n -> do D (p,e) n -> do
notice $ "locally deleted file" <+> pretty p notice $ "locally deleted file" <+> pretty p
-- FIXME: fix-copypaste
tombs <- getTombs
n <- Compact.get tombs (fromString p)
<&> fmap (deserialiseOrFail @Integer . LBS.fromStrict)
<&> fmap (either (const Nothing) Just)
<&> join
when (n < Just 2) do when (n < Just 2) do
tombs <- getTombs
postEntryTx refchan path e postEntryTx refchan path e
Compact.put tombs (fromString p) (LBS.toStrict $ serialise $ maybe 0 succ n) Compact.put tombs (fromString p) (LBS.toStrict $ serialise $ maybe 0 succ n)
@ -522,6 +528,18 @@ runDirectory = do
let fullPath = path </> p let fullPath = path </> p
here <- liftIO $ doesFileExist fullPath here <- liftIO $ doesFileExist fullPath
when here do when here do
tombs <- getTombs
postEntryTx refchan path e
-- FIXME: fix-copypaste
n <- Compact.get tombs (fromString p)
<&> fmap (deserialiseOrFail @Integer . LBS.fromStrict)
<&> fmap (either (const Nothing) Just)
<&> join
Compact.put tombs (fromString p) (LBS.toStrict $ serialise $ maybe 0 succ n)
notice $ red "tomb entry" <+> pretty (path </> p) notice $ red "tomb entry" <+> pretty (path </> p)
rm fullPath rm fullPath