Merge from git-annex.

7 files changed, 75 insertions, 31 deletions

diff --git a/Git/Branch.hs b/Git/Branch.hs
index 0b7d888..5c6135d 100644
--- a/Git/Branch.hs
+++ b/Git/Branch.hs
@@ -43,6 +43,9 @@ currentUnsafe r = parse . firstLine
 		| null l = Nothing
 		| otherwise = Just $ Git.Ref l
 
+currentSha :: Repo -> IO (Maybe Git.Sha)
+currentSha r = maybe (pure Nothing) (`Git.Ref.sha` r) =<< current r
+
 {- Checks if the second branch has any commits not present on the first
  - branch. -}
 changed :: Branch -> Branch -> Repo -> IO Bool
diff --git a/Git/Construct.hs b/Git/Construct.hs
index eed2b99..3c6013a 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -46,8 +46,8 @@ fromCwd = getCurrentDirectory >>= seekUp
 		r <- checkForRepo dir
 		case r of
 			Nothing -> case parentDir dir of
-				"" -> return Nothing
-				d -> seekUp d
+				Nothing -> return Nothing
+				Just d -> seekUp d
 			Just loc -> Just <$> newFrom loc
 
 {- Local Repo constructor, accepts a relative or absolute path. -}
diff --git a/Git/DiffTreeItem.hs b/Git/DiffTreeItem.hs
new file mode 100644
index 0000000..2389b69
--- /dev/null
+++ b/Git/DiffTreeItem.hs
@@ -0,0 +1,24 @@
+{- git diff-tree item
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.DiffTreeItem (
+	DiffTreeItem(..),
+) where
+
+import System.Posix.Types
+
+import Git.FilePath
+import Git.Types
+
+data DiffTreeItem = DiffTreeItem
+	{ srcmode :: FileMode
+	, dstmode :: FileMode
+	, srcsha :: Sha -- nullSha if file was added
+	, dstsha :: Sha -- nullSha if file was deleted
+	, status :: String
+	, file :: TopFilePath
+	} deriving Show
diff --git a/Git/Index.hs b/Git/Index.hs
index c42ac42..7145bb9 100644
--- a/Git/Index.hs
+++ b/Git/Index.hs
@@ -11,6 +11,9 @@ import Common
 import Git
 import Utility.Env
 
+indexEnv :: String
+indexEnv = "GIT_INDEX_FILE"
+
 {- Forces git to use the specified index file.
  -
  - Returns an action that will reset back to the default
@@ -25,7 +28,7 @@ override index = do
 	return $ reset res
   where
 	var = "GIT_INDEX_FILE"
-	reset (Just v) = setEnv var v True
+	reset (Just v) = setEnv indexEnv v True
 	reset _ = unsetEnv var
 
 indexFile :: Repo -> FilePath
@@ -34,3 +37,19 @@ indexFile r = localGitDir r </> "index"
 {- Git locks the index by creating this file. -}
 indexFileLock :: Repo -> FilePath
 indexFileLock r = indexFile r ++ ".lock"
+
+{- When the pre-commit hook is run, and git commit has been run with
+ - a file or files specified to commit, rather than committing the staged
+ - index, git provides the pre-commit hook with a "false index file".
+ -
+ - Changes made to this index will influence the commit, but won't
+ - affect the real index file.
+ -
+ - This detects when we're in this situation, using a heuristic, which
+ - might be broken by changes to git. Any use of this should have a test
+ - case to make sure it works.
+ -}
+haveFalseIndex :: IO Bool
+haveFalseIndex = maybe (False) check <$> getEnv indexEnv
+  where
+	check f = "next-index" `isPrefixOf` takeFileName f
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 77a592b..5731138 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -241,7 +241,7 @@ explodePackedRefsFile r = do
   where
 	makeref (sha, ref) = do
 		let dest = localGitDir r </> fromRef ref
-		createDirectoryIfMissing True (parentDir dest)
+		createDirectoryIfMissing True (takeDirectory dest)
 		unlessM (doesFileExist dest) $
 			writeFile dest (fromRef sha)
 
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index ecd154a..613596d 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -19,7 +19,8 @@ module Git.UpdateIndex (
 	updateIndexLine,
 	stageFile,
 	unstageFile,
-	stageSymlink
+	stageSymlink,
+	stageDiffTreeItem,
 ) where
 
 import Common
@@ -28,6 +29,7 @@ import Git.Types
 import Git.Command
 import Git.FilePath
 import Git.Sha
+import qualified Git.DiffTreeItem as Diff
 
 {- Streamers are passed a callback and should feed it lines in the form
  - read by update-index, and generated by ls-tree. -}
@@ -95,7 +97,10 @@ stageFile sha filetype file repo = do
 unstageFile :: FilePath -> Repo -> IO Streamer
 unstageFile file repo = do
 	p <- toTopFilePath file repo
-	return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
+	return $ unstageFile' p
+
+unstageFile' :: TopFilePath -> Streamer
+unstageFile' p = pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
 
 {- A streamer that adds a symlink to the index. -}
 stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
@@ -106,5 +111,11 @@ stageSymlink file sha repo = do
 		<*> toTopFilePath file repo
 	return $ pureStreamer line
 
+{- A streamer that applies a DiffTreeItem to the index. -}
+stageDiffTreeItem :: Diff.DiffTreeItem -> Streamer
+stageDiffTreeItem d = case toBlobType (Diff.dstmode d) of
+	Nothing -> unstageFile' (Diff.file d)
+	Just t -> pureStreamer $ updateIndexLine (Diff.dstsha d) t (Diff.file d)
+
 indexPath :: TopFilePath -> InternalGitPath
 indexPath = toInternalGitPath . getTopFilePath
diff --git a/Git/Version.hs b/Git/Version.hs
index 5c61f85..73ce2f8 100644
--- a/Git/Version.hs
+++ b/Git/Version.hs
@@ -5,18 +5,17 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Git.Version where
+module Git.Version (
+	installed,
+	older,
+	normalize,
+	GitVersion,
+) where
 
 import Common
+import Utility.DottedVersion
 
-data GitVersion = GitVersion String Integer
-	deriving (Eq)
-
-instance Ord GitVersion where
-	compare (GitVersion _ x) (GitVersion _ y) = compare x y
-
-instance Show GitVersion where
-	show (GitVersion s _) = s
+type GitVersion = DottedVersion
 
 installed :: IO GitVersion
 installed = normalize . extract <$> readProcess "git" ["--version"]
@@ -25,19 +24,7 @@ installed = normalize . extract <$> readProcess "git" ["--version"]
 		[] -> ""
 		(l:_) -> unwords $ drop 2 $ words l
 
-{- To compare dotted versions like 1.7.7 and 1.8, they are normalized to
- - a somewhat arbitrary integer representation. -}
-normalize :: String -> GitVersion
-normalize v = GitVersion v $ 
-	sum $ mult 1 $ reverse $ extend precision $ take precision $
-		map readi $ split "." v
-  where
-	extend n l = l ++ replicate (n - length l) 0
-	mult _ [] = []
-	mult n (x:xs) = (n*x) : mult (n*10^width) xs
-	readi :: String -> Integer
-	readi s = case reads s of
-		((x,_):_) -> x
-		_ -> 0
-	precision = 10 -- number of segments of the version to compare
-	width = length "yyyymmddhhmmss" -- maximum width of a segment
+older :: String -> IO Bool
+older n = do
+	v <- installed
+	return $ v < normalize n