diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/HashObject.hs | 4 | ||||
| -rw-r--r-- | Git/Queue.hs | 18 | ||||
| -rw-r--r-- | Git/UnionMerge.hs | 5 |
3 files changed, 16 insertions, 11 deletions
diff --git a/Git/HashObject.hs b/Git/HashObject.hs index b052413fd..9f37de5ba 100644 --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -36,8 +36,8 @@ hashFile h file = CoProcess.query h send receive receive from = getSha "hash-object" $ hGetLine from {- Injects some content into git, returning its Sha. -} -hashObject :: Repo -> ObjectType -> String -> IO Sha -hashObject repo objtype content = getSha subcmd $ do +hashObject :: ObjectType -> String -> Repo -> IO Sha +hashObject objtype content repo = getSha subcmd $ do (h, s) <- pipeWriteRead (map Param params) content repo length s `seq` do forceSuccess h diff --git a/Git/Queue.hs b/Git/Queue.hs index 5870bf866..f2312cfaa 100644 --- a/Git/Queue.hs +++ b/Git/Queue.hs @@ -77,13 +77,11 @@ defaultLimit = 10240 new :: Maybe Int -> Queue new lim = Queue 0 (fromMaybe defaultLimit lim) M.empty -{- Adds a command to a queue. If the queue already contains a different - - action, it will be flushed; this is to ensure that conflicting actions, - - like add and rm, are run in the right order. +{- Adds an git command to the queue. - - - Actions with the same subcommand but different parameters are - - roughly equivilant; assumed equivilant enough to perform in any order - - with the same result. + - Git commands with the same subcommand but different parameters are + - assumed to be equivilant enough to perform in any order with the same + - result. -} addCommand :: String -> [CommandParam] -> [FilePath] -> Queue -> Repo -> IO Queue addCommand subcommand params files q repo = @@ -100,6 +98,11 @@ addCommand subcommand params files q repo = different (CommandAction { getSubcommand = s }) = s /= subcommand different _ = True +{- Adds an update-index streamer to the queue. + - + - Note that this does not increase the queue size, because data is + - streamed into update-index, so command-line length limits are not + - involved. -} addUpdateIndex :: Git.UpdateIndex.Streamer -> Queue -> Repo -> IO Queue addUpdateIndex streamer q repo = updateQueue action different 0 q repo @@ -147,7 +150,8 @@ flush (Queue _ lim m) repo = do - Intentionally runs the command even if the list of files is empty; - this allows queueing commands that do not need a list of files. -} runAction :: Repo -> Action -> IO () -runAction _repo _action@(UpdateIndexAction {}) = error "TODO" +runAction repo (UpdateIndexAction streamers) = + Git.UpdateIndex.stream_update_index repo streamers runAction repo action@(CommandAction {}) = pOpen WriteToPipe "xargs" ("-0":"git":params) feedxargs where diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index f65b59c53..d38bdfe22 100644 --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -74,8 +74,9 @@ mergeFile :: String -> FilePath -> CatFileHandle -> Repo -> IO (Maybe String) mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of [] -> return Nothing (sha:[]) -> use sha - shas -> use =<< either return (hashObject repo BlobObject . unlines) =<< - calcMerge . zip shas <$> mapM getcontents shas + shas -> use + =<< either return (\s -> hashObject BlobObject (unlines s) repo) + =<< calcMerge . zip shas <$> mapM getcontents shas where [_colonmode, _bmode, asha, bsha, _status] = words info getcontents s = map L.unpack . L.lines . |