avoid double work in git-annex init

reconcileStaged was doing a redundant scan to scannAnnexedFiles.

It would probably make sense to move the body of scannAnnexedFiles
into reconcileStaged, the separation does not really serve any purpose.

Sponsored-by: Dartmouth College's Datalad project
This commit is contained in:
Joey Hess 2021-06-07 16:50:14 -04:00
parent 6ceb31a30a
commit 0f10f208a7
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 93 additions and 38 deletions

View file

@ -23,6 +23,7 @@ module Database.Keys (
removeInodeCache,
isInodeKnown,
runWriter,
runWriter',
) where
import qualified Database.Keys.SQL as SQL
@ -73,7 +74,7 @@ runReader a = do
v <- a (SQL.ReadHandle qh)
return (v, st)
go DbClosed = do
st' <- openDb True DbClosed
st' <- openDb True Nothing DbClosed
v <- case st' of
(DbOpen qh) -> a (SQL.ReadHandle qh)
_ -> return mempty
@ -87,7 +88,15 @@ runReaderIO a = runReader (liftIO . a)
-
- The database is created if it doesn't exist yet. -}
runWriter :: (SQL.WriteHandle -> Annex ()) -> Annex ()
runWriter a = do
runWriter = runWriter' Nothing
runWriterIO :: (SQL.WriteHandle -> IO ()) -> Annex ()
runWriterIO a = runWriter (liftIO . a)
{- When a reconcile action is passed, it is run by reconcileStaged instead
- of its usual scan, and must update the database in the same way. -}
runWriter' :: Maybe (SQL.WriteHandle -> Annex ()) -> (SQL.WriteHandle -> Annex ()) -> Annex ()
runWriter' reconciler a = do
h <- Annex.getRead Annex.keysdbhandle
withDbState h go
where
@ -95,15 +104,12 @@ runWriter a = do
v <- a (SQL.WriteHandle qh)
return (v, st)
go st = do
st' <- openDb False st
st' <- openDb False reconciler st
v <- case st' of
DbOpen qh -> a (SQL.WriteHandle qh)
_ -> error "internal"
return (v, st')
runWriterIO :: (SQL.WriteHandle -> IO ()) -> Annex ()
runWriterIO a = runWriter (liftIO . a)
{- Opens the database, creating it if it doesn't exist yet.
-
- Multiple readers and writers can have the database open at the same
@ -112,10 +118,10 @@ runWriterIO a = runWriter (liftIO . a)
- the database doesn't exist yet, one caller wins the lock and
- can create it undisturbed.
-}
openDb :: Bool -> DbState -> Annex DbState
openDb _ st@(DbOpen _) = return st
openDb False DbUnavailable = return DbUnavailable
openDb forwrite _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
openDb :: Bool -> (Maybe (SQL.WriteHandle -> Annex ())) -> DbState -> Annex DbState
openDb _ _ st@(DbOpen _) = return st
openDb False _ DbUnavailable = return DbUnavailable
openDb forwrite reconciler _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
dbdir <- fromRepo gitAnnexKeysDb
let db = dbdir P.</> "db"
dbexists <- liftIO $ R.doesPathExist db
@ -133,7 +139,7 @@ openDb forwrite _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKe
open db = do
qh <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable
reconcileStaged qh
reconcileStaged qh reconciler
return $ DbOpen qh
{- Closes the database if it was open. Any writes will be flushed to it.
@ -223,8 +229,8 @@ isInodeKnown i s = or <$> runReaderIO ((:[]) <$$> SQL.isInodeKnown i s)
- So when using getAssociatedFiles, have to make sure the file still
- is an associated file.
-}
reconcileStaged :: H.DbQueue -> Annex ()
reconcileStaged qh = do
reconcileStaged :: H.DbQueue -> Maybe (SQL.WriteHandle -> Annex ()) -> Annex ()
reconcileStaged qh mreconciler = do
gitindex <- inRepo currentIndexFile
indexcache <- fromRawFilePath <$> fromRepo gitAnnexKeysDbIndexCache
withTSDelta (liftIO . genInodeCache gitindex) >>= \case
@ -246,12 +252,21 @@ reconcileStaged qh = do
go cur indexcache (Just newtree) = do
oldtree <- getoldtree
when (oldtree /= newtree) $ do
case mreconciler of
Just reconciler ->
reconciler (SQL.WriteHandle qh)
Nothing -> noop
g <- Annex.gitRepo
void $ catstream $ \mdfeeder ->
void $ updatetodiff g
(Just (fromRef oldtree))
(fromRef newtree)
(procdiff mdfeeder)
void $ catstream $ \mdfeeder -> do
case mreconciler of
Nothing -> void $ updatetodiff g
(Just (fromRef oldtree))
(fromRef newtree)
(procdiff mdfeeder)
Just _ -> void $ updatetodiff g
Nothing "--staged"
(procdiff mdfeeder)
liftIO $ writeFile indexcache $ showInodeCache cur
-- Storing the tree in a ref makes sure it does not
-- get garbage collected, and is available to diff