mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

wait for git lstree to exit

Browse source
This commit is contained in:
Joey Hess 2016-01-01 15:50:59 -04:00
commit f7256842cc
Failed to extract signature
3 changed files with 13 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

3
CmdLine/Seek.hs
View file

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

13
Database/Keys.hs
View file

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

9
Git/LsTree.hs
View file

@ -1,6 +1,6 @@
{- git ls-tree interface {- 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. - 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, {- Lists the complete contents of a tree, recursing into sub-trees,
- with lazy output. -} - with lazy output. -}
lsTree :: Ref -> Repo -> IO [TreeItem] lsTree :: Ref -> Repo -> IO ([TreeItem], IO Bool)
lsTree t repo = map parseLsTree lsTree t repo = do
<$> pipeNullSplitZombie (lsTreeParams t []) repo (l, cleanup) <- pipeNullSplit (lsTreeParams t []) repo
return (map parseLsTree l, cleanup)
lsTreeParams :: Ref -> [CommandParam] -> [CommandParam] lsTreeParams :: Ref -> [CommandParam] -> [CommandParam]
lsTreeParams r ps = lsTreeParams r ps =