diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -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 diff --git a/cabal-rpm.cabal b/cabal-rpm.cabal --- a/cabal-rpm.cabal +++ b/cabal-rpm.cabal @@ -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 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 diff --git a/src/CabalRpm.hs b/src/CabalRpm.hs deleted file mode 100644 --- a/src/CabalRpm.hs +++ /dev/null @@ -1,20 +0,0 @@ --- | --- Module : CabalRpm --- Copyright : Bryan O'Sullivan 2007 --- --- Maintainer : Bryan O'Sullivan --- 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 diff --git a/src/Commands/Build.hs b/src/Commands/Build.hs new file mode 100644 --- /dev/null +++ b/src/Commands/Build.hs @@ -0,0 +1,98 @@ +-- | +-- Module : Commands.Build +-- Copyright : Bryan O'Sullivan 2007, 2008 +-- Jens Petersen 2012-2013 +-- +-- Maintainer : Jens Petersen +-- 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" diff --git a/src/Commands/Spec.hs b/src/Commands/Spec.hs new file mode 100644 --- /dev/null +++ b/src/Commands/Spec.hs @@ -0,0 +1,321 @@ +{-# LANGUAGE CPP #-} + +-- | +-- Module : Commands.Spec +-- Copyright : Bryan O'Sullivan 2007, 2008 +-- Jens Petersen 2012-2013 +-- +-- Maintainer : Jens Petersen +-- 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 - " ++ 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 diff --git a/src/Distribution/Package/Rpm.hs b/src/Distribution/Package/Rpm.hs deleted file mode 100644 --- a/src/Distribution/Package/Rpm.hs +++ /dev/null @@ -1,377 +0,0 @@ --- | --- Module : Distribution.Package.Rpm --- Copyright : Bryan O'Sullivan 2007, 2008 --- Jens Petersen 2012 --- --- Maintainer : Jens Petersen --- 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 - " ++ 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 diff --git a/src/Distribution/Package/Rpm/Main.hs b/src/Distribution/Package/Rpm/Main.hs deleted file mode 100644 --- a/src/Distribution/Package/Rpm/Main.hs +++ /dev/null @@ -1,127 +0,0 @@ --- | --- Module : Distribution.Package.Rpm.Main --- Copyright : Bryan O'Sullivan 2007 --- Jens Petersen 2012 --- --- Maintainer : Jens Petersen --- 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 diff --git a/src/Distribution/Package/Rpm/Setup.hs b/src/Distribution/Package/Rpm/Setup.hs deleted file mode 100644 --- a/src/Distribution/Package/Rpm/Setup.hs +++ /dev/null @@ -1,126 +0,0 @@ --- | --- Module : Distribution.Package.Rpm.Setup --- Copyright : Bryan O'Sullivan 2007, 2008 --- Jens Petersen 2012 --- --- Maintainer : Jens Petersen --- 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') diff --git a/src/Distribution/Package/Rpm/Utils.hs b/src/Distribution/Package/Rpm/Utils.hs deleted file mode 100644 --- a/src/Distribution/Package/Rpm/Utils.hs +++ /dev/null @@ -1,74 +0,0 @@ --- | --- Module : Distribution.Package.Rpm.Utils --- Copyright : Jens Petersen 2013 --- --- Maintainer : Jens Petersen --- 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 - diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,120 @@ +-- | +-- Module : Main +-- Copyright : Bryan O'Sullivan 2007 +-- Jens Petersen 2012-2013 +-- +-- Maintainer : Jens Petersen +-- 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 diff --git a/src/PackageUtils.hs b/src/PackageUtils.hs new file mode 100644 --- /dev/null +++ b/src/PackageUtils.hs @@ -0,0 +1,74 @@ +-- | +-- Module : PackageUtils +-- Copyright : Jens Petersen 2013 +-- +-- Maintainer : Jens Petersen +-- 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" diff --git a/src/Setup.hs b/src/Setup.hs new file mode 100644 --- /dev/null +++ b/src/Setup.hs @@ -0,0 +1,126 @@ +-- | +-- Module : Setup +-- Copyright : Bryan O'Sullivan 2007, 2008 +-- Jens Petersen 2012-2013 +-- +-- Maintainer : Jens Petersen +-- 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') diff --git a/src/SysCmd.hs b/src/SysCmd.hs new file mode 100644 --- /dev/null +++ b/src/SysCmd.hs @@ -0,0 +1,83 @@ +-- | +-- Module : SysCmd +-- Copyright : Jens Petersen 2013 +-- +-- Maintainer : Jens Petersen +-- 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 +