use ByteStrings when reading content of files
didn't bother to benchmark this
This commit is contained in:
parent
a91c8a15d5
commit
67f2b7cb3e
2 changed files with 16 additions and 15 deletions
13
Git.hs
13
Git.hs
|
@ -55,7 +55,6 @@ module Git (
|
||||||
repoAbsPath,
|
repoAbsPath,
|
||||||
reap,
|
reap,
|
||||||
useIndex,
|
useIndex,
|
||||||
hashObject,
|
|
||||||
getSha,
|
getSha,
|
||||||
shaSize,
|
shaSize,
|
||||||
commit,
|
commit,
|
||||||
|
@ -417,18 +416,6 @@ useIndex index = do
|
||||||
reset (Right (Just v)) = setEnv var v True
|
reset (Right (Just v)) = setEnv var v True
|
||||||
reset _ = unsetEnv var
|
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
|
{- Runs an action that causes a git subcommand to emit a sha, and strips
|
||||||
any trailing newline, returning the sha. -}
|
any trailing newline, returning the sha. -}
|
||||||
getSha :: String -> IO String -> IO String
|
getSha :: String -> IO String -> IO String
|
||||||
|
|
|
@ -16,8 +16,10 @@ import System.Cmd.Utils
|
||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.String.Utils
|
import Data.String.Utils
|
||||||
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
|
|
||||||
import Git
|
import Git
|
||||||
|
import qualified Git.ByteString as GitB
|
||||||
import Utility.SafeCommand
|
import Utility.SafeCommand
|
||||||
|
|
||||||
{- Performs a union merge between two branches, staging it in the index.
|
{- 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 (_:[]) = error "calc_merge parse error"
|
||||||
pairs (a:b:rest) = (a,b):pairs rest
|
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
|
{- 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
|
- a line suitable for update_index that union merges the two sides of the
|
||||||
- diff. -}
|
- diff. -}
|
||||||
|
@ -86,10 +100,10 @@ mergeFile g (info, file) = case filter (/= nullsha) [asha, bsha] of
|
||||||
[] -> return Nothing
|
[] -> return Nothing
|
||||||
(sha:[]) -> return $ Just $ update_index_line sha file
|
(sha:[]) -> return $ Just $ update_index_line sha file
|
||||||
shas -> do
|
shas -> do
|
||||||
content <- pipeRead g $ map Param ("show":shas)
|
content <- GitB.pipeRead g $ map Param ("show":shas)
|
||||||
sha <- hashObject g $ unionmerge content
|
sha <- hashObject g $ unionmerge content
|
||||||
return $ Just $ update_index_line sha file
|
return $ Just $ update_index_line sha file
|
||||||
where
|
where
|
||||||
[_colonamode, _bmode, asha, bsha, _status] = words info
|
[_colonamode, _bmode, asha, bsha, _status] = words info
|
||||||
nullsha = replicate shaSize '0'
|
nullsha = replicate shaSize '0'
|
||||||
unionmerge = unlines . nub . lines
|
unionmerge = L.unlines . nub . L.lines
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue