select-rpms 0.3.0 → 0.3.1

raw patch · 3 files changed

+105/−51 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• select-rpms.cabal +2/−1
• src/SelectRPMs.hs +94/−50

@@ -1,5 +1,14 @@ # Release history for select-rpms +## 0.3.1 (2025-09-13)+- selections that do not match any RPMs no longer error+- installing debuginfo/debugsource now possible if requested+- default presets for certain package prefixes (currently only ghc*)+- add pkgMgrOpt (from koji-tool)+- add installRPMsAllowErasing which extends installRPMs+- installRPMs (installCommand): use rpm -U since package may exist+- checkSelection: now used directly by decideRPMs+ ## 0.3.0 (2025-06-04) - ExistingStrategy: add ExistingError which aborts for existing installed pkg 

@@ -1,6 +1,6 @@ cabal-version:       2.2 name:                select-rpms-version:             0.3.0+version:             0.3.1 synopsis:            Select a subset of RPM packages description:         A library for selecting a subset of RPM (sub)packages.@@ -22,6 +22,7 @@                       || == 9.6.7                       || == 9.8.4                       || == 9.10.2+                      || == 9.12.2  source-repository head   type:                git

@@ -16,13 +16,15 @@   nvraToRPM,   groupOnArch,   PkgMgr(..),-  installRPMs+  pkgMgrOpt,+  installRPMs,+  installRPMsAllowErasing   ) where  import Control.Monad.Extra (forM_, mapMaybeM, unless, when) import Data.Either (partitionEithers)-import Data.List.Extra (isInfixOf, nubOrd, nubSort, sort,+import Data.List.Extra (isPrefixOf, isSuffixOf, nubOrd, nubSort, sort, #if !MIN_VERSION_base(4,20,0)                         foldl', #endif@@ -45,6 +47,8 @@ import System.FilePath.Glob (compile, isLiteral, match)  -- | The Select type specifies the subpackage selection+--+-- Can use name globs: eg "*-devel" or "lib*" data Select = All -- ^ all packages             | Ask -- ^ interactive prompting             | PkgsReq@@ -54,11 +58,11 @@               [String] -- ^ added   deriving Eq --- | default package selection+-- | Default package selection selectDefault :: Select selectDefault = PkgsReq [] [] [] [] --- | optparse-applicative Parser for Select+-- | An optparse-applicative Parser for Select selectRpmsOptions :: Parser Select selectRpmsOptions =   flagLongWith' All "all" "all subpackages [default if not installed]" <|>@@ -69,7 +73,7 @@   <*> many (strOptionWith 'x' "exclude" "SUBPKG" "deselect subpackage (glob): overrides -p and -e")   <*> many (strOptionWith 'i' "include" "SUBPKG" "additional subpackage (glob) to install: overrides -x") --- | alternative CLI args option parsing to Select packages+-- | An alternative CLI args option to parse String to Select of rpm packages installArgs :: String -> Select installArgs cs =   case words cs of@@ -110,28 +114,36 @@       then error' "empty pattern!"       else f --- FIXME explain if/why this is actually needed (used by koji-tool install)--- | check package Select is not empty+-- FIXME check allowed characters+-- | Check package Select options have no empty strings+--+-- (deprecated export) checkSelection :: Monad m => Select -> m () checkSelection (PkgsReq ps es xs is) =   forM_ (ps ++ es ++ xs ++ is) $ \s ->   when (null s) $ error' "empty package pattern not allowed" checkSelection _ = return () --- | converts a list of RPM files to NVRA's, filtering out debug subpackages+-- | Converts a list of RPM files to sorted NVRA's+--+-- (since 0.3.1 no longer excludes debuginfo and debugsource packages) rpmsToNVRAs :: [String] -> [NVRA]-rpmsToNVRAs = sort . map readNVRA . filter notDebugPkg+rpmsToNVRAs = sort . map readNVRA --- | how to handle already installed packages: re-install, skip, or+-- | How to handle already installed subpackages: re-install, skip, or -- default update -- -- The default strategy is to select existing subpackages, otherwise all. -- -- The constructors are only really needed internally but exported for -- documentation.-data ExistingStrategy = ExistingNoReinstall | ExistingSkip | ExistingOnly | ExistingError+data ExistingStrategy = ExistingNoReinstall -- ^ skip reinstall of same NVRs+                      | ExistingSkip        -- ^ skip installed subpkgs+                      | ExistingOnly        -- ^ only update existing subpkgs+                      | ExistingError       -- ^ abort for existing subpkg   deriving Eq +-- | An optparse-applicative Parser for ExistingStrategy existingStrategyOption :: Parser ExistingStrategy existingStrategyOption =   flagWith' ExistingNoReinstall 'N' "no-reinstall" "Do not reinstall existing NVRs" <|>@@ -139,37 +151,38 @@   flagWith' ExistingOnly 'O' "only-existing" "Only update existing installed subpackages" <|>   flagWith' ExistingError 'E' "error-existing" "Abort for existing installed subpackages" --- | sets prompt default behaviour for yes/no questions+-- | Sets prompt default behaviour for yes/no questions data Yes = No | Yes   deriving Eq --- | current state of a package NVR+-- | Current state of a package NVR data Existence = ExistingNVR -- ^ NVR is already installed                | ChangedNVR -- ^ NVR is different to installed package                | NotInstalled -- ^ package is not currently installed   deriving (Eq, Ord, Show) --- | combines Existence state with an NVRA+-- | Combines Existence state with an NVRA type ExistNVRA = (Existence, NVRA)  -- FIXME determine and add missing internal deps--- | decide list of NVRs based on a Select selection (using a package prefix)+-- | Decide list of NVRs based on a Select selection (using a package prefix) decideRPMs :: Yes -- ^ prompt default choice-           -> Bool -- ^ enable list mode which just display the package list+           -> Bool -- ^ enable list mode which just displays the package list            -> Maybe ExistingStrategy -- ^ optional existing install strategy            -> Select -- ^ specifies package Select choices-           -> String -- ^ package set prefix: allows abbreviated Select-           -> [NVRA] -- ^ list of packages to select from-           -> IO [ExistNVRA] -- ^ returns list of selected packages+           -> String -- ^ package set prefix: allows Select'ing without prefix+           -> [NVRA] -- ^ list of rpm packages to select from+           -> IO [ExistNVRA] -- ^ returns list of selected rpm packages decideRPMs yes listmode mstrategy select prefix nvras = do+  checkSelection select   classified <- mapMaybeM installExists (filter isBinaryRpm nvras)   if listmode     then do-    case select of-      PkgsReq subpkgs exceptpkgs exclpkgs addpkgs ->-        mapM_ printInstalled $-        selectRPMs prefix (subpkgs,exceptpkgs,exclpkgs,addpkgs) classified-      _ -> mapM_ printInstalled classified+    mapM_ printInstalled $+      case select of+        PkgsReq subpkgs exceptpkgs exclpkgs addpkgs ->+          selectRPMs prefix (subpkgs,exceptpkgs,exclpkgs,addpkgs) classified+        _ -> classified     return []     else     case select of@@ -209,7 +222,7 @@       included = matchingRPMs prefix addpkgs rpms       matching =         if null subpkgs && null exceptpkgs-        then defaultRPMs rpms+        then defaultRPMs prefix rpms         else matchingRPMs prefix subpkgs rpms       nonmatching = nonMatchingRPMs prefix exceptpkgs rpms   in nubSort $ ((matching ++ nonmatching) \\ excluded) ++ included@@ -252,24 +265,36 @@     then Just epn     else Nothing -defaultRPMs :: [ExistNVRA] -> [ExistNVRA]-defaultRPMs rpms =+defaultRPMs :: String -> [ExistNVRA] -> [ExistNVRA]+defaultRPMs prefix rpms =   let installed = filter ((/= NotInstalled) . fst) rpms   in if null installed-     then rpms+     then filter (wantedSubpackage . rpmName . snd) rpms      else installed+  where+    wantedSubpackage :: String -> Bool+    wantedSubpackage p =+      notDebugPkg p && defaultSubpackage p +    notDebugPkg :: String -> Bool+    notDebugPkg p =+      not ("-debuginfo" `isSuffixOf` p || "-debugsource" `isSuffixOf` p)++    defaultSubpackage :: String -> Bool+    defaultSubpackage p =+      not ("ghc" `isPrefixOf` prefix)+      ||+      not ("-doc" `isSuffixOf` p || "-prof" `isSuffixOf` p || "compiler-default" `isSuffixOf` p)++-- FIXME add --strict (must match) switch matchingRPMs :: String -> [String] -> [ExistNVRA] -> [ExistNVRA] matchingRPMs prefix subpkgs rpms =   nubSort . mconcat $-  flip map (nubOrd subpkgs) $ \ pkgpat ->+  flip map (nubOrd subpkgs) $ \pkgpat ->   case getMatches pkgpat of     [] -> if headMay pkgpat /= Just '*'-          then-            case getMatches (prefix ++ '-' : pkgpat) of-              [] -> error' $ "no subpackage match for " ++ pkgpat-              result -> result-          else error' $ "no subpackage match for " ++ pkgpat+          then getMatches (prefix ++ '-' : pkgpat)+          else []     result -> result   where     getMatches :: String -> [ExistNVRA]@@ -301,29 +326,48 @@                   (prefix ++ '-' : pat) == rpmname              else match comppat rpmname -notDebugPkg :: String -> Bool-notDebugPkg p =-  not ("-debuginfo-" `isInfixOf` p || "-debugsource-" `isInfixOf` p)---- | whether a package needs to be reinstalled or installed+-- | Whether a package needs to be reinstalled or installed data InstallType = ReInstall                  | Install --- | package manager+-- | Package manager data PkgMgr = DNF3 | DNF5 | RPM | OSTREE   deriving Eq --- FIXME support options per build: install ibus imsettings -i plasma--- (or don't error if multiple packages)--- | do installation of packages+-- | An optparse-applicative Parser for PkgMgr+--+-- (since 0.3.1)+pkgMgrOpt :: Parser PkgMgr+pkgMgrOpt =+  flagLongWith' RPM "rpm" "Use rpm instead of dnf" <|>+  flagLongWith' OSTREE "rpm-ostree" "Use rpm-ostree instead of dnf" <|>+  flagLongWith' DNF5 "dnf5" "Use dnf5 to install" <|>+  flagLongWith' DNF3 "dnf3" "Use dnf-3 to install [default dnf unless ostree]"++-- | Do installation of selected rpm packages installRPMs :: Bool -- ^ dry-run             -> Bool -- ^ debug output             -> Maybe PkgMgr -- ^ optional specify package manager             -> Yes -- ^ prompt default choice             -> [(FilePath,[ExistNVRA])] -- ^ list of rpms to install with path             -> IO ()-installRPMs _ _ _ _ [] = return ()-installRPMs dryrun debug mmgr yes classifieds = do+installRPMs dryrun debug mmgr =+  installRPMsAllowErasing dryrun debug mmgr False++-- FIXME support options per build: install ibus imsettings -i plasma+-- (or don't error if multiple packages)+-- | Do installation of packages (with allowerasing switch)+--+-- (since 0.3.1)+installRPMsAllowErasing :: Bool -- ^ dry-run+                        -> Bool -- ^ debug output+                        -> Maybe PkgMgr -- ^ optional specify package manager+                        -> Bool -- ^ use dnf --allowerasing+                        -> Yes -- ^ prompt default choice+                        -> [(FilePath,[ExistNVRA])] -- ^ list of rpms to install with path+                        -> IO ()+installRPMsAllowErasing _ _ _ _ _ [] = return ()+installRPMsAllowErasing dryrun debug mmgr allowerasing yes classifieds =   case installTypes (concatMap zipDir classifieds) of     ([],is) -> doInstall Install is     (ris,is) -> do@@ -372,7 +416,7 @@           (case mgr of             OSTREE -> cmd_             _ -> if debug then sudoLog else sudo_) pkgmgr $-            com ++ map showRpmFile dirpkgs ++ ["--assumeyes" | yes == Yes && mgr `elem` [DNF3,DNF5]]+            com ++ map showRpmFile dirpkgs ++ ["--allowerasing" | allowerasing] ++ ["--assumeyes" | yes == Yes && mgr `elem` [DNF3,DNF5]]      reinstallCommand :: PkgMgr -> [String]     reinstallCommand mgr =@@ -387,19 +431,19 @@       case mgr of         DNF3 -> ["localinstall"]         DNF5 -> ["install"]-        RPM -> ["-ivh"]+        RPM -> ["-Uvh"]         OSTREE -> ["install"]  -- FIXME replace with export from rpm-nvr (once released)--- | render a NVRA as rpm file+-- | Render a NVRA as rpm file nvraToRPM :: NVRA -> FilePath nvraToRPM nvra = showNVRA nvra <.> "rpm" --- | render path and NVRA are rpm filepath+-- | Render path and NVRA are rpm filepath showRpmFile :: (FilePath,NVRA) -> FilePath showRpmFile (dir,nvra) = dir </> nvraToRPM nvra --- | group rpms by arch (subdirs)+-- | Group rpms by arch (subdirs) groupOnArch :: FilePath -- ^ prefix directory (eg "RPMS")             -> [ExistNVRA]             -> [(FilePath,[ExistNVRA])]