cabal-rpm 0.8.2 → 0.8.3
raw patch · 13 files changed
+839/−732 lines, 13 files
Files
- NEWS +8/−0
- cabal-rpm.cabal +9/−8
- src/CabalRpm.hs +0/−20
- src/Commands/Build.hs +98/−0
- src/Commands/Spec.hs +321/−0
- src/Distribution/Package/Rpm.hs +0/−377
- src/Distribution/Package/Rpm/Main.hs +0/−127
- src/Distribution/Package/Rpm/Setup.hs +0/−126
- src/Distribution/Package/Rpm/Utils.hs +0/−74
- src/Main.hs +120/−0
- src/PackageUtils.hs +74/−0
- src/Setup.hs +126/−0
- src/SysCmd.hs +83/−0
NEWS view
@@ -1,3 +1,11 @@+* 0.8.3 (2013-07-12)+- only try to install missing dependencies+- for executables depending on own lib add BR chrpath and %ghc_fix_dynamic_rpath+- word-wrap generic descriptions+- map ffi to libffi+- move modules to toplevel+- Rpm module split into Spec and Build in Commands/+ * 0.8.2 (2013-07-02) - handle pkg-ver arg, and check cabal list is non-empty - sort all generated deps
cabal-rpm.cabal view
@@ -1,19 +1,19 @@ Name: cabal-rpm-Version: 0.8.2+Version: 0.8.3 Synopsis: RPM package creator for Haskell Cabal-based packages Description: This package generates RPM packages from Haskell Cabal packages. . Recent changes: .+ * 0.8.3: only install missing dependencies, word-wrap generic descriptions+ . * 0.8.2: wrap sentences at end of line, handle pkg-ver arg, sort deps . * 0.8.1: word wrapping of descriptions . * 0.8.0: new simpler revised Fedora packaging; check external commands available .- * 0.7.1: various bugfixes and minor improvments- . * 0.7.0: command arg for spec, srpm, or build; installs existing packaged depends with sudo yum . See <https://github.com/juhp/cabal-rpm/blob/master/NEWS> for more details.@@ -35,7 +35,7 @@ location: https://github.com/juhp/cabal-rpm Executable cblrpm- Main-is: CabalRpm.hs+ Main-is: Main.hs Build-depends: base < 5, Cabal > 1.10, directory,@@ -46,10 +46,11 @@ time, unix Other-modules:- Distribution.Package.Rpm,- Distribution.Package.Rpm.Main,- Distribution.Package.Rpm.Setup,- Distribution.Package.Rpm.Utils+ Commands.Build,+ Commands.Spec,+ PackageUtils,+ Setup,+ SysCmd Hs-Source-Dirs: src GHC-options: -fwarn-missing-signatures -Wall Extensions: CPP
− src/CabalRpm.hs
@@ -1,20 +0,0 @@--- |--- Module : CabalRpm--- Copyright : Bryan O'Sullivan 2007------ Maintainer : Bryan O'Sullivan <bos@serpentine.com>--- Stability : alpha--- Portability : portable------ Explanation: Main entry point for building RPM packages.---- This software may be used and distributed according to the terms of--- the GNU General Public License, incorporated herein by reference.--module Main where--import qualified Distribution.Package.Rpm.Main as Rpm--main :: IO ()--main = Rpm.main
+ src/Commands/Build.hs view
@@ -0,0 +1,98 @@+-- |+-- Module : Commands.Build+-- Copyright : Bryan O'Sullivan 2007, 2008+-- Jens Petersen 2012-2013+--+-- Maintainer : Jens Petersen <petersen@fedoraproject.org>+-- 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.++-- This software may be used and distributed according to the terms of+-- the GNU General Public License, incorporated herein by reference.++module Commands.Build (+ rpmBuild+ ) where++import Commands.Spec (createSpecFile)+import PackageUtils (packageName, packageVersion,+ simplePackageDescription)+import Setup (RpmFlags (..))+import SysCmd (tryReadProcess, trySystem, optionalSudo, systemBool, (+-+))++--import Control.Exception (bracket)+import Control.Monad (filterM, liftM, unless, when)++import Distribution.PackageDescription (GenericPackageDescription (..),+ PackageDescription (..),+ hasExes)++--import Distribution.Version (VersionRange, foldVersionRange')++import System.Directory (copyFile, doesFileExist,+ getCurrentDirectory)+import System.Environment (getEnv)+import System.FilePath.Posix ((</>))++-- autoreconf :: Verbosity -> PackageDescription -> IO ()+-- autoreconf verbose pkgDesc = do+-- ac <- doesFileExist "configure.ac"+-- when ac $ do+-- c <- doesFileExist "configure"+-- when (not c) $ do+-- setupMessage verbose "Running autoreconf" pkgDesc+-- trySystem "autoreconf"++rpmBuild :: FilePath -> GenericPackageDescription -> RpmFlags -> Bool -> IO ()+rpmBuild cabalPath genPkgDesc flags binary = do+-- let verbose = rpmVerbosity flags+ pkgDesc <- simplePackageDescription genPkgDesc flags+-- bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> do+-- autoreconf verbose pkgDesc+ specFile <- specFileName pkgDesc flags+ specFileExists <- doesFileExist specFile+ if specFileExists+ then putStrLn $ "Using existing" +-+ specFile+ else createSpecFile cabalPath genPkgDesc flags+ let pkg = package pkgDesc+ name = packageName pkg+ when binary $ do+ br_out <- tryReadProcess "rpmspec" ["-q", "--buildrequires", specFile]+ missing <- filterM notInstalled $ lines br_out+ unless (null missing) $ do+ putStrLn $ "Installing dependencies:"+ mapM_ putStrLn missing+ optionalSudo ("yum install" +-+ unwords missing)++ cwd <- getCurrentDirectory+ home <- getEnv "HOME"+ let version = packageVersion pkg+ cachedir = home </> ".cabal/packages/hackage.haskell.org" </> name </> version+ tarFile = name ++ "-" ++ version ++ ".tar.gz"+ rpmCmd = if binary then "a" else "s"+ tarFileExists <- doesFileExist tarFile+ unless tarFileExists $ do+ trySystem ("cabal fetch -v0 --no-dependencies" +-+ name ++ "-" ++ version)+ copyFile (cachedir </> tarFile) (cwd </> tarFile)+ trySystem ("rpmbuild -b" ++ rpmCmd +-++ "--define \"_rpmdir" +-+ cwd ++ "\"" +-++ "--define \"_srcrpmdir" +-+ cwd ++ "\"" +-++ "--define \"_sourcedir" +-+ cwd ++ "\"" +-++ specFile)+ where+ notInstalled :: String -> IO Bool+ notInstalled br = do+ liftM not $ systemBool $ "rpm -q" +-+ br++specFileName :: PackageDescription -- ^pkg description+ -> RpmFlags -- ^rpm flags+ -> IO FilePath+specFileName pkgDesc flags = do+ let pkg = package pkgDesc+ name = packageName pkg+ pkgname = if isExec then name else "ghc-" ++ name+ isExec = if (rpmLibrary flags) then False else hasExes pkgDesc+ return $ pkgname ++ ".spec"
+ src/Commands/Spec.hs view
@@ -0,0 +1,321 @@+{-# LANGUAGE CPP #-}++-- |+-- Module : Commands.Spec+-- Copyright : Bryan O'Sullivan 2007, 2008+-- Jens Petersen 2012-2013+--+-- Maintainer : Jens Petersen <petersen@fedoraproject.org>+-- Stability : alpha+-- Portability : portable+--+-- Explanation: Generates an RPM spec file from a .cabal file.++-- This software may be used and distributed according to the terms of+-- the GNU General Public License, incorporated herein by reference.++module Commands.Spec (+ createSpecFile+ ) where++import PackageUtils (buildDependencies,+ depName, packageName, packageVersion,+ simplePackageDescription, showDep)+import Setup (RpmFlags (..))+import SysCmd ((+-+))++--import Control.Exception (bracket)+import Control.Monad (unless, when)+import Data.Char (toLower)+import Data.List (groupBy, isPrefixOf, isSuffixOf, nub, sort)+import Data.Maybe (fromMaybe)+import Data.Time.Clock (UTCTime, getCurrentTime)+import Data.Time.Format (formatTime)+import Data.Version (showVersion)++import Distribution.License (License (..))++import Distribution.Simple.Utils (warn)++import Distribution.PackageDescription (PackageDescription (..), exeName,+ hasExes, hasLibs, withExe, allBuildInfo,+ BuildInfo (..))++--import Distribution.Version (VersionRange, foldVersionRange')++import Distribution.PackageDescription (GenericPackageDescription (..))++import System.Directory (doesDirectoryExist, doesFileExist,+ getDirectoryContents)+import System.IO (IOMode (..), hClose, hPutStrLn, openFile)+import System.Locale (defaultTimeLocale)+import System.FilePath (dropFileName)++import qualified Paths_cabal_rpm (version)+++defaultRelease :: UTCTime -> IO String+defaultRelease now = do+ darcsRepo <- doesDirectoryExist "_darcs"+ return $ if darcsRepo+ then formatTime defaultTimeLocale "0.%Y%m%d" now+ else "1"++rstrip :: (Char -> Bool) -> String -> String+rstrip p = reverse . dropWhile p . reverse++-- packageName :: PackageIdentifier -> String+-- packageName pkg = name+-- where PackageName name = pkgName pkg++-- packageVersion :: PackageIdentifier -> String+-- packageVersion pkg = (showVersion . pkgVersion) pkg++createSpecFile :: FilePath -- ^pkg spec file+ -> GenericPackageDescription -- ^pkg description+ -> RpmFlags -- ^rpm flags+ -> IO ()+createSpecFile cabalPath genPkgDesc flags = do+ let verbose = rpmVerbosity flags+ now <- getCurrentTime+ defRelease <- defaultRelease now+ pkgDesc <- simplePackageDescription genPkgDesc flags+ let pkg = package pkgDesc+ name = packageName pkg+ pkgname = if isExec then name else "ghc-" ++ name+ pkg_name = if isExec then "%{name}" else "%{pkg_name}"+ version = packageVersion pkg+ release = fromMaybe defRelease (rpmRelease flags)+ specFile = pkgname ++ ".spec"+ isExec = if (rpmLibrary flags) then False else hasExes pkgDesc+ isLib = hasLibs pkgDesc+ isBinLib = isExec && isLib+ specAlreadyExists <- doesFileExist specFile+ let specFilename = specFile ++ if (not $ rpmForce flags) && specAlreadyExists then ".cblrpm" else ""+ when specAlreadyExists $ putStrLn $ specFile +-+ "exists:" +-+ "creating" +-+ specFilename+ h <- openFile specFilename WriteMode+ let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val)+ padding hdr = replicate (14 - length hdr) ' ' ++ " "+ putNewline = hPutStrLn h ""+ put = hPutStrLn h+ putDef v s = put $ "%global" +-+ v +-+ s+ date = formatTime defaultTimeLocale "%a %b %e %Y" now+ ghcPkg = if isBinLib then "-n ghc-%{name}" else ""+ ghcPkgDevel = if isBinLib then "-n ghc-%{name}-devel" else "devel"++ put "# https://fedoraproject.org/wiki/Packaging:Haskell"+ putNewline++ -- Some packages conflate the synopsis and description fields. Ugh.+ let syn = synopsis pkgDesc+ when (null syn) $+ warn verbose "this package has no synopsis."+ let syn' = if (null syn)+ then ("Haskell" +-+ name +-+ "package")+ else (unwords $ lines syn)+ let summary = rstrip (== '.') syn'+ when ((length $ "Summary : " ++ syn') > 79) $+ warn verbose "this package has a long synopsis."++ let descr = description pkgDesc+ when (null descr) $+ warn verbose "this package has no description."+ let descLines = (formatParagraphs . lines . finalPeriod) $+ if (null descr) then syn' else descr+ finalPeriod cs = if (last cs == '.') then cs else cs ++ "."++ when isLib $ do+ putDef "pkg_name" name+ putNewline++ putHdr "Name" (if isExec then (if isLib then "%{pkg_name}" else pkgname) else "ghc-%{pkg_name}")+ putHdr "Version" version+ putHdr "Release" $ release ++ "%{?dist}"+ putHdr "Summary" summary+ putNewline+ putHdr "License" $ (showLicense . license) pkgDesc+ putHdr "URL" $ "http://hackage.haskell.org/package/" ++ pkg_name+ putHdr "Source0" $ "http://hackage.haskell.org/packages/archive/" ++ pkg_name ++ "/%{version}/" ++ pkg_name ++ "-%{version}.tar.gz"+ putNewline+ putHdr "BuildRequires" "ghc-Cabal-devel"+ putHdr "BuildRequires" $ "ghc-rpm-macros"++ let (deps, selfdep) = buildDependencies pkgDesc name+ buildinfo = allBuildInfo pkgDesc+ excludedTools n = notElem n ["ghc", "perl"]+ mapTools "gtk2hsC2hs" = "gtk2hs-buildtools"+ mapTools "gtk2hsHookGenerator" = "gtk2hs-buildtools"+ mapTools "gtk2hsTypeGen" = "gtk2hs-buildtools"+ mapTools tool = tool+ chrpath = if selfdep then ["chrpath"] else []+ tools = filter excludedTools $ nub $ (map (mapTools . depName) $ concat (map buildTools buildinfo)) ++ chrpath+ excludedCLibs n = notElem n []+ mapCLibs "curl" = "libcurl"+ mapCLibs "ffi" = "libffi"+ mapCLibs "glut" = "freeglut"+ mapCLibs "iw" = "wireless-tools"+ mapCLibs "z" = "zlib"+ mapCLibs ('X':lib) = "libX" ++ lib+ mapCLibs lib = lib+ clibs = sort $ filter excludedCLibs $ nub $ map mapCLibs $ concat (map extraLibs buildinfo)+ pkgcfgs = nub $ map depName $ concat (map pkgconfigDepends buildinfo)+ showPkgCfg p = "pkgconfig(" ++ p ++ ")"++ when (not . null $ deps ++ tools ++ clibs ++ pkgcfgs) $ do+ put "# Begin cabal-rpm deps:"+ let pkgdeps = sort $ map showDep deps ++ tools ++ map (++ "-devel%{?_isa}") clibs ++ map showPkgCfg pkgcfgs+ mapM_ (putHdr "BuildRequires") pkgdeps+ when (any (\ d -> elem d ["template-haskell", "hamlet"]) deps) $+ putHdr "ExclusiveArch" "%{ghc_arches_with_ghci}"+ put "# End cabal-rpm deps"++ putNewline++ put "%description"+ mapM_ put descLines+ putNewline++ let wrapGenDesc = wordwrap (79 - max 0 (length pkgname - length pkg_name))++ when isLib $ do+ when isExec $ do+ put $ "%package" +-+ ghcPkg+ putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library"+ putNewline+ put $ "%description" +-+ ghcPkg+ put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "shared library."+ putNewline+ put $ "%package" +-+ ghcPkgDevel+ putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library development files"+ putHdr "Requires" "ghc-compiler = %{ghc_version}"+ putHdr "Requires(post)" "ghc-compiler = %{ghc_version}"+ putHdr "Requires(postun)" "ghc-compiler = %{ghc_version}"+ putHdr "Requires" $ (if isExec then "ghc-%{name}" else "%{name}") ++ "%{?_isa} = %{version}-%{release}"+ when (not . null $ clibs ++ pkgcfgs) $ do+ put "# Begin cabal-rpm deps:"+ mapM_ (putHdr "Requires") $ map (++ "-devel%{?_isa}") clibs+ mapM_ (putHdr "Requires") $ map showPkgCfg pkgcfgs+ put "# End cabal-rpm deps"+ putNewline+ put $ "%description" +-+ ghcPkgDevel+ put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "library development files."+ putNewline++ put "%prep"+ put $ "%setup -q" ++ (if pkgname /= name then " -n %{pkg_name}-%{version}" else "")+ putNewline+ putNewline++ put "%build"+ let pkgType = if isLib then "lib" else "bin"+ put $ "%ghc_" ++ pkgType ++ "_build"+ putNewline+ putNewline++ put "%install"+ put $ "%ghc_" ++ pkgType ++ "_install"+ when selfdep $ do+ putNewline+ put "%ghc_fix_dynamic_rpath %{name}"+ putNewline+ putNewline++ when isLib $ do+ put $ "%post" +-+ ghcPkgDevel+ put "%ghc_pkg_recache"+ putNewline+ putNewline+ put $ "%postun" +-+ ghcPkgDevel+ put "%ghc_pkg_recache"+ putNewline+ putNewline++ docs <- findDocs cabalPath pkgDesc++ when isExec $ do+ put "%files"+ -- Add the license file to the main package only if it wouldn't+ -- otherwise be empty.+ unless (null $ licenseFile pkgDesc) $+ put $ "%doc" +-+ licenseFile pkgDesc+ unless (null docs) $+ put $ "%doc" +-+ unwords docs++ withExe pkgDesc $ \exe ->+ let program = exeName exe in+ put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program)+ unless (null (dataFiles pkgDesc) && isExec) $+ put "%{_datadir}/%{name}-%{version}"++ putNewline+ putNewline++ when isLib $ do+ let baseFiles = if isBinLib then "-f ghc-%{name}.files" else "-f %{name}.files"+ develFiles = if isBinLib then "-f ghc-%{name}-devel.files" else "-f %{name}-devel.files"+ put $ "%files" +-+ ghcPkg +-+ baseFiles+ put $ "%doc" +-+ licenseFile pkgDesc+ putNewline+ putNewline+ put $ "%files" +-+ ghcPkgDevel +-+ develFiles+ unless (null docs) $+ put $ "%doc" +-+ unwords docs+ putNewline+ putNewline++ put "%changelog"+ put $ "*" +-+ date +-+ "Fedora Haskell SIG <haskell@lists.fedoraproject.org> - " ++ version ++ "-" ++ release+ put $ "- spec file generated by cabal-rpm-" ++ showVersion Paths_cabal_rpm.version+ hClose h++findDocs :: FilePath -> PackageDescription -> IO [FilePath]+findDocs cabalPath pkgDesc = do+ contents <- getDirectoryContents $ dropFileName cabalPath+ let docs = filter likely contents+ return $ if null lf+ then docs+ else filter unlikely $ filter (/= lf) docs+ where names = ["author", "copying", "doc", "example", "licence", "license",+ "readme", "todo"]+ likely name = let lowerName = map toLower name+ in any (`isPrefixOf` lowerName) names+ lf = licenseFile pkgDesc+ unlikely name = not $ any (`isSuffixOf` name) ["~"]++showLicense :: License -> String+showLicense (GPL Nothing) = "GPL+"+showLicense (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+"+showLicense (LGPL Nothing) = "LGPLv2+"+showLicense (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+"+showLicense BSD3 = "BSD"+showLicense BSD4 = "BSD"+showLicense MIT = "MIT"+showLicense PublicDomain = "Public Domain"+showLicense AllRightsReserved = "Proprietary"+showLicense OtherLicense = "Unknown"+showLicense (UnknownLicense l) = "Unknown" +-+ l+#if MIN_VERSION_Cabal(1,16,0)+showLicense (Apache Nothing) = "ASL ?"+showLicense (Apache (Just ver)) = "ASL" +-+ showVersion ver+#endif++-- from http://stackoverflow.com/questions/930675/functional-paragraphs+-- using split would be: map unlines . (Data.List.Split.splitWhen null)+paragraphs :: [String] -> [String]+paragraphs = map unlines . map (filter $ not . null) . groupBy (const $ not . null)++-- http://rosettacode.org/wiki/Word_wrap#Haskell+wordwrap :: Int -> String -> String+wordwrap maxlen = (wrap_ 0 False) . words where+ wrap_ _ _ [] = "\n"+ wrap_ pos eos (w:ws)+ -- at line start: put down the word no matter what+ | pos == 0 = w ++ wrap_ (pos + lw) endp ws+ | pos + lw + 1 > maxlen - 9 && eos = '\n':wrap_ 0 endp (w:ws)+ | pos + lw + 1 > maxlen = '\n':wrap_ 0 endp (w:ws)+ | otherwise = " " ++ w ++ wrap_ (pos + lw + 1) endp ws+ where lw = length w+ endp = last w == '.'++formatParagraphs :: [String] -> [String]+formatParagraphs = map (wordwrap 79) . paragraphs
− src/Distribution/Package/Rpm.hs
@@ -1,377 +0,0 @@--- |--- Module : Distribution.Package.Rpm--- Copyright : Bryan O'Sullivan 2007, 2008--- Jens Petersen 2012------ Maintainer : Jens Petersen <petersen@fedoraproject.org>--- 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.---- This software may be used and distributed according to the terms of--- the GNU General Public License, incorporated herein by reference.--module Distribution.Package.Rpm (- createSpecFile- , rpmBuild- ) where----import Control.Exception (bracket)-import Control.Monad (unless, when)-import Data.Char (toLower)-import Data.List (groupBy, isPrefixOf, isSuffixOf, nub, sort)-import Data.Maybe (fromMaybe)-import Data.Time.Clock (UTCTime, getCurrentTime)-import Data.Time.Format (formatTime)-import Data.Version (showVersion)--import Distribution.License (License (..))-import Distribution.Package (Dependency (..), PackageIdentifier (..),- PackageName (..))--import Distribution.Simple.Utils (warn)--import Distribution.PackageDescription (PackageDescription (..), exeName,- hasExes, hasLibs, withExe, allBuildInfo,- BuildInfo (..))----import Distribution.Version (VersionRange, foldVersionRange')--import Distribution.Package.Rpm.Setup (RpmFlags (..))-import Distribution.Package.Rpm.Utils (trySystem, optionalSudo, (+-+))--import System.Directory (copyFile, doesDirectoryExist, doesFileExist,- getCurrentDirectory, getDirectoryContents)-import System.Environment (getEnv)-import System.IO (IOMode (..), hClose, hPutStrLn, openFile)-import System.Locale (defaultTimeLocale)-import System.FilePath (dropFileName)-import System.FilePath.Posix ((</>))--import qualified Paths_cabal_rpm (version)---- autoreconf :: Verbosity -> PackageDescription -> IO ()--- autoreconf verbose pkgDesc = do--- ac <- doesFileExist "configure.ac"--- when ac $ do--- c <- doesFileExist "configure"--- when (not c) $ do--- setupMessage verbose "Running autoreconf" pkgDesc--- trySystem "autoreconf"--rpmBuild :: FilePath -> PackageDescription -> RpmFlags -> Bool -> IO ()-rpmBuild cabalPath pkgDesc flags binary = do--- let verbose = rpmVerbosity flags--- flip mapM_ ["BUILD", "RPMS", "SOURCES", "SPECS", "SRPMS"] $ \ subDir -> do--- createDirectoryIfMissing True (tgtPfx </> subDir)--- bracket (setFileCreationMask 0o022) setFileCreationMask $ \ _ -> do--- autoreconf verbose pkgDesc- specFile <- specFileName pkgDesc flags- specFileExists <- doesFileExist specFile- if specFileExists- then putStrLn $ "Using existing" +-+ specFile- else createSpecFile cabalPath pkgDesc flags- let pkg = package pkgDesc- name = packageName pkg- when binary $ do- optionalSudo ("sudo yum-builddep" +-+ specFile)- cwd <- getCurrentDirectory- home <- getEnv "HOME"- let version = packageVersion pkg- cachedir = home </> ".cabal/packages/hackage.haskell.org" </> name </> version- tarFile = name ++ "-" ++ version ++ ".tar.gz"- rpmCmd = if binary then "a" else "s"- tarFileExists <- doesFileExist tarFile- unless tarFileExists $ do- trySystem ("cabal fetch -v0 --no-dependencies" +-+ name ++ "-" ++ version)- copyFile (cachedir </> tarFile) (cwd </> tarFile)- trySystem ("rpmbuild -b" ++ rpmCmd +-+- "--define \"_rpmdir" +-+ cwd ++ "\"" +-+- "--define \"_srcrpmdir" +-+ cwd ++ "\"" +-+- "--define \"_sourcedir" +-+ cwd ++ "\"" +-+- specFile)--defaultRelease :: UTCTime -> IO String-defaultRelease now = do- darcsRepo <- doesDirectoryExist "_darcs"- return $ if darcsRepo- then formatTime defaultTimeLocale "0.%Y%m%d" now- else "1"--rstrip :: (Char -> Bool) -> String -> String-rstrip p = reverse . dropWhile p . reverse--packageName :: PackageIdentifier -> String-packageName pkg = name- where PackageName name = pkgName pkg--packageVersion :: PackageIdentifier -> String-packageVersion pkg = (showVersion . pkgVersion) pkg--specFileName :: PackageDescription -- ^pkg description- -> RpmFlags -- ^rpm flags- -> IO FilePath-specFileName pkgDesc flags = do- let pkg = package pkgDesc- name = packageName pkg- pkgname = if isExec then name else "ghc-" ++ name- isExec = if (rpmLibrary flags) then False else hasExes pkgDesc- return $ pkgname ++ ".spec"--buildDependencies :: PackageDescription -> [String] -> [String]-buildDependencies pkgDesc excl = filter excludedPkgs $ nub $ map depName (buildDepends pkgDesc)- where excludedPkgs n = notElem n $ ["ghc-prim", "integer-gmp"] ++ excl--depName :: Dependency -> String-depName (Dependency (PackageName n) _) = n--showDep :: String -> String-showDep p = "ghc-" ++ p ++ "-devel"--createSpecFile :: FilePath -- ^pkg spec file- -> PackageDescription -- ^pkg description- -> RpmFlags -- ^rpm flags- -> IO ()-createSpecFile cabalPath pkgDesc flags = do- let verbose = rpmVerbosity flags- now <- getCurrentTime- defRelease <- defaultRelease now- let pkg = package pkgDesc- name = packageName pkg- pkgname = if isExec then name else "ghc-" ++ name- pkg_name = if isExec then "%{name}" else "%{pkg_name}"- version = packageVersion pkg- release = fromMaybe defRelease (rpmRelease flags)- specFile = pkgname ++ ".spec"- isExec = if (rpmLibrary flags) then False else hasExes pkgDesc- isLib = hasLibs pkgDesc- isBinLib = isExec && isLib- specAlreadyExists <- doesFileExist specFile- let specFilename = specFile ++ if (not $ rpmForce flags) && specAlreadyExists then ".cblrpm" else ""- when specAlreadyExists $ putStrLn $ specFile +-+ "exists:" +-+ "creating" +-+ specFilename- h <- openFile specFilename WriteMode- let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val)- padding hdr = replicate (14 - length hdr) ' ' ++ " "- putNewline = hPutStrLn h ""- put = hPutStrLn h- putDef v s = put $ "%global" +-+ v +-+ s- date = formatTime defaultTimeLocale "%a %b %e %Y" now- ghcPkg = if isBinLib then "-n ghc-%{name}" else ""- ghcPkgDevel = if isBinLib then "-n ghc-%{name}-devel" else "devel"-- put "# https://fedoraproject.org/wiki/Packaging:Haskell"- putNewline-- -- Some packages conflate the synopsis and description fields. Ugh.- let syn = synopsis pkgDesc- when (null syn) $- warn verbose "this package has no synopsis."- let syn' = if (null syn)- then ("Haskell" +-+ name +-+ "package")- else (unwords $ lines syn)- let summary = rstrip (== '.') syn'- when ((length $ "Summary : " ++ syn') > 79) $- warn verbose "this package has a long synopsis."-- let descr = description pkgDesc- when (null descr) $- warn verbose "this package has no description."- let common_description = (formatParagraphs . lines . finalPeriod) $- if (null descr) then syn' else descr- finalPeriod cs = if (last cs == '.') then cs else cs ++ "."- when isLib $ do- putDef "pkg_name" name- putNewline-- putHdr "Name" (if isExec then (if isLib then "%{pkg_name}" else pkgname) else "ghc-%{pkg_name}")- putHdr "Version" version- putHdr "Release" $ release ++ "%{?dist}"- putHdr "Summary" summary- putNewline- putHdr "License" $ (showLicense . license) pkgDesc- putHdr "URL" $ "http://hackage.haskell.org/package/" ++ pkg_name- putHdr "Source0" $ "http://hackage.haskell.org/packages/archive/" ++ pkg_name ++ "/%{version}/" ++ pkg_name ++ "-%{version}.tar.gz"- putNewline- putHdr "BuildRequires" "ghc-Cabal-devel"- putHdr "BuildRequires" $ "ghc-rpm-macros"-- let deps = buildDependencies pkgDesc [name, "Cabal", "base"]- buildinfo = allBuildInfo pkgDesc- excludedTools n = notElem n ["ghc", "perl"]- mapTools "gtk2hsC2hs" = "gtk2hs-buildtools"- mapTools "gtk2hsHookGenerator" = "gtk2hs-buildtools"- mapTools "gtk2hsTypeGen" = "gtk2hs-buildtools"- mapTools tool = tool- tools = filter excludedTools $ nub $ map (mapTools . depName) $ concat (map buildTools buildinfo)- excludedCLibs n = notElem n []- mapCLibs "curl" = "libcurl"- mapCLibs "glut" = "freeglut"- mapCLibs "iw" = "wireless-tools"- mapCLibs "z" = "zlib"- mapCLibs ('X':lib) = "libX" ++ lib- mapCLibs lib = lib- clibs = sort $ filter excludedCLibs $ nub $ map mapCLibs $ concat (map extraLibs buildinfo)- pkgcfgs = nub $ map depName $ concat (map pkgconfigDepends buildinfo)- showPkgCfg p = "pkgconfig(" ++ p ++ ")"-- when (not . null $ deps ++ tools ++ clibs ++ pkgcfgs) $ do- put "# Begin cabal-rpm deps:"- let pkgdeps = sort $ map showDep deps ++ tools ++ map (++ "-devel%{?_isa}") clibs ++ map showPkgCfg pkgcfgs- mapM_ (putHdr "BuildRequires") pkgdeps- when (any (\ d -> elem d ["template-haskell", "hamlet"]) deps) $- putHdr "ExclusiveArch" "%{ghc_arches_with_ghci}"- put "# End cabal-rpm deps"-- putNewline-- put "%description"- put $ unlines common_description-- when isLib $ do- when isExec $ do- put $ "%package" +-+ ghcPkg- putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library"- putNewline- put $ "%description" +-+ ghcPkg- put $ "This package provides the Haskell" +-+ pkg_name +-+ "shared library."- putNewline- putNewline- put $ "%package" +-+ ghcPkgDevel- putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "library development files"- putHdr "Requires" "ghc-compiler = %{ghc_version}"- putHdr "Requires(post)" "ghc-compiler = %{ghc_version}"- putHdr "Requires(postun)" "ghc-compiler = %{ghc_version}"- putHdr "Requires" $ (if isExec then "ghc-%{name}" else "%{name}") ++ "%{?_isa} = %{version}-%{release}"- when (not . null $ clibs ++ pkgcfgs) $ do- put "# Begin cabal-rpm deps:"- mapM_ (putHdr "Requires") $ map (++ "-devel%{?_isa}") clibs- mapM_ (putHdr "Requires") $ map showPkgCfg pkgcfgs- put "# End cabal-rpm deps"- putNewline- put $ "%description" +-+ ghcPkgDevel- let devel_descr_start = "This package provides the development files for"- devel_descr_middle = "the Haskell"- devel_descr_end = "library."- devel_descr_long = (length $ devel_descr_start +-+ devel_descr_middle +-+ name +-+ devel_descr_end) > 79- put $ "This package provides the development files for" ++- (if devel_descr_long then "\n" else " ") ++ "the Haskell" +-+ pkg_name +-+ "library."- putNewline- putNewline-- put "%prep"- put $ "%setup -q" ++ (if pkgname /= name then " -n %{pkg_name}-%{version}" else "")- putNewline- putNewline-- put "%build"- let pkgType = if isLib then "lib" else "bin"- put $ "%ghc_" ++ pkgType ++ "_build"- putNewline- putNewline-- put "%install"- put $ "%ghc_" ++ pkgType ++ "_install"- putNewline- putNewline-- when isLib $ do- put $ "%post" +-+ ghcPkgDevel- put "%ghc_pkg_recache"- putNewline- putNewline- put $ "%postun" +-+ ghcPkgDevel- put "%ghc_pkg_recache"- putNewline- putNewline-- docs <- findDocs cabalPath pkgDesc-- when isExec $ do- put "%files"- -- Add the license file to the main package only if it wouldn't- -- otherwise be empty.- unless (null $ licenseFile pkgDesc) $- put $ "%doc" +-+ licenseFile pkgDesc- unless (null docs) $- put $ "%doc" +-+ unwords docs-- withExe pkgDesc $ \exe ->- let program = exeName exe in- put $ "%{_bindir}/" ++ (if program == name then "%{name}" else program)- unless (null (dataFiles pkgDesc) && isExec) $- put "%{_datadir}/%{name}-%{version}"-- putNewline- putNewline-- when isLib $ do- let baseFiles = if isBinLib then "-f ghc-%{name}.files" else "-f %{name}.files"- develFiles = if isBinLib then "-f ghc-%{name}-devel.files" else "-f %{name}-devel.files"- put $ "%files" +-+ ghcPkg +-+ baseFiles- put $ "%doc" +-+ licenseFile pkgDesc- putNewline- putNewline- put $ "%files" +-+ ghcPkgDevel +-+ develFiles- unless (null docs) $- put $ "%doc" +-+ unwords docs- putNewline- putNewline-- put "%changelog"- put $ "*" +-+ date +-+ "Fedora Haskell SIG <haskell@lists.fedoraproject.org> - " ++ version ++ "-" ++ release- put $ "- spec file generated by cabal-rpm-" ++ showVersion Paths_cabal_rpm.version- hClose h--findDocs :: FilePath -> PackageDescription -> IO [FilePath]-findDocs cabalPath pkgDesc = do- contents <- getDirectoryContents $ dropFileName cabalPath- let docs = filter likely contents- return $ if null lf- then docs- else filter unlikely $ filter (/= lf) docs- where names = ["author", "copying", "doc", "example", "licence", "license",- "readme", "todo"]- likely name = let lowerName = map toLower name- in any (`isPrefixOf` lowerName) names- lf = licenseFile pkgDesc- unlikely name = not $ any (`isSuffixOf` name) ["~"]--showLicense :: License -> String-showLicense (GPL Nothing) = "GPL+"-showLicense (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+"-showLicense (LGPL Nothing) = "LGPLv2+"-showLicense (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+"-showLicense BSD3 = "BSD"-showLicense BSD4 = "BSD"-showLicense MIT = "MIT"-showLicense PublicDomain = "Public Domain"-showLicense AllRightsReserved = "Proprietary"-showLicense OtherLicense = "Unknown"-showLicense (UnknownLicense l) = "Unknown" +-+ l-#if MIN_VERSION_Cabal(1,16,0)-showLicense (Apache Nothing) = "ASL ?"-showLicense (Apache (Just ver)) = "ASL" +-+ showVersion ver-#endif---- from http://stackoverflow.com/questions/930675/functional-paragraphs--- using split would be: map unlines . (Data.List.Split.splitWhen null)-paragraphs :: [String] -> [String]-paragraphs = map unlines . map (filter $ not . null) . groupBy (const $ not . null)---- http://rosettacode.org/wiki/Word_wrap#Haskell-wordwrap :: Int -> String -> String-wordwrap maxlen = (wrap_ 0 False) . words where- wrap_ _ _ [] = "\n"- wrap_ pos eos (w:ws)- -- at line start: put down the word no matter what- | pos == 0 = w ++ wrap_ (pos + lw) endp ws- | pos + lw + 1 > maxlen - 9 && eos = '\n':wrap_ 0 endp (w:ws)- | pos + lw + 1 > maxlen = '\n':wrap_ 0 endp (w:ws)- | otherwise = " " ++ w ++ wrap_ (pos + lw + 1) endp ws- where lw = length w- endp = last w == '.'--formatParagraphs :: [String] -> [String]-formatParagraphs = map (wordwrap 79) . paragraphs
− src/Distribution/Package/Rpm/Main.hs
@@ -1,127 +0,0 @@--- |--- Module : Distribution.Package.Rpm.Main--- Copyright : Bryan O'Sullivan 2007--- Jens Petersen 2012------ Maintainer : Jens Petersen <petersen@fedoraproject.org>--- Stability : alpha--- Portability : portable------ Explanation: Main entry point for building RPM packages.---- This software may be used and distributed according to the terms of--- the GNU General Public License, incorporated herein by reference.--module Distribution.Package.Rpm.Main where--import Distribution.Compiler (CompilerFlavor (..))-import Distribution.Package.Rpm (createSpecFile, rpmBuild)-import Distribution.Package.Rpm.Setup (RpmFlags (..), parseArgs)-import Distribution.Package.Rpm.Utils (tryReadProcess, trySystem)--import Distribution.PackageDescription (GenericPackageDescription (..),- PackageDescription (..))-import Distribution.PackageDescription.Configuration (finalizePackageDescription)-import Distribution.PackageDescription.Parse (readPackageDescription)-import Distribution.Simple.Compiler (Compiler (..))-import Distribution.Simple.Configure (configCompiler)-import Distribution.Simple.Program (defaultProgramConfiguration)-import Distribution.Simple.Utils (defaultPackageDesc, die, findPackageDesc)-import Distribution.System (Platform (..), buildArch, buildOS)-import Data.List (isSuffixOf)-import Data.Maybe (isJust)-import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory,- removeDirectoryRecursive, setCurrentDirectory)-import System.Environment (getArgs)-import System.FilePath.Posix (takeExtension)--import Text.Regex (matchRegex, mkRegex)--main :: IO ()-main = do (opts, args) <- getArgs >>= parseArgs- let verbosity = rpmVerbosity opts- (cmd:args') = args- (cabalPath, mtmp) <- if null args'- then do- pth <- defaultPackageDesc verbosity- return (pth, Nothing)- else findCabalFile $ head args'- let verbose = rpmVerbosity opts- genPkgDesc <- readPackageDescription verbose cabalPath- pkgDesc <- simplePackageDescription genPkgDesc opts- case cmd of- "spec" -> createSpecFile cabalPath pkgDesc opts- "srpm" -> rpmBuild cabalPath pkgDesc opts False- "build" -> rpmBuild cabalPath pkgDesc opts True--- "install" ->--- "builddep" ->--- "showdeps" ->- c -> error $ "Unknown cmd: " ++ c- maybe (return ()) removeDirectoryRecursive mtmp--simplePackageDescription :: GenericPackageDescription -> RpmFlags- -> IO PackageDescription-simplePackageDescription genPkgDesc flags = do- (compiler, _) <- configCompiler (Just GHC) Nothing Nothing- defaultProgramConfiguration- (rpmVerbosity flags)- case finalizePackageDescription (rpmConfigurationsFlags flags)- (const True) (Platform buildArch buildOS) (compilerId compiler)- [] genPkgDesc of- Left e -> die $ "finalize failed: " ++ show e- Right (pd, _) -> return pd---- returns path to .cabal file and possibly tmpdir to be removed-findCabalFile :: FilePath -> IO (FilePath, Maybe FilePath)-findCabalFile path = do- isdir <- doesDirectoryExist path- if isdir- then do- putStrLn $ "Using " ++ path ++ "/"- file <- findPackageDesc path- return (file, Nothing)- else do- isfile <- doesFileExist path- if not isfile- then if (isJust $ matchRegex pkg_re path)- then do- tryUnpack path- else error $ path ++ ": No such file or directory"- else if takeExtension path == ".cabal"- then return (path, Nothing)- else if isSuffixOf ".tar.gz" path- then do- tmpdir <- mktempdir- trySystem $ "tar zxf " ++ path ++ " -C " ++ tmpdir ++ " *.cabal"- subdir <- tryReadProcess "ls" [tmpdir]- file <- findPackageDesc $ tmpdir ++ "/" ++ init subdir- return (file, Just tmpdir)- else error $ path ++ ": file should be a .cabal or .tar.gz file."- where pkg_re = mkRegex "^([A-Za-z0-9-]+)(-([0-9.]+))?$"-tryUnpack :: String -> IO (FilePath, Maybe FilePath)-tryUnpack pkg = do- pkgver <- if elem '.' pkg then return pkg- else do- contains_pkg <- tryReadProcess "cabal" ["list", "--simple-output", pkg]- let pkgs = filter ((== pkg) . fst . break (== ' ')) $ lines contains_pkg- if (null pkgs)- then error $ pkg ++ " hackage not found"- else return $ map (\c -> if c == ' ' then '-' else c) $ last pkgs- isdir <- doesDirectoryExist pkgver- if isdir- then do- pth <-findPackageDesc pkgver- return (pth, Nothing)- else do- cwd <- getCurrentDirectory- tmpdir <- mktempdir- setCurrentDirectory tmpdir- trySystem $ "cabal unpack -v0 " ++ pkgver- pth <- findPackageDesc pkgver- setCurrentDirectory cwd- return (tmpdir ++ "/" ++ pth, Just tmpdir)--mktempdir :: IO FilePath-mktempdir = do- mktempOut <- tryReadProcess "mktemp" ["-d"]- return $ init mktempOut
− src/Distribution/Package/Rpm/Setup.hs
@@ -1,126 +0,0 @@--- |--- Module : Distribution.Package.Rpm.Setup--- Copyright : Bryan O'Sullivan 2007, 2008--- Jens Petersen 2012------ Maintainer : Jens Petersen <petersen@fedoraproject.org>--- Stability : alpha--- Portability : portable------ Explanation: Command line option processing for building RPM--- packages.---- This software may be used and distributed according to the terms of--- the GNU General Public License, incorporated herein by reference.--module Distribution.Package.Rpm.Setup (- RpmFlags(..)- , parseArgs- ) where--import Control.Monad (unless, when)-import Data.Char (toLower)-import Data.Version (showVersion)--import Distribution.PackageDescription (FlagName (..))-import Distribution.ReadE (readEOrFail)-import Distribution.Verbosity (Verbosity, flagToVerbosity, normal)--import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..),- getOpt', usageInfo)-import System.Environment (getProgName)-import System.Exit (ExitCode (..), exitSuccess, exitWith)-import System.IO (Handle, hPutStr, hPutStrLn, stderr, stdout)--import Paths_cabal_rpm (version)--data RpmFlags = RpmFlags- { rpmConfigurationsFlags :: [(FlagName, Bool)]- , rpmForce :: Bool- , rpmHelp :: Bool- , rpmLibrary :: Bool- , rpmRelease :: Maybe String- , rpmVerbosity :: Verbosity- , rpmVersion :: Bool- }- deriving (Eq, Show)--emptyRpmFlags :: RpmFlags-emptyRpmFlags = RpmFlags- { rpmConfigurationsFlags = []- , rpmForce = False- , rpmHelp = False- , rpmLibrary = False- , rpmRelease = Nothing- , rpmVerbosity = normal- , rpmVersion = False- }--options :: [OptDescr (RpmFlags -> RpmFlags)]--options =- [- Option "h?" ["help"] (NoArg (\x -> x { rpmHelp = True }))- "Show this help text",- Option "l" ["library"] (NoArg (\x -> x { rpmLibrary = True }))- "Force package to be a Library ignoring executables",- Option "f" ["flags"] (ReqArg (\flags x -> x { rpmConfigurationsFlags = rpmConfigurationsFlags x ++ flagList flags }) "FLAGS")- "Set given flags in Cabal conditionals",- Option "" ["force"] (NoArg (\x -> x { rpmForce = True }))- "Overwrite existing spec file.",- Option "" ["release"] (ReqArg (\rel x -> x { rpmRelease = Just rel }) "RELEASE")- "Override the default package release",- Option "v" ["verbose"] (ReqArg (\verb x -> x { rpmVerbosity = readEOrFail flagToVerbosity verb }) "n")- "Change build verbosity",- Option "V" ["version"] (NoArg (\x -> x { rpmVersion = True }))- "Show version number"- ]---- Lifted from Distribution.Simple.Setup, since it's not exported.-flagList :: String -> [(FlagName, Bool)]-flagList = map tagWithValue . words- where tagWithValue ('-':name) = (FlagName (map toLower name), False)- tagWithValue name = (FlagName (map toLower name), True)--printHelp :: Handle -> IO ()--printHelp h = do- progName <- getProgName- let info = "Usage: " ++ progName ++ " [OPTION]... [COMMAND] [PKGDIR|PKG|PKG-VERSION|CABALFILE|TARBALL]\n"- ++ "\n"- ++ "Commands:\n"- ++ " spec\t generate a spec file\n"- ++ " srpm\t generate a src rpm file\n"- ++ " build\t build rpm package\n"--- ++ " install\t install rpm package\n"--- ++ " mock\t mock build package\n"- ++ "\n"- ++ "Options:"- hPutStrLn h (usageInfo info options)--parseArgs :: [String] -> IO (RpmFlags, [String])-parseArgs args = do- let (os, args', unknown, errs) = getOpt' RequireOrder options args- opts = foldl (flip ($)) emptyRpmFlags os- when (rpmHelp opts) $ do- printHelp stdout- exitSuccess- when (rpmVersion opts) $ do- hPutStrLn stdout $ showVersion version- exitSuccess- unless (null errs) $ do- hPutStrLn stderr "Error:"- mapM_ (hPutStrLn stderr) errs- exitWith (ExitFailure 1)- unless (null unknown) $ do- hPutStr stderr "Unrecognised options: "- hPutStrLn stderr $ unwords unknown- exitWith (ExitFailure 1)- when ((null args') || (notElem (head args') ["spec", "srpm", "build", "install"])) $ do- printHelp stderr- exitWith (ExitFailure 1)- when (length args' > 2) $ do- hPutStr stderr "Too many arguments: "- hPutStrLn stderr $ unwords args'- exitWith (ExitFailure 1)- return (opts, args')
− src/Distribution/Package/Rpm/Utils.hs
@@ -1,74 +0,0 @@--- |--- Module : Distribution.Package.Rpm.Utils--- Copyright : Jens Petersen 2013------ Maintainer : Jens Petersen <petersen@fedoraproject.org>--- Stability : alpha--- Portability : portable------ Explanation: Command line option processing for building RPM--- packages.---- This software may be used and distributed according to the terms of--- the GNU General Public License, incorporated herein by reference.--module Distribution.Package.Rpm.Utils (- requireProgram,- trySystem,- tryReadProcess,- optionalSudo,- (+-+)) where--import Control.Monad (when)-import Data.Maybe (isJust, isNothing)--import Distribution.Simple.Utils (die, warn, findProgramLocation)-import Distribution.Verbosity (normal)--import System.Process (readProcess, system)-import System.Exit (ExitCode(..))--requireProgram :: String -> IO ()-requireProgram cmd = do- mavail <- findProgramLocation normal cmd- when (isNothing mavail) $ die (cmd ++ ": command not found")--optionalProgram :: String -> IO Bool-optionalProgram cmd = do- mavail <- findProgramLocation normal cmd- when (isNothing mavail) $ warn normal (cmd ++ ": command not found")- return $ isJust mavail--optionalSudo :: String -> IO ()-optionalSudo cmd = do- havesudo <- optionalProgram "sudo"- when havesudo $ do- let argv = words cmd- cmd0 = head argv - mavail <- findProgramLocation normal cmd0- case mavail of- Nothing -> warn normal $ cmd0 ++ ": command not found"- Just _ -> do- ret <- system $ "sudo" +-+ cmd- case ret of- ExitSuccess -> return ()- ExitFailure n -> warn normal ("\"" ++ cmd ++ "\"" +-+ "failed with status" +-+ show n)--trySystem :: String -> IO ()-trySystem cmd = do- requireProgram $ head $ words cmd- ret <- system cmd- case ret of- ExitSuccess -> return ()- ExitFailure n -> die ("\"" ++ cmd ++ "\"" +-+ "failed with status" +-+ show n)--tryReadProcess :: FilePath -> [String] -> IO String-tryReadProcess cmd args = do- requireProgram cmd- readProcess cmd args []--(+-+) :: String -> String -> String-"" +-+ s = s-s +-+ "" = s-s +-+ t = s ++ " " ++ t-
+ src/Main.hs view
@@ -0,0 +1,120 @@+-- |+-- Module : Main+-- Copyright : Bryan O'Sullivan 2007+-- Jens Petersen 2012-2013+--+-- Maintainer : Jens Petersen <petersen@fedoraproject.org>+-- Stability : alpha+-- Portability : portable+--+-- Explanation: Main entry point for building RPM packages.++-- This software may be used and distributed according to the terms of+-- the GNU General Public License, incorporated herein by reference.++module Main where++import Commands.Build (rpmBuild)+import Commands.Spec (createSpecFile)+import Setup (RpmFlags (..), parseArgs)+import SysCmd (tryReadProcess, trySystem)++import Distribution.PackageDescription.Parse (readPackageDescription)+import Distribution.Simple.Utils (defaultPackageDesc, findPackageDesc)+import Data.List (isSuffixOf)+import Data.Maybe (isJust)+import System.Directory (doesDirectoryExist, doesFileExist, getCurrentDirectory,+ removeDirectoryRecursive, setCurrentDirectory)+import System.Environment (getArgs)+import System.FilePath.Posix (takeExtension)++import Text.Regex (matchRegex, mkRegex)++main :: IO ()+main = do (opts, args) <- getArgs >>= parseArgs+ let verbosity = rpmVerbosity opts+ (cmd:args') = args+ (cabalPath, mtmp) <- if null args'+ then do+ pth <- defaultPackageDesc verbosity+ return (pth, Nothing)+ else findCabalFile $ head args'+ let verbose = rpmVerbosity opts+ genPkgDesc <- readPackageDescription verbose cabalPath+ case cmd of+ "spec" -> createSpecFile cabalPath genPkgDesc opts+ "srpm" -> rpmBuild cabalPath genPkgDesc opts False+ "build" -> rpmBuild cabalPath genPkgDesc opts True+-- "install" ->+-- "builddep" ->+-- "showdeps" ->+ c -> error $ "Unknown cmd: " ++ c+ maybe (return ()) removeDirectoryRecursive mtmp++ -- where+ -- -- copied from Distribution.Simple.Configure configure+ -- depResolver = if build+ -- then not . null . PackageIndex.lookupDependency pkgs'+ -- else (const True)+ -- pkgs' = PackageIndex.insert internalPackage installedPackageSet+ -- pid = packageId genPkgDesc+ -- internalPackage = emptyInstalledPackageInfo {+ -- Installed.installedPackageId = InstalledPackageId $ display $ pid,+ -- Installed.sourcePackageId = pid+ -- }+ -- internalPackageSet = PackageIndex.fromList [internalPackage]++-- returns path to .cabal file and possibly tmpdir to be removed+findCabalFile :: FilePath -> IO (FilePath, Maybe FilePath)+findCabalFile path = do+ isdir <- doesDirectoryExist path+ if isdir+ then do+ putStrLn $ "Using " ++ path ++ "/"+ file <- findPackageDesc path+ return (file, Nothing)+ else do+ isfile <- doesFileExist path+ if not isfile+ then if (isJust $ matchRegex pkg_re path)+ then do+ tryUnpack path+ else error $ path ++ ": No such file or directory"+ else if takeExtension path == ".cabal"+ then return (path, Nothing)+ else if isSuffixOf ".tar.gz" path+ then do+ tmpdir <- mktempdir+ trySystem $ "tar zxf " ++ path ++ " -C " ++ tmpdir ++ " *.cabal"+ subdir <- tryReadProcess "ls" [tmpdir]+ file <- findPackageDesc $ tmpdir ++ "/" ++ init subdir+ return (file, Just tmpdir)+ else error $ path ++ ": file should be a .cabal or .tar.gz file."+ where pkg_re = mkRegex "^([A-Za-z0-9-]+)(-([0-9.]+))?$"+tryUnpack :: String -> IO (FilePath, Maybe FilePath)+tryUnpack pkg = do+ pkgver <- if elem '.' pkg then return pkg+ else do+ contains_pkg <- tryReadProcess "cabal" ["list", "--simple-output", pkg]+ let pkgs = filter ((== pkg) . fst . break (== ' ')) $ lines contains_pkg+ if (null pkgs)+ then error $ pkg ++ " hackage not found"+ else return $ map (\c -> if c == ' ' then '-' else c) $ last pkgs+ isdir <- doesDirectoryExist pkgver+ if isdir+ then do+ pth <-findPackageDesc pkgver+ return (pth, Nothing)+ else do+ cwd <- getCurrentDirectory+ tmpdir <- mktempdir+ setCurrentDirectory tmpdir+ trySystem $ "cabal unpack -v0 " ++ pkgver+ pth <- findPackageDesc pkgver+ setCurrentDirectory cwd+ return (tmpdir ++ "/" ++ pth, Just tmpdir)++mktempdir :: IO FilePath+mktempdir = do+ mktempOut <- tryReadProcess "mktemp" ["-d"]+ return $ init mktempOut
+ src/PackageUtils.hs view
@@ -0,0 +1,74 @@+-- |+-- Module : PackageUtils+-- Copyright : Jens Petersen 2013+--+-- Maintainer : Jens Petersen <petersen@fedoraproject.org>+-- Stability : alpha+-- Portability : portable+--+-- Explanation: functions related to Cabal dependency generation.++-- This software may be used and distributed according to the terms of+-- the GNU General Public License, incorporated herein by reference.++module PackageUtils (+ buildDependencies,+ depName,+ packageName,+ packageVersion,+ simplePackageDescription,+ showDep+ ) where++import Setup (RpmFlags (..))++import Data.List (nub)+import Data.Version (showVersion)++import Distribution.Compiler (CompilerFlavor (..))++import Distribution.Package (Dependency (..), PackageIdentifier (..),+ PackageName (..))+import Distribution.PackageDescription (GenericPackageDescription (..),+ PackageDescription (..))+import Distribution.PackageDescription.Configuration (finalizePackageDescription)++import Distribution.Simple.Compiler (Compiler (..))+import Distribution.Simple.Configure (configCompiler)+--import qualified Distribution.Simple.PackageIndex as PackageIndex+import Distribution.Simple.Program (defaultProgramConfiguration)+import Distribution.Simple.Utils (die)++import Distribution.System (Platform (..), buildArch, buildOS)++simplePackageDescription :: GenericPackageDescription -> RpmFlags+ -> IO PackageDescription+simplePackageDescription genPkgDesc flags = do+ (compiler, _) <- configCompiler (Just GHC) Nothing Nothing+ defaultProgramConfiguration+ (rpmVerbosity flags)+ case finalizePackageDescription (rpmConfigurationsFlags flags)+ (const True) (Platform buildArch buildOS) (compilerId compiler)+ [] genPkgDesc of+ Left e -> die $ "finalize failed: " ++ show e+ Right (pd, _) -> return pd++packageName :: PackageIdentifier -> String+packageName pkg = name+ where PackageName name = pkgName pkg++packageVersion :: PackageIdentifier -> String+packageVersion pkg = (showVersion . pkgVersion) pkg++-- returns list of deps and whether package is self-dependent+buildDependencies :: PackageDescription -> String -> ([String], Bool)+buildDependencies pkgDesc self =+ let deps = nub $ map depName (buildDepends pkgDesc)+ excludedPkgs n = notElem n $ [self, "Cabal", "base", "ghc-prim", "integer-gmp"] in+ (filter excludedPkgs deps, elem self deps)++depName :: Dependency -> String+depName (Dependency (PackageName n) _) = n++showDep :: String -> String+showDep p = "ghc-" ++ p ++ "-devel"
+ src/Setup.hs view
@@ -0,0 +1,126 @@+-- |+-- Module : Setup+-- Copyright : Bryan O'Sullivan 2007, 2008+-- Jens Petersen 2012-2013+--+-- Maintainer : Jens Petersen <petersen@fedoraproject.org>+-- Stability : alpha+-- Portability : portable+--+-- Explanation: Command line option processing for building RPM+-- packages.++-- This software may be used and distributed according to the terms of+-- the GNU General Public License, incorporated herein by reference.++module Setup (+ RpmFlags(..)+ , parseArgs+ ) where++import Control.Monad (unless, when)+import Data.Char (toLower)+import Data.Version (showVersion)++import Distribution.PackageDescription (FlagName (..))+import Distribution.ReadE (readEOrFail)+import Distribution.Verbosity (Verbosity, flagToVerbosity, normal)++import System.Console.GetOpt (ArgDescr (..), ArgOrder (..), OptDescr (..),+ getOpt', usageInfo)+import System.Environment (getProgName)+import System.Exit (ExitCode (..), exitSuccess, exitWith)+import System.IO (Handle, hPutStr, hPutStrLn, stderr, stdout)++import Paths_cabal_rpm (version)++data RpmFlags = RpmFlags+ { rpmConfigurationsFlags :: [(FlagName, Bool)]+ , rpmForce :: Bool+ , rpmHelp :: Bool+ , rpmLibrary :: Bool+ , rpmRelease :: Maybe String+ , rpmVerbosity :: Verbosity+ , rpmVersion :: Bool+ }+ deriving (Eq, Show)++emptyRpmFlags :: RpmFlags+emptyRpmFlags = RpmFlags+ { rpmConfigurationsFlags = []+ , rpmForce = False+ , rpmHelp = False+ , rpmLibrary = False+ , rpmRelease = Nothing+ , rpmVerbosity = normal+ , rpmVersion = False+ }++options :: [OptDescr (RpmFlags -> RpmFlags)]++options =+ [+ Option "h?" ["help"] (NoArg (\x -> x { rpmHelp = True }))+ "Show this help text",+ Option "l" ["library"] (NoArg (\x -> x { rpmLibrary = True }))+ "Force package to be a Library ignoring executables",+ Option "f" ["flags"] (ReqArg (\flags x -> x { rpmConfigurationsFlags = rpmConfigurationsFlags x ++ flagList flags }) "FLAGS")+ "Set given flags in Cabal conditionals",+ Option "" ["force"] (NoArg (\x -> x { rpmForce = True }))+ "Overwrite existing spec file.",+ Option "" ["release"] (ReqArg (\rel x -> x { rpmRelease = Just rel }) "RELEASE")+ "Override the default package release",+ Option "v" ["verbose"] (ReqArg (\verb x -> x { rpmVerbosity = readEOrFail flagToVerbosity verb }) "n")+ "Change build verbosity",+ Option "V" ["version"] (NoArg (\x -> x { rpmVersion = True }))+ "Show version number"+ ]++-- Lifted from Distribution.Simple.Setup, since it's not exported.+flagList :: String -> [(FlagName, Bool)]+flagList = map tagWithValue . words+ where tagWithValue ('-':name) = (FlagName (map toLower name), False)+ tagWithValue name = (FlagName (map toLower name), True)++printHelp :: Handle -> IO ()++printHelp h = do+ progName <- getProgName+ let info = "Usage: " ++ progName ++ " [OPTION]... [COMMAND] [PKGDIR|PKG|PKG-VERSION|CABALFILE|TARBALL]\n"+ ++ "\n"+ ++ "Commands:\n"+ ++ " spec\t generate a spec file\n"+ ++ " srpm\t generate a src rpm file\n"+ ++ " build\t build rpm package\n"+-- ++ " install\t install rpm package\n"+-- ++ " mock\t mock build package\n"+ ++ "\n"+ ++ "Options:"+ hPutStrLn h (usageInfo info options)++parseArgs :: [String] -> IO (RpmFlags, [String])+parseArgs args = do+ let (os, args', unknown, errs) = getOpt' RequireOrder options args+ opts = foldl (flip ($)) emptyRpmFlags os+ when (rpmHelp opts) $ do+ printHelp stdout+ exitSuccess+ when (rpmVersion opts) $ do+ hPutStrLn stdout $ showVersion version+ exitSuccess+ unless (null errs) $ do+ hPutStrLn stderr "Error:"+ mapM_ (hPutStrLn stderr) errs+ exitWith (ExitFailure 1)+ unless (null unknown) $ do+ hPutStr stderr "Unrecognised options: "+ hPutStrLn stderr $ unwords unknown+ exitWith (ExitFailure 1)+ when ((null args') || (notElem (head args') ["spec", "srpm", "build", "install"])) $ do+ printHelp stderr+ exitWith (ExitFailure 1)+ when (length args' > 2) $ do+ hPutStr stderr "Too many arguments: "+ hPutStrLn stderr $ unwords args'+ exitWith (ExitFailure 1)+ return (opts, args')
+ src/SysCmd.hs view
@@ -0,0 +1,83 @@+-- |+-- Module : SysCmd+-- Copyright : Jens Petersen 2013+--+-- Maintainer : Jens Petersen <petersen@fedoraproject.org>+-- Stability : alpha+-- Portability : portable+--+-- Explanation: Command line option processing for building RPM+-- packages.++-- This software may be used and distributed according to the terms of+-- the GNU General Public License, incorporated herein by reference.++module SysCmd (+ requireProgram,+ trySystem,+ tryReadProcess,+ optionalSudo,+ systemBool,+ (+-+)) where++import Control.Monad (when)+import Data.Maybe (isJust, isNothing)++import Distribution.Simple.Utils (die, warn, findProgramLocation)+import Distribution.Verbosity (normal)++import System.Process (readProcess, system)+import System.Exit (ExitCode(..))++requireProgram :: String -> IO ()+requireProgram cmd = do+ mavail <- findProgramLocation normal cmd+ when (isNothing mavail) $ die (cmd ++ ": command not found")++optionalProgram :: String -> IO Bool+optionalProgram cmd = do+ mavail <- findProgramLocation normal cmd+ when (isNothing mavail) $ warn normal (cmd ++ ": command not found")+ return $ isJust mavail++optionalSudo :: String -> IO ()+optionalSudo cmd = do+ havesudo <- optionalProgram "sudo"+ when havesudo $ do+ let argv = words cmd+ cmd0 = head argv + mavail <- findProgramLocation normal cmd0+ case mavail of+ Nothing -> warn normal $ cmd0 ++ ": command not found"+ Just _ -> do+ ret <- system $ "sudo" +-+ cmd+ case ret of+ ExitSuccess -> return ()+ ExitFailure n -> warn normal ("\"" ++ cmd ++ "\"" +-+ "failed with status" +-+ show n)++trySystem :: String -> IO ()+trySystem cmd = do+ requireProgram $ head $ words cmd+ ret <- system cmd+ case ret of+ ExitSuccess -> return ()+ ExitFailure n -> die ("\"" ++ cmd ++ "\"" +-+ "failed with status" +-+ show n)++systemBool :: String -> IO Bool+systemBool cmd = do+ requireProgram $ head $ words cmd+ ret <- system $ cmd +-+ ">/dev/null"+ case ret of+ ExitSuccess -> return True+ ExitFailure _ -> return False++tryReadProcess :: FilePath -> [String] -> IO String+tryReadProcess cmd args = do+ requireProgram cmd+ readProcess cmd args []++(+-+) :: String -> String -> String+"" +-+ s = s+s +-+ "" = s+s +-+ t = s ++ " " ++ t+