diff options
| -rw-r--r-- | Git.hs | 13 | ||||
| -rw-r--r-- | Git/UnionMerge.hs | 18 |
2 files changed, 16 insertions, 15 deletions
@@ -55,7 +55,6 @@ module Git ( repoAbsPath, reap, useIndex, - hashObject, getSha, shaSize, commit, @@ -417,18 +416,6 @@ useIndex index = do reset (Right (Just v)) = setEnv var v True reset _ = unsetEnv var -{- Injects some content into git, returning its hash. -} -hashObject :: Repo -> String -> IO String -hashObject repo content = getSha subcmd $ do - (h, s) <- pipeWriteRead repo (map Param params) content - length s `seq` do - forceSuccess h - reap -- XXX unsure why this is needed - return s - where - subcmd = "hash-object" - params = [subcmd, "-w", "--stdin"] - {- Runs an action that causes a git subcommand to emit a sha, and strips any trailing newline, returning the sha. -} getSha :: String -> IO String -> IO String diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index a5bcbeac4..a2b85dbdc 100644 --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -16,8 +16,10 @@ import System.Cmd.Utils import Data.List import Data.Maybe import Data.String.Utils +import qualified Data.ByteString.Lazy.Char8 as L import Git +import qualified Git.ByteString as GitB import Utility.SafeCommand {- Performs a union merge between two branches, staging it in the index. @@ -78,6 +80,18 @@ calc_merge g differ = do pairs (_:[]) = error "calc_merge parse error" pairs (a:b:rest) = (a,b):pairs rest +{- Injects some content into git, returning its hash. -} +hashObject :: Repo -> L.ByteString -> IO String +hashObject repo content = getSha subcmd $ do + (h, s) <- GitB.pipeWriteRead repo (map Param params) content + L.length s `seq` do + forceSuccess h + reap -- XXX unsure why this is needed + return $ L.unpack s + where + subcmd = "hash-object" + params = [subcmd, "-w", "--stdin"] + {- Given an info line from a git raw diff, and the filename, generates - a line suitable for update_index that union merges the two sides of the - diff. -} @@ -86,10 +100,10 @@ mergeFile g (info, file) = case filter (/= nullsha) [asha, bsha] of [] -> return Nothing (sha:[]) -> return $ Just $ update_index_line sha file shas -> do - content <- pipeRead g $ map Param ("show":shas) + content <- GitB.pipeRead g $ map Param ("show":shas) sha <- hashObject g $ unionmerge content return $ Just $ update_index_line sha file where [_colonamode, _bmode, asha, bsha, _status] = words info nullsha = replicate shaSize '0' - unionmerge = unlines . nub . lines + unionmerge = L.unlines . nub . L.lines |