cabal-rpm 1.0.3 → 2.0.0
raw patch · 19 files changed
+521/−333 lines, 19 filesdep +curl
Dependencies added: curl
Files
- ChangeLog +11/−0
- README.md +2/−3
- TODO +8/−8
- cabal-rpm.cabal +10/−7
- src/Commands/BuildDep.hs +5/−6
- src/Commands/Depends.hs +6/−7
- src/Commands/Diff.hs +4/−5
- src/Commands/Install.hs +18/−12
- src/Commands/Refresh.hs +19/−20
- src/Commands/RpmBuild.hs +10/−11
- src/Commands/Spec.hs +67/−40
- src/Commands/Update.hs +70/−48
- src/Dependencies.hs +11/−12
- src/FileUtils.hs +12/−3
- src/Header.hs +32/−0
- src/Main.hs +20/−21
- src/PackageUtils.hs +118/−76
- src/Stackage.hs +54/−44
- src/Types.hs +44/−10
ChangeLog view
@@ -1,3 +1,14 @@+# 2.0.0 (2020-01-15)+- major refactor to handle stream/pkgid more precisely and correctly+ (hence major version bump due to behavior changes)+ - eg can no longer specify both stream and pkg-ver+- check for package first in default LTS, then latest LTS, and Nightly,+ before Hackage+- respect and read/write --standalone and --stream in spec header consistently+ (note default LTS stream is not written to header)+- fix infinite loop for 'install'+- optioanlly use libcurl binding instead of former stackage-query fallback+ # 1.0.3 (2019-12-31) - define %_devel for f30 packaging compatibility - missingdeps and builddep fixes
README.md view
@@ -46,8 +46,7 @@ $ cabal-rpm spec somepkg-0.1 -which will unpack 'somepkg-0.1' from Hackage (unless the dir already exists),-and create a spec file for it.+which will create a spec file for it. cabal-rpm also works in an rpm package source directory or inside the source of a Haskell package:@@ -61,7 +60,7 @@ $ cabal-rpm install [pkg][-ver] will yum/dnf install any available missing dependencies and-build an rpm package run "cabal install" to build the package.+build rpms of the package. Additionally it will recursively package and install missing Haskell dependencies.
TODO view
@@ -1,11 +1,14 @@+- --without-tests/--disable-tests for install etc+- don't install prof deps for --standalone: use rpmspec to read BRs?++* filter dummy pkgs like fail, bytestring-builder and mtl-compat+ - switch to Cabal 2 for better License handling - check/warn about executable doc files!- - add rpmlint command-- prof install?+- add rpmlint command - spec --bounds - rework "BR: ghc-*-static" with %{?_isa}-- jump from lts-N to lts-N+1 instead of straight to Hackage - move Main to app? - check for cabal executable - revisions of subpackages@@ -13,7 +16,6 @@ ## Misc ? run "cabal update" if package-version not found-- read options from header line - use <> instead of ++ # Commands@@ -25,10 +27,8 @@ - filter or blockformat literate code in description ("> ...") ? use repoquery for missing testdeps - support tarballs again-* filter dummy pkgs like fail, bytestring-builder and mtl-compat - handle ghc-lzma -> lzma! - --releasever option (for repoquery)-- --without-tests - --no-revision ## version ranges@@ -47,8 +47,8 @@ ## update - warm about new missing deps - reverse deps and rebuilds-* update subpkg sources-- sort sources+? update subpkg sources+- depsort sources ## depends - dependency graphs or sorted recursive deps
cabal-rpm.cabal view
@@ -1,5 +1,5 @@ Name: cabal-rpm-Version: 1.0.3+Version: 2.0.0 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package provides a RPM packaging tool for Haskell Cabal-based packages.@@ -19,7 +19,7 @@ Author: Jens Petersen <juhpetersen@gmail.com>, Bryan O'Sullivan <bos@serpentine.com> Maintainer: Jens Petersen <petersen@fedoraproject.org> Copyright: 2007-2008 Bryan O'Sullivan <bos@serpentine.com>,- 2012-2019 Jens Petersen <juhpetersen@gmail.com>+ 2012-2020 Jens Petersen <juhpetersen@gmail.com> Category: Distribution Build-type: Simple Extra-source-files: ChangeLog Makefile README.md TODO man/cabal-rpm.1.md@@ -36,9 +36,9 @@ Description: Use old-locale and time < 1.5 Default: False -Flag https- Description: Use http to query Stackage (ghc >= 8.0)- Default: True+Flag curl+ Description: Use curl library to query Stackage instead of http-client+ Default: False Executable cabal-rpm Main-is: Main.hs@@ -59,12 +59,14 @@ Build-Depends: time >= 1.5 if impl(ghc<8.0) Build-Depends: semigroups- if impl(ghc >= 8.0) && flag(https)+ if impl(ghc >= 8.0) && !flag(curl) Build-Depends: bytestring, http-client >= 0.4.30, http-client-tls, http-conduit- Cpp-options: -DHTTPS+ else+ Build-Depends: curl+ Cpp-options: -DCURL Other-modules: Commands.BuildDep, Commands.Depends,@@ -76,6 +78,7 @@ Commands.Update, Dependencies, FileUtils,+ Header, PackageUtils, Stackage, SysCmd,
src/Commands/BuildDep.hs view
@@ -3,9 +3,8 @@ import Dependencies (pkgInstallMissing) import Types -import SimpleCabal (PackageIdentifier)--builddep :: Flags -> Stream -> Maybe PackageIdentifier -> IO ()-builddep flags stream mpkgid = do- missing <- pkgInstallMissing flags stream mpkgid- mapM_ (builddep flags stream . Just . unversionedPkgId) missing+builddep :: Flags -> Maybe PackageVersionSpecifier -> IO ()+builddep flags mpvs = do+ missing <- pkgInstallMissing flags mpvs+ let mstream = pvsStream =<< mpvs+ mapM_ (builddep flags . streamPkgToPVS mstream . Just . unversionedPkgId) missing
src/Commands/Depends.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Commands.Depends--- Copyright : (C) 2014-2019 Jens Petersen+-- Copyright : (C) 2014-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> -- Stability : alpha@@ -24,8 +24,6 @@ import PackageUtils (PackageData (..), prepare) import Types -import SimpleCabal (PackageIdentifier)- #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) #else import Control.Applicative ((<$>))@@ -38,9 +36,9 @@ data Depends = Depends | Requires | Missing -depends :: Depends -> Flags -> Stream -> Maybe PackageIdentifier -> IO ()-depends action flags stream mpkgid = do- pkgdata <- prepare flags stream mpkgid False+depends :: Depends -> Flags -> Maybe PackageVersionSpecifier -> IO ()+depends action flags mpvs = do+ pkgdata <- prepare flags mpvs False let pkgDesc = packageDesc pkgdata case action of Depends -> do@@ -56,4 +54,5 @@ mapM_ (putStrLn . showDep) missing let miss = mapMaybe hsDep missing unless (null miss) $ putStrLn ""- void $ recurseMissing flags stream [] miss+ let mstream = pvsStream =<< mpvs+ void $ recurseMissing flags mstream [] miss
src/Commands/Diff.hs view
@@ -25,7 +25,6 @@ import SysCmd (die, optionalProgram) import Types -import SimpleCabal (PackageIdentifier) import SimpleCmd (grep_, pipe_, pipe3_) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))@@ -37,15 +36,15 @@ import System.FilePath ((<.>)) import System.Posix.Env (getEnvDefault) -diff :: Flags -> PackageType -> Stream -> Maybe PackageIdentifier -> IO ()-diff flags pkgtype stream mpkgid = do- pkgdata <- prepare flags stream mpkgid True+diff :: Flags -> PackageType -> Maybe PackageVersionSpecifier -> IO ()+diff flags pkgtype mpvs = do+ pkgdata <- prepare flags mpvs True case specFilename pkgdata of Nothing -> die "No (unique) .spec file in directory." Just spec -> do subpkg <- grep_ "%{subpkgs}" spec tmpdir <- mktempdir- speccblrpm <- createSpecFile silent flags False pkgtype subpkg stream (Just tmpdir) mpkgid+ speccblrpm <- createSpecFile silent flags False pkgtype subpkg (Just tmpdir) mpvs diffcmd <- words <$> getEnvDefault "CBLRPM_DIFF" "diff -u" hsp <- optionalProgram "hsp" if hsp
src/Commands/Install.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Commands.Install--- Copyright : (C) 2012-2019 Jens Petersen+-- Copyright : (C) 2012-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> -- Stability : alpha@@ -19,14 +19,14 @@ install ) where -import Commands.RpmBuild (rpmBuild)+import Commands.RpmBuild (rpmBuild, rpmBuild_) import Dependencies (notInstalled, pkgInstallMissing) import FileUtils (withTempDirectory)-import PackageUtils (rpmInstall, RpmStage (..))+import PackageUtils (checkForSpecFile, rpmInstall, RpmStage (..)) import SysCmd (rpmEval) import Types -import SimpleCabal(PackageIdentifier, PackageName)+import SimpleCabal(PackageName) import SimpleCmd (cmd_, (+-+)) import SimpleCmd.Rpm (rpmspec) @@ -38,17 +38,23 @@ import Distribution.Text (display) import System.FilePath ((</>)) -install :: Flags -> PackageType -> Bool -> Stream -> Maybe PackageIdentifier- -> IO ()-install flags pkgtype subpackage stream mpkgid = do- stillMissing <- pkgInstallMissing flags stream mpkgid+install :: Flags -> PackageType -> Bool -> Maybe PackageVersionSpecifier -> IO ()+install flags pkgtype subpackage mpvs = do+ stillMissing <- pkgInstallMissing flags mpvs unless (null stillMissing) $ do putStrLn $ "Missing:" +-+ unwords (map display stillMissing) mapM_ cblrpmInstallMissing stillMissing- withTempDirectory $ \ _ -> do- spec <- rpmBuild Binary flags pkgtype subpackage stream mpkgid- rpmdir <- rpmEval "%{_rpmdir}"- rpmspec [] (fmap (</> "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm") rpmdir) spec >>= rpmInstall False+ mspec <- checkForSpecFile (pvsPackage =<< mpvs)+ case mspec of+ Nothing ->+ withTempDirectory $ \ _ -> do+ spec <- rpmBuild Binary flags pkgtype subpackage mpvs+ rpmdir <- rpmEval "%{_rpmdir}"+ rpmspec [] (fmap (</> "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm") rpmdir) spec >>= rpmInstall False+ Just spec -> do+ rpmBuild_ Binary flags pkgtype subpackage mpvs+ rpmdir <- rpmEval "%{_rpmdir}"+ rpmspec [] (fmap (</> "%{arch}/%{name}-%{version}-%{release}.%{arch}.rpm") rpmdir) spec >>= rpmInstall False cblrpmInstallMissing :: PackageName -> IO () cblrpmInstallMissing pkg = do
src/Commands/Refresh.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Commands.Refresh--- Copyright : (C) 2016-2019 Jens Petersen+-- Copyright : (C) 2016-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> --@@ -20,13 +20,13 @@ import Paths_cabal_rpm (version) import Commands.Spec (createSpecFile) import FileUtils (withTempDirectory)+import Header (headerVersion, withSpecHead) import PackageUtils (PackageData (..), cabal_, patchSpec, prepare) import SysCmd (die, optionalProgram) import Types -import SimpleCabal(PackageIdentifier)-import SimpleCmd (cmd, cmd_, grep_, removePrefix)+import SimpleCmd (cmd, cmd_, grep_) import SimpleCmd.Git (rwGitDir) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))@@ -34,7 +34,6 @@ import Control.Applicative ((<$>)) #endif import Control.Monad (unless, when)-import Data.List (isPrefixOf) import Data.Version (showVersion) import Distribution.Verbosity (silent) import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist,@@ -43,9 +42,9 @@ --import System.Exit (exitSuccess) import System.FilePath ((</>), (<.>)) -refresh :: Bool -> PackageType -> Stream -> Maybe PackageIdentifier -> IO ()-refresh dryrun pkgtype stream mpkgid = do- pkgdata <- prepare [] stream mpkgid True+refresh :: Bool -> PackageType -> Maybe PackageVersionSpecifier -> IO ()+refresh dryrun pkgtype mpvs = do+ pkgdata <- prepare [] mpvs True case specFilename pkgdata of Nothing -> die "No (unique) .spec file in directory." Just spec -> do@@ -55,19 +54,19 @@ unless (null local) $ putStrLn "Working dir contain local changes!" -- exitSuccess- first <- head . lines <$> readFile spec- -- filter "--subpackage", etc- let cblrpmver = head . words $- if "# generated by cabal-rpm-" `isPrefixOf` first- then removePrefix "# generated by cabal-rpm-" first- else "0.9.11"- if cblrpmver == showVersion version- then putStrLn "Packaging is up to date"- else do- subpkg <- grep_ "%{subpkgs}" spec- oldspec <- createOldSpec subpkg cblrpmver spec- newspec <- createSpecFile silent [] False pkgtype subpkg stream Nothing mpkgid- patchSpec dryrun Nothing oldspec newspec+ withSpecHead spec $ \ headerwords -> do+ let cblrpmver = headerVersion headerwords+ if cblrpmver == showVersion version+ then putStrLn "Packaging is up to date"+ else do+ let spectype =+ case pkgtype of+ DefaultPkg | "--standalone" `elem` headerwords -> StandalonePkg+ _ -> pkgtype+ subpkg <- grep_ "%{subpkgs}" spec+ oldspec <- createOldSpec subpkg cblrpmver spec+ newspec <- createSpecFile silent [] False spectype subpkg Nothing mpvs+ patchSpec dryrun Nothing oldspec newspec -- setCurrentDirectory cwd -- when rwGit $ -- cmd_ "git" ["commit", "-a", "-m", "refreshed to cabal-rpm-" ++ showVersion version]
src/Commands/RpmBuild.hs view
@@ -27,7 +27,7 @@ rpmbuild, RpmStage (..)) import Types -import SimpleCabal (package, PackageIdentifier)+import SimpleCabal (package) import SimpleCmd ((+-+)) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))@@ -37,16 +37,15 @@ import Control.Monad (void, when) import Distribution.Verbosity (normal) -rpmBuild :: RpmStage -> Flags -> PackageType -> Bool -> Stream ->- Maybe PackageIdentifier -> IO FilePath-rpmBuild stage flags pkgtype subpackage stream mpkgid = do- pkgdata <- prepare flags stream mpkgid True+rpmBuild :: RpmStage -> Flags -> PackageType -> Bool+ -> Maybe PackageVersionSpecifier -> IO FilePath+rpmBuild stage flags pkgtype subpackage mpvs = do+ pkgdata <- prepare flags mpvs True when (stage == Binary) $ void $ pkgInstallMissing' pkgdata- let pkgDesc = packageDesc pkgdata mspec = specFilename pkgdata- specFile <- maybe (createSpecFile normal flags False pkgtype subpackage stream Nothing mpkgid)+ specFile <- maybe (createSpecFile normal flags False pkgtype subpackage Nothing mpvs) (\ s -> putStrLn ("Using existing" +-+ s) >> return s) mspec let pkgid = package pkgDesc@@ -55,7 +54,7 @@ return specFile -rpmBuild_ :: RpmStage -> Flags -> PackageType -> Bool -> Stream ->- Maybe PackageIdentifier -> IO ()-rpmBuild_ stage flags pkgtype subpackage stream mpkgid =- void $ rpmBuild stage flags pkgtype subpackage stream mpkgid+rpmBuild_ :: RpmStage -> Flags -> PackageType -> Bool+ -> Maybe PackageVersionSpecifier -> IO ()+rpmBuild_ stage flags pkgtype subpackage mpvs =+ void $ rpmBuild stage flags pkgtype subpackage mpvs
src/Commands/Spec.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Commands.Spec -- Copyright : (C) 2007-2008 Bryan O'Sullivan--- (C) 2012-2019 Jens Petersen+-- (C) 2012-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> -- Stability : alpha@@ -24,11 +24,13 @@ missingOtherPkgs, notSrcOrInst, packageDeps, packageDependencies, pkgSuffix, subPackages, testsuiteDependencies')-import Types+import Header (headerOption, withSpecHead) import PackageUtils (bringTarball, latestPackage, PackageData (..), prepare) import SimpleCabal (buildable, mkPackageName, PackageDescription (..), PackageIdentifier(..), PackageName, showVersion) import SimpleCmd ((+-+), removePrefix)+import Stackage (defaultLTS)+import Types import Control.Monad (filterM, unless, void, when, (>=>)) @@ -88,10 +90,11 @@ unUnqualComponentName = id #endif -createSpecFile :: Verbosity -> Flags -> Bool -> PackageType -> Bool -> Stream- -> Maybe FilePath -> Maybe PackageIdentifier -> IO FilePath-createSpecFile verbose flags force pkgtype subpackage stream mdest mpkgid = do- pkgdata <- prepare flags stream mpkgid True+createSpecFile :: Verbosity -> Flags -> Bool -> PackageType -> Bool+ -> Maybe FilePath -> Maybe PackageVersionSpecifier+ -> IO FilePath+createSpecFile verbose flags force pkgtype subpackage mdest mpvs = do+ pkgdata <- prepare flags mpvs True let mspec = case pkgtype of SpecFile f -> Just f _ -> specFilename pkgdata@@ -100,8 +103,18 @@ pkgDesc = packageDesc pkgdata pkgid = package pkgDesc name = display $ pkgName pkgid- standalone = pkgtype == StandalonePkg- hasExec = hasExes pkgDesc++ standalone <- if pkgtype == StandalonePkg then return True+ else+ case mspec of+ Nothing -> return False+ Just spec -> do+ specExists <- doesFileExist spec+ if specExists then+ withSpecHead spec $ return . ("--standalone" `elem`)+ else return False++ let hasExec = hasExes pkgDesc hasLib = hasLibs pkgDesc hasLibPkg = hasLib && not standalone dupdocs = docs `intersect` dataFiles pkgDesc@@ -111,22 +124,31 @@ basename | binlib = "%{pkg_name}" | hasExecPkg = name | otherwise = "ghc-%{pkg_name}"- specFile = fromMaybe "" mdest </> pkgname <.> "spec"+ targetSpecFile = fromMaybe "" mdest </> pkgname <.> "spec" hasExecPkg = binlib || (hasExec && not hasLibPkg) -- run commands before opening file to prevent empty file on error -- maybe shell commands should be in a monad or something (deps, setupDeps, tools, clibs, pkgcfgs) <- packageDependencies pkgDesc-- specAlreadyExists <- doesFileExist specFile- let specFile' = specFile ++ if not force && specAlreadyExists then ".cblrpm" else ""- if specAlreadyExists- then warn verbose $ specFile +-+ "exists:" +-+ (if force then "forcing overwrite" else "creating") +-+ specFile'+ targetSpecAlreadyExists <- doesFileExist targetSpecFile+ let outputFile = targetSpecFile ++ if not force && targetSpecAlreadyExists then ".cblrpm" else ""+ if targetSpecAlreadyExists+ then warn verbose $ targetSpecFile +-+ "exists:" +-+ (if force then "forcing overwrite" else "creating") +-+ outputFile else do let realdir dir = "cblrpm." `isPrefixOf` takeBaseName dir when (maybe True realdir mdest) $ putStrLn pkgname - h <- openFile specFile' WriteMode+ mstream <- case pvsStream =<< mpvs of+ Just s -> return $ Just s+ Nothing ->+ case mpvs of+ Just (PVPackageId _) -> return Nothing+ _ -> case mspec of+ Just spec ->+ withSpecHead spec (return . fmap read . headerOption "--stream")+ Nothing -> return Nothing++ h <- openFile outputFile WriteMode let putHdr hdr val = hPutStrLn h (hdr ++ ":" ++ padding hdr ++ val) padding hdr = replicate (14 - length hdr) ' ' ++ " " putHdrComment hdr val = putHdr ('#':hdr) (' ':val)@@ -137,7 +159,7 @@ subpkgParam lt = if binlib then "-n ghc-%{name}" ++ pkgSuffix lt else show lt put $ "# generated by cabal-rpm-" ++ V.showVersion Paths_cabal_rpm.version- +-+ unwords (["--standalone" | standalone] ++ ["--subpackage" | subpackage])+ +-+ unwords (["--standalone" | standalone] ++ ["--stream " ++ showStream (fromJust mstream) | isJust mstream, mstream /= Just defaultLTS] ++ ["--subpackage" | subpackage]) put "# https://fedoraproject.org/wiki/Packaging:Haskell" putNewline @@ -179,13 +201,14 @@ global "pkg_name" name global "pkgver" "%{pkg_name}-%{version}" putNewline- global "_devel" $- if hasLib- -- rpm-4.15 supports %{expr:b?t:f} (not in rhel8)- then "-%{?ghc_devel_prof}%{!?ghc_devel_prof:devel}"- -- FIXME: use static%{_isa}- else "-%{?ghc_devel_prof:static}%{!?ghc_devel_prof:devel}"- putNewline+ unless standalone $ do+ global "_devel" $+ if hasLib+ -- rpm-4.15 supports %{expr:b?t:f} (not in rhel8)+ then "%{?ghc_devel_prof}%{!?ghc_devel_prof:devel}"+ -- FIXME: use static%{_isa}+ else "%{?ghc_devel_prof:static}%{!?ghc_devel_prof:devel}"+ putNewline let pkgver = if hasLib then "%{pkgver}" else pkg_name ++ "-%{version}" @@ -196,8 +219,11 @@ miss <- if subpackage || standalone then missingLibraries hasLibPkg pkgDesc else return [] return $ nub (subs ++ miss) subpkgs <- if subpackage then- mapM (getsubpkgMacro stream specFile >=>- \(m,pv) -> global m (display pv) >> return ("%{" ++ m ++ "}")) missingLibs+ case mspec of+ Just spec ->+ mapM (getsubpkgMacro mstream spec >=>+ \(m,pv) -> global m (display pv) >> return ("%{" ++ m ++ "}")) missingLibs+ Nothing -> return [] else return [] let hasSubpkgs = subpkgs /= [] when hasSubpkgs $ do@@ -243,7 +269,7 @@ unless (null deps) $ -- put "# Build"- mapM_ (\ d -> (if d `elem` missingLibs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Base d) ++ "%{_devel}")) $ sort deps+ mapM_ (\ d -> (if d `elem` missingLibs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Base d) ++ if standalone then "-devel" else "-%{_devel}")) $ sort deps let otherdeps = sort $ tools ++ clibs ++ pkgcfgs unless (null otherdeps) $ do -- put "# Other"@@ -266,14 +292,15 @@ put "# End cabal-rpm deps" when standalone $ do putHdr "BuildRequires" "cabal-install > 1.18"- unless (null missingLibs) $+ unless (null missingLibs) $ do+ putStrLn "checking for deps of missing dependencies:" let putPkgDeps pkg = do- more <- packageDeps flags stream pkg+ more <- packageDeps flags Nothing pkg let moredeps = more \\ (deps ++ missingLibs) unless (null moredeps) $ do- put $ "# deps for missing" +-+ display pkg ++ ":"- mapM_ (\ d -> (if d `elem` missingLibs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Static d))) moredeps- in mapM_ putPkgDeps missingLibs+ put $ "# for missing dep:" +-+ display pkg ++ ":"+ mapM_ (\ d -> (if d `elem` missingLibs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Devel d))) moredeps+ mapM_ putPkgDeps missingLibs putNewline put "%description"@@ -335,8 +362,8 @@ put $ "%description" +-+ subpkgParam Doc put $ wrapGenDesc $ "This package provides the Haskell" +-+ pkg_name +-+ "library documentation." put "%endif"+ {- HLINT ignore "Reduce duplication"-} sectionNewline- put "%if %{with ghc_prof}" put $ "%package" +-+ subpkgParam Prof putHdr "Summary" $ "Haskell" +-+ pkg_name +-+ "profiling library"@@ -496,12 +523,12 @@ put $ "*" +-+ date +-+ "Fedora Haskell SIG <haskell@lists.fedoraproject.org> - " ++ version ++ "-" ++ release put $ "- spec file generated by cabal-rpm-" ++ V.showVersion Paths_cabal_rpm.version hClose h- return specFile'+ return outputFile -createSpecFile_ :: Maybe FilePath -> Verbosity -> Flags -> Bool -> PackageType- -> Bool -> Stream -> Maybe PackageIdentifier -> IO ()-createSpecFile_ mdest verbose flags force pkgtype subpackage stream mpkgid =- void (createSpecFile verbose flags force pkgtype subpackage stream mdest mpkgid)+createSpecFile_ :: Verbosity -> Flags -> Bool -> PackageType+ -> Bool -> Maybe PackageVersionSpecifier -> IO ()+createSpecFile_ verbose flags force pkgtype subpackage mpvs =+ void (createSpecFile verbose flags force pkgtype subpackage Nothing mpvs) isBuildable :: Executable -> Bool isBuildable exe = buildable $ buildInfo exe@@ -562,11 +589,11 @@ paragraphs :: [String] -> [String] paragraphs = map (unlines . filter notNull) . groupBy (const notNull) -getsubpkgMacro :: Stream -> FilePath -> PackageName+getsubpkgMacro :: Maybe Stream -> FilePath -> PackageName -> IO (String, PackageIdentifier)-getsubpkgMacro stream spec pkg = do+getsubpkgMacro mstream spec pkg = do let macro = filter (/= '-') $ display pkg- pkgid <- latestPackage stream pkg+ pkgid <- latestPackage mstream pkg bringTarball pkgid False spec return (macro, pkgid)
src/Commands/Update.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Commands.Update--- Copyright : (C) 2014-2019 Jens Petersen+-- Copyright : (C) 2014-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> -- Stability : alpha@@ -20,16 +20,18 @@ import Commands.Spec (createSpecFile) import FileUtils (withTempDirectory)+import Header (headerOption, withSpecHead) import PackageUtils (PackageData (..), bringTarball, editSpecField, getRevisedCabal, getSpecField, latestPackage,- patchSpec, prepare)+ patchSpec, pkgSpecPkgData, prepare)+import Stackage (defaultLTS) import SysCmd (die) import Types import SimpleCabal (PackageDescription (customFieldsPD, package), PackageIdentifier (..), showVersion)-import SimpleCmd (cmd_, grep_, removeSuffix, shell_, (+-+))-import SimpleCmd.Git (rwGitDir)+import SimpleCmd (cmd_, error', grep_, shell_, (+-+))+import SimpleCmd.Git (grepGitConfig, rwGitDir) #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) #else import Control.Applicative ((<$>))@@ -41,9 +43,9 @@ import System.Directory (createDirectory, renameFile, setCurrentDirectory) import System.FilePath ((</>), (<.>)) -update :: Stream -> Maybe String -> IO ()-update stream mver = do- pkgdata <- prepare [] stream Nothing True+update :: Maybe PackageVersionSpecifier -> IO ()+update mpvs = do+ pkgdata <- pkgSpecPkgData [] (pvsPackage =<< mpvs) True case specFilename pkgdata of Nothing -> die "No (unique) .spec file in directory." Just spec -> do@@ -51,9 +53,28 @@ oldPkgId = package pkgDesc name = pkgName oldPkgId revised = isJust $ lookup "x-revision" (customFieldsPD pkgDesc)- newPkgId <- case mver of- Just v -> return $ PackageIdentifier name (read v)- _ -> latestPackage stream name+ newPkgId <- case mpvs of+ Nothing -> do+ stream <-+ withSpecHead spec $ \ headerwords -> do+ let mspecstream = read <$> headerOption "--stream" headerwords+ case mspecstream of+ Just specStream -> do+ putStrLn $ "Using stream" +-+ showStream specStream +-+ "from spec file"+ when (specStream <= defaultLTS) $+ putStrLn $ "Warning: < current default stream" +-+ showStream defaultLTS+ Nothing -> return ()+ return mspecstream+ latestPackage stream name+ Just pvs ->+ case pvs of+ PVStreamPackage stream mpkg ->+ case mpkg of+ Just pkg | pkg /= name -> error' "different package name"+ _ -> latestPackage (Just stream) name+ PVPackageId pkgid -> return pkgid+ PVPackageName pkg -> latestPackage Nothing pkg+ let newver = pkgVersion newPkgId oldver = pkgVersion oldPkgId updated = newver > oldver@@ -65,50 +86,51 @@ putStrLn "Package is already latest version." when (not revised || updated) $ withTempDirectory $ \cwd -> do- let specfile = cwd </> spec- subpkg <- grep_ "%{subpkgs}" specfile- (curspec, _) <- createSpecVersion oldPkgId specfile revised subpkg- (newspec, newrevised) <- createSpecVersion newPkgId specfile True subpkg- let suffix = "%{?dist}"- defrelease = "1"- currel <- removeSuffix suffix <$> getSpecField "Release" specfile- editSpecField "Release" (defrelease ++ suffix) specfile- patchSpec False (Just cwd) curspec newspec- ver' <- readVersion <$> getSpecField "Version" specfile- when (ver' /= newver) $- editSpecField "Version" (showVersion newver) specfile- if updated && not subpkg- then editSpecField "Release" (defrelease ++ suffix) specfile- else editSpecField "Release" (currel ++ suffix) specfile- when updated $ do- -- FIXME reset when all subpkgs updated- unless subpkg $- editSpecField "Release" ("0" ++ suffix) specfile- cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ showVersion newver, specfile]- setCurrentDirectory cwd- rwGit <- rwGitDir- when (rwGit && subpkg) $ do- cmd_ "cp" ["-p", "sources", "sources.cblrpm"]- cmd_ "sed" ["-i", "/" ++ display oldPkgId <.> "tar.gz" ++ "/d", "sources.cblrpm"]- bringTarball newPkgId False spec- when rwGit $ do- cmd_ "fedpkg" ["new-sources", display newPkgId <.> "tar.gz"]- when subpkg $ do- shell_ $ "cat sources >>" +-+ "sources.cblrpm"- renameFile "sources.cblrpm" "sources"- when newrevised $- cmd_ "git" ["add", display newPkgId <.> "cabal"]- when revised $- cmd_ "git" ["rm", display oldPkgId <.> "cabal"]- cmd_ "git" ["commit", "-a", "-m", "update to" +-+ showVersion newver]+ let specfile = cwd </> spec+ subpkg <- grep_ "%{subpkgs}" specfile+ (curspec, _) <- createSpecVersion oldPkgId specfile revised subpkg+ (newspec, newrevised) <- createSpecVersion newPkgId specfile True subpkg+ currel <- getSpecField "Release" specfile+ let suffix = "%{?dist}"+ defrelease = "1"+ editSpecField "Release" (defrelease ++ suffix) specfile+ patchSpec False (Just cwd) curspec newspec+ ver' <- readVersion <$> getSpecField "Version" specfile+ when (ver' /= newver) $+ editSpecField "Version" (showVersion newver) specfile+ if updated && not subpkg+ then editSpecField "Release" (defrelease ++ suffix) specfile+ else editSpecField "Release" (currel ++ suffix) specfile+ when updated $ do+ -- FIXME reset when all subpkgs updated+ unless subpkg $+ editSpecField "Release" ("0" ++ suffix) specfile+ cmd_ "rpmdev-bumpspec" ["-c", "update to" +-+ showVersion newver, specfile]+ setCurrentDirectory cwd+ rwGit <- rwGitDir+ when (rwGit && subpkg) $ do+ cmd_ "cp" ["-p", "sources", "sources.cblrpm"]+ cmd_ "sed" ["-i", "/" ++ display oldPkgId <.> "tar.gz" ++ "/d", "sources.cblrpm"]+ bringTarball newPkgId False spec+ distgit <- grepGitConfig "\\(pkgs\\|src\\)."+ when (rwGit && distgit) $ do+ cmd_ "fedpkg" ["new-sources", display newPkgId <.> "tar.gz"]+ when subpkg $ do+ shell_ $ "cat sources >>" +-+ "sources.cblrpm"+ renameFile "sources.cblrpm" "sources"+ when newrevised $+ cmd_ "git" ["add", display newPkgId <.> "cabal"]+ when revised $+ cmd_ "git" ["rm", display oldPkgId <.> "cabal"]+ cmd_ "git" ["commit", "-a", "-m", "update to" +-+ showVersion newver] where createSpecVersion :: PackageIdentifier -> String -> Bool -> Bool -> IO (FilePath, Bool) createSpecVersion pkgid spec revise subpkg = do- pd <- prepare [] stream (Just pkgid) revise+ pd <- prepare [] (streamPkgToPVS Nothing (Just pkgid)) revise let pkgdata' = pd { specFilename = Just spec } dir = display pkgid ++ if revise then ".revised" else ".orig" createDirectory dir- newspec <- createSpecFile silent [] False (SpecFile spec) subpkg stream (Just dir) (Just pkgid)+ newspec <- createSpecFile silent [] False (SpecFile spec) subpkg (Just dir) (streamPkgToPVS Nothing (Just pkgid)) let newrevised = let pkgDesc = packageDesc pkgdata' in isJust $ lookup "x-revision" (customFieldsPD pkgDesc)
src/Dependencies.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Dependencies--- Copyright : (C) 2012-2019 Jens Petersen+-- Copyright : (C) 2012-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> -- Stability : alpha@@ -41,7 +41,6 @@ import SimpleCabal (buildDependencies, mkPackageName, exeDepName, PackageDescription (package),- PackageIdentifier, PackageName, pkgcfgDepName, pkgName, setupDependencies, testsuiteDependencies) import SimpleCmd (cmd, cmdBool, removePrefix, removeSuffix, warning, (+-+))@@ -214,9 +213,9 @@ stripPkgDevel :: String -> String stripPkgDevel = removeSuffix "-devel" . removePrefix "ghc-" -pkgInstallMissing :: Flags -> Stream -> Maybe PackageIdentifier -> IO [PackageName]-pkgInstallMissing flags stream mpkgid = do- pkgdata <- prepare flags stream mpkgid True+pkgInstallMissing :: Flags -> Maybe PackageVersionSpecifier -> IO [PackageName]+pkgInstallMissing flags mpvs = do+ pkgdata <- prepare flags mpvs True pkgInstallMissing' pkgdata pkgInstallMissing' :: PackageData -> IO [PackageName]@@ -258,21 +257,21 @@ hsDep (RpmHsLib _ n) = Just n hsDep _ = Nothing -recurseMissing :: Flags -> Stream -> [PackageName] -> [PackageName] -> IO [PackageName]+recurseMissing :: Flags -> Maybe Stream -> [PackageName] -> [PackageName] -> IO [PackageName] recurseMissing _ _ already [] = return already-recurseMissing flags stream already (dep:deps) = do+recurseMissing flags mstream already (dep:deps) = do miss <- missingDepsPkg dep putMissing miss let hmiss = mapMaybe hsDep miss let accum = nub (dep : hmiss ++ already) -- deeper <- recurseMissing flags stream accum (miss \\ accum) -- let accum2 = nub $ accum ++ deeper- more <- recurseMissing flags stream accum (deps \\ accum)+ more <- recurseMissing flags mstream accum (deps \\ accum) return $ nub $ accum ++ more where missingDepsPkg :: PackageName -> IO [RpmPackage] missingDepsPkg pkg = do- pkgdata <- prepare flags stream (Just (unversionedPkgId pkg)) False+ pkgdata <- prepare flags (streamPkgToPVS mstream (Just (unversionedPkgId pkg))) False missingPackages (packageDesc pkgdata) >>= filterM notAvail putMissing :: [RpmPackage] -> IO ()@@ -291,9 +290,9 @@ notAvail :: RpmPackage -> IO Bool notAvail pkg = null <$> repoquery [] (showRpm pkg) -packageDeps :: Flags -> Stream -> PackageName -> IO [PackageName]-packageDeps flags stream pkg = do- pkgdata <- prepare flags stream (Just (unversionedPkgId pkg)) False+packageDeps :: Flags -> Maybe Stream -> PackageName -> IO [PackageName]+packageDeps flags mstream pkg = do+ pkgdata <- prepare flags (streamPkgToPVS mstream (Just (unversionedPkgId pkg))) False let pkgDesc = packageDesc pkgdata (deps, setup, _, _, _) = dependencies pkgDesc return $ nub $ (deps ++ setup) \\ [pkg]
src/FileUtils.hs view
@@ -2,7 +2,7 @@ -- | -- Module : FileUtils--- Copyright : (C) 2014, 2016-2019 Jens Petersen+-- Copyright : (C) 2014, 2016-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> -- Stability : alpha@@ -17,6 +17,7 @@ -- (at your option) any later version. module FileUtils (+ assertFileNonEmpty, filesWithExtension, fileWithExtension, fileWithExtension_,@@ -25,15 +26,15 @@ withCurrentDirectory, withTempDirectory) where -import SimpleCmd (cmd)- #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) #else import Control.Applicative ((<$>)) #endif import Control.Exception (bracket)+import Control.Monad (when) import Data.List (isPrefixOf) import Data.Maybe (isJust)+import SimpleCmd (cmd, error') import System.Directory (getCurrentDirectory, getDirectoryContents, setCurrentDirectory, removeDirectoryRecursive, #if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))@@ -41,6 +42,7 @@ #endif ) import System.FilePath (takeExtension, (</>))+import System.Posix.Files (fileSize, getFileStatus) filesWithExtension :: FilePath -> String -> IO [FilePath] filesWithExtension dir ext =@@ -75,6 +77,7 @@ return res) -- getDirectoryContents without hidden files+-- (note: listDirectory only filters "." and "..") getDirectoryContents_ :: FilePath -> IO [FilePath] getDirectoryContents_ dir = filter (not . isPrefixOf ".") <$> getDirectoryContents dir@@ -87,3 +90,9 @@ setCurrentDirectory dir action #endif++assertFileNonEmpty :: FilePath -> IO ()+assertFileNonEmpty file = do+ size <- fileSize <$> getFileStatus file+ when (size == 0) $+ error' $ file ++ " is empty!"
+ src/Header.hs view
@@ -0,0 +1,32 @@+module Header (+ withSpecHead,+ headerOption,+ headerVersion+ )+where++import Data.List (isPrefixOf)+import SimpleCmd (removePrefix)++import FileUtils (assertFileNonEmpty)++withSpecHead :: FilePath -> ([String] -> IO a) -> IO a+withSpecHead spec act = do+ assertFileNonEmpty spec+ readFile spec >>= (act . headerWords)+ where+ headerWords :: String -> [String]+ headerWords = words . head . lines++headerVersion :: [String] -> String+headerVersion headerwords =+ let cblrpm = filter ("cabal-rpm-" `isPrefixOf`) headerwords+ in case cblrpm of+ [nv] -> removePrefix "cabal-rpm-" nv+ _ -> "0.9.11"++headerOption :: String -> [String] -> Maybe String+headerOption opt headerwords =+ if opt `elem` headerwords+ then (Just . head . tail . dropWhile (/= opt)) headerwords+ else Nothing
src/Main.hs view
@@ -29,6 +29,7 @@ #endif import Distribution.Text (simpleParse) import Distribution.Verbosity (normal, silent)+import Options.Applicative (maybeReader) import System.IO (BufferMode(LineBuffering), hSetBuffering, stdout) import Commands.BuildDep (builddep)@@ -40,12 +41,11 @@ import Commands.Spec (createSpecFile_) import Commands.Update (update) -import Options.Applicative (maybeReader) import PackageUtils (RpmStage (..)) import Paths_cabal_rpm (version) import Types -import SimpleCabal (PackageIdentifier)+import SimpleCabal (PackageIdentifier(..)) import SimpleCmdArgs main :: IO ()@@ -55,40 +55,40 @@ "RPM package tool for Haskell Stackage/Hackage packages" $ subcommands [ Subcommand "spec" "Generate a spec file" $- createSpecFile_ Nothing <$> quietOpt <*> flags <*> force <*> pkgtype <*> subpackage <*> stream <*> pkgId+ createSpecFile_ <$> quietOpt <*> flags <*> force <*> pkgtype <*> subpackage <*> pkgVerSpecifier , Subcommand "srpm" "Generate an srpm" $- rpmBuild_ Source <$> flags <*> pkgtype <*> subpackage <*> stream <*> pkgId+ rpmBuild_ Source <$> flags <*> pkgtype <*> subpackage <*> pkgVerSpecifier , Subcommand "prep" "Unpack source" $- rpmBuild_ Prep <$> flags <*> pkgtype <*> subpackage <*> stream <*> pkgId+ rpmBuild_ Prep <$> flags <*> pkgtype <*> subpackage <*> pkgVerSpecifier , Subcommand "local" "Build rpm package locally" $- rpmBuild_ Binary <$> flags <*> pkgtype <*> subpackage <*> stream <*> pkgId+ rpmBuild_ Binary <$> flags <*> pkgtype <*> subpackage <*> pkgVerSpecifier , Subcommand "build" "Alias for 'local' - builds rpm locally" $- rpmBuild_ Binary <$> flags <*> pkgtype <*> subpackage <*> stream <*> pkgId+ rpmBuild_ Binary <$> flags <*> pkgtype <*> subpackage <*> pkgVerSpecifier , Subcommand "builddep" "Install build dependencies with dnf" $- builddep <$> flags <*> stream <*> pkgId+ builddep <$> flags <*> pkgVerSpecifier , Subcommand "install" "Build and install recursively" $- install <$> flags <*> pkgtype <*> subpackage <*> stream <*> pkgId+ install <$> flags <*> pkgtype <*> subpackage <*> pkgVerSpecifier -- should be (optional versionArg) not pkgid , Subcommand "diff" "Diff with pristine generated spec file" $- diff <$> flags <*> pkgtype <*> stream <*> pkgId+ diff <$> flags <*> pkgtype <*> pkgVerSpecifier , Subcommand "depends" "List Haskell dependencies" $- depends Depends <$> flags <*> stream <*> pkgId+ depends Depends <$> flags <*> pkgVerSpecifier , Subcommand "requires" "List buildrequires for package" $- depends Requires <$> flags <*> stream <*> pkgId+ depends Requires <$> flags <*> pkgVerSpecifier , Subcommand "missingdeps" "List dependencies not available" $- depends Missing <$> flags <*> stream <*> pkgId+ depends Missing <$> flags <*> pkgVerSpecifier -- should be just Maybe PackageName- , Subcommand "refresh" "Refresh spec file to lastest packaging" $- refresh <$> dryrun <*> pkgtype <*> stream <*> pkgId+ , Subcommand "refresh" "Refresh spec file to latest packaging" $+ refresh <$> dryrun <*> pkgtype <*> pkgVerSpecifier , Subcommand "update" "Update package to latest version" $- update <$> stream <*> optional versionArg+ update <$> pkgVerSpecifier ] where pkgId :: Parser (Maybe PackageIdentifier) pkgId = optional (argumentWith (maybeReader simpleParse) "PKG[VER]") - stream :: Parser Stream- stream = optionalWith auto 's' "stream" "STREAM" "Stackage stream or Hackage" (LTS "13")+ stream :: Parser (Maybe Stream)+ stream = optional (optionWith auto 's' "stream" "STREAM" "Stackage stream or Hackage") flags :: Parser Flags flags = optionalWith auto 'f' "flag" "[(String,Bool)]" "Set or disable Cabal flags" []@@ -109,6 +109,5 @@ subpackage :: Parser Bool subpackage = switchWith 'S' "subpackage" "Subpackage missing Haskell dependencies" - -- FIXME: use Version- versionArg :: Parser String- versionArg = strArg "VERSION"+ pkgVerSpecifier :: Parser (Maybe PackageVersionSpecifier)+ pkgVerSpecifier = streamPkgToPVS <$> stream <*> pkgId
src/PackageUtils.hs view
@@ -2,7 +2,7 @@ -- | -- Module : PackageUtils--- Copyright : (C) 2013-2019 Jens Petersen+-- Copyright : (C) 2013-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> -- Stability : alpha@@ -18,6 +18,7 @@ module PackageUtils ( bringTarball, cabal_,+ checkForSpecFile, editSpecField, getRevisedCabal, getSpecField,@@ -25,6 +26,7 @@ PackageData (..), packageManager, patchSpec,+ pkgSpecPkgData, prepare, repoquery, rpmbuild,@@ -32,18 +34,18 @@ RpmStage (..) ) where -import FileUtils (filesWithExtension, fileWithExtension,+import FileUtils (assertFileNonEmpty, filesWithExtension, fileWithExtension, getDirectoryContents_, mktempdir, withCurrentDirectory, withTempDirectory) import SimpleCabal (finalPackageDescription, licenseFiles, mkPackageName, PackageDescription, PackageIdentifier(..), PackageName, tryFindPackageDesc)-import SimpleCmd (cmd, cmd_, cmdIgnoreErr, cmdLines, grep_, removePrefix,- sudo, sudo_, (+-+))+import SimpleCmd (cmd, cmd_, cmdIgnoreErr, cmdLines, error', grep_,+ removePrefix, sudo, sudo_, (+-+)) import SimpleCmd.Git (isGitDir, grepGitConfig) import SimpleCmd.Rpm (rpmspec) import SysCmd (optionalProgram, requireProgram, rpmEval)-import Stackage (latestStackage)+import Stackage (defaultLTS, latestStackage) import Types #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))@@ -65,7 +67,7 @@ removeDirectoryRecursive, renameFile, setCurrentDirectory) import System.Environment (getEnv)-import System.FilePath ((</>), (<.>), dropFileName, takeExtensions,+import System.FilePath ((</>), (<.>), dropFileName, takeBaseName, takeExtensions, takeFileName) import System.IO (hIsTerminalDevice, stdout) import System.Posix.Files (accessTime, fileMode, getFileStatus,@@ -93,25 +95,6 @@ in any (`isPrefixOf` lowerName) names unlikely name = not $ any (`isSuffixOf` name) ["~", ".cabal"] -cabalFromSpec :: FilePath -> Bool -> IO FilePath-cabalFromSpec specFile revise = do- namever <- removePrefix "ghc-" . head <$> rpmspec ["--srpm"] (Just "%{name}-%{version}") specFile- case simpleParse namever of- Nothing -> error "pkgid could not be parsed"- Just pkgid -> bringTarball pkgid revise specFile- dExists <- doesDirectoryExist namever- if dExists- then do- specTime <- modificationTime <$> getFileStatus specFile- dirTime <- accessTime <$> getFileStatus namever- when (specTime > dirTime) $ do- rpmbuild Prep specFile- dExists' <- doesDirectoryExist namever- when dExists' $ cmd_ "touch" [namever]- else- rpmbuild Prep specFile- tryFindPackageDesc namever- bringTarball :: PackageIdentifier -> Bool -> FilePath -> IO () bringTarball pkgid revise spec = do havespec <- doesFileExist spec@@ -142,7 +125,7 @@ sourceFieldFile field = if null field then -- should be impossible- error "Empty source field!"+ error "empty source field!" else (takeFileName . last . words) field copyTarball :: Bool -> FilePath -> FilePath -> IO ()@@ -163,7 +146,7 @@ tarballs <- filterM doesFileExist paths if null tarballs then if ranFetch- then error $ "No" +-+ tarfile +-+ "found"+ then error $ "no" +-+ tarfile +-+ "found" else do cabal_ "fetch" ["-v0", "--no-dependencies", display pkgid] copyTarball True dir file@@ -249,7 +232,7 @@ isdir <- doesDirectoryExist dir if isdir then do- mcabal <- withCurrentDirectory dir $ checkForCabalFile (Just pkgid)+ mcabal <- withCurrentDirectory dir $ checkForCabalFile (Just (pkgName pkgid)) if isJust mcabal then do pth <- tryFindPackageDesc dir return (pth, Nothing)@@ -264,10 +247,10 @@ setCurrentDirectory cwd return (tmpdir </> pth, Just tmpdir) -latestPackage :: Stream -> PackageName -> IO PackageIdentifier-latestPackage Hackage pkg = latestHackage pkg-latestPackage stream pkg = do- stk <- latestStackage stream pkg+latestPackage :: Maybe Stream -> PackageName -> IO PackageIdentifier+latestPackage (Just Hackage) pkg = latestHackage pkg+latestPackage mstream pkg = do+ stk <- latestStackage mstream pkg case stk of Just pkgid -> return pkgid Nothing -> latestHackage pkg@@ -289,30 +272,28 @@ putStrLn $ res +-+ "in Hackage" return $ PackageIdentifier (mkPackageName pkg) $ readVersion $ head avails -checkForSpecFile :: Maybe PackageIdentifier -> IO (Maybe FilePath)-checkForSpecFile mpkgid = do- let mpkg = display . pkgName <$> mpkgid+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"])) mpkg+ let predicate = maybe ((/= '.') . head) (\ 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" case specs of [one] -> return $ Just one [] -> return Nothing- _ -> error "More than one spec file found!"+ _ -> error' "more than one spec file found!" -checkForCabalFile :: Maybe PackageIdentifier -> IO (Maybe FilePath)-checkForCabalFile mpkgid = do- let mpkg = display . pkgName <$> mpkgid+checkForCabalFile :: Maybe PackageName -> IO (Maybe FilePath)+checkForCabalFile mpkg = do allCabals <- filesWithExtension "." ".cabal"- let predicate = maybe (const True) (\ pkg -> (== pkg <.> "cabal")) mpkg+ let predicate = maybe (const True) (\ pkg -> (== pkg <.> "cabal")) (display <$> mpkg) cabals = filter predicate allCabals case cabals of [one] -> return $ Just one [] -> return Nothing- _ -> error "More than one cabal file found!"+ _ -> error' "more than one cabal file found!" checkForPkgCabalFile :: PackageIdentifier -> IO (Maybe FilePath) checkForPkgCabalFile pkgid = do@@ -324,9 +305,57 @@ else do exists <- doesDirectoryExist $ display pkgid if exists- then fileWithExtension (display pkg) ".cabal"+ then fileWithExtension (display pkgid) ".cabal" else return Nothing +pkgSpecPkgData :: Flags -> Maybe PackageName -> Bool -> IO PackageData+pkgSpecPkgData flags mpkg revise = do+ mspec <- checkForSpecFile mpkg+ case mspec of+ Just spec -> specPackageData spec+ Nothing -> do+ mcabal <- checkForCabalFile mpkg+ case mcabal of+ Just cabalfile -> do+ (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile+ return $ PackageData Nothing docs licenses pkgDesc+ Nothing ->+ case mpkg of+ Just pkg -> prepStreamPkg flags Nothing defaultLTS pkg revise+ Nothing -> do+ cwd <- getCurrentDirectory+ let trydir = simpleParse (takeFileName cwd)+ case trydir of+ Just pdir | pkgVersion pdir == nullVersion ->+ prepare flags (streamPkgToPVS Nothing trydir) revise+ _ -> error' "package not found for directory"+ where+ specPackageData :: FilePath -> IO PackageData+ specPackageData spec = do+ assertFileNonEmpty spec+ cabalfile <- cabalFromSpec spec+ (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile+ return $ PackageData (Just spec) docs licenses pkgDesc+ where+ cabalFromSpec :: FilePath -> IO FilePath+ cabalFromSpec specFile = do+ namever <- removePrefix "ghc-" . head <$> rpmspec ["--srpm"] (Just "%{name}-%{version}") specFile+ case simpleParse namever of+ Nothing -> error "pkgid could not be parsed"+ Just pkgid -> bringTarball pkgid revise specFile+ dExists <- doesDirectoryExist namever+ if dExists+ then do+ specTime <- modificationTime <$> getFileStatus specFile+ dirTime <- accessTime <$> getFileStatus namever+ when (specTime > dirTime) $ do+ rpmbuild Prep specFile+ dExists' <- doesDirectoryExist namever+ when dExists' $ cmd_ "touch" [namever]+ else+ rpmbuild Prep specFile+ tryFindPackageDesc namever+ -- findSpecFile :: PackageDescription -> RpmFlags -> IO (FilePath, Bool) -- findSpecFile pkgDesc flags = do -- pkgname <- findPkgName pkgDesc flags@@ -341,41 +370,54 @@ , packageDesc :: PackageDescription } --- Nothing implies existing packaging in cwd--- Something implies either new packaging or some existing spec file in dir-prepare :: Flags -> Stream -> Maybe PackageIdentifier -> Bool -> IO PackageData-prepare flags stream mpkgid revise = do- mspec <- checkForSpecFile mpkgid- case mspec of- Just spec -> do- cabalfile <- cabalFromSpec spec revise+prepPkgId :: Flags -> Maybe FilePath -> PackageIdentifier -> Bool+ -> IO PackageData+prepPkgId flags mspec pkgid revise = do+ (cabalfile, mtmp) <- tryUnpack pkgid revise+ (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile+ maybe (return ()) removeDirectoryRecursive mtmp+ return $ PackageData mspec docs licenses pkgDesc++prepStreamPkg :: Flags -> Maybe FilePath -> Stream -> PackageName -> Bool -> IO PackageData+prepStreamPkg flags mspec stream pkg revise = do+ pkgid <- latestPackage (Just stream) pkg+ mcabal <- checkForPkgCabalFile pkgid+ case mcabal of+ Just cabalfile -> do (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile return $ PackageData mspec docs licenses pkgDesc- Nothing ->- case mpkgid of+ Nothing -> prepPkgId flags mspec pkgid revise++-- Nothing means package in cwd+prepare :: Flags -> Maybe PackageVersionSpecifier -> Bool -> IO PackageData+prepare flags Nothing revise = pkgSpecPkgData flags Nothing revise+-- Something implies either new packaging or some existing spec file in dir+prepare flags (Just pvs) revise =+ case pvs of+ PVPackageName pkg -> pkgSpecPkgData flags (Just pkg) revise+ PVPackageId pkgid -> do+ mspec <- checkForSpecFile $ Just (pkgName pkgid)+ mcabal <- checkForPkgCabalFile pkgid+ case mcabal of+ Just cabalfile -> do+ (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile+ return $ PackageData mspec docs licenses pkgDesc+ Nothing -> prepPkgId flags mspec pkgid revise+ PVStreamPackage stream Nothing -> do+ mspec <- checkForSpecFile Nothing+ case mspec of Nothing -> do- mcabal <- checkForCabalFile Nothing- case mcabal of- Just cabalfile -> do- (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile- return $ PackageData Nothing docs licenses pkgDesc- Nothing -> do- cwd <- getCurrentDirectory- prepare flags stream (simpleParse (takeFileName cwd)) revise- Just pkgid -> do- mcabal <- checkForPkgCabalFile pkgid- case mcabal of- Just cabalfile -> do- (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile- return $ PackageData Nothing docs licenses pkgDesc- Nothing -> do- pkgid' <- if pkgVersion pkgid == nullVersion- then latestPackage stream (pkgName pkgid)- else return pkgid- (cabalfile, mtmp) <- tryUnpack pkgid' revise- (pkgDesc, docs, licenses) <- simplePackageDescription flags cabalfile- maybe (return ()) removeDirectoryRecursive mtmp- return $ PackageData Nothing docs licenses pkgDesc+ cwd <- getCurrentDirectory+ let trydir = simpleParse (takeFileName cwd)+ case trydir of+ Just pdir | pkgVersion pdir == nullVersion -> prepare flags (streamPkgToPVS (Just stream) trydir) revise+ _ -> error' "package not found"+ Just spec -> do+ let pkg = mkPackageName $ removePrefix "ghc-" $ takeBaseName spec+ prepStreamPkg flags (Just spec) stream pkg revise+ PVStreamPackage stream (Just pkg) -> do+ mspec <- checkForSpecFile (Just pkg)+ prepStreamPkg flags mspec stream pkg revise patchSpec :: Bool -> Maybe FilePath -> FilePath -> FilePath -> IO () patchSpec dryrun mdir oldspec newspec = do@@ -414,4 +456,4 @@ getSpecField :: String -> FilePath -> IO String getSpecField field spec =- cmd "sed" ["-n", "-e s/^" ++ field ++ ":\\s\\+\\(\\S\\+\\)/\\1/p", spec]+ cmd "rpmspec" ["-q", "--qf", "%{" ++ field ++ "}", "--srpm", "--undefine", "dist", spec]
src/Stackage.hs view
@@ -3,7 +3,7 @@ -- | -- Module : Stackage--- Copyright : (C) 2017-2019 Jens Petersen+-- Copyright : (C) 2017-2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> -- Stability : alpha@@ -17,66 +17,76 @@ -- (at your option) any later version. module Stackage (+ defaultLTS, latestStackage ) where -#ifdef HTTPS-import qualified Data.ByteString.Char8 as B-import Data.List (isPrefixOf)-import Data.Maybe (mapMaybe)-import Network.HTTP.Client-import Network.HTTP.Client.TLS-import System.FilePath (takeFileName)-import SimpleCmd ((+-+), removePrefix)-#else+#ifdef CURL+import Network.Curl #if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0)) #else import Control.Applicative ((<$>)) #endif-import SimpleCmd ((+-+), cmdMaybe)-import SysCmd (optionalProgram)+#else+import qualified Data.ByteString.Char8 as B+import Network.HTTP.Client+import Network.HTTP.Client.TLS #endif+import Data.Maybe (fromMaybe) import Distribution.Text (display) import SimpleCabal (PackageIdentifier(..), PackageName)+import SimpleCmd ((+-+), removePrefix)+import System.FilePath (takeFileName) import Types +defaultLTS :: Stream+defaultLTS = LTS "13"++latestLTS :: Stream+latestLTS = LTS "14"+ stackageList :: Stream -> PackageName -> IO (Maybe PackageIdentifier) stackageList stream pkg = do-#ifdef HTTPS- mgr <- newManager tlsManagerSettings- let pkgurl = topurl ++ (show stream) ++ "/package/"- req <- parseRequest $ pkgurl ++ display pkg- hist <- responseOpenHistory req mgr- let redirs = mapMaybe (lookup "Location" . responseHeaders . snd) $ hrRedirects hist- if null redirs- then return Nothing- else do- let loc = B.unpack $ last redirs- if topurl `isPrefixOf` loc- then- let ver = (readVersion . removePrefix (display pkg ++ "-") . takeFileName) loc- in return $ Just (PackageIdentifier pkg ver)- else return Nothing- where- topurl :: String- topurl = "https://www.stackage.org/"+ let pkgurl = "https://www.stackage.org/" ++ showStream stream ++ "/package/" ++ display pkg+ mloc <-+#ifdef CURL+ withCurlDo $+ (lookup "location" . reverse . snd) <$> curlHead pkgurl [CurlFollowLocation True] #else- -- check for stackage-query- haveStackage <- optionalProgram "stackage"- if haveStackage- then do- mver <- cmdMaybe "stackage" ["package", show stream, display pkg]- return $ PackageIdentifier pkg . readVersion <$> mver- else do- putStrLn "'cabal install stackage-query' to check against Stackage LTS"- return Nothing+ do+ mgr <- newManager tlsManagerSettings+ req <- parseRequest pkgurl+ hist <- responseOpenHistory (req {method = "HEAD"}) mgr+ let redirs = hrRedirects hist+ if null redirs+ then return Nothing+ else return $ (fmap B.unpack . lookup "Location" . responseHeaders . snd . last) redirs #endif+ case mloc of+ Nothing -> return Nothing+ Just loc -> do+ let file = takeFileName loc+ -- check if no version+ if file == display pkg then+ return Nothing+ else+ let ver = (readVersion . removePrefix (display pkg ++ "-")) file in+ return $ Just $ PackageIdentifier pkg ver -latestStackage :: Stream -> PackageName -> IO (Maybe PackageIdentifier)-latestStackage stream pkg = do+latestStackage :: Maybe Stream -> PackageName -> IO (Maybe PackageIdentifier)+latestStackage mstream pkg = do+ let stream = fromMaybe defaultLTS mstream mpkgid <- stackageList stream pkg case mpkgid of- Nothing -> return ()- Just pkgid -> putStrLn $ display pkgid +-+ "in Stackage" +-+ show stream- return mpkgid+ Just pkgid -> do+ putStrLn $ display pkgid +-+ "in Stackage" +-+ showStream stream+ return mpkgid+ Nothing -> case mstream of+ Nothing -> if defaultLTS == latestLTS then return Nothing+ else latestStackage (Just LatestLTS) pkg+ Just s -> case s of+ LTS n | LTS n < latestLTS -> latestStackage (Just LatestLTS) pkg+ LTS n | LTS n >= latestLTS -> latestStackage (Just LatestNightly) pkg+ LatestLTS -> latestStackage (Just LatestNightly) pkg+ _ -> return Nothing
src/Types.hs view
@@ -2,7 +2,7 @@ -- | -- Module : Types--- Copyright : (C) 2019 Jens Petersen+-- Copyright : (C) 2020 Jens Petersen -- -- Maintainer : Jens Petersen <petersen@fedoraproject.org> --@@ -16,13 +16,18 @@ module Types ( Flags, -- flagList, LibPkgType(..),+ nullVersion, PackageType(..),- unversionedPkgId,+ PackageVersionSpecifier(..),+ pvsPackage,+ pvsStream, readVersion, RpmPackage(..), showRpm,+ showStream, Stream(..),- nullVersion,+ streamPkgToPVS,+ unversionedPkgId, Verbose(..) ) where @@ -46,6 +51,7 @@ import SimpleCabal (FlagName, {-- mkFlagName, --} PackageIdentifier(..), PackageName)+import SimpleCmd (error') data LibPkgType = Base | Devel | Prof | Doc | Static deriving Eq@@ -83,14 +89,15 @@ -- where tagWithValue ('-':name) = (mkFlagName (map toLower name), False) -- tagWithValue name = (mkFlagName (map toLower name), True) -data Stream = LatestNightly | LatestLTS | LTS String | Nightly String | Hackage+data Stream = LTS String | LatestLTS | Nightly String | LatestNightly | Hackage+ deriving (Eq, Ord) -instance Show Stream where- show LatestNightly = "nightly"- show LatestLTS = "lts"- show (Nightly date) = "nightly-" <> date- show (LTS ver) = "lts-" <> ver- show Hackage = "hackage"+showStream :: Stream -> String+showStream LatestNightly = "nightly"+showStream LatestLTS = "lts"+showStream (Nightly date) = "nightly-" <> date+showStream (LTS ver) = "lts-" <> ver+showStream Hackage = "hackage" instance Read Stream where readsPrec _ "hackage" = [(Hackage,"")]@@ -129,3 +136,30 @@ nullVersion :: Version nullVersion = mkVersion [] #endif++data PackageVersionSpecifier = PVStreamPackage Stream (Maybe PackageName)+ | PVPackageId PackageIdentifier+ | PVPackageName PackageName++pvsStream :: PackageVersionSpecifier -> Maybe Stream+pvsStream (PVStreamPackage s _) = Just s+pvsStream (PVPackageId _) = Nothing+pvsStream (PVPackageName _) = Nothing++pvsPackage :: PackageVersionSpecifier -> Maybe PackageName+pvsPackage (PVStreamPackage _ mp) = mp+pvsPackage (PVPackageId pkgid) = Just $ pkgName pkgid+pvsPackage (PVPackageName pkg) = Just pkg++streamPkgToPVS :: Maybe Stream -> Maybe PackageIdentifier+ -> Maybe PackageVersionSpecifier+streamPkgToPVS Nothing Nothing = Nothing+streamPkgToPVS Nothing (Just pkgid) =+ Just $ if pkgVersion pkgid == nullVersion+ then PVPackageName (pkgName pkgid)+ else PVPackageId pkgid+streamPkgToPVS (Just s) Nothing = Just $ PVStreamPackage s Nothing+streamPkgToPVS (Just s) (Just p) | pkgVersion p == nullVersion =+ Just $ PVStreamPackage s $ Just (pkgName p)+streamPkgToPVS (Just _) (Just _) =+ error' "cannot specify stream and package version"