This commit is contained in:
Joey Hess 2019-03-01 12:50:33 -04:00
parent a3f6e07fec
commit 7acee61adf
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38

View file

@ -182,7 +182,9 @@ removeExportTree h k loc = queueDb h $
ik = toIKey k ik = toIKey k
ef = toSFilePath (fromExportLocation loc) ef = toSFilePath (fromExportLocation loc)
type DiffUpdater -- An action that is passed the old and new values that were exported,
-- and updates state.
type ExportDiffUpdater
= ExportHandle = ExportHandle
-> Maybe ExportKey -> Maybe ExportKey
-- ^ old exported key -- ^ old exported key
@ -191,11 +193,11 @@ type DiffUpdater
-> Git.DiffTree.DiffTreeItem -> Git.DiffTree.DiffTreeItem
-> Annex () -> Annex ()
mkDiffUpdater mkExportDiffUpdater
:: (ExportHandle -> Key -> ExportLocation -> IO ()) :: (ExportHandle -> Key -> ExportLocation -> IO ())
-> (ExportHandle -> Key -> ExportLocation -> IO ()) -> (ExportHandle -> Key -> ExportLocation -> IO ())
-> DiffUpdater -> ExportDiffUpdater
mkDiffUpdater removeold addnew h srcek dstek i = do mkExportDiffUpdater removeold addnew h srcek dstek i = do
case srcek of case srcek of
Nothing -> return () Nothing -> return ()
Just k -> liftIO $ removeold h (asKey k) loc Just k -> liftIO $ removeold h (asKey k) loc
@ -205,8 +207,8 @@ mkDiffUpdater removeold addnew h srcek dstek i = do
where where
loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i loc = mkExportLocation $ getTopFilePath $ Git.DiffTree.file i
runDiffUpdater :: DiffUpdater -> ExportHandle -> Sha -> Sha -> Annex () runExportDiffUpdater :: ExportDiffUpdater -> ExportHandle -> Sha -> Sha -> Annex ()
runDiffUpdater updater h old new = do runExportDiffUpdater 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
@ -221,16 +223,16 @@ runDiffUpdater updater h old new = do
{- Diff from the old to the new tree and update the ExportTree table. -} {- Diff from the old to the new tree and update the ExportTree table. -}
updateExportTree :: ExportHandle -> Sha -> Sha -> Annex () updateExportTree :: ExportHandle -> Sha -> Sha -> Annex ()
updateExportTree = runDiffUpdater updateExportTree' updateExportTree = runExportDiffUpdater updateExportTree'
updateExportTree' :: DiffUpdater updateExportTree' :: ExportDiffUpdater
updateExportTree' = mkDiffUpdater removeExportTree addExportTree updateExportTree' = mkExportDiffUpdater removeExportTree addExportTree
{- Diff from the old to the new tree and update all tables in the export {- 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 - database. Should only be used when all the files in the new tree have
- been verified to already be present in the export remote. -} - been verified to already be present in the export remote. -}
updateExportDb :: ExportHandle -> Sha -> Sha -> Annex () updateExportDb :: ExportHandle -> Sha -> Sha -> Annex ()
updateExportDb = runDiffUpdater $ mkDiffUpdater removeold addnew updateExportDb = runExportDiffUpdater $ mkExportDiffUpdater removeold addnew
where where
removeold h k loc = liftIO $ do removeold h k loc = liftIO $ do
removeExportTree h k loc removeExportTree h k loc