summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex/Branch.hs10
-rw-r--r--Command/Watch.hs12
-rw-r--r--Git/Queue.hs2
-rw-r--r--Git/UnionMerge.hs43
-rw-r--r--Git/UpdateIndex.hs37
5 files changed, 58 insertions, 46 deletions
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 1dacd5f32..7b433cc6e 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -261,15 +261,15 @@ files = withIndexUpdate $ do
- in changes from other branches.
-}
genIndex :: Git.Repo -> IO ()
-genIndex g = Git.UpdateIndex.stream_update_index g
- [Git.UpdateIndex.ls_tree fullname g]
+genIndex g = Git.UpdateIndex.streamUpdateIndex g
+ [Git.UpdateIndex.lsTree fullname g]
{- Merges the specified refs into the index.
- Any changes staged in the index will be preserved. -}
mergeIndex :: [Git.Ref] -> Annex ()
mergeIndex branches = do
h <- catFileHandle
- inRepo $ \g -> Git.UnionMerge.merge_index h g branches
+ inRepo $ \g -> Git.UnionMerge.mergeIndex h g branches
{- Runs an action using the branch's index file. -}
withIndex :: Annex a -> Annex a
@@ -338,13 +338,13 @@ stageJournal = do
g <- gitRepo
withIndex $ liftIO $ do
h <- hashObjectStart g
- Git.UpdateIndex.stream_update_index g
+ Git.UpdateIndex.streamUpdateIndex g
[genstream (gitAnnexJournalDir g) h fs]
hashObjectStop h
where
genstream dir h fs streamer = forM_ fs $ \file -> do
let path = dir </> file
sha <- hashFile h path
- _ <- streamer $ Git.UpdateIndex.update_index_line
+ _ <- streamer $ Git.UpdateIndex.updateIndexLine
sha FileBlob (asTopFilePath $ fileJournal file)
removeFile path
diff --git a/Command/Watch.hs b/Command/Watch.hs
index bf544679d..c5d824864 100644
--- a/Command/Watch.hs
+++ b/Command/Watch.hs
@@ -19,9 +19,6 @@ import qualified Annex.Queue
import qualified Command.Add
import qualified Git.Command
import qualified Git.UpdateIndex
-import Git.HashObject
-import Git.Types
-import Git.FilePath
import qualified Backend
import Annex.Content
@@ -140,9 +137,6 @@ onErr = warning
{- Adds a symlink to the index, without ever accessing the actual symlink
- on disk. -}
stageSymlink :: FilePath -> String -> Annex ()
-stageSymlink file linktext = do
- line <- Git.UpdateIndex.update_index_line
- <$> inRepo (hashObject BlobObject linktext)
- <*> pure SymlinkBlob
- <*> inRepo (toTopFilePath file)
- Annex.Queue.addUpdateIndex $ \streamer -> streamer line
+stageSymlink file linktext =
+ Annex.Queue.addUpdateIndex =<<
+ inRepo (Git.UpdateIndex.stageSymlink file linktext)
diff --git a/Git/Queue.hs b/Git/Queue.hs
index f2312cfaa..78b52a2bc 100644
--- a/Git/Queue.hs
+++ b/Git/Queue.hs
@@ -151,7 +151,7 @@ flush (Queue _ lim m) repo = do
- this allows queueing commands that do not need a list of files. -}
runAction :: Repo -> Action -> IO ()
runAction repo (UpdateIndexAction streamers) =
- Git.UpdateIndex.stream_update_index repo streamers
+ Git.UpdateIndex.streamUpdateIndex 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 d38bdfe22..0987f9131 100644
--- a/Git/UnionMerge.hs
+++ b/Git/UnionMerge.hs
@@ -7,7 +7,7 @@
module Git.UnionMerge (
merge,
- merge_index
+ mergeIndex
) where
import qualified Data.Text.Lazy as L
@@ -32,40 +32,40 @@ import Git.FilePath
merge :: Ref -> Ref -> Repo -> IO ()
merge x y repo = do
h <- catFileStart repo
- stream_update_index repo
- [ ls_tree x repo
- , merge_trees x y h repo
+ streamUpdateIndex repo
+ [ lsTree x repo
+ , mergeTrees x y h repo
]
catFileStop h
-{- Merges a list of branches into the index. Previously staged changed in
+{- Merges a list of branches into the index. Previously staged changes in
- the index are preserved (and participate in the merge). -}
-merge_index :: CatFileHandle -> Repo -> [Ref] -> IO ()
-merge_index h repo bs =
- stream_update_index repo $ map (\b -> merge_tree_index b h repo) bs
+mergeIndex :: CatFileHandle -> Repo -> [Ref] -> IO ()
+mergeIndex h repo bs =
+ streamUpdateIndex repo $ map (\b -> mergeTreeIndex b h repo) bs
{- For merging two trees. -}
-merge_trees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
-merge_trees (Ref x) (Ref y) h = calc_merge h $ "diff-tree":diff_opts ++ [x, y]
+mergeTrees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
+mergeTrees (Ref x) (Ref y) h = doMerge h $ "diff-tree":diffOpts ++ [x, y]
{- For merging a single tree into the index. -}
-merge_tree_index :: Ref -> CatFileHandle -> Repo -> Streamer
-merge_tree_index (Ref x) h = calc_merge h $
- "diff-index" : diff_opts ++ ["--cached", x]
+mergeTreeIndex :: Ref -> CatFileHandle -> Repo -> Streamer
+mergeTreeIndex (Ref x) h = doMerge h $
+ "diff-index" : diffOpts ++ ["--cached", x]
-diff_opts :: [String]
-diff_opts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
+diffOpts :: [String]
+diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
-{- Calculates how to perform a merge, using git to get a raw diff,
- - and generating update-index input. -}
-calc_merge :: CatFileHandle -> [String] -> Repo -> Streamer
-calc_merge ch differ repo streamer = gendiff >>= go
+{- Streams update-index changes to perform a merge,
+ - using git to get a raw diff. -}
+doMerge :: CatFileHandle -> [String] -> Repo -> Streamer
+doMerge ch differ repo streamer = gendiff >>= go
where
gendiff = pipeNullSplit (map Param differ) repo
go [] = noop
go (info:file:rest) = mergeFile info file ch repo >>=
maybe (go rest) (\l -> streamer l >> go rest)
- go (_:[]) = error "calc_merge parse error"
+ go (_:[]) = error $ "parse error " ++ show differ
{- 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
@@ -81,7 +81,8 @@ mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of
[_colonmode, _bmode, asha, bsha, _status] = words info
getcontents s = map L.unpack . L.lines .
L.decodeUtf8 <$> catObject h s
- use sha = return $ Just $ update_index_line sha FileBlob $ asTopFilePath file
+ use sha = return $ Just $
+ updateIndexLine sha FileBlob $ asTopFilePath file
{- Calculates a union merge between a list of refs, with contents.
-
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 8c003dd13..a32db8b9d 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -7,9 +7,11 @@
module Git.UpdateIndex (
Streamer,
- stream_update_index,
- ls_tree,
- update_index_line,
+ pureStreamer,
+ streamUpdateIndex,
+ lsTree,
+ updateIndexLine,
+ stageSymlink
) where
import System.Cmd.Utils
@@ -19,14 +21,19 @@ import Git
import Git.Types
import Git.Command
import Git.FilePath
+import Git.HashObject
{- Streamers are passed a callback and should feed it lines in the form
- read by update-index, and generated by ls-tree. -}
type Streamer = (String -> IO ()) -> IO ()
+{- A streamer with a precalculated value. -}
+pureStreamer :: String -> Streamer
+pureStreamer s = \streamer -> streamer s
+
{- Streams content into update-index from a list of Streamers. -}
-stream_update_index :: Repo -> [Streamer] -> IO ()
-stream_update_index repo as = do
+streamUpdateIndex :: Repo -> [Streamer] -> IO ()
+streamUpdateIndex repo as = do
(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
fileEncoding h
forM_ as (stream h)
@@ -39,14 +46,24 @@ stream_update_index repo as = do
hPutStr h s
hPutStr h "\0"
-{- Gets the current tree for a ref. -}
-ls_tree :: Ref -> Repo -> Streamer
-ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
+{- A streamer that adds the current tree for a ref. Useful for eg, copying
+ - and modifying branches. -}
+lsTree :: Ref -> Repo -> Streamer
+lsTree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
where
params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]
{- Generates a line suitable to be fed into update-index, to add
- a given file with a given sha. -}
-update_index_line :: Sha -> BlobType -> TopFilePath -> String
-update_index_line sha filetype file =
+updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
+updateIndexLine sha filetype file =
show filetype ++ " blob " ++ show sha ++ "\t" ++ getTopFilePath file
+
+{- A streamer that adds a symlink to the index. -}
+stageSymlink :: FilePath -> String -> Repo -> IO Streamer
+stageSymlink file linktext repo = do
+ line <- updateIndexLine
+ <$> hashObject BlobObject linktext repo
+ <*> pure SymlinkBlob
+ <*> toTopFilePath file repo
+ return $ pureStreamer line
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-03 16:35:09 +0000