merge from git-annex and relicense accordingly

Merge git library and utility from git-annex. The former is now relicensed
AGPL, so git-repair as a whole becomes AGPL.

For simplicity, I am relicensing the remainder of the code in git-repair
AGPL as well, per the header changes in this commit. While that code is
also technically available under the GPL license, as it's been released
under that license before, changes going forward will be only released by
me under the AGPL.

1 files changed, 84 insertions, 62 deletions

diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index f945838..5534307 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -1,13 +1,15 @@
 {- git ls-files interface
  -
- - Copyright 2010,2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2018 Joey Hess <id@joeyh.name>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - Licensed under the GNU AGPL version 3 or higher.
  -}
 
 module Git.LsFiles (
 	inRepo,
+	inRepoOrBranch,
 	notInRepo,
+	notInRepoIncludingEmptyDirectories,
 	allFiles,
 	deleted,
 	modified,
@@ -32,69 +34,89 @@ import Git.Sha
 
 import Numeric
 import System.Posix.Types
+import qualified Data.ByteString.Lazy as L
 
-{- Scans for files that are checked into git at the specified locations. -}
-inRepo :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-inRepo l = pipeNullSplit $ 
-	Param "ls-files" :
-	Param "--cached" :
-	Param "-z" :
-	Param "--" :
-	map File l
+{- Scans for files that are checked into git's index at the specified locations. -}
+inRepo :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+inRepo = inRepo' [] 
+
+inRepo' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+inRepo' ps l repo = pipeNullSplit' params repo
+  where
+	params = 
+		Param "ls-files" :
+		Param "--cached" :
+		Param "-z" :
+		ps ++
+		(Param "--" : map (File . fromRawFilePath) l)
+
+{- Files that are checked into the index or have been committed to a
+ - branch. -}
+inRepoOrBranch :: Branch -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+inRepoOrBranch (Ref b) = inRepo' [Param $ "--with-tree=" ++ b]
 
 {- 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
+notInRepo :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+notInRepo = notInRepo' []
+
+notInRepo' :: [CommandParam] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+notInRepo' ps include_ignored l repo = pipeNullSplit' params repo
   where
 	params = concat
 		[ [ Param "ls-files", Param "--others"]
+		, ps
 		, exclude
 		, [ Param "-z", Param "--" ]
-		, map File l
+		, map (File . fromRawFilePath) l
 		]
 	exclude
 		| include_ignored = []
 		| otherwise = [Param "--exclude-standard"]
 
+{- Scans for files at the specified locations that are not checked into
+ - git. Empty directories are included in the result. -}
+notInRepoIncludingEmptyDirectories :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+notInRepoIncludingEmptyDirectories = notInRepo' [Param "--directory"]
+
 {- Finds all files in the specified locations, whether checked into git or
  - not. -}
-allFiles :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-allFiles l = pipeNullSplit $
+allFiles :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+allFiles l = pipeNullSplit' $
 	Param "ls-files" :
 	Param "--cached" :
 	Param "--others" :
 	Param "-z" :
 	Param "--" :
-	map File l
+	map (File . fromRawFilePath) 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
+deleted :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+deleted l repo = pipeNullSplit' params repo
   where
 	params =
 		Param "ls-files" :
 		Param "--deleted" :
 		Param "-z" :
 		Param "--" :
-		map File l
+		map (File . fromRawFilePath) 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
+modified :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+modified l repo = pipeNullSplit' params repo
   where
 	params = 
 		Param "ls-files" :
 		Param "--modified" :
 		Param "-z" :
 		Param "--" :
-		map File l
+		map (File . fromRawFilePath) 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
+modifiedOthers :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+modifiedOthers l repo = pipeNullSplit' params repo
   where
 	params = 
 		Param "ls-files" :
@@ -103,69 +125,69 @@ modifiedOthers l repo = pipeNullSplit params repo
 		Param "--exclude-standard" :
 		Param "-z" :
 		Param "--" :
-		map File l
+		map (File . fromRawFilePath) l
 
 {- Returns a list of all files that are staged for commit. -}
-staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+staged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 staged = staged' []
 
 {- Returns a list of the files, staged for commit, that are being added,
  - moved, or changed (but not deleted), from the specified locations. -}
-stagedNotDeleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+stagedNotDeleted :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
 
-staged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
-staged' ps l = pipeNullSplit $ prefix ++ ps ++ suffix
+staged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
+staged' ps l repo = pipeNullSplit' (prefix ++ ps ++ suffix) repo
   where
 	prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
-	suffix = Param "--" : map File l
+	suffix = Param "--" : map (File . fromRawFilePath) l
 
-type StagedDetails = (FilePath, Maybe Sha, Maybe FileMode)
+type StagedDetails = (RawFilePath, 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 :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 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)
+stagedDetails :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails = stagedDetails' []
 
 {- Gets details about staged files, including the Sha of their staged
  - contents. -}
-stagedDetails' :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedDetails], IO Bool)
+stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
 stagedDetails' ps l repo = do
 	(ls, cleanup) <- pipeNullSplit params repo
 	return (map parse ls, cleanup)
   where
 	params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++ 
-		Param "--" : map File l
+		Param "--" : map (File . fromRawFilePath) l
 	parse s
-		| null file = (s, Nothing, Nothing)
-		| otherwise = (file, extractSha $ take shaSize rest, readmode mode)
+		| null file = (L.toStrict s, Nothing, Nothing)
+		| otherwise = (toRawFilePath file, extractSha $ take shaSize rest, readmode mode)
 	  where
-		(metadata, file) = separate (== '\t') s
+		(metadata, file) = separate (== '\t') (decodeBL' s)
 		(mode, rest) = separate (== ' ') metadata
 		readmode = fst <$$> headMaybe . readOct
 
 {- Returns a list of the files in the specified locations that are staged
  - for commit, and whose type has changed. -}
-typeChangedStaged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+typeChangedStaged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 typeChangedStaged = typeChanged' [Param "--cached"]
 
 {- Returns a list of the files in the specified locations whose type has
  - changed.  Files only staged for commit will not be included. -}
-typeChanged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+typeChanged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 typeChanged = typeChanged' []
 
-typeChanged' :: [CommandParam] -> [FilePath] -> Repo -> IO ([FilePath], IO Bool)
+typeChanged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 typeChanged' ps l repo = do
 	(fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo
 	-- git diff returns filenames relative to the top of the git repo;
 	-- convert to filenames relative to the cwd, like git ls-files.
-	top <- absPath (repoPath repo)
+	top <- absPath (fromRawFilePath (repoPath repo))
 	currdir <- getCurrentDirectory
-	return (map (\f -> relPathDirToFileAbs currdir $ top </> f) fs, cleanup)
+	return (map (\f -> toRawFilePath (relPathDirToFileAbs currdir $ top </> decodeBL' f)) fs, cleanup)
   where
 	prefix = 
 		[ Param "diff"
@@ -173,7 +195,7 @@ typeChanged' ps l repo = do
 		, Param "--diff-filter=T"
 		, Param "-z"
 		]
-	suffix = Param "--" : (if null l then [File "."] else map File l)
+	suffix = Param "--" : (if null l then [File "."] else map (File . fromRawFilePath) l)
 
 {- A item in conflict has two possible values.
  - Either can be Nothing, when that side deleted the file. -}
@@ -183,10 +205,10 @@ data Conflicting v = Conflicting
 	} deriving (Show)
 
 data Unmerged = Unmerged
-	{ unmergedFile :: FilePath
-	, unmergedBlobType :: Conflicting BlobType
+	{ unmergedFile :: RawFilePath
+	, unmergedTreeItemType :: Conflicting TreeItemType
 	, unmergedSha :: Conflicting Sha
-	} deriving (Show)
+	}
 
 {- Returns a list of the files in the specified locations that have
  - unresolved merge conflicts.
@@ -198,38 +220,38 @@ data Unmerged = Unmerged
  -   3 = them
  - If a line is omitted, that side removed the file.
  -}
-unmerged :: [FilePath] -> Repo -> IO ([Unmerged], IO Bool)
+unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool)
 unmerged l repo = do
 	(fs, cleanup) <- pipeNullSplit params repo
-	return (reduceUnmerged [] $ catMaybes $ map parseUnmerged fs, cleanup)
+	return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL') fs, cleanup)
   where
 	params = 
 		Param "ls-files" :
 		Param "--unmerged" :
 		Param "-z" :
 		Param "--" :
-		map File l
+		map (File . fromRawFilePath) l
 
 data InternalUnmerged = InternalUnmerged
 	{ isus :: Bool
-	, ifile :: FilePath
-	, iblobtype :: Maybe BlobType
+	, ifile :: RawFilePath
+	, itreeitemtype :: Maybe TreeItemType
 	, isha :: Maybe Sha
-	} deriving (Show)
+	}
 
 parseUnmerged :: String -> Maybe InternalUnmerged
 parseUnmerged s
 	| null file = Nothing
 	| otherwise = case words metadata of
-		(rawblobtype:rawsha:rawstage:_) -> do
+		(rawtreeitemtype:rawsha:rawstage:_) -> do
 			stage <- readish rawstage :: Maybe Int
 			if stage /= 2 && stage /= 3
 				then Nothing
 				else do
-					blobtype <- readBlobType rawblobtype
+					treeitemtype <- readTreeItemType (encodeBS rawtreeitemtype)
 					sha <- extractSha rawsha
-					return $ InternalUnmerged (stage == 2) file
-						(Just blobtype) (Just sha)
+					return $ InternalUnmerged (stage == 2) (toRawFilePath file)
+						(Just treeitemtype) (Just sha)
 		_ -> Nothing
   where
 	(metadata, file) = separate (== '\t') s
@@ -239,12 +261,12 @@ 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)
+	(treeitemtypeA, treeitemtypeB, shaA, shaB)
+		| isus i    = (itreeitemtype i, itreeitemtype sibi, isha i, isha sibi)
+		| otherwise = (itreeitemtype sibi, itreeitemtype i, isha sibi, isha i)
 	new = Unmerged
 		{ unmergedFile = ifile i
-		, unmergedBlobType = Conflicting blobtypeA blobtypeB
+		, unmergedTreeItemType = Conflicting treeitemtypeA treeitemtypeB
 		, unmergedSha = Conflicting shaA shaB
 		}
 	findsib templatei [] = ([], removed templatei)
@@ -253,6 +275,6 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
 		| otherwise = (l:ls, removed templatei)
 	removed templatei = templatei
 		{ isus = not (isus templatei)
-		, iblobtype = Nothing
+		, itreeitemtype = Nothing
 		, isha = Nothing
 		}