diff options
| -rw-r--r-- | Annex/Branch.hs | 3 | ||||
| -rw-r--r-- | Git/HashObject.hs | 14 |
2 files changed, 10 insertions, 7 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 556df976f..f9fa6cbb3 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -291,9 +291,10 @@ stageJournal = do withIndex $ liftIO $ do let dir = gitAnnexJournalDir g let paths = map (dir </>) fs - shas <- Git.HashObject.hashFiles paths g + (shas, cleanup) <- Git.HashObject.hashFiles paths g Git.UnionMerge.update_index g $ index_lines shas (map fileJournal fs) + cleanup mapM_ removeFile paths where index_lines shas = map genline . zip shas diff --git a/Git/HashObject.hs b/Git/HashObject.hs index f28d865b1..99b96afcb 100644 --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -10,16 +10,15 @@ module Git.HashObject where import Common import Git -{- Injects a set of files into git, returning the shas of the objects. -} -hashFiles :: [FilePath] -> Repo -> IO [Sha] +{- Injects a set of files into git, returning the shas of the objects + - and an IO action to call ones the the shas have been used. -} +hashFiles :: [FilePath] -> Repo -> IO ([Sha], IO ()) hashFiles paths repo = do (pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object repo _ <- forkProcess (feeder toh) hClose toh - shas <- map Git.Ref . lines <$> hGetContents fromh - hClose fromh - forceSuccess pid - return shas + shas <- map Git.Ref . lines <$> hGetContentsStrict fromh + return (shas, ender fromh pid) where git_hash_object = Git.gitCommandLine [Param "hash-object", Param "-w", Param "--stdin-paths"] @@ -27,3 +26,6 @@ hashFiles paths repo = do hPutStr toh $ unlines paths hClose toh exitSuccess + ender fromh pid = do + hClose fromh + forceSuccess pid |