better git version checking

Assistant/DeleteRemote.hs

@@ -18,7 +18,7 @@ import Assistant.DaemonStatus
 import qualified Remote
 import Remote.List
 import qualified Git.Command
-import qualified Git.Version
+import qualified Git.BuildVersion
 import Logs.Trust
 import qualified Annex
 
@@ -39,7 +39,7 @@ disableRemote uuid = do
 			[ Param "remote"
 			-- name of this subcommand changed
 			, Param $
-				if Git.Version.older "1.8.0"
+				if Git.BuildVersion.older "1.8.0"
 					then "rm"
 					else "remove"
 			, Param (Remote.name remote)

Assistant/Threads/Committer.hs

@@ -22,7 +22,7 @@ import Logs.Location
 import qualified Annex.Queue
 import qualified Git.Command
 import qualified Git.LsFiles
-import qualified Git.Version
+import qualified Git.BuildVersion
 import qualified Command.Add
 import Utility.ThreadScheduler
 import qualified Utility.Lsof as Lsof
@@ -234,9 +234,9 @@ commitStaged = do
 		, Param "--no-verify"
 		]
 	nomessage ps
-		| Git.Version.older "1.7.2" =
+		| Git.BuildVersion.older "1.7.2" =
 			Param "-m" : Param "autocommit" : ps
-		| Git.Version.older "1.7.8" =
+		| Git.BuildVersion.older "1.7.8" =
 			Param "--allow-empty-message" :
 			Param "-m" : Param "" : ps
 		| otherwise =

Build/Configure.hs

@@ -17,6 +17,7 @@ import Utility.SafeCommand
 import Utility.Monad
 import Utility.Exception
 import Utility.ExternalSHA
+import qualified Git.Version
 
 tests :: [TestCase]
 tests =
@@ -121,10 +122,8 @@ getChangelogVersion = do
 	middle = drop 1 . init
 
 getGitVersion :: Test
-getGitVersion = do
+getGitVersion = Config "gitversion" . StringConfig . show
-	s <- readProcess "git" ["--version"] ""
+	<$> Git.Version.installed
-	let version = unwords $ drop 2 $ words $ head $ lines s
-	return $ Config "gitversion" (StringConfig version)
 
 getSshConnectionCaching :: Test
 getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$>

Git/BuildVersion.hs

@@ -0,0 +1,21 @@
+{- git build version
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.BuildVersion where
+
+import Git.Version
+import qualified Build.SysConfig
+
+{- Using the version it was configured for avoids running git to check its
+ - version, at the cost that upgrading git won't be noticed.
+ - This is only acceptable because it's rare that git's version influences
+ - code's behavior. -}
+buildVersion :: GitVersion
+buildVersion = normalize Build.SysConfig.gitversion
+
+older :: String -> Bool
+older n = buildVersion < normalize n 

Git/CheckAttr.hs

@@ -10,7 +10,7 @@ module Git.CheckAttr where
 import Common
 import Git
 import Git.Command
-import qualified Git.Version
+import qualified Git.BuildVersion
 import qualified Utility.CoProcess as CoProcess
 
 type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], String)
@@ -54,7 +54,7 @@ checkAttr (h, attrs, cwd) want file = do
 	 - With newer git, git check-attr chokes on some absolute
 	 - filenames, and the bugs that necessitated them were fixed,
 	 - so use relative filenames. -}
-	oldgit = Git.Version.older "1.7.7"
+	oldgit = Git.BuildVersion.older "1.7.7"
 	file'
 		| oldgit = absPathFrom cwd file
 		| otherwise = relPathDirToFile cwd $ absPathFrom cwd file

Git/Merge.hs

@@ -10,7 +10,7 @@ module Git.Merge where
 import Common
 import Git
 import Git.Command
-import Git.Version
+import Git.BuildVersion
 
 {- Avoids recent git's interactive merge. -}
 mergeNonInteractive :: Ref -> Repo -> IO Bool

Git/Version.hs

@@ -1,6 +1,6 @@
-{- git version checking
+{- git versions
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011, 2013 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -8,24 +8,29 @@
 module Git.Version where
 
 import Common
-import qualified Build.SysConfig
 
-{- Using the version it was configured for avoids running git to check its
+data GitVersion = GitVersion String Integer
- - version, at the cost that upgrading git won't be noticed.
+	deriving (Eq)
- - This is only acceptable because it's rare that git's version influences
- - code's behavior. -}
-version :: String
-version = Build.SysConfig.gitversion
 
-older :: String -> Bool
+instance Ord GitVersion where
-older v = normalize version < normalize v
+	compare (GitVersion _ x) (GitVersion _ y) = compare x y
+
+instance Show GitVersion where
+	show (GitVersion s _) = s
+
+installed :: IO GitVersion
+installed = normalize . extract <$> readProcess "git" ["--version"]
+  where
+  	extract s = case lines s of
+		[] -> ""
+		(l:_) -> unwords $ drop 2 $ words l
 
 {- To compare dotted versions like 1.7.7 and 1.8, they are normalized to
  - a somewhat arbitrary integer representation. -}
-normalize :: String -> Integer
+normalize :: String -> GitVersion
-normalize = sum . mult 1 . reverse .
+normalize v = GitVersion v $ 
-		extend precision . take precision .
+	sum $ mult 1 $ reverse $ extend precision $ take precision $
-		map readi . split "."
+		map readi $ split "." v
   where
 	extend n l = l ++ replicate (n - length l) 0
 	mult _ [] = []