avoid closing pipe before all the shas are read from it

Could have just used hGetContentsStrict here, but that would require
storing all the shas in memory. Since this is called at the end of a
git-annex run, it may have created a *lot* of shas, so I avoid that memory
use and stream them out like before.
This commit is contained in:
Joey Hess 2011-12-12 21:41:37 -04:00
parent 0e45b762a0
commit 46588674b0
2 changed files with 10 additions and 7 deletions

View file

@ -291,9 +291,10 @@ stageJournal = do
withIndex $ liftIO $ do withIndex $ liftIO $ do
let dir = gitAnnexJournalDir g let dir = gitAnnexJournalDir g
let paths = map (dir </>) fs let paths = map (dir </>) fs
shas <- Git.HashObject.hashFiles paths g (shas, cleanup) <- Git.HashObject.hashFiles paths g
Git.UnionMerge.update_index g $ Git.UnionMerge.update_index g $
index_lines shas (map fileJournal fs) index_lines shas (map fileJournal fs)
cleanup
mapM_ removeFile paths mapM_ removeFile paths
where where
index_lines shas = map genline . zip shas index_lines shas = map genline . zip shas

View file

@ -10,16 +10,15 @@ module Git.HashObject where
import Common import Common
import Git import Git
{- Injects a set of files into git, returning the shas of the objects. -} {- Injects a set of files into git, returning the shas of the objects
hashFiles :: [FilePath] -> Repo -> IO [Sha] - and an IO action to call ones the the shas have been used. -}
hashFiles :: [FilePath] -> Repo -> IO ([Sha], IO ())
hashFiles paths repo = do hashFiles paths repo = do
(pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object repo (pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object repo
_ <- forkProcess (feeder toh) _ <- forkProcess (feeder toh)
hClose toh hClose toh
shas <- map Git.Ref . lines <$> hGetContents fromh shas <- map Git.Ref . lines <$> hGetContentsStrict fromh
hClose fromh return (shas, ender fromh pid)
forceSuccess pid
return shas
where where
git_hash_object = Git.gitCommandLine git_hash_object = Git.gitCommandLine
[Param "hash-object", Param "-w", Param "--stdin-paths"] [Param "hash-object", Param "-w", Param "--stdin-paths"]
@ -27,3 +26,6 @@ hashFiles paths repo = do
hPutStr toh $ unlines paths hPutStr toh $ unlines paths
hClose toh hClose toh
exitSuccess exitSuccess
ender fromh pid = do
hClose fromh
forceSuccess pid