wait for git lstree to exit

This commit is contained in:
Joey Hess 2016-01-01 15:50:59 -04:00
parent 70fee8208c
commit f7256842cc
Failed to extract signature
3 changed files with 13 additions and 12 deletions

View file

@ -77,7 +77,7 @@ withFilesInRefs a = mapM_ go
where
go r = do
matcher <- Limit.getMatcher
l <- inRepo $ LsTree.lsTree (Git.Ref r)
(l, cleanup) <- inRepo $ LsTree.lsTree (Git.Ref r)
forM_ l $ \i -> do
let f = getTopFilePath $ LsTree.file i
v <- catKey (Git.Ref $ LsTree.sha i)
@ -85,6 +85,7 @@ withFilesInRefs a = mapM_ go
Nothing -> noop
Just k -> whenM (matcher $ MatchingKey k) $
commandAction $ a f k
liftIO $ void cleanup
withPathContents :: ((FilePath, FilePath) -> CommandStart) -> CmdParams -> CommandSeek
withPathContents a params = do

View file

@ -29,9 +29,8 @@ import Database.Types
import Database.Keys.Handle
import qualified Database.Queue as H
import Locations
import Common hiding (delete)
import Annex
import Types.Key
import Common.Annex hiding (delete)
import qualified Annex
import Annex.Perms
import Annex.LockFile
import Utility.InodeCache
@ -42,7 +41,6 @@ import qualified Git.Branch
import Git.Ref
import Git.FilePath
import Annex.CatFile
import Messages
import Database.Persist.TH
import Database.Esqueleto hiding (Key)
@ -130,12 +128,12 @@ queueDb a (WriteHandle h) = liftIO $ H.queueDb h checkcommit a
{- Gets the handle cached in Annex state; creates a new one if it's not yet
- available, but doesn't open the database. -}
getDbHandle :: Annex DbHandle
getDbHandle = go =<< getState keysdbhandle
getDbHandle = go =<< Annex.getState Annex.keysdbhandle
where
go (Just h) = pure h
go Nothing = do
h <- liftIO newDbHandle
changeState $ \s -> s { keysdbhandle = Just h }
Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }
return h
{- Opens the database, perhaps creating it if it doesn't exist yet.
@ -219,11 +217,12 @@ scanAssociatedFiles = whenM (isJust <$> inRepo Git.Branch.current) $
runWriter $ \h -> do
showSideAction "scanning for unlocked files"
dropallassociated h
l <- inRepo $ Git.LsTree.lsTree headRef
(l, cleanup) <- inRepo $ Git.LsTree.lsTree headRef
forM_ l $ \i ->
when (isregfile i) $
maybe noop (add h i)
=<< catKey (Git.Types.Ref $ Git.LsTree.sha i)
liftIO $ void cleanup
where
dropallassociated = queueDb $
delete $ from $ \(_r :: SqlExpr (Entity Associated)) ->

View file

@ -1,6 +1,6 @@
{- git ls-tree interface
-
- Copyright 2011 Joey Hess <id@joeyh.name>
- Copyright 2011-2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -32,9 +32,10 @@ data TreeItem = TreeItem
{- Lists the complete contents of a tree, recursing into sub-trees,
- with lazy output. -}
lsTree :: Ref -> Repo -> IO [TreeItem]
lsTree t repo = map parseLsTree
<$> pipeNullSplitZombie (lsTreeParams t []) repo
lsTree :: Ref -> Repo -> IO ([TreeItem], IO Bool)
lsTree t repo = do
(l, cleanup) <- pipeNullSplit (lsTreeParams t []) repo
return (map parseLsTree l, cleanup)
lsTreeParams :: Ref -> [CommandParam] -> [CommandParam]
lsTreeParams r ps =