From 7c12f0ac9224246dac308e837bccb5b2157062ee Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 15 Dec 2015 17:47:59 -0700 Subject: Import git-repair_1.20151215.orig.tar.xz [dgit import orig git-repair_1.20151215.orig.tar.xz] --- Build/Configure.hs | 30 +++++++++ Build/TestConfig.hs | 141 +++++++++++++++++++++++++++++++++++++++++++ Build/Version.hs | 69 +++++++++++++++++++++ Build/collect-ghc-options.sh | 12 ++++ Build/make-sdist.sh | 21 +++++++ 5 files changed, 273 insertions(+) create mode 100644 Build/Configure.hs create mode 100644 Build/TestConfig.hs create mode 100644 Build/Version.hs create mode 100755 Build/collect-ghc-options.sh create mode 100755 Build/make-sdist.sh (limited to 'Build') diff --git a/Build/Configure.hs b/Build/Configure.hs new file mode 100644 index 0000000..e488ee1 --- /dev/null +++ b/Build/Configure.hs @@ -0,0 +1,30 @@ +{- Checks system configuration and generates SysConfig.hs. -} + +module Build.Configure where + +import System.Environment +import Control.Applicative +import Control.Monad.IfElse + +import Build.TestConfig +import Build.Version +import Git.Version + +tests :: [TestCase] +tests = + [ TestCase "version" (Config "packageversion" . StringConfig <$> getVersion) + , TestCase "git" $ requireCmd "git" "git --version >/dev/null" + , TestCase "git version" getGitVersion + ] + +getGitVersion :: Test +getGitVersion = Config "gitversion" . StringConfig . show + <$> Git.Version.installed + +run :: [TestCase] -> IO () +run ts = do + args <- getArgs + config <- runTests ts + writeSysConfig config + whenM (isReleaseBuild) $ + cabalSetup "git-repair.cabal" diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs new file mode 100644 index 0000000..e55641f --- /dev/null +++ b/Build/TestConfig.hs @@ -0,0 +1,141 @@ +{- Tests the system and generates Build.SysConfig.hs. -} + +module Build.TestConfig where + +import Utility.Path +import Utility.Monad +import Utility.SafeCommand + +import System.IO +import System.FilePath +import System.Directory + +type ConfigKey = String +data ConfigValue = + BoolConfig Bool | + StringConfig String | + MaybeStringConfig (Maybe String) | + MaybeBoolConfig (Maybe Bool) +data Config = Config ConfigKey ConfigValue + +type Test = IO Config +type TestName = String +data TestCase = TestCase TestName Test + +instance Show ConfigValue where + show (BoolConfig b) = show b + show (StringConfig s) = show s + show (MaybeStringConfig s) = show s + show (MaybeBoolConfig s) = show s + +instance Show Config where + show (Config key value) = unlines + [ key ++ " :: " ++ valuetype value + , key ++ " = " ++ show value + ] + where + valuetype (BoolConfig _) = "Bool" + valuetype (StringConfig _) = "String" + valuetype (MaybeStringConfig _) = "Maybe String" + valuetype (MaybeBoolConfig _) = "Maybe Bool" + +writeSysConfig :: [Config] -> IO () +writeSysConfig config = writeFile "Build/SysConfig.hs" body + where + body = unlines $ header ++ map show config ++ footer + header = [ + "{- Automatically generated. -}" + , "module Build.SysConfig where" + , "" + ] + footer = [] + +runTests :: [TestCase] -> IO [Config] +runTests [] = return [] +runTests (TestCase tname t : ts) = do + testStart tname + c <- t + testEnd c + rest <- runTests ts + return $ c:rest + +{- Tests that a command is available, aborting if not. -} +requireCmd :: ConfigKey -> String -> Test +requireCmd k cmdline = do + ret <- testCmd k cmdline + handle ret + where + handle r@(Config _ (BoolConfig True)) = return r + handle r = do + testEnd r + error $ "** the " ++ c ++ " command is required" + c = head $ words cmdline + +{- Checks if a command is available by running a command line. -} +testCmd :: ConfigKey -> String -> Test +testCmd k cmdline = do + ok <- boolSystem "sh" [ Param "-c", Param $ quiet cmdline ] + return $ Config k (BoolConfig ok) + +{- Ensures that one of a set of commands is available by running each in + - turn. The Config is set to the first one found. -} +selectCmd :: ConfigKey -> [(String, String)] -> Test +selectCmd k = searchCmd + (return . Config k . StringConfig) + (\cmds -> do + testEnd $ Config k $ BoolConfig False + error $ "* need one of these commands, but none are available: " ++ show cmds + ) + +maybeSelectCmd :: ConfigKey -> [(String, String)] -> Test +maybeSelectCmd k = searchCmd + (return . Config k . MaybeStringConfig . Just) + (\_ -> return $ Config k $ MaybeStringConfig Nothing) + +searchCmd :: (String -> Test) -> ([String] -> Test) -> [(String, String)] -> Test +searchCmd success failure cmdsparams = search cmdsparams + where + search [] = failure $ fst $ unzip cmdsparams + search ((c, params):cs) = do + ok <- boolSystem "sh" [ Param "-c", Param $ quiet $ c ++ " " ++ params ] + if ok + then success c + else search cs + +{- Finds a command, either in PATH or perhaps in a sbin directory not in + - PATH. If it's in PATH the config is set to just the command name, + - but if it's found outside PATH, the config is set to the full path to + - the command. -} +findCmdPath :: ConfigKey -> String -> Test +findCmdPath k command = do + ifM (inPath command) + ( return $ Config k $ MaybeStringConfig $ Just command + , do + r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"] + return $ Config k $ MaybeStringConfig r + ) + where + find d = + let f = d command + in ifM (doesFileExist f) ( return (Just f), return Nothing ) + +quiet :: String -> String +quiet s = s ++ " >/dev/null 2>&1" + +testStart :: TestName -> IO () +testStart s = do + putStr $ " checking " ++ s ++ "..." + hFlush stdout + +testEnd :: Config -> IO () +testEnd (Config _ (BoolConfig True)) = status "yes" +testEnd (Config _ (BoolConfig False)) = status "no" +testEnd (Config _ (StringConfig s)) = status s +testEnd (Config _ (MaybeStringConfig (Just s))) = status s +testEnd (Config _ (MaybeStringConfig Nothing)) = status "not available" +testEnd (Config _ (MaybeBoolConfig (Just True))) = status "yes" +testEnd (Config _ (MaybeBoolConfig (Just False))) = status "no" +testEnd (Config _ (MaybeBoolConfig Nothing)) = status "unknown" + +status :: String -> IO () +status s = putStrLn $ ' ':s diff --git a/Build/Version.hs b/Build/Version.hs new file mode 100644 index 0000000..da9d1bb --- /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 Utility.Monad +import Utility.Exception + +type Version = String + +{- 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 :: IO Version +getVersion = do + changelogversion <- getChangelogVersion + ifM (isReleaseBuild) + ( return changelogversion + , catchDefaultIO changelogversion $ do + let major = takeWhile (/= '.') changelogversion + autoversion <- takeWhile (\c -> isAlphaNum c || c == '-') <$> 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 ] + ) + +getChangelogVersion :: IO Version +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 ++ ": " diff --git a/Build/collect-ghc-options.sh b/Build/collect-ghc-options.sh new file mode 100755 index 0000000..4f75a72 --- /dev/null +++ b/Build/collect-ghc-options.sh @@ -0,0 +1,12 @@ +#!/bin/sh +# Generate --ghc-options to pass LDFLAGS, CFLAGS, and CPPFLAGS through ghc +# and on to ld, cc, and cpp. +for w in $LDFLAGS; do + printf -- "-optl%s\n" "$w" +done +for w in $CFLAGS; do + printf -- "-optc%s\n" "$w" +done +for w in $CPPFLAGS; do + printf -- "-optc-Wp,%s\n" "$w" +done diff --git a/Build/make-sdist.sh b/Build/make-sdist.sh new file mode 100755 index 0000000..d4dbdb9 --- /dev/null +++ b/Build/make-sdist.sh @@ -0,0 +1,21 @@ +#!/bin/sh +# +# Workaround for `cabal sdist` requiring all included files to be listed +# in .cabal. + +# Create target directory +sdist_dir=git-repair-$(grep '^Version:' git-repair.cabal | sed -re 's/Version: *//') +mkdir --parents dist/$sdist_dir + +find . \( -name .git -or -name dist -or -name cabal-dev \) -prune \ + -or -not -name \\*.orig -not -type d -print \ +| perl -ne "print unless length >= 100 - length q{$sdist_dir}" \ +| xargs cp --parents --target-directory dist/$sdist_dir + +cd dist +tar --format=ustar -caf $sdist_dir.tar.gz $sdist_dir + +# Check that tarball can be unpacked by cabal. +# It's picky about tar longlinks etc. +rm -rf $sdist_dir +cabal unpack $sdist_dir.tar.gz -- cgit v1.2.3