cabal-rpm 2.2.1 → 2.3.0
raw patch · 12 files changed
+300/−220 lines, 12 filesdep +html-entitiesdep +safedep ~simple-cabal
Dependencies added: html-entities, safe
Dependency ranges changed: simple-cabal
Files
- ChangeLog.md +13/−0
- README.md +1/−1
- cabal-rpm.cabal +17/−15
- src/Commands/Diff.hs +8/−3
- src/Commands/Spec.hs +62/−53
- src/Commands/Update.hs +5/−5
- src/Dependencies.hs +24/−22
- src/FileUtils.hs +3/−0
- src/Header.hs +8/−6
- src/Main.hs +8/−7
- src/PackageUtils.hs +133/−95
- src/Types.hs +18/−13
ChangeLog.md view
@@ -1,3 +1,16 @@+# 2.3.0 (2025-02-23)+- refactor all head/tail usage to safe functions (headMay and tailSafe)+- spec: explicit url+- spec: html entity decoding of description+- spec: simplify name and binlib logic+- spec: use %bcond to enable tests rather than %bcond_without+- spec: use -w for cabal update+- spec: use available source manpages+- Dependencies: add rts to excludedPkgs+- Dependencies: filter excludedTools from testToolDeps+- readStream replaces Read Stream for better error+- initial testsuite+ # 2.2.1 (2024-08-02) - getBuildDir: handle new rpm-4.20 BUILD/n-v-build dir - spec: --stream should be used first when determining stream
README.md view
@@ -72,7 +72,7 @@ `$ cabal-rpm --version` ```-2.2.1+2.3.0 ``` `$ cabal-rpm --help`
cabal-rpm.cabal view
@@ -1,6 +1,6 @@ Cabal-version: 1.18 Name: cabal-rpm-Version: 2.2.1+Version: 2.3.0 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package provides a RPM packaging tool for Haskell Cabal-based@@ -45,12 +45,14 @@ Main-is: Main.hs Build-depends: base < 5, aeson,- Cabal > 1.10 && < 3.11,+ Cabal > 1.10 && < 3.15, cached-json-file, directory, extra, filepath >= 1.4,+ html-entities, http-query,+ safe, simple-cabal >= 0.1.3, simple-cmd >= 0.2.3, simple-cmd-args >= 0.1.7,@@ -88,16 +90,16 @@ Paths_cabal_rpm Hs-Source-Dirs: src ghc-options: -fwarn-missing-signatures -Wall- if impl(ghc >= 8.0)- ghc-options: -Wcompat- -Widentities- -Wincomplete-uni-patterns- -Wincomplete-record-updates- -Wredundant-constraints- if impl(ghc >= 8.2)- ghc-options: -fhide-source-paths- if impl(ghc >= 8.4)- ghc-options: -Wmissing-export-lists- -Wpartial-fields- if impl(ghc >= 8.10)- ghc-options: -Wunused-packages+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages
src/Commands/Diff.hs view
@@ -32,7 +32,7 @@ import SimpleCmd (grep_, error', pipe) import System.FilePath ((<.>)) import System.IO.Extra (withTempDir)-import System.Posix.Env (getEnvDefault)+import System.Posix.Env (getEnv) diff :: Flags -> PackageType -> Maybe PackageVersionSpecifier -> IO () diff flags pkgtype mpvs = do@@ -46,8 +46,13 @@ currel <- getSpecField "Release" spec let suffix = "%{?dist}" editSpecField "Release" (currel ++ suffix) speccblrpm- diffcmd <- words <$> getEnvDefault "CBLRPM_DIFF" "diff -u"- out <- dropChangelog <$> pipe (head diffcmd, tail diffcmd ++ [spec, speccblrpm])+ mdiffcmd <- getEnv "CBLRPM_DIFF"+ let (diffc,diffargs) =+ case words <$> mdiffcmd of+ Nothing -> ("diff", ["-u"])+ Just (c:args) -> (c,args)+ _ -> error' "CBLRPM_DIFF is ill-defined"+ out <- dropChangelog <$> pipe (diffc, diffargs ++ [spec, speccblrpm]) ---- was for %autorelease: -- out <- pipe (head diffcmd, tail diffcmd ++ [spec, speccblrpm]) ("sed", ["-e", "s%" ++ speccblrpm ++ "%" ++ spec <.> "cblrpm" ++ "%"])
src/Commands/Spec.hs view
@@ -26,9 +26,9 @@ prettyShow, recurseMissing, subPackages, testsuiteDependencies') import Header (headerOption, withSpecHead)-import PackageUtils (dependencySortCabals, PackageData (..), prepare,- packageMacro)-import SimpleCabal (buildable, mkPackageName, PackageDescription (..),+import PackageUtils (builtExecs, dependencySortCabals, PackageData (..),+ packageMacro, prepare)+import SimpleCabal (mkPackageName, PackageDescription (..), PackageIdentifier(..)) import SimpleCmd ((+-+), cmd, cmdLines, cmdMaybe, grep, grep_, removePrefix) import Types@@ -42,38 +42,37 @@ import Data.Char (toUpper) import Data.List.Extra import Data.Maybe (isJust, isNothing, fromMaybe, fromJust)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB import Data.Time.Clock (getCurrentTime) import Data.Time.Format (defaultTimeLocale, formatTime) import qualified Data.Version as V import Distribution.PackageDescription (- Executable (buildInfo),- Library (exposedModules), exeName,+ Library (exposedModules), hasExes, hasLibs, #if MIN_VERSION_Cabal(2,2,0) license, #endif )- import Distribution.Simple.Utils (warn) import Distribution.Text (display)- #if MIN_VERSION_Cabal(2,0,0) import Distribution.Types.UnqualComponentName (unUnqualComponentName) #endif+#if MIN_VERSION_Cabal(3,2,0)+import qualified Distribution.Utils.ShortText as ST (fromShortText)+#endif import Distribution.Verbosity (Verbosity) +import qualified HTMLEntities.Decoder as HD import System.Directory (doesFileExist) import System.IO (IOMode (..), hClose, hPutStrLn, openFile)-import System.FilePath (takeBaseName, (</>), (<.>))+import System.FilePath (takeBaseName, takeFileName, (</>), (<.>)) import qualified Paths_cabal_rpm (version) -#if MIN_VERSION_Cabal(3,2,0)-import qualified Distribution.Utils.ShortText as ST (fromShortText)-#endif-- #if !MIN_VERSION_Cabal(2,0,0) unUnqualComponentName :: String -> String unUnqualComponentName = id@@ -91,6 +90,7 @@ _ -> specFilename pkgdata docs = docFilenames pkgdata licensefiles = licenseFilenames pkgdata+ manpages = manpageFiles pkgdata pkgDesc = packageDesc pkgdata pkgid = package pkgDesc name = display $ pkgName pkgid@@ -146,14 +146,14 @@ ghc_name = if isJust mwithghc then "%{ghc_name}" else "ghc" majorVer = V.showVersion . V.makeVersion . take 2 . V.versionBranch ghcname = "ghc" ++ maybe "" majorVer mwithghc- -- FIXME is binlib misnamed?- (pkgname, binlib) <- getPkgName mspec ghcname pkgDesc (pkgtype == BinaryPkg || standalone)+ -- binlib means package shipping both exe and proper lib+ (pkgname, binlib) <- getPkgName mspec ghcname pkgDesc (pkgtype == BinaryPkg) hasLibPkg let pkg_name = if pkgname == name then "%{name}" else "%{pkg_name}"+ hasExecPkg = binlib || (hasExec && not hasLibPkg) basename | binlib = "%{pkg_name}" | hasExecPkg = name | otherwise = ghc_name ++ "-%{pkg_name}" targetSpecFile = fromMaybe "" mdest </> pkgname <.> "spec"- hasExecPkg = binlib || (hasExec && not hasLibPkg) targetSpecAlreadyExists <- doesFileExist targetSpecFile -- run commands before opening file to prevent empty file on error -- maybe shell commands should be in a monad or something@@ -184,7 +184,7 @@ Just (PVPackageId _) -> return Nothing _ -> case mspec of Just spec ->- withSpecHead spec (return . fmap read . headerOption "--stream")+ withSpecHead spec (return . fmap readStream . headerOption "--stream") Nothing -> return Nothing h <- openFile outputFile WriteMode@@ -229,7 +229,7 @@ #endif description pkgDesc when (null descr) $ warn verbose "this package has no description."- let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod . paragraphPeriods) $ if null descr then syn' else descr+ let descLines = (formatParagraphs . initialCapital . filterSymbols . finalPeriod . paragraphPeriods . htmlEntityDecode) $ if null descr then syn' else descr paragraphPeriods = unlines . map (\l -> if l == "." then "" else l) . lines finalPeriod cs =@@ -239,13 +239,12 @@ _ -> cs ++ "." filterSymbols [] = [] filterSymbols (c:cs) =- if c `notElem` "@\\"- then c: filterSymbols cs- else- case c of- '@' -> '\'': filterSymbols cs- '\\' -> head cs: filterSymbols (tail cs)- _ -> c: filterSymbols cs+ case c of+ '@' -> '\'' : filterSymbols cs+ '\\' -> case cs of+ (c':cs') -> c': filterSymbols cs'+ "" -> ""+ _ -> c : filterSymbols cs when standalone $ do global "ghc_without_dynamic" "1"@@ -257,14 +256,14 @@ global "debug_package" "%{nil}" putNewline - when hasLib $ do+ when hasLibPkg $ do global "pkg_name" name global "pkgver" "%{pkg_name}-%{version}"- when (hasLib || subpackage) $ do+ when (hasLibPkg || subpackage) $ do put "%{?haskell_setup}" putNewline - let pkgver = if hasLib then "%{pkgver}" else pkg_name ++ "-%{version}"+ let pkgver = if hasLibPkg then "%{pkgver}" else pkg_name ++ "-%{version}" missingLibsLicenses <- do subs <- if subpackage then subPackages mspec pkgDesc else return []@@ -296,7 +295,7 @@ let testable = notNull testsuiteDeps && not standalone && null missTestDeps && not notestsuite && isNothing mwithghc if testable then do- put "%bcond_without tests"+ put "%bcond tests 1" putNewline else unless (null missTestDeps || standalone) $ do put $ "# testsuite missing deps: " ++ unwords (map display missTestDeps)@@ -319,7 +318,7 @@ return $ "CRLF" `isInfixOf` filetype else return False - putHdr "Name" (if binlib then "%{pkg_name}" else basename)+ putHdr "Name" basename putHdr "Version" version if autorelease && not subpackage then putHdr "Release" "%autorelease"@@ -331,7 +330,7 @@ putHdr "Summary" summary putNewline putHdr "License" $ (prettyShow . license) pkgDesc- putHdr "Url" $ "https://hackage.haskell.org/package" </> pkg_name+ putHdr "URL" $ "https://hackage.haskell.org/package" </> name put "# Begin cabal-rpm sources:" putHdr "Source0" $ sourceUrl pkgver when hasSubpkgs $@@ -379,9 +378,9 @@ when (isJust mwithghc) $ put "%endif" let usesOptparse = hasExecPkg && any ((`elem` buildDeps pkgdeps) . mkPackageName) ["optparse-applicative","optparse-simple","simple-cmd-args"]- when usesOptparse $+ when (usesOptparse && null manpages) $ putHdr "BuildRequires" "help2man"- let common = binlib && datafiles /= [] && not standalone+ let common = binlib && datafiles /= [] versionRelease = " = %{version}-%{release}" when common $ putHdr "Requires" $ "%{name}-common" ++ versionRelease@@ -512,7 +511,7 @@ put "# Begin cabal-rpm build:" if standalone then do global "cabal_install" "%{_bindir}/cabal"- put "%cabal_install update"+ put $ "%cabal_install update" +-+ (if isJust mwithghc then "-w ghc-%{ghc_major}" else "") put "%if %{defined rhel} && 0%{?rhel} < 9" put "%cabal_install sandbox init" -- FIXME support mwithghc?@@ -547,8 +546,8 @@ putNewline warn verbose $ "doc files found in datadir:" +-+ unwords dupdocs put $ "rm %{buildroot}%{_datadir}" </> pkgver </>- case length dupdocs of- 1 -> head dupdocs+ case dupdocs of+ [hd] -> hd _ -> "{" ++ intercalate "," dupdocs ++ "}" when (hasLibPkg && not hasModules) $@@ -557,14 +556,13 @@ when common $ put "mv %{buildroot}%{_ghcdocdir}{,-common}" - let execs = sort $ map exeName $ filter isBuildable $ executables pkgDesc+ let execs = builtExecs pkgDesc execNaming p = let pn = unUnqualComponentName p in if pn == name then "%{name}" else pn -- FIXME check for included file maybeGenerateBashCompletion exn = put $ "%{buildroot}%{_bindir}" </> exn +-+ "--bash-completion-script" +-+ exn +-+ "| sed s/filenames/default/ >" +-+ "%{buildroot}%{bash_completions_dir}" </> exn- -- FIXME check for included file- maybeGenerateManpage exn =+ generateManpage exn = put $ "help2man --no-info %{buildroot}%{_bindir}" </> exn +-+ ">" +-+ "%{buildroot}%{_mandir}/man1" </> exn <.> "1" when usesOptparse $ do@@ -573,10 +571,16 @@ put "mkdir -p %{buildroot}%{bash_completions_dir}" -- FIXME convert to for loop mapM_ (maybeGenerateBashCompletion . execNaming) execs+ when (null manpages) $ do+ putNewline+ put "mkdir -p %{buildroot}%{_mandir}/man1/"+ -- FIXME convert to for loop+ mapM_ (generateManpage . execNaming) execs+ unless (null manpages) $ do putNewline put "mkdir -p %{buildroot}%{_mandir}/man1/"- -- FIXME convert to for loop- mapM_ (maybeGenerateManpage . execNaming) execs+ forM_ manpages $ \man ->+ put $ "install -m 644 -p -t %{buildroot}%{_mandir}/man1/" +-+ man put "# End cabal-rpm install" sectionNewline@@ -606,7 +610,10 @@ put $ "%{_datadir}" </> pkgver when usesOptparse $ do mapM_ (put . ("%{bash_completions_dir}" </>) . execNaming) execs- mapM_ (put . (\e -> "%{_mandir}/man1" </> e <.> "1*") . execNaming) execs+ when (null manpages) $+ mapM_ (put . (\e -> "%{_mandir}/man1" </> e <.> "1*") . execNaming) execs+ unless (null manpages) $+ mapM_ (put . (\m -> "%{_mandir}/man1" </> takeFileName m ++ "*")) manpages put "# End cabal-rpm files" sectionNewline @@ -638,8 +645,11 @@ mapM_ (\l -> put $ license_macro +-+ l) licensefiles unless (common || null docs) $ put $ "%doc" +-+ unwords docs- unless binlib $+ unless binlib $ do mapM_ ((\p -> put $ "%{_bindir}" </> (if p == name then "%{pkg_name}" else p)) . unUnqualComponentName) execs+ unless (null manpages) $+ mapM_ (put . (\m -> "%{_mandir}/man1" </> takeFileName m ++ "*")) manpages+ -- put "# End cabal-rpm files" sectionNewline @@ -672,9 +682,6 @@ createSpecFile_ ignoreMissing verbose flags notestsuite force pkgtype subpkgStream mwithghc mpvs = void (createSpecFile ignoreMissing verbose flags False notestsuite force pkgtype subpkgStream mwithghc Nothing mpvs) -isBuildable :: Executable -> Bool-isBuildable exe = buildable $ buildInfo exe- sourceUrl :: String -> String sourceUrl pv = "https://hackage.haskell.org/package" </> pv </> pv <.> ".tar.gz" @@ -704,18 +711,16 @@ number :: [a] -> [(String,a)] number = zip (map show [(1::Int)..]) -getPkgName :: Maybe FilePath -> String -> PackageDescription -> Bool+getPkgName :: Maybe FilePath -> String -> PackageDescription -> Bool -> Bool -> IO (String, Bool)-getPkgName (Just spec) _ pkgDesc binary = do+getPkgName (Just spec) _ pkgDesc binary hasLibPkg = do let name = display . pkgName $ package pkgDesc pkgname = takeBaseName spec- hasLib = hasLibs pkgDesc- return $ if name == pkgname || binary then (name, hasLib) else (pkgname, False)-getPkgName Nothing ghcname pkgDesc binary = do+ return $ if name == pkgname || binary then (name, hasLibPkg) else (pkgname, False)+getPkgName Nothing ghcname pkgDesc binary hasLibPkg = do let name = display . pkgName $ package pkgDesc hasExec = hasExes pkgDesc- hasLib = hasLibs pkgDesc- return $ if binary || hasExec && not hasLib then (name, hasLib) else (ghcname ++ "-" ++ name, False)+ return $ if binary || hasExec && not hasLibPkg then (name, hasLibPkg) else (ghcname ++ "-" ++ name, False) quoteMacros :: String -> String quoteMacros "" = ""@@ -729,3 +734,7 @@ ifJust :: Maybe a -> (a -> IO Bool) -> IO Bool ifJust Nothing _ = return False ifJust (Just x) act = act x++htmlEntityDecode :: String -> String+htmlEntityDecode =+ TL.unpack . TLB.toLazyText . HD.htmlEncodedText . T.pack
src/Commands/Update.hs view
@@ -26,10 +26,6 @@ import Stackage (defaultLTS) import Types -import SimpleCabal (customFieldsPD, package,- PackageIdentifier (..), showVersion)-import SimpleCmd-import SimpleCmd.Git (grepGitConfig, rwGitDir) #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif@@ -38,6 +34,10 @@ import Data.Maybe import Distribution.Text (display) import Distribution.Verbosity (silent)+import SimpleCabal (customFieldsPD, package,+ PackageIdentifier (..), showVersion)+import SimpleCmd (cmd, cmd_, error', grep_, shell_, (+-+))+import SimpleCmd.Git (grepGitConfig, rwGitDir) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, removeDirectoryRecursive, renameFile) import System.FilePath ((<.>))@@ -59,7 +59,7 @@ Nothing -> do stream <- withSpecHead spec $ \ headerwords -> do- let mspecstream = read <$> headerOption "--stream" headerwords+ let mspecstream = readStream <$> headerOption "--stream" headerwords case mspecstream of Just specStream -> do putStrLn $ "Using stream" +-+ showStream specStream +-+ "from spec file"
src/Dependencies.hs view
@@ -41,29 +41,13 @@ import SysCmd (rpmEval) import Types -import SimpleCabal (allLibraries, buildDependencies, mkPackageName,- exeDepName, Library(..),- PackageDescription (package),- PackageIdentifier(..),- PackageName, pkgcfgDepName, pkgName,- setupDependencies, testsuiteDependencies,-#if !MIN_VERSION_Cabal(2,2,0)- showVersion,-#endif-#if MIN_VERSION_Cabal(2,0,0)- unPackageName-#endif- )-import SimpleCmd (cmd, cmdBool, removePrefix, removeSuffix, warning, (+-+))-import SimpleCmd.Rpm (rpmspec)- #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad (filterM, when, unless) import Data.List (delete, isSuffixOf, nub, (\\))-import Data.Maybe (catMaybes, fromJust, isJust, isNothing, mapMaybe)+import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, isNothing, mapMaybe) #if !MIN_VERSION_Cabal(2,2,0) import Distribution.License (License (..))@@ -78,13 +62,33 @@ #if MIN_VERSION_Cabal(2,0,0) import Distribution.Types.ExeDependency (ExeDependency(..)) #endif+import Safe (headMay)+import SimpleCabal (allLibraries, buildDependencies, mkPackageName,+ exeDepName, Library(..),+ PackageDescription (package),+ PackageIdentifier(..),+ PackageName, pkgcfgDepName, pkgName,+ setupDependencies, testsuiteDependencies,+#if !MIN_VERSION_Cabal(2,2,0)+ showVersion,+#endif+#if MIN_VERSION_Cabal(2,0,0)+ unPackageName+#endif+ )+import SimpleCmd (cmd, cmdBool, removePrefix, removeSuffix, warning, (+-+))+import SimpleCmd.Rpm (rpmspec) import System.Directory (doesDirectoryExist, doesFileExist) import System.FilePath ((<.>), (</>)) excludedPkgs :: PackageName -> Bool excludedPkgs =- flip notElem $ map mkPackageName ["ghc-prim", "integer-gmp", "system-cxx-std-lib"]+ flip notElem $ map mkPackageName ["ghc-prim", "integer-gmp", "rts", "system-cxx-std-lib"] +excludedTools :: String -> Bool+excludedTools n =+ n `notElem` ["ghc", "hsc2hs", "perl"]+ pkgSuffix :: LibPkgType -> String pkgSuffix lpt = if null rep then "" else '-' : rep@@ -168,7 +172,6 @@ -> IO PackageDependencies packageDependencies pkgDesc = do let (deps, setup, tools', clibs', pkgcfgs) = dependencies pkgDesc- excludedTools n = n `notElem` ["ghc", "hsc2hs", "perl"] tools = filter excludedTools $ nub $ map mapTools tools' -- nothing provides libpthread.so clibsWithErrors <- mapM resolveLib $ delete "pthread" clibs'@@ -192,7 +195,7 @@ where tests = map testBuildInfo $ testSuites pkgDesc testTools = map exeDepName $ concatMap buildTools tests- testToolDeps = concatMap buildToolDepends' tests+ testToolDeps = concatMap (filter excludedTools . buildToolDepends') tests missingPackages :: PackageDescription -> IO [RpmPackage] missingPackages pkgDesc = do@@ -256,8 +259,7 @@ else return res where singleLine :: String -> String- singleLine "" = ""- singleLine s = (head . lines) s+ singleLine = fromMaybe "" . headMay . lines subPackages :: Maybe FilePath -> PackageDescription -> IO [PackageName] subPackages mspec pkgDesc = do
src/FileUtils.hs view
@@ -21,6 +21,9 @@ filesWithExtension, fileWithExtension, fileWithExtension_,+#if !MIN_VERSION_filepath(1,4,2)+ isExtensionOf,+#endif listDirectory', mktempdir, withCurrentDirectory,
src/Header.hs view
@@ -6,7 +6,8 @@ where import Data.List (isPrefixOf)-import SimpleCmd (removePrefix)+import Safe (headMay, tailSafe)+import SimpleCmd (removePrefix, (+-+)) import FileUtils (assertFileNonEmpty) @@ -16,7 +17,10 @@ readFile spec >>= (act . headerWords) where headerWords :: String -> [String]- headerWords = words . head . lines+ headerWords s =+ case headMay $ lines s of+ Nothing -> error $ "empty" +-+ spec+ Just h -> words h headerVersion :: [String] -> String headerVersion headerwords =@@ -26,7 +30,5 @@ _ -> "0.9.11" headerOption :: String -> [String] -> Maybe String-headerOption opt headerwords =- if opt `elem` headerwords- then (Just . head . tail . dropWhile (/= opt)) headerwords- else Nothing+headerOption opt =+ headMay . tailSafe . dropWhile (/= opt)
src/Main.hs view
@@ -33,6 +33,7 @@ -- allows building with 0.1.6 --import Options.Applicative (maybeReader) #endif+import Safe (headMay, tailSafe) import System.IO (BufferMode(LineBuffering), hSetBuffering, stdout) import Commands.BuildDep (builddep)@@ -64,7 +65,7 @@ <*> quietOpt <*> flags <*> notestsuite- <*> force+ <*> pure False -- force <*> pkgtype <*> fmap toSubpkgStream subpackage <*> optional (readVersion <$> strOptionWith 'w' "with-ghc" "VERSION" "ghc compiler version")@@ -133,7 +134,7 @@ <*> pkgVerSpecifier , Subcommand "update" "Update package to latest version" $ update- <$> optional (optionWith auto 'o' "old-stream" "OLDSTREAM" "Current subpackage stream")+ <$> optional (readStream <$> strOptionWith 'o' "old-stream" "OLDSTREAM" "Current subpackage stream") <*> pkgVerSpecifier ] where@@ -147,8 +148,8 @@ mapToFlags Nothing = [] mapToFlags (Just cs) = let ws = words cs in- case partition (\w -> head w == '-') ws of- (ds,es) -> map (\f -> (mkFlagName f,True)) es ++ map (\f -> (mkFlagName (tail f),False)) ds+ case partition (\w -> headMay w == Just '-') ws of+ (ds,es) -> map (\f -> (mkFlagName f,True)) es ++ map (\f -> (mkFlagName (tailSafe f),False)) ds quietRpmbuild = switchWith 'q' "quiet" "Quiet rpmbuild output" verboseRpmbuild = flagWith True False 'v' "verbose" "Verbose rpmbuild output"@@ -156,8 +157,8 @@ notestsuite :: Parser Bool notestsuite = switchWith 'T' "no-tests" "Disable test-suite (even if deps available)" - force :: Parser Bool- force = switchWith 'F' "force" "Force overwriting existing of any .spec file"+ -- force :: Parser Bool+ -- force = switchWith 'F' "force" "Force overwriting existing of any .spec file" dryrun = switchWith 'n' "dry-run" "Just show patch" @@ -176,7 +177,7 @@ pkgVerSpecifier :: Parser (Maybe PackageVersionSpecifier) pkgVerSpecifier = streamPkgToPVS- <$> optional (optionWith auto 's' "stream" "STREAM" "Stackage stream or Hackage")+ <$> optional (readStream <$> strOptionWith 's' "stream" "STREAM" "Stackage stream or Hackage") <*> pkgId toSubpkgStream :: Bool -> Maybe (Maybe Stream)
src/PackageUtils.hs view
@@ -35,55 +35,86 @@ rpmInstall, RpmStage (..), packageMacro,- readGlobalMacro+ readGlobalMacro,+ builtExecs ) where -import Data.Ord (comparing, Down(Down))-import FileUtils (assertFileNonEmpty, filesWithExtension, fileWithExtension,- listDirectory', withTempDirectory)-import SimpleCabal (finalPackageDescription, licenseFiles, mkPackageName,- PackageDescription, PackageIdentifier(..), PackageName,- showPkgId, tryFindPackageDesc)-import SimpleCmd (cmd, cmd_, cmdBool, cmdIgnoreErr, cmdLines,- cmdStderrToStdoutIn, error', grep, grep_,- removePrefix, sudo, sudo_, (+-+))-import SimpleCmd.Git (isGitDir, grepGitConfig)-import SimpleCmd.Rpm (rpmspec)-import SysCmd (optionalProgram, requireProgram, rpmEval)-import Stackage (defaultLTS, latestStackage)-import Types- #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif import Control.Monad (filterM, forM_, unless, void, when)- import Data.List.Extra import Data.Maybe+import Data.Ord (comparing, Down(Down)) import Data.Time.Clock (diffUTCTime, getCurrentTime)-+import Distribution.PackageDescription (buildable, Executable(buildInfo),+ exeName, executables,+ ) import Distribution.Text (display, simpleParse)+#if MIN_VERSION_Cabal(2,0,0)+import Distribution.Types.UnqualComponentName (UnqualComponentName(),+ mkUnqualComponentName)+#endif #if MIN_VERSION_Cabal(3,6,0) import Distribution.Utils.Path (getSymbolicPath) #endif--import System.Directory+import Safe (headMay, tailSafe)+import SimpleCabal (finalPackageDescription, licenseFiles, mkPackageName,+ PackageDescription, PackageIdentifier(..), PackageName,+ showPkgId, tryFindPackageDesc)+import SimpleCmd (cmd, cmd_, cmdBool, cmdIgnoreErr, cmdLines,+ cmdStderrToStdoutIn, error', grep, grep_,+ removePrefix, sudo, sudo_, (+-+))+import SimpleCmd.Git (isGitDir, grepGitConfig)+import SimpleCmd.Rpm (rpmspec)+import System.Directory.Extra (copyFile, createDirectoryIfMissing,+ doesDirectoryExist, doesFileExist,+ getCurrentDirectory, getModificationTime,+ listFilesRecursive, withCurrentDirectory) import System.Environment (getEnv) import System.FilePath import System.IO (hIsTerminalDevice, stdout) import System.Posix.Files (accessTime, fileMode, getFileStatus, modificationTime, setFileMode) -simplePackageDescription :: Flags -> FilePath- -> IO (PackageDescription, [FilePath], [FilePath])-simplePackageDescription flags cabalfile = do+import FileUtils (assertFileNonEmpty, filesWithExtension, fileWithExtension,+#if !MIN_VERSION_filepath(1,4,2)+ isExtensionOf,+#endif+ listDirectory', withTempDirectory)+import SysCmd (optionalProgram, requireProgram, rpmEval)+import Stackage (defaultLTS, latestStackage)+import Types+++simplePackageDescription :: Flags -> FilePath -> Maybe FilePath+ -> IO PackageData+simplePackageDescription flags cabalfile mspec = do final <- finalPackageDescription flags cabalfile- (docs, licensefiles) <- findDocsLicenses (dropFileName cabalfile) final- return (final, docs, licensefiles)+ (docs, licensefiles, manpages) <- findDocsLicenses (dropFileName cabalfile) final+ return $ PackageData mspec final docs licensefiles manpages --- FIXME only include (doc) files listed in the .cabal file+builtExecs :: PackageDescription ->+#if MIN_VERSION_Cabal(2,0,0)+ [UnqualComponentName]+#else+ [String]+#endif+builtExecs = sort . map exeName . filter isBuildable . executables+ where+ isBuildable :: Executable -> Bool+ isBuildable = buildable . buildInfo++#if !MIN_VERSION_Cabal(2,0,0)+mkUnqualComponentName :: String -> String+mkUnqualComponentName = id+#endif++-- FIXME only include (doc/man) files listed in the .cabal file -- eg ChangeLog.md may exist but not dist packaged-findDocsLicenses :: FilePath -> PackageDescription -> IO ([FilePath], [FilePath])+-- (edge case for packaging from git repo)+findDocsLicenses :: FilePath -> PackageDescription+ -> IO ([FilePath], [FilePath], [FilePath]) findDocsLicenses dir pkgDesc = do contents <- listDirectory' dir let docs = sort $ filter unlikely $ filter (likely docNames) contents@@ -91,14 +122,19 @@ (map getSymbolicPath (licenseFiles pkgDesc) ++ filter (likely licenseNames) contents) docfiles = if null licenses then docs else filter (`notElem` licenses) docs- return (docfiles, licenses)- where docNames = ["announce", "author", "bugs", "changelog", "changes",- "contribut", "example", "news", "readme", "todo"]- licenseNames = ["copying", "licence", "license"]- likely :: [String] -> String -> Bool- likely names name = any (`isPrefixOf` lower name) names- unlikely name = not $ any (`isSuffixOf` name)- ["~", ".cabal", ".hs", ".hi", ".o"]+ let execs = builtExecs pkgDesc+ manpages <- filter (\f -> ".1" `isExtensionOf` f &&+ mkUnqualComponentName (takeBaseName f) `elem` execs) <$>+ withCurrentDirectory dir (listFilesRecursive ".")+ return (docfiles, licenses, manpages)+ where+ docNames = ["announce", "author", "bugs", "changelog", "changes",+ "contribut", "example", "news", "readme", "todo"]+ licenseNames = ["copying", "licence", "license"]+ likely :: [String] -> String -> Bool+ likely names name = any (`isPrefixOf` lower name) names+ unlikely name = not $ any (`isSuffixOf` name)+ ["~", ".cabal", ".hs", ".hi", ".o"] bringTarball :: PackageIdentifier -> Maybe FilePath -> IO () bringTarball pkgid mspec = do@@ -154,19 +190,20 @@ paths = map (\ repo -> cacheparent </> repo </> tarpath) remotes -- if more than one tarball, should maybe warn if they are different tarballs <- filterM doesFileExist paths- if null tarballs- then if ranFetch- then error $ "no" +-+ tarfile +-+ "found"- else do- cabal_ "fetch" ["-v0", "--no-dependencies", display pkgid']- copyTarball True dir file- else do- createDirectoryIfMissing True dir- copyFile (head tarballs) dest- -- cabal-1.18 fetch creates tarballs with mode 0600- stat <- getFileStatus dest- when (fileMode stat /= 0o100644) $- setFileMode dest 0o0644+ case tarballs of+ [] ->+ if ranFetch+ then error $ "no" +-+ tarfile +-+ "found"+ else do+ cabal_ "fetch" ["-v0", "--no-dependencies", display pkgid']+ copyTarball True dir file+ (tarball:_) -> do+ createDirectoryIfMissing True dir+ copyFile tarball dest+ -- cabal-1.18 fetch creates tarballs with mode 0600+ stat <- getFileStatus dest+ when (fileMode stat /= 0o100644) $+ setFileMode dest 0o0644 getSourceDir :: IO FilePath getSourceDir = do@@ -227,22 +264,25 @@ [ "--define="++ mcr +-+ cwd | gitDir, mcr <- ["_sourcedir"]] let args = ["-b" ++ singleton rpmCmd] ++ ["--nodeps" | mode == Prep] ++ rpmdirs_override ++ [spec]- if not quiet then- cmd_ "rpmbuild" args+ if not quiet+ then cmd_ "rpmbuild" args else do putStr $ "rpmbuild" +-+ show mode ++ ": " -- may hang for build (ok, out) <- cmdStderrToStdoutIn "rpmbuild" args "" if ok- then putStrLn "done"- else error' $ "\n" ++ dropToPrefix "+ /usr/bin/chmod -Rf" out+ then putStrLn "done"+ else error' $ "\n" ++ dropToPrefix "+ /usr/bin/chmod -Rf" out where dropToPrefix :: String -> String -> String dropToPrefix _ "" = "" dropToPrefix prefix cs = let ls = lines cs rest = dropWhile (not . (prefix `isPrefixOf`)) ls- in unlines (if null rest then tail ls else tail rest)+ in unlines $+ case rest of+ [] -> tailSafe ls+ (_:rs) -> rs #if !MIN_VERSION_base(4,15,0) singleton :: Char -> String@@ -321,18 +361,18 @@ else do let field = " Default available version: " let avails = map (removePrefix field) $ filter (isPrefixOf field) top- if null avails- then error $ pkg +-+ "latest available version not found"- else do- let res = pkg ++ "-" ++ head avails- putStrLn $ res +-+ "in Hackage"- return $ PackageIdentifier (mkPackageName pkg) $ readVersion $ head avails+ case avails of+ [] -> error $ pkg +-+ "latest available version not found"+ (avail:_) -> do+ let res = pkg ++ "-" ++ avail+ putStrLn $ res +-+ "in Hackage"+ return $ PackageIdentifier (mkPackageName pkg) $ readVersion avail checkForSpecFile :: Maybe PackageName -> IO (Maybe FilePath) checkForSpecFile mpkg = do allSpecs <- filesWithExtension "." ".spec" -- emacs makes ".#*.spec" tmp files- let predicate = maybe ((/= '.') . head) ((\ pkg -> (`elem` [pkg <.> "spec", "ghc-" ++ pkg <.> "spec"])) . display) mpkg+ let predicate = maybe ((/= Just '.') . headMay) ((\ pkg -> (`elem` [pkg <.> "spec", "ghc-" ++ pkg <.> "spec"])) . display) mpkg specs = filter predicate allSpecs when (specs /= allSpecs && isNothing mpkg) $ putStrLn "Warning: dir contains a hidden spec file"@@ -376,9 +416,7 @@ Nothing -> do mcabal <- checkForCabalFile mpkg case mcabal of- Just cabalfile -> do- (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile- return $ PackageData Nothing docs licenses pkgDesc+ Just cabalfile -> simplePackageDescription flags cabalfile Nothing Nothing -> case mpkg of Just pkg -> prepStreamPkg flags mnv Nothing defaultLTS pkg@@ -393,35 +431,39 @@ specPackageData spec = do assertFileNonEmpty spec cabalfile <- cabalFromSpec spec- (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile- return $ PackageData (Just spec) docs licenses pkgDesc+ simplePackageDescription flags cabalfile (Just spec) where cabalFromSpec :: FilePath -> IO FilePath cabalFromSpec specFile = do -- FIXME handle ghcX.Y havePkgname <- grep_ "%{pkg_name}" specFile -- FIXME handle bin packages starting with ghc, like "ghc-tags"- nv <- head- <$> rpmspec ["--srpm"] (Just "%{name}-%{version}") specFile- let namever = (if havePkgname then removePrefix "ghc-" else id) nv- case simpleParse namever of- Nothing -> error' $ "pkgid could not be parsed:" +-+ namever- Just pkgid -> do- bringTarball pkgid (Just specFile)- builddir <- getBuildDir $ Just nv- let pkgsrcdir = builddir </> namever- dExists <- doesDirectoryExist pkgsrcdir- if dExists- then do- specTime <- modificationTime <$> getFileStatus specFile- dirTime <- accessTime <$> getFileStatus pkgsrcdir- when (specTime > dirTime) $ do- rpmbuild True Prep specFile- dExists' <- doesDirectoryExist pkgsrcdir- when dExists' $ cmd_ "touch" [pkgsrcdir]- else- rpmbuild True Prep specFile- tryFindPackageDesc pkgsrcdir+ -- FIXME what about mnv above??+ mnv' <- headMay <$>+ rpmspec ["--srpm"] (Just "%{name}-%{version}") specFile+ case mnv' of+ Nothing -> error' $ "Failed to determine NVR for" +-+ specFile+ Just nv -> do+ let namever =+ (if havePkgname then removePrefix "ghc-" else id) nv+ case simpleParse namever of+ Nothing -> error' $ "pkgid could not be parsed:" +-+ namever+ Just pkgid -> do+ bringTarball pkgid (Just specFile)+ builddir <- getBuildDir $ Just nv+ let pkgsrcdir = builddir </> namever+ dExists <- doesDirectoryExist pkgsrcdir+ if dExists+ then do+ specTime <- modificationTime <$> getFileStatus specFile+ dirTime <- accessTime <$> getFileStatus pkgsrcdir+ when (specTime > dirTime) $ do+ rpmbuild True Prep specFile+ dExists' <- doesDirectoryExist pkgsrcdir+ when dExists' $ cmd_ "touch" [pkgsrcdir]+ else+ rpmbuild True Prep specFile+ tryFindPackageDesc pkgsrcdir -- findSpecFile :: PackageDescription -> RpmFlags -> IO (FilePath, Bool) -- findSpecFile pkgDesc flags = do@@ -432,9 +474,10 @@ data PackageData = PackageData { specFilename :: Maybe FilePath+ , packageDesc :: PackageDescription , docFilenames :: [FilePath] , licenseFilenames :: [FilePath]- , packageDesc :: PackageDescription+ , manpageFiles :: [FilePath] } prepPkgId :: Flags -> Maybe String -> Maybe FilePath@@ -442,8 +485,7 @@ prepPkgId flags mnv mspec pkgid = do void $ getRevisedCabal pkgid cabalfile <- tryUnpack mnv pkgid- (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile- return $ PackageData mspec docs licenses pkgDesc+ simplePackageDescription flags cabalfile mspec prepStreamPkg :: Flags -> Maybe String -> Maybe FilePath -> Stream -> PackageName -> IO PackageData@@ -451,9 +493,7 @@ pkgid <- latestPackage (Just stream) pkg mcabal <- checkForPkgCabalFile mnv pkgid case mcabal of- Just cabalfile -> do- (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile- return $ PackageData mspec docs licenses pkgDesc+ Just cabalfile -> simplePackageDescription flags cabalfile mspec Nothing -> prepPkgId flags mnv mspec pkgid prepare :: Flags -> Maybe String@@ -469,9 +509,7 @@ mspec <- checkForSpecFile $ Just (pkgName pkgid) mcabal <- checkForPkgCabalFile mpkgid pkgid case mcabal of- Just cabalfile -> do- (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile- return $ PackageData mspec docs licenses pkgDesc+ Just cabalfile -> simplePackageDescription flags cabalfile mspec Nothing -> prepPkgId flags mpkgid mspec pkgid PVStreamPackage stream Nothing -> do mspec <- checkForSpecFile Nothing
src/Types.hs view
@@ -24,8 +24,9 @@ readVersion, RpmPackage(..), showRpm,- showStream, Stream(..),+ readStream,+ showStream, streamPkgToPVS, unversionedPkgId, Verbose(..)@@ -50,7 +51,7 @@ import SimpleCabal (FlagName, {-- mkFlagName, --} PackageIdentifier(..), PackageName)-import SimpleCmd (error')+import SimpleCmd (error', (+-+)) data LibPkgType = Base | Devel | Prof | Doc | Static deriving Eq@@ -98,17 +99,21 @@ showStream (LTS ver) = "lts-" <> show ver showStream Hackage = "hackage" -instance Read Stream where- readsPrec _ "hackage" = [(Hackage,"")]- readsPrec _ "nightly" = [(LatestNightly,"")]- readsPrec _ "lts" = [(LatestLTS,"")]- readsPrec _ input | "nightly-" `isPrefixOf` input =- let (date,rest) = span (\ c -> isDigit c || c == '-') $ removePrefix "nightly-" input in- [(Nightly date,rest)]- readsPrec _ input | "lts-" `isPrefixOf` input =- let (ver,rest) = span isDigit $ removePrefix "lts-" input in- [(LTS (read ver),rest)]- readsPrec _ _ = []+readStream :: String -> Stream+readStream "hackage" = Hackage+readStream "nightly" = LatestNightly+readStream "lts" = LatestLTS+readStream input | "nightly-" `isPrefixOf` input =+ let (date,rest) = span (\ c -> isDigit c || c == '-') $ removePrefix "nightly-" input in+ if null rest+ then Nightly date+ else error $ "invalid Stream:" +-+ input+ | "lts-" `isPrefixOf` input =+ let (ver,rest) = span isDigit $ removePrefix "lts-" input in+ if null rest+ then LTS (read ver)+ else error $ "invalid Stream:" +-+ input+ | otherwise = error $ "invalid Stream:" +-+ input removePrefix :: String -> String-> String removePrefix pref orig = fromMaybe orig (stripPrefix pref orig)