add stage number to stagedDetails parser

And convert parser to attoparsec, probably faster.

Before, a parse failure threw the whole --stage output line in to the
filename, which was certianly a bad idea, so fixed that.

Annex/View.hs

@@ -349,9 +349,9 @@ applyView' mkviewedfile getfilemetadata view = do
 	liftIO . nukeFile =<< fromRepo gitAnnexViewIndex
 	viewg <- withViewIndex gitRepo
 	withUpdateIndex viewg $ \uh -> do
-		forM_ l $ \(f, sha, mode) -> do
+		forM_ l $ \(f, sha, mode, _) -> do
 			topf <- inRepo (toTopFilePath f)
-			go uh topf sha (toTreeItemType =<< mode) =<< lookupFile f
+			go uh topf sha (toTreeItemType mode) =<< lookupFile f
 		liftIO $ void clean
 		genViewBranch view
   where
@@ -365,7 +365,7 @@ applyView' mkviewedfile getfilemetadata view = do
 			f' <- fromRawFilePath <$> 
 				fromRepo (fromTopFilePath $ asTopFilePath $ toRawFilePath fv)
 			stagesymlink uh f' =<< calcRepo (gitAnnexLink f' k)
-	go uh topf (Just sha) (Just treeitemtype) Nothing
+	go uh topf sha (Just treeitemtype) Nothing
 		| "." `B.isPrefixOf` getTopFilePath topf =
 			liftIO $ Git.UpdateIndex.streamUpdateIndex' uh $
 				pureStreamer $ updateIndexLine sha treeitemtype topf

Git/LsFiles.hs

@@ -16,6 +16,8 @@ module Git.LsFiles (
 	modified,
 	staged,
 	stagedNotDeleted,
+	usualStageNum,
+	mergeConflictHeadStageNum,
 	stagedDetails,
 	typeChanged,
 	typeChangedStaged,
@@ -33,12 +35,13 @@ import Git.Types
 import Git.Sha
 import Utility.InodeCache
 import Utility.TimeStamp
+import Utility.Attoparsec
 
-import Numeric
-import Data.Char
 import System.Posix.Types
 import qualified Data.Map as M
 import qualified Data.ByteString as S
+import qualified Data.Attoparsec.ByteString as A
+import qualified Data.Attoparsec.ByteString.Char8 as A8
 
 {- It's only safe to use git ls-files on the current repo, not on a remote.
  -
@@ -136,12 +139,23 @@ staged' ps l repo = guardSafeForLsFiles repo $
 	prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
 	suffix = Param "--" : map (File . fromRawFilePath) l
 
-type StagedDetails = (RawFilePath, Maybe Sha, Maybe FileMode)
+type StagedDetails = (RawFilePath, Sha, FileMode, StageNum)
+
+type StageNum = Int
+
+{- Used when not in a merge conflict. -}
+usualStageNum :: Int
+usualStageNum = 0
+
+{- WHen in a merge conflict, git uses stage number 2 for the local HEAD
+ - side of the merge conflict. -}
+mergeConflictHeadStageNum :: Int
+mergeConflictHeadStageNum = 2
 
 {- Returns details about all files that are staged in the index.
  -
  - Note that, during a conflict, a file will appear in the list
- - more than once.
+ - more than once with different stage numbers.
  -}
 stagedDetails :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails = stagedDetails' []
@@ -149,20 +163,25 @@ stagedDetails = stagedDetails' []
 stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails' ps l repo = guardSafeForLsFiles repo $ do
 	(ls, cleanup) <- pipeNullSplit' params repo
-	return (map parseStagedDetails ls, cleanup)
+	return (mapMaybe parseStagedDetails ls, cleanup)
   where
 	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
 		Param "--" : map (File . fromRawFilePath) l
 
-parseStagedDetails :: S.ByteString -> StagedDetails
-parseStagedDetails s
-	| S.null file = (s, Nothing, Nothing)
-	| otherwise = (file, extractSha sha, readmode mode)
+parseStagedDetails :: S.ByteString -> Maybe StagedDetails
+parseStagedDetails = eitherToMaybe . A.parseOnly parser
   where
-	(metadata, file) = separate' (== fromIntegral (ord '\t')) s
-	(mode, metadata') = separate' (== fromIntegral (ord ' ')) metadata
-	(sha, _) = separate' (== fromIntegral (ord ' ')) metadata'
-	readmode = fst <$$> headMaybe . readOct . decodeBS'
+	parser = do
+		mode <- octal
+		void $ A8.char ' '
+		sha <- maybe (fail "bad sha") return . extractSha =<< nextword
+		void $ A8.char ' '
+		stagenum <- A8.decimal
+		void $ A8.char '\t'
+		file <- A.takeByteString
+		return (file, sha, mode, stagenum)
+	
+	nextword = A8.takeTill (== ' ')
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}

Git/Repair.hs

@@ -38,7 +38,6 @@ import qualified Git.Branch as Branch
 import Utility.Tmp.Dir
 import Utility.Rsync
 import Utility.FileMode
-import Utility.Tuple
 
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as L
@@ -379,9 +378,8 @@ missingIndex r = not <$> doesFileExist (fromRawFilePath (localGitDir r) </> "ind
 partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool)
 partitionIndex r = do
 	(indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r
-	l <- forM indexcontents $ \i -> case i of
-		(_file, Just sha, Just _mode) -> (,) <$> isMissing sha r <*> pure i
-		_ -> pure (False, i)
+	l <- forM indexcontents $ \i@(_file, sha, _mode, _stagenum) -> 
+		(,) <$> isMissing sha r <*> pure i
 	let (bad, good) = partition fst l
 	return (map snd bad, map snd good, cleanup)
 
@@ -397,13 +395,12 @@ rewriteIndex r
 			UpdateIndex.streamUpdateIndex r
 				=<< (catMaybes <$> mapM reinject good)
 		void cleanup
-		return $ map (fromRawFilePath . fst3) bad
+		return $ map (\(file,_, _, _) -> fromRawFilePath file) bad
   where
-	reinject (file, Just sha, Just mode) = case toTreeItemType mode of
+	reinject (file, sha, mode, _) = case toTreeItemType mode of
 		Nothing -> return Nothing
 		Just treeitemtype -> Just <$>
 			UpdateIndex.stageFile sha treeitemtype (fromRawFilePath file) r
-	reinject _ = return Nothing
 
 newtype GoodCommits = GoodCommits (S.Set Sha)
 

Logs/Web.hs

@@ -99,11 +99,10 @@ knownUrls = do
 		void $ liftIO cleanup
 		return $ concat r
   where
-	getkeyurls (f, s, _) = case urlLogFileKey f of
+	getkeyurls (f, s, _, _) = case urlLogFileKey f of
 		Just k -> zip (repeat k) <$> geturls s
 		Nothing -> return []
-	geturls Nothing = return []
-	geturls (Just logsha) =
+	geturls logsha =
 		map (decodeBS . fromLogInfo) . getLog 
 			<$> catObject logsha
 

Upgrade/V5.hs

@@ -114,7 +114,7 @@ upgradeDirectWorkTree = do
 	forM_ l go
 	void $ liftIO clean
   where
-	go (f, Just _sha, Just mode) | isSymLink mode = do
+	go (f, _sha, mode, _stagenum) | isSymLink mode = do
 		-- Cannot use lookupFile here, as we're in between direct
 		-- mode and v6.
 		mk <- catKeyFile f