summaryrefslogtreecommitdiff
path: root/Build/Version.hs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@debian.org>2013-11-22 11:16:03 -0400
committerJoey Hess <joeyh@debian.org>2013-11-22 11:16:03 -0400
commit7e592e1d6ed5e0b25b37215da7558c6324688d6f (patch)
tree75a86ff02e9311bcff817f2dcfe9b0a6ca1b5708 /Build/Version.hs
downloadgit-repair-7e592e1d6ed5e0b25b37215da7558c6324688d6f.tar.gz
git-repair (1.20131122) unstable; urgency=low
* Added test mode, which can be used to randomly corrupt test repositories, in reproducible ways, which allows easy corruption-driven-development. * Improve repair code in the case where the index file is corrupt, and this hides other problems. * Write a dummy .git/HEAD if the file is missing or corrupt, as git otherwise will not treat the repository as a git repo. * Improve fsck code to find badly corrupted objects that crash git fsck before it can complain about them. * Fixed crashes on bad file encodings. * Can now run 10000 tests (git-repair --test -n 10000 --force) with 0 failures. # imported from the archive
Diffstat (limited to 'Build/Version.hs')
-rw-r--r--Build/Version.hs69
1 files changed, 69 insertions, 0 deletions
diff --git a/Build/Version.hs b/Build/Version.hs
new file mode 100644
index 0000000..98e0dbf
--- /dev/null
+++ b/Build/Version.hs
@@ -0,0 +1,69 @@
+{- Package version determination, for configure script. -}
+
+module Build.Version where
+
+import Data.Maybe
+import Control.Applicative
+import Data.List
+import System.Environment
+import System.Directory
+import Data.Char
+import System.Process
+
+import Build.TestConfig
+import Utility.Monad
+import Utility.Exception
+
+{- Set when making an official release. (Distribution vendors should set
+ - this too.) -}
+isReleaseBuild :: IO Bool
+isReleaseBuild = isJust <$> catchMaybeIO (getEnv "RELEASE_BUILD")
+
+{- Version is usually based on the major version from the changelog,
+ - plus the date of the last commit, plus the git rev of that commit.
+ - This works for autobuilds, ad-hoc builds, etc.
+ -
+ - If git or a git repo is not available, or something goes wrong,
+ - or this is a release build, just use the version from the changelog. -}
+getVersion :: Test
+getVersion = do
+ changelogversion <- getChangelogVersion
+ version <- ifM (isReleaseBuild)
+ ( return changelogversion
+ , catchDefaultIO changelogversion $ do
+ let major = takeWhile (/= '.') changelogversion
+ autoversion <- readProcess "sh"
+ [ "-c"
+ , "git log -n 1 --format=format:'%ci %h'| sed -e 's/-//g' -e 's/ .* /-g/'"
+ ] ""
+ if null autoversion
+ then return changelogversion
+ else return $ concat [ major, ".", autoversion ]
+ )
+ return $ Config "packageversion" (StringConfig version)
+
+getChangelogVersion :: IO String
+getChangelogVersion = do
+ changelog <- readFile "debian/changelog"
+ let verline = takeWhile (/= '\n') changelog
+ return $ middle (words verline !! 1)
+ where
+ middle = drop 1 . init
+
+{- Set up cabal file with version. -}
+cabalSetup :: FilePath -> IO ()
+cabalSetup cabalfile = do
+ version <- takeWhile (\c -> isDigit c || c == '.')
+ <$> getChangelogVersion
+ cabal <- readFile cabalfile
+ writeFile tmpcabalfile $ unlines $
+ map (setfield "Version" version) $
+ lines cabal
+ renameFile tmpcabalfile cabalfile
+ where
+ tmpcabalfile = cabalfile++".tmp"
+ setfield field value s
+ | fullfield `isPrefixOf` s = fullfield ++ value
+ | otherwise = s
+ where
+ fullfield = field ++ ": "