merge from git-annex

8 files changed, 106 insertions, 40 deletions

diff --git a/Git/Construct.hs b/Git/Construct.hs
index 5b20605..03dd29f 100644
--- a/Git/Construct.hs
+++ b/Git/Construct.hs
@@ -58,24 +58,29 @@ fromPath dir = fromAbsPath =<< absPath dir
  - specified. -}
 fromAbsPath :: FilePath -> IO Repo
 fromAbsPath dir
-	| absoluteGitPath dir = ifM (doesDirectoryExist dir') ( ret dir' , hunt )
+	| absoluteGitPath dir = hunt
 	| otherwise =
 		error $ "internal error, " ++ dir ++ " is not absolute"
   where
 	ret = pure . newFrom . LocalUnknown
-	{- Git always looks for "dir.git" in preference to
-	 - to "dir", even if dir ends in a "/". -}
 	canondir = dropTrailingPathSeparator dir
-	dir' = canondir ++ ".git"
 	{- When dir == "foo/.git", git looks for "foo/.git/.git",
 	 - and failing that, uses "foo" as the repository. -}
 	hunt
 		| (pathSeparator:".git") `isSuffixOf` canondir =
 			ifM (doesDirectoryExist $ dir </> ".git")
 				( ret dir
-				, ret $ takeDirectory canondir
+				, ret (takeDirectory canondir)
 				)
-		| otherwise = ret dir
+		| otherwise = ifM (doesDirectoryExist dir)
+			( ret dir
+			-- git falls back to dir.git when dir doesn't
+			-- exist, as long as dir didn't end with a
+			-- path separator
+			, if dir == canondir
+				then ret (dir ++ ".git")
+				else ret dir
+			)
 
 {- Remote Repo constructor. Throws exception on invalid url.
  -
diff --git a/Git/Destroyer.hs b/Git/Destroyer.hs
index 2ac4dae..e923796 100644
--- a/Git/Destroyer.hs
+++ b/Git/Destroyer.hs
@@ -21,7 +21,6 @@ import Utility.Tmp
 
 import qualified Data.ByteString as B
 import Data.Word
-import System.PosixCompat.Types
 
 {- Ways to damange a git repository. -}
 data Damage
diff --git a/Git/Filename.hs b/Git/Filename.hs
index 382eb8d..ee84d48 100644
--- a/Git/Filename.hs
+++ b/Git/Filename.hs
@@ -24,5 +24,5 @@ encode :: FilePath -> String
 encode s = "\"" ++ encode_c s ++ "\""
 
 {- for quickcheck -}
-prop_idempotent_deencode :: String -> Bool
-prop_idempotent_deencode s = s == decode (encode s)
+prop_isomorphic_deencode :: String -> Bool
+prop_isomorphic_deencode s = s == decode (encode s)
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index e80c1b2..f945838 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -35,14 +35,23 @@ import System.Posix.Types
 
 {- Scans for files that are checked into git at the specified locations. -}
 inRepo :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-inRepo l = pipeNullSplit $ Params "ls-files --cached -z --" : map File l
+inRepo l = pipeNullSplit $ 
+	Param "ls-files" :
+	Param "--cached" :
+	Param "-z" :
+	Param "--" :
+	map File l
 
 {- Scans for files at the specified locations that are not checked into git. -}
 notInRepo :: Bool -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 notInRepo include_ignored l repo = pipeNullSplit params repo
   where
-	params = [Params "ls-files --others"] ++ exclude ++
-		[Params "-z --"] ++ map File l
+	params = concat
+		[ [ Param "ls-files", Param "--others"]
+		, exclude
+		, [ Param "-z", Param "--" ]
+		, map File l
+		]
 	exclude
 		| include_ignored = []
 		| otherwise = [Param "--exclude-standard"]
@@ -50,28 +59,51 @@ notInRepo include_ignored l repo = pipeNullSplit params repo
 {- Finds all files in the specified locations, whether checked into git or
  - not. -}
 allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-allFiles l = pipeNullSplit $ Params "ls-files --cached --others -z --" : map File l
+allFiles l = pipeNullSplit $
+	Param "ls-files" :
+	Param "--cached" :
+	Param "--others" :
+	Param "-z" :
+	Param "--" :
+	map File l
 
 {- Returns a list of files in the specified locations that have been
  - deleted. -}
 deleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 deleted l repo = pipeNullSplit params repo
   where
-	params = [Params "ls-files --deleted -z --"] ++ map File l
+	params =
+		Param "ls-files" :
+		Param "--deleted" :
+		Param "-z" :
+		Param "--" :
+		map File l
 
 {- Returns a list of files in the specified locations that have been
  - modified. -}
 modified :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 modified l repo = pipeNullSplit params repo
   where
-	params = [Params "ls-files --modified -z --"] ++ map File l
+	params = 
+		Param "ls-files" :
+		Param "--modified" :
+		Param "-z" :
+		Param "--" :
+		map File l
 
 {- Files that have been modified or are not checked into git (and are not
  - ignored). -}
 modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 modifiedOthers l repo = pipeNullSplit params repo
   where
-	params = [Params "ls-files --modified --others --exclude-standard -z --"] ++ map File l
+	params = 
+		Param "ls-files" :
+		Param "--modified" :
+		Param "--others" :
+		Param "--exclude-standard" :
+		Param "-z" :
+		Param "--" :
+		map File l
 
 {- Returns a list of all files that are staged for commit. -}
 staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
@@ -85,7 +117,7 @@ stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
 staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
 staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
   where
-	prefix = [Params "diff --cached --name-only -z"]
+	prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
 	suffix = Param "--" : map File l
 
 type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)
@@ -93,7 +125,7 @@ type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)
 {- Returns details about files that are staged in the index,
  - as well as files not yet in git. Skips ignored files. -}
 stagedOthersDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
-stagedOthersDetails = stagedDetails' [Params "--others --exclude-standard"]
+stagedOthersDetails = stagedDetails' [Param "--others", Param "--exclude-standard"]
 
 {- Returns details about all files that are staged in the index. -}
 stagedDetails :: [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
@@ -106,7 +138,7 @@ stagedDetails' ps l repo = do
 	(ls, cleanup) <- pipeNullSplit params repo
 	return (map parse ls, cleanup)
   where
-	params = Params "ls-files --stage -z" : ps ++ 
+	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
 		Param "--" : map File l
 	parse s
 		| null file = (s, Nothing, Nothing)
@@ -135,7 +167,12 @@ typeChanged' ps l repo = do
 	currdir <- getCurrentDirectory
 	return (map (\f -> relPathDirToFileAbs currdir $ top </> f) fs, cleanup)
   where
-	prefix = [Params "diff --name-only --diff-filter=T -z"]
+	prefix = 
+		[ Param "diff"
+		, Param "--name-only"
+		, Param "--diff-filter=T"
+		, Param "-z"
+		]
 	suffix = Param "--" : (if null l then [File "."] else map File l)
 
 {- A item in conflict has two possible values.
@@ -166,7 +203,12 @@ unmerged l repo = do
 	(fs, cleanup) <- pipeNullSplit params repo
 	return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
   where
-	params = Params "ls-files --unmerged -z --" : map File l
+	params = 
+		Param "ls-files" :
+		Param "--unmerged" :
+		Param "-z" :
+		Param "--" :
+		map File l
 
 data InternalUnmerged = InternalUnmerged
 	{ isus :: Bool
diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 7ef9518..1ed6247 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -13,10 +13,6 @@ module Git.LsTree (
 	parseLsTree
 ) where
 
-import Numeric
-import Control.Applicative
-import System.Posix.Types
-
 import Common
 import Git
 import Git.Command
@@ -24,6 +20,9 @@ import Git.Sha
 import Git.FilePath
 import qualified Git.Filename
 
+import Numeric
+import System.Posix.Types
+
 data TreeItem = TreeItem
 	{ mode :: FileMode
 	, typeobj :: String
@@ -35,16 +34,30 @@ data TreeItem = TreeItem
  - with lazy output. -}
 lsTree :: Ref -> Repo -> IO [TreeItem]
 lsTree t repo = map parseLsTree
-	<$> pipeNullSplitZombie (lsTreeParams t) repo
+	<$> pipeNullSplitZombie (lsTreeParams t []) repo
 
-lsTreeParams :: Ref -> [CommandParam]
-lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ fromRef t ]
+lsTreeParams :: Ref -> [CommandParam] -> [CommandParam]
+lsTreeParams r ps =
+	[ Param "ls-tree"
+	, Param "--full-tree"
+	, Param "-z"
+	, Param "-r"
+	] ++ ps ++
+	[ Param "--"
+	, File $ fromRef r
+	]
 
 {- Lists specified files in a tree. -}
 lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
 lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
   where
-	ps = [Params "ls-tree --full-tree -z --", File $ fromRef t] ++ map File fs
+	ps =
+		[ Param "ls-tree"
+		, Param "--full-tree"
+		, Param "-z"
+		, Param "--"
+		, File $ fromRef t
+		] ++ map File fs
 
 {- Parses a line of ls-tree output.
  - (The --long format is not currently supported.) -}
diff --git a/Git/RefLog.hs b/Git/RefLog.hs
index 7c20047..57f35e9 100644
--- a/Git/RefLog.hs
+++ b/Git/RefLog.hs
@@ -14,14 +14,17 @@ import Git.Sha
 
 {- Gets the reflog for a given branch. -}
 get :: Branch -> Repo -> IO [Sha]
-get = get' []
+get b = getMulti [b]
 
-get' :: [CommandParam] -> Branch -> Repo -> IO [Sha]
-get' ps b = mapMaybe extractSha . lines <$$> pipeReadStrict ps'
+{- Gets reflogs for multiple branches. -}
+getMulti :: [Branch] -> Repo -> IO [Sha]
+getMulti bs = get' (map (Param . fromRef) bs)
+
+get' :: [CommandParam] -> Repo -> IO [Sha]
+get' ps = mapMaybe extractSha . lines <$$> pipeReadStrict ps'
   where
-	ps' = 
-		[ Param "log"
-		, Param "-g"
-		, Param "--format=%H"
-		, Param (fromRef b)
+	ps' = catMaybes
+		[ Just $ Param "log"
+		, Just $ Param "-g"
+		, Just $ Param "--format=%H"
 		] ++ ps
diff --git a/Git/Repair.hs b/Git/Repair.hs
index 2557e3b..b441f13 100644
--- a/Git/Repair.hs
+++ b/Git/Repair.hs
@@ -99,7 +99,7 @@ retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResult
 retrieveMissingObjects missing referencerepo r
 	| not (foundBroken missing) = return missing
 	| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do
-		unlessM (boolSystem "git" [Params "init", File tmpdir]) $
+		unlessM (boolSystem "git" [Param "init", File tmpdir]) $
 			error $ "failed to create temp repository in " ++ tmpdir
 		tmpr <- Config.read =<< Construct.fromAbsPath tmpdir
 		stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing
@@ -140,7 +140,9 @@ retrieveMissingObjects missing referencerepo r
 		ps' = 
 			[ Param "fetch"
 			, Param fetchurl
-			, Params "--force --update-head-ok --quiet"
+			, Param "--force"
+			, Param "--update-head-ok"
+			, Param "--quiet"
 			] ++ ps
 		fetchr' = fetchr { gitGlobalOpts = gitGlobalOpts fetchr ++ nogc }
 		nogc = [ Param "-c", Param "gc.auto=0" ]
@@ -339,7 +341,7 @@ verifyTree :: MissingObjects -> Sha -> Repo -> IO Bool
 verifyTree missing treesha r
 	| S.member treesha missing = return False
 	| otherwise = do
-		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams treesha) r
+		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams treesha []) r
 		let objshas = map (extractSha . LsTree.sha . LsTree.parseLsTree) ls
 		if any isNothing objshas || any (`S.member` missing) (catMaybes objshas)
 			then do
diff --git a/Git/Version.hs b/Git/Version.hs
index ecd1244..19ff945 100644
--- a/Git/Version.hs
+++ b/Git/Version.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# OPTIONS_GHC -fno-warn-tabs #-}
+
 module Git.Version (
 	installed,
 	older,