diff options
-rw-r--r-- | Annex/Branch.hs | 19 | ||||
-rw-r--r-- | Git/HashObject.hs | 29 |
2 files changed, 32 insertions, 16 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 42940f4ff..556df976f 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -17,7 +17,6 @@ module Annex.Branch ( files, ) where -import System.Exit import qualified Data.ByteString.Lazy.Char8 as L import Common.Annex @@ -25,9 +24,10 @@ import Annex.Exception import Annex.BranchState import Annex.Journal import qualified Git -import qualified Git.UnionMerge import qualified Git.Ref import qualified Git.Branch +import qualified Git.UnionMerge +import qualified Git.HashObject import Annex.CatFile {- Name of the branch that is used to store git-annex's information. -} @@ -291,23 +291,10 @@ stageJournal = do withIndex $ liftIO $ do let dir = gitAnnexJournalDir g let paths = map (dir </>) fs - -- inject all the journal files directly into git - -- in one quick command - (pid, fromh, toh) <- hPipeBoth "git" $ toCommand $ git_hash_object g - _ <- forkProcess $ do - hPutStr toh $ unlines paths - hClose toh - exitSuccess - hClose toh - shas <- map Git.Ref . lines <$> hGetContents fromh - -- update the index, also in just one command + shas <- Git.HashObject.hashFiles paths g Git.UnionMerge.update_index g $ index_lines shas (map fileJournal fs) - hClose fromh - forceSuccess pid mapM_ removeFile paths where index_lines shas = map genline . zip shas genline (sha, file) = Git.UnionMerge.update_index_line sha file - git_hash_object = Git.gitCommandLine - [Param "hash-object", Param "-w", Param "--stdin-paths"] diff --git a/Git/HashObject.hs b/Git/HashObject.hs new file mode 100644 index 000000000..f28d865b1 --- /dev/null +++ b/Git/HashObject.hs @@ -0,0 +1,29 @@ +{- git hash-object interface + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +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] +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 + where + git_hash_object = Git.gitCommandLine + [Param "hash-object", Param "-w", Param "--stdin-paths"] + feeder toh = do + hPutStr toh $ unlines paths + hClose toh + exitSuccess |