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

wip

This commit is contained in:
Dmitry Zuikov 2024-08-05 11:39:04 +03:00
parent 092dd572a7
commit 0cf84e1c94
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -276,6 +276,10 @@ instance IsContext c => ToSexp c EntryDesc where
instance IsContext c => ToSexp c Entry where instance IsContext c => ToSexp c Entry where
toSexp (DirEntry w p) = mkForm @c "entry" [toSexp w, mkStr p] toSexp (DirEntry w p) = mkForm @c "entry" [toSexp w, mkStr p]
makeTomb :: Word64 -> FilePath -> Entry
makeTomb t n = DirEntry (EntryDesc Tomb t Nothing) n
entryPath :: Entry -> FilePath entryPath :: Entry -> FilePath
entryPath (DirEntry _ p) = p entryPath (DirEntry _ p) = p
@ -520,11 +524,14 @@ mergeState orig = do
let names = Map.keysSet (dirs <> files) let names = Map.keysSet (dirs <> files)
now <- liftIO $ getPOSIXTime <&> round
S.toList_ do S.toList_ do
for_ (Map.toList files) $ \(p,e@(DirEntry d _)) -> do for_ (Map.toList files) $ \(p,e@(DirEntry d _)) -> do
if Map.member p dirs then do if Map.member p dirs then do
let new = uniqName names p let new = uniqName names p
S.yield (new, DirEntry d new) S.yield (new, DirEntry d new)
S.yield (p, makeTomb now p)
else else
S.yield (p,e) S.yield (p,e)
@ -609,10 +616,9 @@ getStateFromDir seed path incl excl = do
S.toList_ do S.toList_ do
S.each es0 S.each es0
for_ es2 $ \(p, e) -> do for_ es2 $ \(p, e) -> do
isDir <- liftIO $ doesDirectoryExist (path </> p) d <- liftIO $ doesDirectoryExist (path </> p)
ts <- liftIO $ getFileTimestamp (path </> p) when d do
ts <- liftIO $ getFileTimestamp (path </> p)
when isDir do
S.yield (p, DirEntry (EntryDesc Dir ts mzero) p) S.yield (p, DirEntry (EntryDesc Dir ts mzero) p)
S.yield (p,e) S.yield (p,e)