cabal-rpm 2.1.2 → 2.1.3
raw patch · 10 files changed
+356/−152 lines, 10 filesdep +aesondep +cached-json-filedep +http-query
Dependencies added: aeson, cached-json-file, http-query, text
Files
- ChangeLog +10/−1
- README.md +1/−1
- cabal-rpm.cabal +9/−2
- src/Commands/Spec.hs +38/−83
- src/Commands/Update.hs +11/−7
- src/Dependencies.hs +79/−21
- src/PackageUtils.hs +25/−6
- src/Stackage.hs +61/−31
- src/Stackage/MajorVer.hs +77/−0
- src/Stackage/Snapshots.hs +45/−0
ChangeLog view
@@ -1,4 +1,13 @@-# 2.1.2 (2023-07-27)+# 2.1.3 (2023-09-27)+- spec: implement recursive missing deps fully; use cabal-sort if available+- spec: also get the license of subpkgs now+- spec: optparse-simple also supports bash completions+- spec: simplify standalone %ghc_set_gcc_flags conditional+- Stackage: prefer stack list if available: should be faster+- Stackage: cache latest snapshots versions with code from stack-all+- update: be more careful about adding new revised .cabal++# 2.1.2 (2023-07-27, F39) - PackageUtils checkForPkgCabalFile: check within BUILD dir - PackageUtils patchSpec: drop problem code for showing patch -.rej - Stackage: bump default to lts-21
README.md view
@@ -71,7 +71,7 @@ ## Help output ```shellsession $ cabal-rpm --version-2.1.2+2.1.3 $ cabal-rpm --help Cabal-rpm tool
cabal-rpm.cabal view
@@ -1,6 +1,6 @@ Cabal-version: 1.18 Name: cabal-rpm-Version: 2.1.2+Version: 2.1.3 Synopsis: RPM packaging tool for Haskell Cabal-based packages Description: This package provides a RPM packaging tool for Haskell Cabal-based packages.@@ -28,7 +28,8 @@ Extra-source-files: man/cabal-rpm.1.md Tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7,- GHC == 9.0.2, GHC == 9.2.8, GHC == 9.4.5+ GHC == 9.0.2, GHC == 9.2.8, GHC == 9.4.7,+ GHC == 9.6.3 source-repository head type: git@@ -45,15 +46,19 @@ Executable cabal-rpm Main-is: Main.hs Build-depends: base < 5,+ aeson, Cabal > 1.10 && < 3.11,+ cached-json-file, directory, extra, filepath >= 1.4,+ http-query, optparse-applicative, process, simple-cabal >= 0.1.3, simple-cmd >= 0.2.3, simple-cmd-args >= 0.1.6,+ text, unix if flag(old-locale) Build-Depends: old-locale >= 1 && < 1.1,@@ -85,6 +90,8 @@ Header, PackageUtils, Stackage,+ Stackage.MajorVer,+ Stackage.Snapshots, SysCmd, Types, Paths_cabal_rpm
src/Commands/Spec.hs view
@@ -23,15 +23,12 @@ import Dependencies (missingLibraries, missingOtherPkgs, notSrcOrInst, packageDeps, PackageDependencies(..), packageDependencies, pkgSuffix,- subPackages, testsuiteDependencies')+ prettyShow,+ recurseMissing, subPackages, testsuiteDependencies') import Header (headerOption, withSpecHead)-import PackageUtils (bringTarball, latestPackage, PackageData (..), prepare)+import PackageUtils (dependencySortCabals, PackageData (..), prepare) import SimpleCabal (buildable, mkPackageName, PackageDescription (..),- PackageIdentifier(..), PackageName-#if !MIN_VERSION_Cabal(2,2,0)- , showVersion-#endif- )+ PackageIdentifier(..)) import SimpleCmd ((+-+), cmd, cmdLines, cmdMaybe, grep, grep_, removePrefix) import Stackage (defaultLTS) import Types@@ -49,9 +46,6 @@ import Data.Time.Format (formatTime) import qualified Data.Version as V -#if !MIN_VERSION_Cabal(2,2,0)-import Distribution.License (License (..))-#endif import Distribution.PackageDescription ( Executable (buildInfo), Library (exposedModules), exeName,@@ -60,9 +54,7 @@ license, #endif )-#if MIN_VERSION_Cabal(2,2,0)-import Distribution.Pretty (prettyShow)-#endif+ import Distribution.Simple.Utils (warn) import Distribution.Text (display) @@ -273,24 +265,32 @@ let pkgver = if hasLib then "%{pkgver}" else pkg_name ++ "-%{version}" - -- FIXME sort by build order- -- FIXME recursive missingdeps- missingLibs <- do+ missingLibsLicenses <- do subs <- if subpackage then subPackages mspec pkgDesc else return []- miss <- if subpackage || standalone then missingLibraries pkgDesc else return []- return $ nub (subs ++ miss) \\ droppedDeps- subpkgs <- if subpackage then- mapM (getsubpkgMacro (streamSubpackage mstream subpkgStream) mspec >=>- \(m,pv) -> global m (display pv) >> return ("%{" ++ m ++ "}")) missingLibs- else return []+ miss <- if subpackage || standalone+ then missingLibraries pkgDesc+ else return []+ deep <- recurseMissing flags mstream [] $ nub (subs ++ miss)+ --print deep+ return $ filter (\(d,_) -> pkgName d `notElem` droppedDeps) deep+ subpkgsOrdered <- dependencySortCabals mspec $ map fst missingLibsLicenses+ --print subpkgs+ let subpkgs = sort subpkgsOrdered+ mkSubpkgMacro = filter (/= '-') . display . pkgName+ subpkgMacro pid = "%{" ++ mkSubpkgMacro pid ++ "}"+ subpkgMacros = map subpkgMacro subpkgs+ subpkgMacrosOrdered = map subpkgMacro subpkgsOrdered+ forM_ (sort subpkgs) $ \pid ->+ global (mkSubpkgMacro pid) $ display pid let hasSubpkgs = subpkgs /= [] when hasSubpkgs $ do- global "subpkgs" $ unwords subpkgs putNewline+ global "subpkgs" $ unwords subpkgMacrosOrdered+ putNewline let (testsuiteDeps,testsuiteTools) = testsuiteDependencies' pkgDesc unpkgedTestDeps <- filterM (notSrcOrInst . RpmHsLib Devel) testsuiteDeps- let missTestDeps = unpkgedTestDeps \\ missingLibs+ let missTestDeps = unpkgedTestDeps \\ map pkgName subpkgs let testable = notNull testsuiteDeps && not standalone && (null missTestDeps || testsuite) && isNothing mwithghc if testable then do put "%bcond_without tests"@@ -321,7 +321,8 @@ then putHdr "Release" "%autorelease" else do when hasSubpkgs $- put "# can only be reset when all subpkgs bumped"+ let multipkg = if length subpkgs > 1 then "all subpkgs" else "subpkg"+ in put $ "# can only be reset when" +-+ multipkg +-+ "bumped" putHdr "Release" $ release ++ "%{?dist}" putHdr "Summary" summary putNewline@@ -329,7 +330,7 @@ putHdr "Url" $ "https://hackage.haskell.org/package" </> pkg_name put "# Begin cabal-rpm sources:" putHdr "Source0" $ sourceUrl pkgver- mapM_ (\ (n,p) -> putHdr ("Source" ++ n) (sourceUrl p)) $ number subpkgs+ mapM_ (\ (n,p) -> putHdr ("Source" ++ n) (sourceUrl p)) $ number subpkgMacros when revised $ putHdr ("Source" ++ show (1 + length subpkgs)) $ "https://hackage.haskell.org/package" </> pkgver </> pkg_name <.> "cabal" ++ "#" </> pkgver <.> "cabal" put "# End cabal-rpm sources"@@ -340,7 +341,7 @@ -- put "# Setup" unless (mkPackageName "Cabal" `elem` buildDeps pkgdeps) $ putHdr "BuildRequires" $ ghc_name ++ "-Cabal-devel"- mapM_ (\ d -> (if d `elem` missingLibs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Devel d))) $ setupDeps pkgdeps+ mapM_ (\ d -> (if d `elem` map pkgName subpkgs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Devel d))) $ setupDeps pkgdeps putHdr "BuildRequires" $ "ghc-rpm-macros" ++ (if hasSubpkgs then "-extra" else "") unless (null (buildDeps pkgdeps)) $ do@@ -352,10 +353,10 @@ put "%else" let metaPackages = [mkPackageName "haskell-gi-overloading"]- mapM_ (\ d -> (if d `elem` missingLibs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Devel d))) $ sort $ buildDeps pkgdeps+ mapM_ (\ d -> (if d `elem` map pkgName subpkgs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Devel d))) $ sort $ buildDeps pkgdeps when hasLibPkg $ do put "%if %{with ghc_prof}"- mapM_ (\ d -> (if d `elem` missingLibs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Prof d))) $ sort $ buildDeps pkgdeps \\ metaPackages+ mapM_ (\ d -> (if d `elem` map pkgName subpkgs then putHdrComment else putHdr) "BuildRequires" (showRpm (RpmHsLib Prof d))) $ sort $ buildDeps pkgdeps \\ metaPackages put "%endif" let otherdeps = sort $ toolDeps pkgdeps ++ clibDeps pkgdeps ++ pkgcfgDeps pkgdeps unless (null otherdeps) $ do@@ -378,14 +379,14 @@ when (standalone || subpackage) $ do when standalone $ putHdr "BuildRequires" "cabal-install > 1.18"- unless (null missingLibs || ignoreMissing) $ do- putStrLn "checking for deps of missing dependencies:"+ unless (null subpkgs || ignoreMissing) $ do -- let deptype = if standalone then Devel else Prof when (isJust mwithghc) $ put "%if %{undefined ghc_name}"- forM_ missingLibs $ \ pkg -> do- more <- packageDeps flags (streamSubpackage mstream subpkgStream) pkg- let moredeps = sort $ more \\ (buildDeps pkgdeps ++ missingLibs)+ forM_ subpkgs $ \pid -> do+ let pkg = pkgName pid+ more <- packageDeps flags pid+ let moredeps = sort $ more \\ (buildDeps pkgdeps ++ map pkgName subpkgs) unless (null moredeps) $ do put $ "# for missing dep '" ++ display pkg ++ "':" missingMore <- filterM (notSrcOrInst . RpmHsLib Devel) moredeps@@ -477,7 +478,7 @@ global "main_version" "%{version}" putNewline put "%if %{defined ghclibdir}"- mapM_ (\p -> put $ "%ghc_lib_subpackage" +-+ p) subpkgs+ mapM_ (\p -> let mlic = lookup p missingLibsLicenses in put $ "%ghc_lib_subpackage" +-+ maybe "" ("-l" +-+) mlic +-+ subpkgMacro p) subpkgs put "%endif" putNewline global "version" "%{main_version}"@@ -520,10 +521,8 @@ put "# Begin cabal-rpm install" if standalone then do put "mkdir -p %{buildroot}%{_bindir}"- put "%if 0%{?fedora} >= 33 || 0%{?rhel} > 8"- put "%if 0%{?fedora} >= 36"+ put "%if 0%{?fedora} || 0%{?rhel} >= 9" put "%ghc_set_gcc_flags"- put "%endif" put $ "%cabal_install install" +-+ maybe "" (\v -> "-w ghc-" ++ V.showVersion v) mwithghc +-+ "--install-method=copy --enable-executable-stripping --installdir=%{buildroot}%{_bindir}" put "%else" put "for i in .cabal-sandbox/bin/*; do"@@ -552,7 +551,7 @@ let execs = sort $ map exeName $ filter isBuildable $ executables pkgDesc execNaming p = let pn = unUnqualComponentName p in if pn == name then "%{name}" else pn- bashCompletions = hasExecPkg && any ((`elem` buildDeps pkgdeps) . mkPackageName) ["optparse-applicative","simple-cmd-args"]+ bashCompletions = hasExecPkg && any ((`elem` buildDeps pkgdeps) . mkPackageName) ["optparse-applicative","optparse-simple","simple-cmd-args"] when bashCompletions $ do put "mkdir -p %{buildroot}%{_datadir}/bash-completion/completions/"@@ -652,38 +651,6 @@ isBuildable :: Executable -> Bool isBuildable exe = buildable $ buildInfo exe --- FIXME convert strings to SPDX or drop?-#if !MIN_VERSION_Cabal(2,2,0)-prettyShow :: License -> String-prettyShow (GPL Nothing) = "GPL+"-prettyShow (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+"-prettyShow (LGPL Nothing) = "LGPLv2+"-prettyShow (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+"-prettyShow BSD3 = "BSD"-prettyShow BSD4 = "BSD"-prettyShow MIT = "MIT"-prettyShow PublicDomain = "Public Domain"-prettyShow AllRightsReserved = "Proprietary"-prettyShow OtherLicense = "Unknown"-prettyShow (UnknownLicense l) = removePrefix "LicenseRef" l -- FIXME-#if MIN_VERSION_Cabal(1,16,0)-prettyShow (Apache Nothing) = "ASL ?"-prettyShow (Apache (Just ver)) = "ASL" +-+ showVersion ver-#endif-#if MIN_VERSION_Cabal(1,18,0)-prettyShow (AGPL Nothing) = "AGPLv?"-prettyShow (AGPL (Just ver)) = "AGPLv" ++ showVersion ver-#endif-#if MIN_VERSION_Cabal(1,20,0)-prettyShow BSD2 = "BSD"-prettyShow (MPL ver) = "MPLv" ++ showVersion ver-#endif-#if MIN_VERSION_Cabal(1,22,0)-prettyShow ISC = "ISC"-prettyShow UnspecifiedLicense = "Unspecified license!"-#endif-#endif- sourceUrl :: String -> String sourceUrl pv = "https://hackage.haskell.org/package" </> pv </> pv <.> ".tar.gz" @@ -710,14 +677,6 @@ paragraphs :: [String] -> [String] paragraphs = map (unlines . filter notNull) . groupBy (const notNull) -getsubpkgMacro :: Maybe Stream -> Maybe FilePath -> PackageName- -> IO (String, PackageIdentifier)-getsubpkgMacro mstream mspec pkg = do- let macro = filter (/= '-') $ display pkg- pkgid <- latestPackage mstream pkg- bringTarball pkgid mspec- return (macro, pkgid)- number :: [a] -> [(String,a)] number = zip (map show [(1::Int)..]) @@ -737,10 +696,6 @@ quoteMacros :: String -> String quoteMacros "" = "" quoteMacros (c:cs) = (if c == '%' then "%%" else [c]) ++ quoteMacros cs--streamSubpackage :: Maybe Stream -> Maybe (Maybe Stream) -> Maybe Stream-streamSubpackage _ (Just (Just stream)) = Just stream-streamSubpackage mstream _ = mstream #if !MIN_VERSION_extra(1,6,8) notNull :: [a] -> Bool
src/Commands/Update.hs view
@@ -125,7 +125,8 @@ bringTarball newPkgId (Just spec) distgit <- grepGitConfig "\\(pkgs\\|src\\)." when (rwGit && distgit) $ do- when updated $ do+ if updated+ then do krbTicket cmd_ "fedpkg" ["new-sources", display newPkgId <.> "tar.gz"] when subpkg $ do@@ -133,18 +134,21 @@ renameFile "sources.cblrpm" "sources" when wasrevised $ cmd_ "git" ["rm", display oldPkgId <.> "cabal"]- when newrev $- cmd_ "git" ["add", display newPkgId <.> "cabal"]- if updated then+ when newrev $+ cmd_ "git" ["add", display newPkgId <.> "cabal"] cmd_ "git" ["commit", "-a", "-m", if autochangelog then "https://hackage.haskell.org/package/" ++ display newPkgId ++ "/changelog" else "update to" +-+ showVersion newver] else- when newrev $- unlessM (gitBool "diff-index" ["--quiet", "HEAD"]) $- cmd_ "git" ["commit", "-a", "-m", "revised .cabal file"]+ when newrev $ do+ if wasrevised+ then cmd_ "git" ["commit", "-a", "-m", "refresh .cabal revision"]+ else+ unlessM (gitBool "diff-index" ["--quiet", "HEAD"]) $ do+ cmd_ "git" ["add", display newPkgId <.> "cabal"]+ cmd_ "git" ["commit", "-a", "-m", "revise .cabal file"] rpmbuild True Prep spec where -- Just Nothing is default stream
src/Dependencies.hs view
@@ -30,6 +30,7 @@ pkgInstallMissing, pkgInstallMissing', pkgSuffix,+ prettyShow, recurseMissing, showDep, subPackages,@@ -42,8 +43,12 @@ 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@@ -59,9 +64,15 @@ import Data.List (delete, isSuffixOf, nub, (\\)) import Data.Maybe (catMaybes, fromJust, isNothing, mapMaybe) +#if !MIN_VERSION_Cabal(2,2,0)+import Distribution.License (License (..))+#endif+#if MIN_VERSION_Cabal(2,2,0)+import Distribution.Pretty (prettyShow)+#endif import Distribution.Text (display) import Distribution.PackageDescription (buildInfo, BuildInfo (..),- executables, hasLibs,+ executables, hasLibs, license, testBuildInfo, testSuites) #if MIN_VERSION_Cabal(2,0,0) import Distribution.Types.ExeDependency (ExeDependency(..))@@ -101,9 +112,8 @@ buildToolDepends' :: BuildInfo -> [String] #if MIN_VERSION_Cabal(2,0,0) buildToolDepends' buildinfo =- map prettyShow $ buildToolDepends buildinfo- where- prettyShow (ExeDependency pn _ _) = unPackageName pn+ map (unPackageName . \(ExeDependency pn _ _) -> pn) $+ buildToolDepends buildinfo #else buildToolDepends' _ = []@@ -296,22 +306,38 @@ hsDep (RpmHsLib _ n) = Just n hsDep _ = Nothing -recurseMissing :: Flags -> Maybe Stream -> [PackageName] -> [PackageName] -> IO [PackageName]+recurseMissing :: Flags -> Maybe Stream -> [(PackageIdentifier,String)]+ -> [PackageName] -> IO [(PackageIdentifier,String)] recurseMissing _ _ already [] = return already 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 mstream accum (deps \\ accum)+ (miss,mpidLic) <- missingDepsPkg dep+ (more,accum) <-+ case mpidLic of+ Nothing -> do+ pids <- recurseMissing flags mstream already deps+ return (pids, already)+ Just (pid,lic) -> do+ putMissing miss+ let hmiss = mapMaybe hsDep miss+ accum1 = (pid,lic) : already+ deeper <- recurseMissing flags mstream accum1 hmiss+ let accum2 = nub $ accum1 ++ deeper+ pids <- recurseMissing flags mstream accum2 deps+ return (pids, accum2) return $ nub $ accum ++ more where- missingDepsPkg :: PackageName -> IO [RpmPackage]- missingDepsPkg pkg = do- pkgdata <- prepare flags (streamPkgToPVS mstream (Just (unversionedPkgId pkg)))- missingPackages (packageDesc pkgdata) >>= filterM notAvail+ missingDepsPkg :: PackageName+ -> IO ([RpmPackage], Maybe (PackageIdentifier, String))+ missingDepsPkg pkg =+ if pkg `elem` map (pkgName . fst) already+ then return ([], Nothing)+ else do+ pkgdata <- prepare flags (streamPkgToPVS mstream (Just (unversionedPkgId pkg)))+ let pkgdesc = packageDesc pkgdata+ missdeps <- missingPackages pkgdesc >>= filterM notAvail+ let pid = package pkgdesc+ licensestr = prettyShow $ license pkgdesc+ return (missdeps, Just (pid, licensestr)) putMissing :: [RpmPackage] -> IO () putMissing [] = return ()@@ -324,14 +350,46 @@ (op ++ showDep d ++ cl) : markAlready ds alreadyMentioned :: RpmPackage -> Bool- alreadyMentioned d = maybe False (`elem` already) (hsDep d)+ alreadyMentioned d = maybe False (`elem` map (pkgName . fst) already) (hsDep d) notAvail :: RpmPackage -> IO Bool notAvail pkg = null <$> repoquery [] (showRpm pkg) -packageDeps :: Flags -> Maybe Stream -> PackageName -> IO [PackageName]-packageDeps flags mstream pkg = do- pkgdata <- prepare flags (streamPkgToPVS mstream (Just (unversionedPkgId pkg)))+packageDeps :: Flags -> PackageIdentifier -> IO [PackageName]+packageDeps flags pid = do+ pkgdata <- prepare flags (Just $ PVPackageId pid) let pkgDesc = packageDesc pkgdata (deps, setup, _, _, _) = dependencies pkgDesc- return $ nub $ (deps ++ setup) \\ [pkg]+ return $ nub $ (deps ++ setup) \\ [pkgName pid]++-- FIXME convert strings to SPDX or drop?+#if !MIN_VERSION_Cabal(2,2,0)+prettyShow :: License -> String+prettyShow (GPL Nothing) = "GPL+"+prettyShow (GPL (Just ver)) = "GPLv" ++ showVersion ver ++ "+"+prettyShow (LGPL Nothing) = "LGPLv2+"+prettyShow (LGPL (Just ver)) = "LGPLv" ++ [head $ showVersion ver] ++ "+"+prettyShow BSD3 = "BSD"+prettyShow BSD4 = "BSD"+prettyShow MIT = "MIT"+prettyShow PublicDomain = "Public Domain"+prettyShow AllRightsReserved = "Proprietary"+prettyShow OtherLicense = "Unknown"+prettyShow (UnknownLicense l) = removePrefix "LicenseRef" l -- FIXME+#if MIN_VERSION_Cabal(1,16,0)+prettyShow (Apache Nothing) = "ASL ?"+prettyShow (Apache (Just ver)) = "ASL" +-+ showVersion ver+#endif+#if MIN_VERSION_Cabal(1,18,0)+prettyShow (AGPL Nothing) = "AGPLv?"+prettyShow (AGPL (Just ver)) = "AGPLv" ++ showVersion ver+#endif+#if MIN_VERSION_Cabal(1,20,0)+prettyShow BSD2 = "BSD"+prettyShow (MPL ver) = "MPLv" ++ showVersion ver+#endif+#if MIN_VERSION_Cabal(1,22,0)+prettyShow ISC = "ISC"+prettyShow UnspecifiedLicense = "Unspecified license!"+#endif+#endif
src/PackageUtils.hs view
@@ -19,6 +19,7 @@ bringTarball, cabal_, checkForSpecFile,+ dependencySortCabals, dropChangelog, editSpecField, getRevisedCabal,@@ -39,10 +40,10 @@ listDirectory', withTempDirectory) import SimpleCabal (finalPackageDescription, licenseFiles, mkPackageName, PackageDescription, PackageIdentifier(..), PackageName,- tryFindPackageDesc)+ showPkgId, tryFindPackageDesc) import SimpleCmd (cmd, cmd_, cmdBool, cmdIgnoreErr, cmdLines,- cmdStderrToStdoutIn,- error', grep_, removePrefix, sudo, sudo_, (+-+))+ cmdStderrToStdoutIn, error', grep_,+ removePrefix, sudo, sudo_, (+-+)) import SimpleCmd.Git (isGitDir, grepGitConfig) import SimpleCmd.Rpm (rpmspec) import SysCmd (optionalProgram, requireProgram, rpmEval)@@ -52,7 +53,7 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif-import Control.Monad (filterM, unless, void, when)+import Control.Monad (filterM, forM_, unless, void, when) import Data.List.Extra import Data.Maybe@@ -178,7 +179,6 @@ getRevisedCabal :: PackageIdentifier -> IO Bool getRevisedCabal pkgid = do let file = display (pkgName pkgid) <.> "cabal"- dir <- getSourceDir withTempDirectory $ do -- FIXME use cabal-file dl <- cmdBool "wget" ["--quiet", "https://hackage.haskell.org/package" </> display pkgid </> file]@@ -186,7 +186,9 @@ then return False else do revised <- grep_ "^x-revision:" file- when revised $+ when revised $ do+ dir <- getSourceDir+ createDirectoryIfMissing True dir -- renameFile can fail across fs devices copyFile file $ dir </> display pkgid <.> "cabal" return revised@@ -519,3 +521,20 @@ getSymbolicPath :: FilePath -> String getSymbolicPath = id #endif++dependencySortCabals :: Maybe FilePath -> [PackageIdentifier]+ -> IO [PackageIdentifier]+dependencySortCabals mspec pkgids = do+ cabalsort <- optionalProgram "cabal-sort"+ if cabalsort+ then do+ forM_ pkgids $ prepare [] . Just . PVPackageId+ builddir <- getBuildDir+ withCurrentDirectory builddir $ do+ -- pre-sort to stabilize sorting+ sorted <- cmdLines "cabal-sort" (map (\pid -> showPkgId pid </> display (pkgName pid) <.> "cabal") $ sort pkgids)+ --print sorted+ return $ mapMaybe (simpleParse . takeDirectory) sorted+ else do+ mapM_ (`bringTarball` mspec) pkgids+ return pkgids
src/Stackage.hs view
@@ -35,43 +35,70 @@ import Data.Maybe (fromMaybe) import Distribution.Text (display) import SimpleCabal (PackageIdentifier(..), PackageName)-import SimpleCmd ((+-+), removePrefix)+import SimpleCmd ((+-+), cmdFull, removePrefix) import System.FilePath (takeFileName)++import qualified Stackage.MajorVer as MV+import Stackage.Snapshots (latestMajorSnapshot, latestLTS)+import SysCmd (optionalProgram) import Types defaultLTS :: Stream defaultLTS = LTS 21 -latestLTS :: Stream-latestLTS = LTS 21+streamToMajorVer :: Stream -> MV.MajorVer+streamToMajorVer (LTS n) = MV.LTS n+streamToMajorVer LatestLTS = MV.LTSLatest+streamToMajorVer LatestNightly = MV.Nightly+streamToMajorVer _ = error "unsupported/impossible stream" +majorVerToStream :: MV.MajorVer -> Stream+majorVerToStream (MV.LTS n) = LTS n+majorVerToStream MV.LTSLatest = LatestLTS+majorVerToStream MV.Nightly = LatestNightly+ stackageList :: Stream -> PackageName -> IO (Maybe PackageIdentifier) stackageList stream pkg = do- let pkgurl = "https://www.stackage.org/" ++ showStream stream ++ "/package/" ++ display pkg- mloc <-+ haveStack <- optionalProgram "stack"+ if haveStack+ then do+ msnap <- latestMajorSnapshot $ streamToMajorVer stream+ case msnap of+ Nothing -> error "snapshot not found"+ Just snap -> do+ (ok,out,err) <- cmdFull "stack" ["--resolver", snap, "--verbosity", "info", "list", display pkg] ""+ if not ok+ then return Nothing+ else do+ let pkgver = if null out then err else out+ ver = (readVersion . removePrefix (display pkg ++ "-")) pkgver+ return $ Just $ PackageIdentifier pkg ver+ else do+ let pkgurl = "https://www.stackage.org/" ++ showStream stream ++ "/package/" ++ display pkg+ mloc <- #ifdef CURL- withCurlDo $- (lookup "location" . reverse . snd) <$> curlHead pkgurl [CurlFollowLocation True]+ withCurlDo $+ (lookup "location" . reverse . snd) <$> curlHead pkgurl [CurlFollowLocation True] #else- 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+ 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+ 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 :: Maybe Stream -> PackageName -> IO (Maybe PackageIdentifier) latestStackage mstream pkg = do@@ -82,12 +109,15 @@ putStrLn $ display pkgid +-+ "in Stackage" +-+ showStream stream return mpkgid Nothing ->- maybe (return Nothing) (\ nstream -> latestStackage (Just nstream) pkg) $ newerStream stream+ newerStream stream >>=+ maybe (return Nothing) (\ nstream -> latestStackage (Just nstream) pkg) where- newerStream :: Stream -> Maybe Stream- newerStream (LTS n) =- if LTS n < latestLTS+ newerStream :: Stream -> IO (Maybe Stream)+ newerStream (LTS n) = do+ latest <- latestLTS+ return $+ if LTS n < majorVerToStream latest then Just (LTS (n+1)) else Just LatestNightly- newerStream LatestLTS = Just LatestNightly- newerStream _ = Nothing+ newerStream LatestLTS = return $ Just LatestNightly+ newerStream _ = return Nothing
+ src/Stackage/MajorVer.hs view
@@ -0,0 +1,77 @@+module Stackage.MajorVer (+ MajorVer(..),+ readCompactMajor,+ readMajor,+ showMajor,+ showCompact,+ snapMajorVer,+ MajorVerAlias(..),+ eitherReadMajorAlias+ )+where++import Control.Applicative+import Data.List.Extra+import SimpleCmd (error')+import Text.Read (readMaybe)++-- FIXME allow specific snapshots?+data MajorVer = LTS Int | LTSLatest | Nightly+ deriving (Eq, Ord)++maybeReadMajor :: String -> Maybe MajorVer+maybeReadMajor "nightly" = Just Nightly+maybeReadMajor ver =+ if "lts" `isPrefixOf` ver then+ case readMaybe (dropPrefix "lts-" ver) <|> readMaybe (dropPrefix "lts" ver) of+ Just major -> Just (LTS major)+ Nothing -> Nothing+ else Nothing++-- readMajor "lts-16"+readMajor :: String -> MajorVer+readMajor "nightly" = Nightly+readMajor "lts" = LTSLatest+readMajor ver =+ case maybeReadMajor ver of+ Just s -> s+ Nothing ->+ error' $! "couldn't parse " ++ ver ++ " (expected lts-XX or ltsXX)"++-- readCompactMajor "lts16"+-- Should we support "stack-lts.yaml"?+readCompactMajor :: String -> Maybe MajorVer+readCompactMajor "nightly" = Just Nightly+readCompactMajor ver =+ if "lts" `isPrefixOf` ver then+ case readMaybe (dropPrefix "lts" ver) of+ Just major -> Just (LTS major)+ Nothing -> error' $! "couldn't parse compact " ++ ver ++ " (expected ltsXX)"+ else Nothing++showMajor :: MajorVer -> String+showMajor Nightly = "nightly"+showMajor LTSLatest = "lts"+showMajor (LTS ver) = "lts-" ++ show ver++showCompact :: MajorVer -> String+showCompact = filter (/= '-') . showMajor++snapMajorVer :: String -> MajorVer+snapMajorVer snap =+ case breakOn "." snap of+ (major,_suf) -> readMajor major++---- MajorVerAlias++data MajorVerAlias = LatestLTS | MajorVer MajorVer++maybeReadMajorAlias :: String -> Maybe MajorVerAlias+maybeReadMajorAlias "lts" = Just LatestLTS+maybeReadMajorAlias v = MajorVer <$> maybeReadMajor v++eitherReadMajorAlias :: String -> Either String MajorVerAlias+eitherReadMajorAlias cs =+ case maybeReadMajorAlias cs of+ Just s -> Right s+ _ -> Left cs
+ src/Stackage/Snapshots.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE CPP, OverloadedStrings #-}++module Stackage.Snapshots (+ latestMajorSnapshot,+ latestLTS,+ latestLtsSnapshot,+ resolveMajor+ )+where++import Data.Aeson+import qualified Data.Text as T+import Network.HTTP.Query+import SimpleCmd (error')+import System.Cached.JSON++import Stackage.MajorVer++latestMajorSnapshot :: MajorVer -> IO (Maybe String)+latestMajorSnapshot ver = do+ lookupKey (T.pack (showMajor ver)) <$> getSnapshots++getSnapshots :: IO Object+getSnapshots =+ getCachedJSON "stackage-snapshots" "snapshots.json" "http://haddock.stackage.org/snapshots.json" 200++latestLTS :: IO MajorVer+latestLTS = do+ msnap <- lookupKey "lts" <$> getSnapshots+ case msnap of+ Just snap -> return $ snapMajorVer snap+ Nothing -> error' "could not resolve lts major version"++latestLtsSnapshot :: IO String+latestLtsSnapshot = do+ msnap <- resolveMajor LatestLTS >>= latestMajorSnapshot+ case msnap of+ Nothing ->+ error' "failed to determine latest lts snapshot"+ Just snap -> return snap++-- converts 'lts' to actual version+resolveMajor :: MajorVerAlias -> IO MajorVer+resolveMajor LatestLTS = latestLTS+resolveMajor (MajorVer ver) = return ver