fully update export db during import
This makes exporting immediately after import and merge be a no-op.
This commit is contained in:
parent
b1f10fbb4d
commit
d0066d9a87
2 changed files with 47 additions and 15 deletions
|
@ -139,7 +139,7 @@ buildImportCommit remote importtreeconfig importcommitconfig importable =
|
||||||
prevtree <- liftIO $ fromMaybe emptyTree
|
prevtree <- liftIO $ fromMaybe emptyTree
|
||||||
<$> Export.getExportTreeCurrent db
|
<$> Export.getExportTreeCurrent db
|
||||||
when (importedtree /= prevtree) $ do
|
when (importedtree /= prevtree) $ do
|
||||||
Export.updateExportTree db prevtree importedtree
|
Export.updateExportDb db prevtree importedtree
|
||||||
liftIO $ Export.recordExportTreeCurrent db importedtree
|
liftIO $ Export.recordExportTreeCurrent db importedtree
|
||||||
-- TODO: addExportedLocation etc
|
-- TODO: addExportedLocation etc
|
||||||
Export.closeDb db
|
Export.closeDb db
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- Sqlite database used for exports to special remotes.
|
{- Sqlite database used for exports to special remotes.
|
||||||
-
|
-
|
||||||
- Copyright 2017 Joey Hess <id@joeyh.name>
|
- Copyright 2017-2019 Joey Hess <id@joeyh.name>
|
||||||
-:
|
-:
|
||||||
- Licensed under the GNU GPL version 3 or higher.
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
-}
|
-}
|
||||||
|
@ -28,6 +28,7 @@ module Database.Export (
|
||||||
updateExportTree,
|
updateExportTree,
|
||||||
updateExportTree',
|
updateExportTree',
|
||||||
updateExportTreeFromLog,
|
updateExportTreeFromLog,
|
||||||
|
updateExportDb,
|
||||||
ExportedId,
|
ExportedId,
|
||||||
ExportedDirectoryId,
|
ExportedDirectoryId,
|
||||||
ExportTreeId,
|
ExportTreeId,
|
||||||
|
@ -181,31 +182,62 @@ removeExportTree h k loc = queueDb h $
|
||||||
ik = toIKey k
|
ik = toIKey k
|
||||||
ef = toSFilePath (fromExportLocation loc)
|
ef = toSFilePath (fromExportLocation loc)
|
||||||
|
|
||||||
{- Diff from the old to the new tree and update the ExportTree table. -}
|
type DiffUpdater
|
||||||
updateExportTree :: ExportHandle -> Sha -> Sha -> Annex ()
|
= ExportHandle
|
||||||
updateExportTree h old new = do
|
-> Maybe ExportKey
|
||||||
|
-- ^ old exported key
|
||||||
|
-> Maybe ExportKey
|
||||||
|
-- ^ new exported key
|
||||||
|
-> Git.DiffTree.DiffTreeItem
|
||||||
|
-> Annex ()
|
||||||
|
|
||||||
|
mkDiffUpdater
|
||||||
|
:: (ExportHandle -> Key -> ExportLocation -> IO ())
|
||||||
|
-> (ExportHandle -> Key -> ExportLocation -> IO ())
|
||||||
|
-> DiffUpdater
|
||||||
|
mkDiffUpdater removeold addnew h srcek dstek i = do
|
||||||
|
case srcek of
|
||||||
|
Nothing -> return ()
|
||||||
|
Just k -> liftIO $ removeold h (asKey k) loc
|
||||||
|
case dstek of
|
||||||
|
Nothing -> return ()
|
||||||
|
Just k -> liftIO $ addnew h (asKey k) loc
|
||||||
|
where
|
||||||
|
loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i
|
||||||
|
|
||||||
|
runDiffUpdater :: DiffUpdater -> ExportHandle -> Sha -> Sha -> Annex ()
|
||||||
|
runDiffUpdater updater h old new = do
|
||||||
(diff, cleanup) <- inRepo $
|
(diff, cleanup) <- inRepo $
|
||||||
Git.DiffTree.diffTreeRecursive old new
|
Git.DiffTree.diffTreeRecursive old new
|
||||||
forM_ diff $ \i -> do
|
forM_ diff $ \i -> do
|
||||||
srcek <- getek (Git.DiffTree.srcsha i)
|
srcek <- getek (Git.DiffTree.srcsha i)
|
||||||
dstek <- getek (Git.DiffTree.dstsha i)
|
dstek <- getek (Git.DiffTree.dstsha i)
|
||||||
updateExportTree' h srcek dstek i
|
updater h srcek dstek i
|
||||||
void $ liftIO cleanup
|
void $ liftIO cleanup
|
||||||
where
|
where
|
||||||
getek sha
|
getek sha
|
||||||
| sha == nullSha = return Nothing
|
| sha == nullSha = return Nothing
|
||||||
| otherwise = Just <$> exportKey sha
|
| otherwise = Just <$> exportKey sha
|
||||||
|
|
||||||
updateExportTree' :: ExportHandle -> Maybe ExportKey -> Maybe ExportKey -> Git.DiffTree.DiffTreeItem -> Annex ()
|
{- Diff from the old to the new tree and update the ExportTree table. -}
|
||||||
updateExportTree' h srcek dstek i = do
|
updateExportTree :: ExportHandle -> Sha -> Sha -> Annex ()
|
||||||
case srcek of
|
updateExportTree = runDiffUpdater updateExportTree'
|
||||||
Nothing -> return ()
|
|
||||||
Just k -> liftIO $ removeExportTree h (asKey k) loc
|
updateExportTree' :: DiffUpdater
|
||||||
case dstek of
|
updateExportTree' = mkDiffUpdater removeExportTree addExportTree
|
||||||
Nothing -> return ()
|
|
||||||
Just k -> liftIO $ addExportTree h (asKey k) loc
|
{- Diff from the old to the new tree and update all tables in the export
|
||||||
|
- database. Should only be used when all the files in the new tree have
|
||||||
|
- been verified to already be present in the export remote. -}
|
||||||
|
updateExportDb :: ExportHandle -> Sha -> Sha -> Annex ()
|
||||||
|
updateExportDb = runDiffUpdater $ mkDiffUpdater removeold addnew
|
||||||
where
|
where
|
||||||
loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i
|
removeold h k loc = liftIO $ do
|
||||||
|
removeExportTree h k loc
|
||||||
|
removeExportedLocation h k loc
|
||||||
|
addnew h k loc = liftIO $ do
|
||||||
|
addExportTree h k loc
|
||||||
|
addExportedLocation h k loc
|
||||||
|
|
||||||
data ExportUpdateResult = ExportUpdateSuccess | ExportUpdateConflict
|
data ExportUpdateResult = ExportUpdateSuccess | ExportUpdateConflict
|
||||||
deriving (Eq)
|
deriving (Eq)
|
||||||
|
|
Loading…
Add table
Reference in a new issue