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, 31 insertions, 30 deletions

diff --git a/Git/Fsck.hs b/Git/Fsck.hs
index a716b56..6f33e11 100644
--- a/Git/Fsck.hs
+++ b/Git/Fsck.hs
@@ -2,7 +2,7 @@
  -
  - Copyright 2013 Joey Hess <id@joeyh.name>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - Licensed under the GNU AGPL version 3 or higher.
  -}
 
 {-# LANGUAGE BangPatterns #-}
@@ -22,10 +22,11 @@ import Git
 import Git.Command
 import Git.Sha
 import Utility.Batch
-import qualified Git.Version
 
 import qualified Data.Set as S
 import Control.Concurrent.Async
+import qualified Data.Semigroup as Sem
+import Prelude
 
 data FsckResults 
 	= FsckFoundMissing
@@ -44,15 +45,21 @@ type MissingObjects = S.Set Sha
 
 type Truncated = Bool
 
+appendFsckOutput :: FsckOutput -> FsckOutput -> FsckOutput
+appendFsckOutput (FsckOutput s1 t1) (FsckOutput s2 t2) =
+	FsckOutput (S.union s1 s2) (t1 || t2)
+appendFsckOutput (FsckOutput s t) _ = FsckOutput s t
+appendFsckOutput _ (FsckOutput s t) = FsckOutput s t
+appendFsckOutput NoFsckOutput NoFsckOutput = NoFsckOutput
+appendFsckOutput AllDuplicateEntriesWarning AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
+appendFsckOutput AllDuplicateEntriesWarning NoFsckOutput = AllDuplicateEntriesWarning
+appendFsckOutput NoFsckOutput AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
+
+instance Sem.Semigroup FsckOutput where
+	(<>) = appendFsckOutput
+
 instance Monoid FsckOutput where
 	mempty = NoFsckOutput
-	mappend (FsckOutput s1 t1) (FsckOutput s2 t2) = FsckOutput (S.union s1 s2) (t1 || t2)
-	mappend (FsckOutput s t) _ = FsckOutput s t
-	mappend _ (FsckOutput s t) = FsckOutput s t
-	mappend NoFsckOutput NoFsckOutput = NoFsckOutput
-	mappend AllDuplicateEntriesWarning AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
-	mappend AllDuplicateEntriesWarning NoFsckOutput = AllDuplicateEntriesWarning
-	mappend NoFsckOutput AllDuplicateEntriesWarning = AllDuplicateEntriesWarning
 
 {- Runs fsck to find some of the broken objects in the repository.
  - May not find all broken objects, if fsck fails on bad data in some of
@@ -65,9 +72,7 @@ instance Monoid FsckOutput where
  -}
 findBroken :: Bool -> Repo -> IO FsckResults
 findBroken batchmode r = do
-	supportsNoDangling <- (>= Git.Version.normalize "1.7.10")
-		<$> Git.Version.installed
-	let (command, params) = ("git", fsckParams supportsNoDangling r)
+	let (command, params) = ("git", fsckParams r)
 	(command', params') <- if batchmode
 		then toBatchCommand (command, params)
 		else return (command, params)
@@ -78,8 +83,8 @@ findBroken batchmode r = do
 			, std_err = CreatePipe
 			}
 	(o1, o2) <- concurrently
-		(parseFsckOutput maxobjs r supportsNoDangling (stdoutHandle p))
-		(parseFsckOutput maxobjs r supportsNoDangling (stderrHandle p))
+		(parseFsckOutput maxobjs r (stdoutHandle p))
+		(parseFsckOutput maxobjs r (stderrHandle p))
 	fsckok <- checkSuccessProcess pid
 	case mappend o1 o2 of
 		FsckOutput badobjs truncated
@@ -112,15 +117,15 @@ knownMissing (FsckFoundMissing s _) = s
 findMissing :: [Sha] -> Repo -> IO MissingObjects
 findMissing objs r = S.fromList <$> filterM (`isMissing` r) objs
 
-parseFsckOutput :: Int -> Repo -> Bool -> Handle -> IO FsckOutput
-parseFsckOutput maxobjs r supportsNoDangling h = do
+parseFsckOutput :: Int -> Repo -> Handle -> IO FsckOutput
+parseFsckOutput maxobjs r h = do
 	ls <- lines <$> hGetContents h
 	if null ls
 		then return NoFsckOutput
 		else if all ("duplicateEntries" `isInfixOf`) ls
 			then return AllDuplicateEntriesWarning
 			else do
-				let shas = findShas supportsNoDangling ls
+				let shas = findShas ls
 				let !truncated = length shas > maxobjs
 				missingobjs <- findMissing (take maxobjs shas) r
 				return $ FsckOutput missingobjs truncated
@@ -133,18 +138,14 @@ isMissing s r = either (const True) (const False) <$> tryIO dump
 		, Param (fromRef s)
 		] r
 
-findShas :: Bool -> [String] -> [Sha]
-findShas supportsNoDangling = catMaybes . map extractSha . concat . map words . filter wanted
+findShas :: [String] -> [Sha]
+findShas = catMaybes . map extractSha . concat . map words . filter wanted
   where
-	wanted l
-		| supportsNoDangling = True
-		| otherwise = not ("dangling " `isPrefixOf` l)
-
-fsckParams :: Bool -> Repo -> [CommandParam]
-fsckParams supportsNoDangling = gitCommandLine $ map Param $ catMaybes
-	[ Just "fsck"
-	, if supportsNoDangling
-		then Just "--no-dangling"
-		else Nothing
-	, Just "--no-reflogs"
+	wanted l = not ("dangling " `isPrefixOf` l)
+
+fsckParams :: Repo -> [CommandParam]
+fsckParams = gitCommandLine $ map Param
+	[ "fsck"
+	, "--no-dangling"
+	, "--no-reflogs"
 	]