From 7e592e1d6ed5e0b25b37215da7558c6324688d6f Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@debian.org>
Date: Fri, 22 Nov 2013 11:16:03 -0400
Subject: git-repair (1.20131122) unstable; urgency=low

  * Added test mode, which can be used to randomly corrupt test
    repositories, in reproducible ways, which allows easy
    corruption-driven-development.
  * Improve repair code in the case where the index file is corrupt,
    and this hides other problems.
  * Write a dummy .git/HEAD if the file is missing or corrupt, as
    git otherwise will not treat the repository as a git repo.
  * Improve fsck code to find badly corrupted objects that crash git fsck
    before it can complain about them.
  * Fixed crashes on bad file encodings.
  * Can now run 10000 tests (git-repair --test -n 10000 --force)
    with 0 failures.

# imported from the archive
---
 Git/UpdateIndex.hs | 86 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 86 insertions(+)
 create mode 100644 Git/UpdateIndex.hs

(limited to 'Git/UpdateIndex.hs')

diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
new file mode 100644
index 0000000..3b33ac8
--- /dev/null
+++ b/Git/UpdateIndex.hs
@@ -0,0 +1,86 @@
+{- git-update-index library
+ -
+ - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE BangPatterns, CPP #-}
+
+module Git.UpdateIndex (
+	Streamer,
+	pureStreamer,
+	streamUpdateIndex,
+	lsTree,
+	updateIndexLine,
+	stageFile,
+	unstageFile,
+	stageSymlink
+) where
+
+import Common
+import Git
+import Git.Types
+import Git.Command
+import Git.FilePath
+import Git.Sha
+
+{- 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. -}
+streamUpdateIndex :: Repo -> [Streamer] -> IO ()
+streamUpdateIndex repo as = pipeWrite params repo $ \h -> do
+	fileEncoding h
+	forM_ as (stream h)
+	hClose h
+  where
+	params = map Param ["update-index", "-z", "--index-info"]
+	stream h a = a (streamer h)
+	streamer h s = do
+		hPutStr h s
+		hPutStr h "\0"
+
+{- 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 = do
+	(s, cleanup) <- pipeNullSplit params repo
+	mapM_ streamer s
+	void $ cleanup
+  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. -}
+updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
+updateIndexLine sha filetype file =
+	show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file
+
+stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer
+stageFile sha filetype file repo = do
+	p <- toTopFilePath file repo
+	return $ pureStreamer $ updateIndexLine sha filetype p
+
+{- A streamer that removes a file from the index. -}
+unstageFile :: FilePath -> Repo -> IO Streamer
+unstageFile file repo = do
+	p <- toTopFilePath file repo
+	return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ indexPath p
+
+{- A streamer that adds a symlink to the index. -}
+stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
+stageSymlink file sha repo = do
+	!line <- updateIndexLine
+		<$> pure sha
+		<*> pure SymlinkBlob
+		<*> toTopFilePath file repo
+	return $ pureStreamer line
+
+indexPath :: TopFilePath -> InternalGitPath
+indexPath = toInternalGitPath . getTopFilePath
-- 
cgit v1.2.3