Stefan O'Rear wrote:
Besides, remember that 50 patches is
50x the documentation :)
Yes, but it's 50x the blundering about when trying to review the code :-)
Here's a seemingly reasonable compromise. I've attached a single
unified diff that contains all of my changes in a single lump. If the
code looks sane, you can then "darcs pull" the real changes and see if
the history "smells right".
There shouldn't be any review surprises. The only "unrelated" change it
makes is to check the return code from tar in SrcDist, something that
must have been overlooked.
The actual darcs history is pretty clean, too. Small, self-contained
changes, etc, etc.
<b
Cabal.cabal | 3
Distribution/Setup.hs | 87 +++
Distribution/Simple.hs | 17
Distribution/Simple/Rpm.hs | 497 +++++++++++++++++++++
Distribution/Simple/SrcDist.hs | 66 ++
5 files changed, 649 insertions(+), 21 deletions(-)
diff --exclude '.*' --exclude dist --exclude _darcs --exclude '*~' -urN cabal/Cabal.cabal cabal-rpm/Cabal.cabal
--- cabal/Cabal.cabal 2007-02-16 14:06:42.000000000 -0800
+++ cabal-rpm/Cabal.cabal 2007-02-18 09:52:36.000000000 -0800
@@ -5,7 +5,7 @@
CC-Options: "-DCABAL_VERSION=1,1,7"
Copyright: 2003-2006, Isaac Jones
-- For ghc 6.2 you need to add 'unix' to Build-Depends:
-Build-Depends: base
+Build-Depends: base, time
License: BSD3
License-File: LICENSE
Author: Isaac Jones <[EMAIL PROTECTED]>
@@ -46,6 +46,7 @@
Distribution.Simple.LocalBuildInfo,
Distribution.Simple.NHC,
Distribution.Simple.Register,
+ Distribution.Simple.Rpm,
Distribution.Simple.SrcDist,
Distribution.Simple.Utils,
Distribution.Version,
diff --exclude '.*' --exclude dist --exclude _darcs --exclude '*~' -urN cabal/Distribution/Setup.hs cabal-rpm/Distribution/Setup.hs
--- cabal/Distribution/Setup.hs 2007-02-16 14:06:42.000000000 -0800
+++ cabal-rpm/Distribution/Setup.hs 2007-02-20 13:31:08.000000000 -0800
@@ -50,7 +50,7 @@
HaddockFlags(..), emptyHaddockFlags, emptyCleanFlags,
BuildFlags(..), CleanFlags(..), PFEFlags(..),
RegisterFlags(..), emptyRegisterFlags,
- SDistFlags(..),
+ SDistFlags(..), RpmFlags(..), emptyRpmFlags,
MaybeUserFlag(..), userOverride,
--optionHelpString,
#ifdef DEBUG
@@ -60,8 +60,8 @@
parseConfigureArgs, parseBuildArgs, parseCleanArgs,
parseHaddockArgs, parseProgramaticaArgs, parseTestArgs,
parseInstallArgs, parseSDistArgs, parseRegisterArgs,
- parseUnregisterArgs, parseCopyArgs,
- reqPathArg, reqDirArg
+ parseUnregisterArgs, parseCopyArgs, parseRpmArgs,
+ reqPathArg, reqDirArg, reqStrArg
) where
@@ -92,6 +92,7 @@
| ProgramaticaCmd -- pfesetup
| InstallCmd -- install (install-prefix)
| SDistCmd -- sdist
+ | RpmCmd -- rpm
| TestCmd -- test
| RegisterCmd -- register
| UnregisterCmd -- unregister
@@ -213,6 +214,30 @@
,sDistVerbose:: Int}
deriving Show
+-- | Flags to @rpm@: (verbose)
+data RpmFlags = RpmFlags { rpmVerbose :: Int
+ , rpmGenSpec :: Bool
+ , rpmCompiler :: Maybe CompilerFlavor
+ , rpmLibProf :: Bool
+ , rpmName :: Maybe String
+ , rpmVersion :: Maybe String
+ , rpmRelease :: Maybe String
+ , rpmHaddock :: Bool
+ , rpmTopDir :: Maybe String
+ }
+ deriving Show
+
+emptyRpmFlags = RpmFlags { rpmVerbose = 0
+ , rpmGenSpec = False
+ , rpmCompiler = defaultCompilerFlavor
+ , rpmLibProf = True
+ , rpmName = Nothing
+ , rpmVersion = Nothing
+ , rpmRelease = Nothing
+ , rpmHaddock = True
+ , rpmTopDir = Nothing
+ }
+
-- | Flags to @register@ and @unregister@: (user package, gen-script,
-- in-place, verbose)
data RegisterFlags = RegisterFlags {regUser::MaybeUserFlag
@@ -285,6 +310,13 @@
| DestDir FilePath
-- For sdist:
| Snapshot
+ -- For rpm
+ | GenSpec
+ | RpmName String
+ | RpmVersion String
+ | RpmRelease String
+ | WithoutHaddock
+ | RpmTopDir String
-- For haddock:
| HaddockHoogle
-- For clean:
@@ -377,7 +409,7 @@
commandList :: ProgramConfiguration -> [Cmd a]
commandList progConf = [(configureCmd progConf), buildCmd, cleanCmd, installCmd,
- copyCmd, sdistCmd, testCmd, haddockCmd, programaticaCmd,
+ copyCmd, sdistCmd, rpmCmd, testCmd, haddockCmd, programaticaCmd,
registerCmd, unregisterCmd]
lookupCommand :: String -> [Cmd a] -> Maybe (Cmd a)
@@ -533,6 +565,9 @@
reqDirArg :: (FilePath -> a) -> ArgDescr a
reqDirArg constr = ReqArg (constr . platformPath) "DIR"
+reqStrArg :: (String -> a) -> ArgDescr a
+reqStrArg constr = ReqArg constr "STRING"
+
parseConfigureArgs :: ProgramConfiguration -> ConfigFlags -> [String] -> [OptDescr a] ->
IO (ConfigFlags, [a], [String])
parseConfigureArgs progConf = parseArgs (configureCmd progConf) updateCfg
@@ -710,6 +745,50 @@
Verbose n -> (SDistFlags snapshot n)
_ -> error $ "Unexpected flag!"
+rpmCmd :: Cmd a
+rpmCmd = Cmd {
+ cmdName = "rpm",
+ cmdHelp = "Generate an RPM package.",
+ cmdDescription = "", -- This can be a multi-line description
+ cmdOptions = [cmd_help,cmd_verbose,
+ Option "g" ["ghc"] (NoArg GhcFlag) "compile with GHC",
+ Option "n" ["nhc"] (NoArg NhcFlag) "compile with NHC",
+ Option "" ["jhc"] (NoArg JhcFlag) "compile with JHC",
+ Option "" ["hugs"] (NoArg HugsFlag) "compile with hugs",
+ Option "" ["disable-library-profiling"] (NoArg WithoutProfLib)
+ "Disable library profiling",
+ Option "" ["gen-spec"] (NoArg GenSpec)
+ "Generate a spec file, nothing more",
+ Option "" ["name"] (reqStrArg RpmName)
+ "Override the default package name",
+ Option "" ["version"] (reqStrArg RpmVersion)
+ "Override the default package version",
+ Option "" ["release"] (reqStrArg RpmRelease)
+ "Override the default package release",
+ Option "" ["disable-haddock"] (NoArg WithoutHaddock)
+ "Disable build and packaging of haddock-generated docs",
+ Option "" ["topdir"] (reqDirArg RpmTopDir)
+ "Build packages in the given directory"
+ ],
+ cmdAction = RpmCmd
+ }
+
+parseRpmArgs :: [String] -> [OptDescr a] -> IO (RpmFlags, [a], [String])
+parseRpmArgs = parseArgs rpmCmd updateCfg emptyRpmFlags
+ where updateCfg c GenSpec = c { rpmGenSpec = True }
+ updateCfg c WithoutProfLib = c { rpmLibProf = False }
+ updateCfg c GhcFlag = c { rpmCompiler = Just GHC }
+ updateCfg c HugsFlag = c { rpmCompiler = Just Hugs }
+ updateCfg c JhcFlag = c { rpmCompiler = Just JHC }
+ updateCfg c NhcFlag = c { rpmCompiler = Just NHC }
+ updateCfg c (Verbose n) = c { rpmVerbose = n }
+ updateCfg c (RpmName s) = c { rpmName = Just s }
+ updateCfg c (RpmVersion s) = c { rpmVersion = Just s }
+ updateCfg c (RpmRelease s) = c { rpmRelease = Just s }
+ updateCfg c WithoutHaddock = c { rpmHaddock = False }
+ updateCfg c (RpmTopDir s) = c { rpmTopDir = Just s }
+ updateCfg c _ = error $ "Unexpected flag!"
+
testCmd :: Cmd a
testCmd = Cmd {
cmdName = "test",
diff --exclude '.*' --exclude dist --exclude _darcs --exclude '*~' -urN cabal/Distribution/Simple/Rpm.hs cabal-rpm/Distribution/Simple/Rpm.hs
--- cabal/Distribution/Simple/Rpm.hs 1969-12-31 16:00:00.000000000 -0800
+++ cabal-rpm/Distribution/Simple/Rpm.hs 2007-02-20 14:30:45.000000000 -0800
@@ -0,0 +1,497 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Distribution.Simple.Rpm
+-- Copyright : Bryan O'Sullivan 2007
+--
+-- Maintainer : Bryan O'Sullivan <[EMAIL PROTECTED]>
+-- Stability : alpha
+-- Portability : portable
+--
+-- Explanation: Support for building RPM packages. Can also generate
+-- an RPM spec file if you need a basic one to hand-customize.
+
+{- All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Bryan O'Sullivan nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
+
+module Distribution.Simple.Rpm (
+ rpm
+ ) where
+
+import Control.Monad (filterM, liftM, mapM, when)
+import Data.Char (toLower)
+import Data.List (find, intersperse, isPrefixOf, sort)
+import Data.Maybe
+import Data.Time.Clock (getCurrentTime)
+import Data.Time.LocalTime (formatTime)
+import Data.Version (Version(..), showVersion)
+import System.Cmd (system)
+import System.Directory (canonicalizePath, doesFileExist, getDirectoryContents)
+import System.Environment (getProgName)
+import System.Exit (ExitCode(..))
+import System.IO
+import System.Locale (defaultTimeLocale)
+import System.Process (runInteractiveCommand, waitForProcess)
+
+import Distribution.Compat.Directory (createDirectoryIfMissing)
+import Distribution.Compat.FilePath (joinFileName)
+import Distribution.Compiler (CompilerFlavor(..), Compiler(..))
+import Distribution.License
+import Distribution.PreProcess (PPSuffixHandler)
+import Distribution.Setup (RpmFlags(..))
+import Distribution.Simple.Configure (configCompiler)
+import Distribution.Simple.LocalBuildInfo (distPref)
+import Distribution.Simple.SrcDist (createArchive, prepareTree, tarBallName)
+import Distribution.Simple.Utils (copyDirectoryRecursiveVerbose,
+ copyFileVerbose, die)
+import Distribution.Package (pkgName, pkgVersion)
+import Distribution.PackageDescription (BuildInfo(..), Library(..),
+ PackageDescription(..), exeName,
+ hasLibs, withExe, withLib)
+import Distribution.Version(Dependency(..), VersionRange(..), withinRange)
+
+rpm :: PackageDescription -- ^info from the .cabal file
+ -> RpmFlags -- ^rpm flags
+ -> FilePath -- ^build prefix (temp dir)
+ -> [PPSuffixHandler] -- ^extra preprocessors
+ -> IO ()
+
+rpm pkgDesc flags tmpDir pps = do
+ if rpmGenSpec flags
+ then do
+ (name, extraDocs) <- createSpecFile pkgDesc flags "."
+ putStrLn $ "Spec file created: " ++ name
+ when ((not . null) extraDocs) $ do
+ putStrLn "NOTE: docs packaged, but not in .cabal file:"
+ mapM_ putStrLn $ sort extraDocs
+ return ()
+ else rpmBuild pkgDesc flags tmpDir pps
+
+-- | Copy a file or directory (recursively, in the latter case) to the
+-- same name in the target directory. Arguments flipped from the
+-- conventional order.
+
+copyTo :: Int -> FilePath -> FilePath -> IO ()
+
+copyTo verbose dest src = do
+ isFile <- doesFileExist src
+ let destDir = dest `joinFileName` src
+ if isFile
+ then copyFileVerbose verbose src destDir
+ else copyDirectoryRecursiveVerbose verbose src destDir
+
+rpmBuild pkgDesc flags tmpDir pps = do
+ let verbose = rpmVerbose flags
+ tgtPfx <- canonicalizePath (maybe distPref id $ rpmTopDir flags)
+ createDirectoryIfMissing True tgtPfx
+ flip mapM_ ["BUILD", "RPMS", "SOURCES", "SPECS", "SRPMS"] $ \ subDir -> do
+ createDirectoryIfMissing True (tgtPfx `joinFileName` subDir)
+ tree <- prepareTree pkgDesc verbose False tmpDir pps 0
+ (_, extraDocs) <- createSpecFile pkgDesc flags tree
+ mapM_ (copyTo verbose tree) extraDocs
+ tarball <- createArchive pkgDesc Nothing tmpDir
+ (tgtPfx `joinFileName` "SOURCES")
+ ret <- system ("rpmbuild -ta --define \"_topdir " ++ tgtPfx ++ "\" " ++
+ tarball)
+ case ret of
+ ExitSuccess -> return ()
+ ExitFailure n -> die ("rpmbuild failed with status " ++ show n)
+
+createSpecFile :: PackageDescription -- ^info from the .cabal file
+ -> RpmFlags -- ^rpm flags
+ -> FilePath -- ^directory in which to create file
+ -> IO (FilePath, [FilePath])
+
+createSpecFile pkgDesc flags tgtPfx = do
+ compiler <- configCompiler (rpmCompiler flags) Nothing Nothing
+ (rpmVerbose flags)
+ let pkg = package pkgDesc
+ origName = pkgName pkg
+ name = maybe (map toLower origName) id (rpmName flags)
+ version = maybe ((showVersion . pkgVersion) pkg) id (rpmVersion flags)
+ release = maybe "1" id (rpmRelease flags)
+ specPath = tgtPfx `joinFileName` name ++ ".spec"
+ group = "Development/Languages"
+ buildRoot = "%{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)"
+ cmplrVersion = compilerVersion compiler
+ doHaddock = rpmHaddock flags && hasLibs pkgDesc
+ (cmplr, runner) = case compilerFlavor compiler of
+ GHC -> ("ghc", "runghc")
+ Hugs -> ("hugs", "runhugs")
+ JHC -> ("jhc", "runjhc")
+ NHC -> ("nhc", "runnhc")
+ (OtherCompiler s) -> (s, "run" ++ s)
+ specAlreadyExists <- doesFileExist specPath
+ when specAlreadyExists $
+ die $ "spec file already exists: " ++ specPath
+ h <- openFile specPath WriteMode
+ buildReq <- showBuildReq doHaddock compiler pkgDesc
+ runtimeReq <- showRuntimeReq compiler pkgDesc
+ progName <- getProgName
+ now <- getCurrentTime
+ let putHdr hdr val = hPutStrLn h (hdr ++ ": " ++ val)
+ putHdr_ hdr val = when (not $ null val) $
+ hPutStrLn h (hdr ++ ": " ++ val)
+ putHdrD hdr val dfl = hPutStrLn h (hdr ++ ": " ++
+ if null val then dfl else val)
+ putNewline = hPutStrLn h ""
+ put s = hPutStrLn h s
+ putDef v s = put $ "%define " ++ v ++ ' ' : s
+ putSetup s = put $ runner ++ " " ++ progName ++ ' ' : s
+ date = formatTime defaultTimeLocale "%a %b %d %Y" now
+ putDef "hsc_name" cmplr
+ putDef "hsc_version" $ showVersion cmplrVersion
+ putDef "hsc_namever" $ compilerNameVersion compiler
+ putDef "pkg_name" origName
+ putDef "pkg_libdir" "%{_libdir}/%{pkg_name}-%{version}/%{hsc_name}-%{hsc_version}"
+ putNewline
+
+ putHdr "Name" name
+ putHdr "Version" version
+ putHdr "Release" $ release ++ "%{?dist}"
+ putHdr "License" $ (showLicense . license) pkgDesc
+ putHdr "Group" group
+ putHdr_ "URL" $ homepage pkgDesc
+ putHdr "Source" $ tarBallName pkgDesc
+ putHdrD "Summary" (synopsis pkgDesc) "This package has no summary."
+ putHdr "BuildRoot" buildRoot
+ putHdr "BuildRequires" buildReq
+ -- External libraries incur both build-time and runtime
+ -- dependencies. The latter only need to be made explicit for the
+ -- built library, as RPM is smart enough to ferret out good
+ -- dependencies for binaries.
+ extDeps <- withLib pkgDesc [] (findLibDeps .libBuildInfo)
+ let extraReq = concat $ intersperse ", " extDeps
+ putHdr_ "BuildRequires" extraReq
+ putHdr_ "Requires" extraReq
+ putNewline
+ putNewline
+
+ let putDesc = do
+ put $ if (null . description) pkgDesc
+ then "This package does not have a description."
+ else description pkgDesc
+ put "%description"
+ putDesc
+ putNewline
+ putNewline
+
+ {- Compiler-specific library data goes into a package of its own.<
+
+ Unlike a library for a traditional language, the library
+ packagen depends on the compiler, because when installed, it
+ has to register itself with the compiler's own package
+ management system. -}
+
+ withLib pkgDesc () $ \lib -> do
+ put "%package %{hsc_namever}"
+ putHdrD "Summary" (synopsis pkgDesc) "This package has no summary."
+ putHdr "Group" group
+ putHdr "Requires" $ "%{hsc_name} = %{hsc_version}"
+ putHdr_ "Requires" runtimeReq
+ putHdr "Provides" "%{pkg_name}-%{hsc_namever} = %{version}"
+ putNewline
+ putNewline
+
+ put "%description %{hsc_namever}"
+ putDesc
+ putNewline
+ put "This package contains libraries for %{hsc_name} %{hsc_version}."
+ putNewline
+ putNewline
+
+ put "%prep"
+ put $ "%setup -q -n %{pkg_name}-%{version}"
+ putNewline
+ putNewline
+
+ put "%build"
+ putSetup ("configure --prefix=%{_prefix} --libdir=%{_libdir} " ++
+ (if (rpmLibProf flags) then "--enable" else "--disable") ++
+ "-library-profiling --" ++ cmplr)
+ putSetup "build"
+ when doHaddock $
+ putSetup "haddock"
+ putSetup "register --gen-script"
+ putSetup "unregister --gen-script"
+ putNewline
+ putNewline
+
+ put "%install"
+ put "rm -rf ${RPM_BUILD_ROOT}"
+ putSetup "copy --destdir=${RPM_BUILD_ROOT}"
+ put "cp register.sh unregister.sh ${RPM_BUILD_ROOT}%{pkg_libdir}"
+ put "rm -rf ${RPM_BUILD_ROOT}/%{_datadir}/%{pkg_name}-%{version}/doc"
+ putNewline
+ putNewline
+
+ put "%clean"
+ put "rm -rf ${RPM_BUILD_ROOT}"
+ putNewline
+ putNewline
+
+ docs <- findDocs pkgDesc
+
+ withLib pkgDesc () $ \lib -> do
+ put "%post %{hsc_namever}"
+ put "%{pkg_libdir}/register.sh"
+ putNewline
+ putNewline
+
+ {- We must unregister an old version during an upgrade as
+ well as during a normal removal, otherwise the Haskell
+ runtime's package system will be left with a phantom record
+ for a package it can no longer use. -}
+
+ put "%preun %{hsc_namever}"
+ put "%{pkg_libdir}/unregister.sh"
+ putNewline
+ putNewline
+
+ put "%files %{hsc_namever}"
+ put "%defattr(-,root,root)"
+ put "%defattr(-,root,root)"
+ put "%{pkg_libdir}"
+ when doHaddock $
+ put "%doc dist/doc/html"
+ when ((not . null) docs) $
+ put $ "%doc " ++ concat (intersperse " " docs)
+ putNewline
+ putNewline
+
+ put "%files"
+ put "%defattr(-,root,root)"
+ withExe pkgDesc $ \exe -> put $ "%{_bindir}/" ++ exeName exe
+ when ((not . null . dataFiles) pkgDesc) $
+ put "%{_datadir}/%{pkg_name}-%{version}"
+
+ -- Add the license file to the main package only if it wouldn't
+ -- otherwise be empty.
+ when ((not . null . licenseFile) pkgDesc &&
+ ((not . null . executables) pkgDesc ||
+ (not . null . dataFiles) pkgDesc)) $
+ put $ "%doc " ++ licenseFile pkgDesc
+ putNewline
+ putNewline
+
+ put "%changelog"
+ put ("* " ++ date ++ " Cabal <[email protected]> - " ++
+ version ++ "-" ++ release)
+ put "- spec file autogenerated by Cabal"
+ hClose h
+ return (specPath, filter (`notElem` (extraSrcFiles pkgDesc)) docs)
+
+findDocs :: PackageDescription -> IO [FilePath]
+
+findDocs pkgDesc = do
+ contents <- getDirectoryContents "."
+ let docs = filter likely contents
+ return $ if (null . licenseFile) pkgDesc
+ then docs
+ else let license = licenseFile pkgDesc
+ in license : filter (/= license) docs
+ where names = ["author", "copying", "doc", "example", "licence", "license",
+ "readme", "todo"]
+ likely name = let lowerName = map toLower name
+ in any (`isPrefixOf` lowerName) names
+
+-- | Take a Haskell package name, and turn it into a "virtual package"
+-- that encodes the compiler name and version used.
+
+virtualPackage :: Compiler -> String -> String
+virtualPackage compiler name = name ++ '-' : compilerNameVersion compiler
+
+compilerNameVersion :: Compiler -> String
+compilerNameVersion (Compiler flavour version _ _) = name ++ squishedVersion
+ where name = case flavour of
+ GHC -> "ghc"
+ Hugs -> "hugs"
+ JHC -> "jhc"
+ NHC -> "nhc"
+ squishedVersion = (concat . map show . versionBranch) version
+
+-- | Convert from license to RPM-friendly description. The strings are
+-- taken from TagsCheck.py in the rpmlint distribution.
+
+showLicense :: License -> String
+showLicense GPL = "GPL"
+showLicense LGPL = "LGPL"
+showLicense BSD3 = "BSD"
+showLicense BSD4 = "BSD-like"
+showLicense PublicDomain = "Public Domain"
+showLicense AllRightsReserved = "Proprietary"
+showLicense OtherLicense = "Non-distributable"
+
+-- | Determine whether a specific version of a Haskell package is "built
+-- into" this particular version of the given compiler.
+
+isBuiltIn :: CompilerFlavor
+ -> Version
+ -> Dependency
+ -> Bool
+isBuiltIn cn cv (Dependency pkg version) = maybe False checkVersion $ do
+ (_, _, cb) <- find (\(n, v, _) -> (n,v) == (cn,cv)) builtIns
+ (_, pv) <- find (\(pn, _) -> pn == pkg) cb
+ return pv
+ where checkVersion = flip withinRange version
+ builtIns = [(GHC, Version [6,6] [], ghc66BuiltIns)]
+ v n x = (n, Version x [])
+ ghc66BuiltIns = [
+ v "base" [2,0], v "Cabal" [1,1,6], v "cgi" [2006,9,6],
+ v "fgl" [5,2], v "ghc" [6,6], v "GLUT" [2,0],
+ v "haskell98" [1,0], v "haskell-src" [1,0], v "HGL" [3,1],
+ v "html" [1,0], v "HTTP" [2006,7,7], v "HUnit" [1,1],
+ v "mtl" [1,0], v "network" [2,0], v "OpenAL" [1,3],
+ v "OpenGL" [2,1], v "parsec" [2,0], v "QuickCheck" [1,0],
+ v "readline" [1,0], v "regex-base" [0,71],
+ v "regex-compat" [0,71], v "regex-posix" [0,71],
+ v "rts" [1,0], v "stm" [2,0], v "template-haskell" [2,0],
+ v "time" [1,0], v "unix" [1,0], v "X11" [1,1],
+ v "xhtml" [2006,9,13]
+ ]
+
+-- | Generate a string expressing runtime dependencies, but only
+-- on package/version pairs not already "built into" a compiler
+-- distribution.
+
+showRuntimeReq :: Compiler -> PackageDescription -> IO String
+
+showRuntimeReq c@(Compiler cFlav cVersion _ _) pkgDesc = do
+ let externalDeps = filter (not . isBuiltIn cFlav cVersion)
+ (buildDepends pkgDesc)
+ clauses <- mapM (showRpmReq (virtualPackage c)) externalDeps
+ return $ (concat . intersperse ", " . concat) clauses
+
+-- | Generate a string expressing package build dependencies, but only
+-- on package/version pairs not already "built into" a compiler
+-- distribution.
+
+showBuildReq :: Bool -> Compiler -> PackageDescription -> IO String
+
+showBuildReq haddock c@(Compiler cFlav cVersion _ _) pkgDesc = do
+ cPkg <- case cFlav of
+ GHC -> return "ghc"
+ Hugs -> return "hugs98"
+ _ -> die $ "unknown compiler " ++ show cFlav
+ let myDeps = [Dependency cPkg (ThisVersion cVersion)] ++
+ if haddock then [Dependency "haddock" AnyVersion] else []
+ externalDeps = filter (not . isBuiltIn cFlav cVersion)
+ (buildDepends pkgDesc)
+ exReqs <- mapM (showRpmReq (virtualPackage c)) externalDeps
+ myReqs <- mapM (showRpmReq id) myDeps
+ return $ (concat . intersperse ", " . concat) (myReqs ++ exReqs)
+
+-- | Represent a dependency in a form suitable for an RPM spec file.
+
+showRpmReq :: (String -> String) -> Dependency -> IO [String]
+
+showRpmReq f (Dependency pkg AnyVersion) =
+ return [f pkg]
+showRpmReq f (Dependency pkg (ThisVersion v)) =
+ return [f pkg ++ " = " ++ showVersion v]
+showRpmReq f (Dependency pkg (EarlierVersion v)) =
+ return [f pkg ++ " < " ++ showVersion v]
+showRpmReq f (Dependency pkg (LaterVersion v)) =
+ return [f pkg ++ " > " ++ showVersion v]
+showRpmReq f (Dependency pkg (UnionVersionRanges
+ (ThisVersion v1)
+ (LaterVersion v2)))
+ | v1 == v2 = return [f pkg ++ " >= " ++ showVersion v1]
+showRpmReq f (Dependency pkg (UnionVersionRanges
+ (ThisVersion v1)
+ (EarlierVersion v2)))
+ | v1 == v2 = return [f pkg ++ " <= " ++ showVersion v1]
+showRpmReq f (Dependency pkg (UnionVersionRanges _ _)) = do
+ hPutStrLn stderr ("Warning: cannot accurately represent " ++
+ "dependency on package " ++ f pkg)
+ hPutStrLn stderr " (uses version union, which RPM can't handle)"
+ return [f pkg]
+showRpmReq f (Dependency pkg (IntersectVersionRanges r1 r2)) = do
+ d1 <- showRpmReq f (Dependency pkg r1)
+ d2 <- showRpmReq f (Dependency pkg r2)
+ return (d1 ++ d2)
+
+-- | Find the paths to all "extra" libraries specified in the package
+-- config. Prefer shared libraries, since that's what gcc prefers.
+findLibPaths :: BuildInfo -> IO [FilePath]
+
+findLibPaths buildInfo = mapM findLib (extraLibs buildInfo)
+ where findLib :: String -> IO FilePath
+ findLib lib = do
+ so <- findLibPath ("lib" ++ lib ++ ".so")
+ if isJust so
+ then return (fromJust so)
+ else findLibPath ("lib" ++ lib ++ ".a") >>=
+ maybe (die $ "could not find library: lib" ++ lib)
+ return
+ findLibPath extraLib = do
+ loc <- findInExtraLibs (extraLibDirs buildInfo)
+ if isJust loc
+ then return loc
+ else findWithGcc extraLib
+ where findInExtraLibs (d:ds) = do
+ let path = d `joinFileName` extraLib
+ exists <- doesFileExist path
+ if exists
+ then return (Just path)
+ else findInExtraLibs ds
+ findInExtraLibs [] = return Nothing
+
+-- | Return the full path to a file (usually an object file) that gcc
+-- knows about.
+
+findWithGcc :: FilePath -> IO (Maybe FilePath)
+
+findWithGcc lib = do
+ (i,o,e,p) <- runInteractiveCommand $ "gcc -print-file-name=" ++ lib
+ loc <- hGetLine o
+ mapM_ hClose [i,o,e]
+ waitForProcess p
+ return $ if loc == lib then Nothing else Just loc
+
+-- | Return the RPM that owns a particular file or directory. Die if
+-- not owned.
+
+findRpmOwner :: FilePath -> IO String
+findRpmOwner path = do
+ (i,o,e,p) <- runInteractiveCommand (rpmQuery ++ path)
+ pkg <- hGetLine o
+ mapM_ hClose [i,o,e]
+ ret <- waitForProcess p
+ case ret of
+ ExitSuccess -> return pkg
+ _ -> die $ "not owned by any package: " ++ path
+ where rpmQuery = "rpm --queryformat='%{NAME}' -qf "
+
+-- | Find all RPMs on which the build of this package depends. Die if
+-- a dependency is not present, or not owned by an RPM.
+
+findLibDeps :: BuildInfo -> IO [String]
+
+findLibDeps buildInfo = findLibPaths buildInfo >>= mapM findRpmOwner
diff --exclude '.*' --exclude dist --exclude _darcs --exclude '*~' -urN cabal/Distribution/Simple/SrcDist.hs cabal-rpm/Distribution/Simple/SrcDist.hs
--- cabal/Distribution/Simple/SrcDist.hs 2007-02-16 14:06:42.000000000 -0800
+++ cabal-rpm/Distribution/Simple/SrcDist.hs 2007-02-20 11:58:24.000000000 -0800
@@ -48,6 +48,10 @@
module Distribution.Simple.SrcDist (
sdist
+ ,createArchive
+ ,prepareTree
+ ,tarBallName
+ ,copyFileTo
#ifdef DEBUG
,hunitTests
#endif
@@ -69,6 +73,7 @@
import Data.Char (isSpace, toLower)
import Data.List (isPrefixOf)
import System.Cmd (system)
+import System.Exit (ExitCode(..))
import System.Time (getClockTime, toCalendarTime, CalendarTime(..))
import Distribution.Compat.Directory (doesFileExist, doesDirectoryExist,
getCurrentDirectory, createDirectoryIfMissing, removeDirectoryRecursive)
@@ -94,6 +99,24 @@
| snapshot = updatePackage (updatePkgVersion
(updateVersionBranch (++ [date]))) pkg_descr_orig
| otherwise = pkg_descr_orig
+ prepareTree pkg_descr verbose snapshot tmpDir pps date
+ createArchive pkg_descr mb_lbi tmpDir targetPref
+ return ()
+ where
+ updatePackage f pd = pd { package = f (package pd) }
+ updatePkgVersion f pkg = pkg { pkgVersion = f (pkgVersion pkg) }
+ updateVersionBranch f v = v { versionBranch = f (versionBranch v) }
+
+-- |Prepare a directory tree of source files.
+prepareTree :: PackageDescription -- ^info from the cabal file
+ -> Int -- ^verbose
+ -> Bool -- ^snapshot
+ -> FilePath -- ^source tree to populate
+ -> [PPSuffixHandler] -- ^extra preprocessors (includes suffixes)
+ -> Int -- ^date
+ -> IO FilePath
+
+prepareTree pkg_descr verbose snapshot tmpDir pps date = do
setupMessage verbose "Building source dist for" pkg_descr
ex <- doesDirectoryExist tmpDir
when ex (die $ "Source distribution already in place. please move: " ++ tmpDir)
@@ -133,7 +156,27 @@
writeFile targetDescFile $
unlines $ map (appendVersion date) $ lines $ contents
else copyFileVerbose verbose descFile targetDescFile
+ return targetDir
+
+ where
+
+ appendVersion :: Int -> String -> String
+ appendVersion n line
+ | "version:" `isPrefixOf` map toLower line =
+ trimTrailingSpace line ++ "." ++ show n
+ | otherwise = line
+
+ trimTrailingSpace :: String -> String
+ trimTrailingSpace = reverse . dropWhile isSpace . reverse
+
+-- |Create an archive from a tree of source files, and clean up the tree.
+createArchive :: PackageDescription -- ^info from cabal file
+ -> Maybe LocalBuildInfo -- ^info from configure
+ -> FilePath -- ^source tree to archive
+ -> FilePath -- ^name of archive to create
+ -> IO FilePath
+createArchive pkg_descr mb_lbi tmpDir targetPref = do
let tarBallFilePath = targetPref `joinFileName` tarBallName pkg_descr
let tarDefault = "tar"
tarProgram <-
@@ -148,23 +191,14 @@
-- [The prev. solution used pipes and sub-command sequences to set up the paths correctly,
-- which is problematic in a Windows setting.]
let tarArgs = "-C"++tmpDir ++ " -czf " ++ tarBallFilePath
- system (tarProgram ++ ' ':tarArgs ++ ' ':(nameVersion pkg_descr))
+ ret <- system (tarProgram ++ ' ':tarArgs ++ ' ':(nameVersion pkg_descr))
removeDirectoryRecursive tmpDir
- putStrLn $ "Source tarball created: " ++ tarBallFilePath
-
- where
- updatePackage f pd = pd { package = f (package pd) }
- updatePkgVersion f pkg = pkg { pkgVersion = f (pkgVersion pkg) }
- updateVersionBranch f v = v { versionBranch = f (versionBranch v) }
-
- appendVersion :: Int -> String -> String
- appendVersion n line
- | "version:" `isPrefixOf` map toLower line =
- trimTrailingSpace line ++ "." ++ show n
- | otherwise = line
-
- trimTrailingSpace :: String -> String
- trimTrailingSpace = reverse . dropWhile isSpace . reverse
+ case ret of
+ ExitSuccess -> do
+ putStrLn $ "Source tarball created: " ++ tarBallFilePath
+ return tarBallFilePath
+ ExitFailure n -> die ("source tarball creation failed! Tar exited " ++
+ "with status " ++ show n)
-- |Move the sources into place based on buildInfo
prepareDir :: Int -- ^verbose
diff --exclude '.*' --exclude dist --exclude _darcs --exclude '*~' -urN cabal/Distribution/Simple.hs cabal-rpm/Distribution/Simple.hs
--- cabal/Distribution/Simple.hs 2007-02-16 14:06:42.000000000 -0800
+++ cabal-rpm/Distribution/Simple.hs 2007-02-20 11:50:52.000000000 -0800
@@ -79,6 +79,7 @@
import Distribution.Simple.Build ( build )
import Distribution.Simple.SrcDist ( sdist )
+import Distribution.Simple.Rpm ( rpm )
import Distribution.Simple.Register ( register, unregister,
writeInstalledConfig, installedPkgConfigFile,
regScriptLocation, unregScriptLocation
@@ -183,6 +184,13 @@
-- |Hook to run after sdist command. Second arg indicates verbosity level.
postSDist :: Args -> SDistFlags -> PackageDescription -> Maybe LocalBuildInfo -> IO ExitCode,
+ -- |Hook to run before rpm command. Second arg indicates verbosity level.
+ preRpm :: Args -> RpmFlags -> IO HookedBuildInfo,
+ -- |Over-ride this hook to get different behavior during rpm.
+ rpmHook :: PackageDescription -> Maybe LocalBuildInfo -> Maybe UserHooks -> RpmFlags -> IO (),
+ -- |Hook to run after rpm command. Second arg indicates verbosity level.
+ postRpm :: Args -> RpmFlags -> PackageDescription -> Maybe LocalBuildInfo -> IO ExitCode,
+
-- |Hook to run before register command
preReg :: Args -> RegisterFlags -> IO HookedBuildInfo,
-- |Over-ride this hook to get different behavior during pfe.
@@ -342,6 +350,11 @@
preSDist sDistHook postSDist
maybeGetPersistBuildConfig
+ RpmCmd -> do
+ command parseRpmArgs rpmVerbose
+ preRpm rpmHook postRpm
+ maybeGetPersistBuildConfig
+
TestCmd -> do
(verbose,_, args) <- parseTestArgs all_args []
localbuildinfo <- getPersistBuildConfig
@@ -586,6 +599,9 @@
preSDist = rn,
sDistHook = ru,
postSDist = res,
+ preRpm = rn,
+ rpmHook = ru,
+ postRpm = res,
preReg = rn,
regHook = ru,
postReg = res,
@@ -613,6 +629,7 @@
copyHook = \desc lbi _ f -> install desc lbi f, -- has correct 'copy' behavior with params
instHook = defaultInstallHook,
sDistHook = \p l h f -> sdist p l f srcPref distPref (allSuffixHandlers h),
+ rpmHook = \p _ h f -> rpm p f srcPref (allSuffixHandlers h),
pfeHook = pfe,
cleanHook = clean,
haddockHook = haddock,
_______________________________________________
cabal-devel mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cabal-devel
