diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -71,7 +71,7 @@ ## Help output ```shellsession $ cabal-rpm --version -2.1.2 +2.1.3 $ cabal-rpm --help Cabal-rpm tool diff --git a/cabal-rpm.cabal b/cabal-rpm.cabal --- a/cabal-rpm.cabal +++ b/cabal-rpm.cabal @@ -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 diff --git a/src/Commands/Spec.hs b/src/Commands/Spec.hs --- a/src/Commands/Spec.hs +++ b/src/Commands/Spec.hs @@ -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 diff --git a/src/Commands/Update.hs b/src/Commands/Update.hs --- a/src/Commands/Update.hs +++ b/src/Commands/Update.hs @@ -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 diff --git a/src/Dependencies.hs b/src/Dependencies.hs --- a/src/Dependencies.hs +++ b/src/Dependencies.hs @@ -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 diff --git a/src/PackageUtils.hs b/src/PackageUtils.hs --- a/src/PackageUtils.hs +++ b/src/PackageUtils.hs @@ -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 diff --git a/src/Stackage.hs b/src/Stackage.hs --- a/src/Stackage.hs +++ b/src/Stackage.hs @@ -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 diff --git a/src/Stackage/MajorVer.hs b/src/Stackage/MajorVer.hs new file mode 100644 --- /dev/null +++ b/src/Stackage/MajorVer.hs @@ -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 diff --git a/src/Stackage/Snapshots.hs b/src/Stackage/Snapshots.hs new file mode 100644 --- /dev/null +++ b/src/Stackage/Snapshots.hs @@ -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