Merge branch 'master' into assistant

4 files changed, 98 insertions, 5 deletions

diff --git a/Git/Config.hs b/Git/Config.hs
index dab1cdf5e..c9e4f9a2d 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -54,6 +54,10 @@ read' repo = go repo
 {- Reads git config from a handle and populates a repo with it. -}
 hRead :: Repo -> Handle -> IO Repo
 hRead repo h = do
+	-- We use the FileSystemEncoding when reading from git-config,
+	-- because it can contain arbitrary filepaths (and other strings)
+	-- in any encoding.
+	fileEncoding h
 	val <- hGetContentsStrict h
 	store val repo
 
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index 06d4b9f44..321913334 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -1,6 +1,6 @@
 {- git ls-files interface
  -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
+ - Copyright 2010,2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -13,11 +13,16 @@ module Git.LsFiles (
 	changedUnstaged,
 	typeChanged,
 	typeChangedStaged,
+	Conflicting(..),
+	Unmerged(..),
+	unmerged,
 ) where
 
 import Common
 import Git
 import Git.Command
+import Git.Types
+import Git.Sha
 
 {- Scans for files that are checked into git at the specified locations. -}
 inRepo :: [FilePath] -> Repo -> IO [FilePath]
@@ -75,3 +80,76 @@ typeChanged' ps l repo = do
 	where
 		prefix = [Params "diff --name-only --diff-filter=T -z"]
 		suffix = Param "--" : map File l
+
+{- A item in conflict has two possible values.
+ - Either can be Nothing, when that side deleted the file. -}
+data Conflicting v = Conflicting
+	{ valUs :: Maybe v
+	, valThem :: Maybe v
+	} deriving (Show)
+
+data Unmerged = Unmerged
+	{ unmergedFile :: FilePath
+	, unmergedBlobType :: Conflicting BlobType
+	, unmergedSha :: Conflicting Sha
+	} deriving (Show)
+
+{- Returns a list of the files in the specified locations that have
+ - unresolved merge conflicts.
+ -
+ - ls-files outputs multiple lines per conflicting file, each with its own
+ - stage number:
+ -   1 = old version, can be ignored
+ -   2 = us
+ -   3 = them
+ - If a line is omitted, that side deleted the file.
+ -}
+unmerged :: [FilePath] -> Repo -> IO [Unmerged]
+unmerged l repo = reduceUnmerged [] . catMaybes . map parseUnmerged <$> list repo
+	where
+		files = map File l
+		list = pipeNullSplit $ Params "ls-files --unmerged -z --" : files
+
+data InternalUnmerged = InternalUnmerged
+	{ isus :: Bool
+	, ifile :: FilePath
+	, iblobtype :: Maybe BlobType
+	, isha :: Maybe Sha
+	} deriving (Show)
+
+parseUnmerged :: String -> Maybe InternalUnmerged
+parseUnmerged s
+	| null file || length ws < 3 = Nothing
+	| otherwise = do
+		stage <- readish (ws !! 2) :: Maybe Int
+		unless (stage == 2 || stage == 3) $
+			fail undefined -- skip stage 1
+		blobtype <- readBlobType (ws !! 0)
+		sha <- extractSha (ws !! 1)
+		return $ InternalUnmerged (stage == 2) file (Just blobtype) (Just sha)
+	where
+		(metadata, file) = separate (== '\t') s
+		ws = words metadata
+
+reduceUnmerged :: [Unmerged] -> [InternalUnmerged] -> [Unmerged]
+reduceUnmerged c [] = c
+reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
+	where
+		(rest, sibi) = findsib i is
+		(blobtypeA, blobtypeB, shaA, shaB)
+			| isus i    = (iblobtype i, iblobtype sibi, isha i, isha sibi)
+			| otherwise = (iblobtype sibi, iblobtype i, isha sibi, isha i)
+		new = Unmerged
+			{ unmergedFile = ifile i
+			, unmergedBlobType = Conflicting blobtypeA blobtypeB
+			, unmergedSha = Conflicting shaA shaB
+			}
+		findsib templatei [] = ([], deleted templatei)
+		findsib templatei (l:ls)
+			| ifile l == ifile templatei = (ls, l)
+			| otherwise = (l:ls, deleted templatei)
+		deleted templatei = templatei
+			{ isus = not (isus templatei)
+			, iblobtype = Nothing
+			, isha = Nothing
+			}
diff --git a/Git/Types.hs b/Git/Types.hs
index 1df6e343b..0c37427c7 100644
--- a/Git/Types.hs
+++ b/Git/Types.hs
@@ -51,6 +51,7 @@ type Tag = Ref
 
 {- Types of objects that can be stored in git. -}
 data ObjectType = BlobObject | CommitObject | TreeObject
+	deriving (Eq)
 
 instance Show ObjectType where
 	show BlobObject = "blob"
@@ -65,9 +66,16 @@ readObjectType _ = Nothing
 
 {- Types of blobs. -}
 data BlobType = FileBlob | ExecutableBlob | SymlinkBlob
+	deriving (Eq)
 
 {- Git uses magic numbers to denote the type of a blob. -}
 instance Show BlobType where
 	show FileBlob = "100644"
 	show ExecutableBlob = "100755"
 	show SymlinkBlob = "120000"
+
+readBlobType :: String -> Maybe BlobType
+readBlobType "100644" = Just FileBlob
+readBlobType "100755" = Just ExecutableBlob
+readBlobType "120000" = Just SymlinkBlob
+readBlobType _ = Nothing
diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs
index 0987f9131..504147e1d 100644
--- a/Git/UnionMerge.hs
+++ b/Git/UnionMerge.hs
@@ -10,8 +10,7 @@ module Git.UnionMerge (
 	mergeIndex
 ) where
 
-import qualified Data.Text.Lazy as L
-import qualified Data.Text.Lazy.Encoding as L
+import qualified Data.ByteString.Lazy as L
 import qualified Data.Set as S
 
 import Common
@@ -79,10 +78,14 @@ mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of
 		=<< calcMerge . zip shas <$> mapM getcontents shas
 	where
 		[_colonmode, _bmode, asha, bsha, _status] = words info
-		getcontents s = map L.unpack . L.lines .
-			L.decodeUtf8 <$> catObject h s
 		use sha = return $ Just $
 			updateIndexLine sha FileBlob $ asTopFilePath file
+		-- We don't know how the file is encoded, but need to
+		-- split it into lines to union merge. Using the
+		-- FileSystemEncoding for this is a hack, but ensures there
+		-- are no decoding errors. Note that this works because
+		-- streamUpdateIndex sets fileEncoding on its write handle.
+		getcontents s = lines . encodeW8 . L.unpack <$> catObject h s
 
 {- Calculates a union merge between a list of refs, with contents.
  -