bumper 0.6.0.3 → 0.7.0.0
raw patch · 7 files changed
+87/−111 lines, 7 filesdep +lensdep −fclabelsdep −strictdep ~Cabaldep ~containersdep ~processnew-uploader
Dependencies added: lens
Dependencies removed: fclabels, strict
Dependency ranges changed: Cabal, containers, process
Files
- CHANGELOG.md +6/−0
- README.md +4/−1
- bumper.cabal +24/−17
- src/Bumper.hs +16/−15
- src/Config.hs +10/−14
- src/Package.hs +19/−21
- src/Version.hs +8/−43
CHANGELOG.md view
@@ -1,6 +1,12 @@+#### 0.7.0.0++* Update dependencies for 2025+* Migrate from `fclabels` to `lens`+ #### 0.6.0.3 * Allow Cabal 1.22.*+* Allow process 1.3.* #### 0.6.0.2
README.md view
@@ -1,6 +1,9 @@ # Bumper -[](https://travis-ci.org/silkapp/bumper)+[](https://github.com/ulysses4ever/bumper/actions?query=workflow%3Ahaskell-ci)+[](https://hackage.haskell.org/package/bumper)+[](https://www.stackage.org/package/bumper)+[](https://www.stackage.org/package/bumper) Bumper is a tool for working with cabal packages. It lets you manage the version bounds of packages by transitively bumping packages (and their dependencies transitively), without you needing to edit the cabal files manually.
bumper.cabal view
@@ -1,42 +1,49 @@+cabal-version: 3.4 name: bumper-version: 0.6.0.3+version: 0.7.0.0+description:+ Bumper is a tool for working with cabal packages.+ It lets you manage the version bounds of packages by transitively bumping packages+ (and their dependencies transitively), without you needing to edit the cabal files manually. synopsis: Automatically bump package versions, also transitively.-description: Automatically bump package versions, also transitively.- .- Readme: <https://www.github.com/silkapp/bumper/blob/master/README.md> author: Silk copyright: (c) 2012, Silk-maintainer: code@silk.co-homepage: http://github.com/silkapp/bumper+maintainer: Artem Pelenitsyn <a@pelenitsyn.top>+homepage: http://github.com/ulysses4ever/bumper category: Development-license: BSD3+license: BSD-3-Clause license-file: LICENSE-cabal-version: >= 1.6 build-type: Simple+tested-with:+ GHC ==9.8.4+ || ==9.10.2 -extra-source-files:+extra-doc-files: CHANGELOG.md LICENSE README.md source-repository head type: git- location: https://github.com/silkapp/bumper.git+ location: https://github.com/ulysses4ever/bumper.git executable bumper+ default-language: Haskell2010 ghc-options: -Wall hs-source-dirs: src main-is: Bumper.hs other-modules: Config Package+ Paths_bumper Version+ autogen-modules:+ Paths_bumper build-depends: base == 4.*- , Cabal >= 1.6 && < 1.23- , containers >= 0.4 && < 0.6- , fclabels >= 1.0 && < 2.1- , process >= 1.0 && < 1.3- , regex-compat >= 0.93 && < 0.96- , split >= 0.1 && < 0.3- , strict == 0.3.2+ , Cabal >= 3 && < 4+ , containers >= 0.4 && <0.8+ , lens >= 4.0 && < 5.4+ , process >= 1.0 && <1.7+ , regex-compat >= 0.93 && <0.96+ , split >= 0.1 && <0.3
src/Bumper.hs view
@@ -1,14 +1,15 @@ module Main where import Config+import Control.Lens hiding ((<.>)) import Control.Monad-import Data.Label import Data.List import Data.Maybe-import Data.Version import Distribution.Package hiding (Package) import Distribution.Text import Distribution.Version+import qualified Distribution.Compat.NonEmptySet as NESet+import Distribution.Types.LibraryName import Package import Version import qualified Data.Map as M@@ -17,16 +18,16 @@ main :: IO () main = do conf <- getConfig- case get action conf of+ case view action conf of ShowHelp -> printUsage options- ShowVersion -> putStrLn $ "bumper, version " ++ showVersion Paths.version+ ShowVersion -> putStrLn $ "bumper, version " ++ show Paths.version ShowDeps -> run conf showDeps Run -> run conf updateDeps where showDeps _ changed = putStr $ intercalate " " $ map display $ M.keys changed updateDeps base changed = mapM_ (\p -> updatePackage p (makeUpdates p)) base where- makeUpdates p = (M.lookup (get name p) changed, dependencyUpdates changed p)+ makeUpdates p = (M.lookup (view name p) changed, dependencyUpdates changed p) run :: Config -> (Packages -> Changes -> IO ()) -> IO () run conf act =@@ -34,15 +35,15 @@ ps <- packages --Check for non-existent packages- let changePks = map fst (get setVersion conf) ++ concat (M.elems (get bump conf))+ let changePks = map fst (view setVersion conf) ++ concat (M.elems (view bump conf)) notFound = filter (not . isJust . flip lookupPackage ps) changePks when (not $ null notFound) $ putStrLn $ "[Warning] packages not found: " ++ (intercalate "," $ map display notFound) -- Retrieve base versions- base <- maybe (return ps) (flip getBaseVersions ps) $ get global conf- let changed = (if get transitive conf then trans base else id)- $ concatChanges (map (\(p,pks) -> bumpVersions p pks base) (M.toAscList (get bump conf)))- <.> userVersions (get setVersion conf) base+ base <- maybe (return ps) (flip getBaseVersions ps) $ view global conf+ let changed = (if view transitive conf then trans base else id)+ $ concatChanges (map (\(p,pks) -> bumpVersions p pks base) (M.toAscList (view bump conf)))+ <.> userVersions (view setVersion conf) base act base changed type Changes = M.Map PackageName Version@@ -60,7 +61,7 @@ userVersions vs ps = M.fromList $ filter (\nv -> hasPackage (fst nv) ps) vs bumpVersions :: Int -> [PackageName] -> Packages -> Changes-bumpVersions pos ns ps = M.fromList $ map (\p -> (get name p, bumpPosition pos (get version p))) $ lookupPackages ns ps+bumpVersions pos ns ps = M.fromList $ map (\p -> (view name p, bumpPosition pos (view version p))) $ lookupPackages ns ps -- | Make transitive changes trans :: Packages -> Changes -> Changes@@ -69,7 +70,7 @@ transStep :: Packages -> Changes -> Changes transStep ps old = new <.> old where deps = filter (not . null . dependencyUpdates old) ps- new = M.fromList . map (\p -> (get name p, bumpPosition 3 (get version p))) $ deps+ new = M.fromList . map (\p -> (view name p, bumpPosition 3 (view version p))) $ deps fix :: (Eq a) => (a -> a) -> a -> a fix f a | b == a = a@@ -78,10 +79,10 @@ -- | Caclulate updated dependencies dependencyUpdates :: Changes -> Package -> [Dependency]-dependencyUpdates ch = foldr addDep [] . get dependencies- where addDep (Dependency n r) dps =+dependencyUpdates ch = foldr addDep [] . view dependencies+ where addDep (Dependency n r _) dps = case M.lookup n ch of Just v -> if withinRange v r then dps- else Dependency n (addVersionToRange v r) : dps+ else Dependency n (addVersionToRange v r) (NESet.singleton LMainLibName) : dps Nothing -> dps
src/Config.hs view
@@ -1,19 +1,15 @@-{-# LANGUAGE- TypeOperators- , TemplateHaskell- #-}+{-# LANGUAGE TemplateHaskell #-} module Config where +import Control.Lens import Control.Monad-import Data.Label import Data.List.Split-import Data.Version+import Distribution.Types.Version (Version) import Distribution.Package-import Distribution.Text+import Distribution.Parsec import System.Console.GetOpt import System.Environment import qualified Data.Map as M- data Action = Run | ShowDeps | ShowHelp@@ -29,7 +25,7 @@ , _action :: Action } deriving Show -$(mkLabels [''Config])+$(makeLenses ''Config) defaultConfig :: Config defaultConfig = Config@@ -45,8 +41,8 @@ versionPar = foldr addVer [] . splitOn "," where addVer fld ac = case splitOn "@" fld of- [p,v] -> case simpleParse v of- (Just ver) -> (PackageName p, ver) : ac+ [p,v] -> case simpleParsec v of+ (Just ver) -> (mkPackageName p, ver) : ac Nothing -> ac _ -> ac @@ -57,16 +53,16 @@ , Option ['1'] ["bump-1"] (ReqArg (addBumps 1) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a bump at position 1." , Option ['2'] ["bump-2"] (ReqArg (addBumps 2) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a bump at position 2." , Option ['3'] ["bump-3"] (ReqArg (addBumps 3) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will get a bump at position 3."- , Option [] ["set-versions"] (ReqArg (\v -> modify setVersion (++ versionPar v)) "PACKAGE@VERSION(,PACKAGE@VERSION)*") "Comma-separated list of packages and their versions."+ , Option [] ["set-versions"] (ReqArg (\v -> over setVersion (++ versionPar v)) "PACKAGE@VERSION(,PACKAGE@VERSION)*") "Comma-separated list of packages and their versions." , Option ['t'] ["no-transitive"] (NoArg (set transitive False)) "Do not apply bumping transitively."- , Option ['i'] ["ignore"] (ReqArg (\v -> modify ignore (++ map PackageName (splitOn "," v))) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will be ignored when transitive bumping."+ , Option ['i'] ["ignore"] (ReqArg (\v -> over ignore (++ map mkPackageName (splitOn "," v))) "PACKAGE(,PACKAGE)*") "Comma-separated list of packages which will be ignored when transitive bumping." , Option ['g'] ["global"] (ReqArg (\v -> set global (Just v)) "PATH") "Bump according to latest version number in the given package database." , Option ['d'] ["dry-run"] (NoArg (set action ShowDeps)) "Just output the dependencies that will be updated." , Option ['?'] ["help"] (NoArg (set action ShowHelp)) "Show usage help and exit." , Option ['v'] ["version"] (NoArg (set action ShowVersion)) "Show version info and exit." ] where addBumps :: Int -> String -> Config -> Config- addBumps p pks = modify bump (M.insertWith (++) p (map PackageName $ splitOn "," pks))+ addBumps p pks = over bump (M.insertWith (++) p (map mkPackageName $ splitOn "," pks)) getConfig :: IO Config getConfig =
src/Package.hs view
@@ -1,32 +1,27 @@ -- * Contains helper functions to load and manipulate .cabal files {-# LANGUAGE- TypeOperators- , TemplateHaskell+ TemplateHaskell , TupleSections #-} module Package where -import Prelude hiding (readFile)--import Control.Applicative+import Control.Lens import Control.Monad-import Data.Label import Data.List import Data.List.Split import Data.Maybe-import Data.Version+import Distribution.Types.Version (Version) import Distribution.Package hiding (Package) import Distribution.PackageDescription-import Distribution.PackageDescription.Configuration-import Distribution.PackageDescription.Parse+import Distribution.Simple.PackageDescription (readGenericPackageDescription) import Distribution.Text import Distribution.Verbosity-import System.IO.Strict import System.Process import Text.Regex-import Version import qualified Data.Map as M +import System.IO (hGetContents)+ data Package = Package { _name :: PackageName , _path :: String@@ -34,14 +29,14 @@ , _dependencies :: [Dependency] } deriving (Show, Eq) -$(mkLabels [''Package])+$(makeLenses ''Package) type Packages = [Package] -- | Helper functions lookupPackage :: PackageName -> Packages -> Maybe Package-lookupPackage s = find ((== s) . _name)+lookupPackage s = find ((== s) . view name) lookupPackages :: [PackageName] -> Packages -> Packages lookupPackages ns ps = catMaybes . map (flip lookupPackage ps) $ ns@@ -50,7 +45,7 @@ hasPackage n = isJust . lookupPackage n removePackage :: PackageName -> Packages -> Packages-removePackage s = filter ((/= s). _name)+removePackage s = filter ((/= s). view name) removeAll :: [PackageName] -> Packages -> Packages removeAll = flip $ foldr removePackage@@ -61,12 +56,15 @@ do (_, hOut, _, _) <- runInteractiveCommand "find . -name *.cabal -type f" paths <- lines <$> hGetContents hOut forM paths $ \p ->- do pkg <- flattenPackageDescription `liftM` readPackageDescription normal p+ do gpd <- readGenericPackageDescription normal p+ let pkg = packageDescription gpd return $ Package { _name = pkgName $ package pkg , _path = p , _version = pkgVersion $ package pkg- , _dependencies = buildDepends pkg+ , _dependencies = targetBuildDepends $ (case allBuildInfo pkg of+ (bi:_) -> bi+ [] -> emptyBuildInfo) } getBaseVersions :: String -> Packages -> IO Packages@@ -74,10 +72,10 @@ do (_, hOut, _, _) <- runInteractiveCommand $ "tar -tf " ++ ind gps <- lines <$> hGetContents hOut let vs = catMaybes $ map (parseVer . splitOn "/") gps- parseVer (n:v:_) = fmap (PackageName n, ) $ simpleParse v+ parseVer (n:v:_) = fmap (mkPackageName n, ) $ simpleParse v parseVer _ = Nothing globver = M.fromListWith (\a b -> if a > b then a else b) vs- updVer p = modify version (maybe id (\v -> if get version p < v then const v else id) $ M.lookup (_name p) globver) p+ updVer p = over version (maybe id (\v -> if view version p < v then const v else id) $ M.lookup (view name p) globver) p return $ map updVer ps -- | Manipulating package contents@@ -90,11 +88,11 @@ result = "\\1 " ++ display v modifyDependency :: Dependency -> String -> String-modifyDependency (Dependency nm range) s = subRegex (mkRegexWithOpts regex False False) s result+modifyDependency (Dependency nm range _) s = subRegex (mkRegexWithOpts regex False False) s result where regex = "(build-depends" ++ whiteReg ++ ":" ++ "[^:]*" ++ "[ ,\n\t]" ++ display nm ++ whiteReg ++ ")([" ++ rangeChar ++ " \t\n]*[" ++ rangeChar ++ "])" rangeChar = "0-9.*&|()<>="- result = "\\1" ++ printRange range+ result = "\\1" ++ display range -- | Data structure containing package modifications type PackageChanges = (Maybe Version, [Dependency])@@ -105,4 +103,4 @@ . maybe id modifyVersion mv updatePackage :: Package -> PackageChanges -> IO ()-updatePackage p ch = readFile (get path p) >>= writeFile (get path p) . modifyPackage ch+updatePackage p ch = readFile (view path p) >>= writeFile (view path p) . modifyPackage ch
src/Version.hs view
@@ -1,35 +1,27 @@ -- * Manipulation functions for cabal versions and version ranges-{-# LANGUAGE- TypeOperators- , TemplateHaskell- #-}+{-# LANGUAGE TemplateHaskell #-} module Version where -import Data.Label-import Distribution.Text import Distribution.Version -$(mkLabels [''Version])-$(mkLabels [''VersionRange])- -- | Function to bump the nth position in a version to a higher number -- trailing version number will be discarded bumpPosition :: Int -> Version -> Version-bumpPosition p = modify lVersionBranch (addPos p)+bumpPosition p v = mkVersion $ addPos p (versionNumbers v) where addPos 0 [] = [1]- addPos 0 (v: _) = [v+1]+ addPos 0 (vn: _) = [vn+1] addPos x [] = 0 : addPos (x - 1) []- addPos x (v: vs) = v : addPos (x - 1) vs+ addPos x (vn: vns) = vn : addPos (x - 1) vns previousVersion :: Version -> Version-previousVersion = modify lVersionBranch mkPrevious+previousVersion = mkVersion . mkPrevious . versionNumbers where mkPrevious = reverse . prevHelp . reverse prevHelp [] = [] prevHelp (x:xs) = if x <= 1 then xs else (x - 1): xs -- No trailing zeros nextVersion :: Version -> Version-nextVersion = modify lVersionBranch mkNext+nextVersion = mkVersion . mkNext . versionNumbers where mkNext = reverse . nextHelp . reverse nextHelp [] = [] nextHelp (x:xs) = (x + 1) : xs@@ -38,33 +30,6 @@ addVersionToRange new r = if withinRange new r then r- else- let cVersion = const (thisVersion new)- c2Version = const $ const (thisVersion new)- in foldVersionRange'- anyVersion -- any- cVersion -- (==)- cVersion -- >- cVersion -- <- cVersion -- >=- cVersion -- <=- (\v _ -> withinVersion $ v { versionBranch = take (length $ versionBranch v) $ versionBranch new }) -- .*- c2Version -- (||)- c2Version -- (&&)- id -- (_)- r+ else unionVersionRanges r (thisVersion new) -printRange :: VersionRange -> String-printRange =- let sShow s = ((s ++ " ") ++) . display- in foldVersionRange'- "*"- (sShow "==")- (sShow ">")- (sShow "<")- (sShow ">=")- (sShow "<=")- (\v _ -> "== " ++ display v ++ ".*")- (\v1 v2 -> v1 ++ " || " ++ v2)- (\v1 v2 -> v1 ++ " && " ++ v2)- (\v -> "(" ++ v ++ ")")+