diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,14 @@ # Revision history for cabal-plan-bounds +## 0.1.5 -- 2023-08-17 + +* Strip patch-level from version numbers + +## 0.1.4 -- 2023-07-13 + +* Right-associate `||` when using `--extend` +* Add `--also` flag to add versions without a full build plan + ## 0.1.3.1 -- 2023-05-30 * GHC-9.6 support diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -13,7 +13,8 @@ system, or implied by compatibility with the tested versions (by way of the [PVP]). Typically, these are versions near the lower edge of the bounds, but can also -be on the upper end (e.g. when they are packaged with GHC and Cabal prefers installed versions, or when they are not actually installable yet). +be on the upper end (e.g. when they are packaged with GHC and Cabal prefers +installed versions, or when they are not actually installable yet). There are ways to mitigate this problem, such as being very careful, and maybe using Cabal's new [`--prefer-oldest`] flag. But these are not reliable. @@ -64,13 +65,13 @@ - optparse-applicative, containers, - text - build-depends: bytestring, -+ build-depends: base ^>=4.14.3.0 || ^>=4.15.1.0 || ^>=4.16.4.0 || ^>=4.17.0.0, -+ Cabal-syntax ^>=3.8.1.0, -+ cabal-plan ^>=0.7.2.3, -+ optparse-applicative ^>=0.17.0.0, -+ containers ^>=0.6.4.1, -+ text ^>=1.2.4.1 || ^>=2.0.1 -+ build-depends: bytestring ^>=0.10.12.0 || ^>=0.11.3.1 ++ build-depends: base ^>=4.14.3 || ^>=4.15.1 || ^>=4.16.4 || ^>=4.17.0, ++ Cabal-syntax ^>=3.8.1, ++ cabal-plan ^>=0.7.2, ++ optparse-applicative ^>=0.17.0, ++ containers ^>=0.6.4, ++ text ^>=1.2.4 || ^>=2.0.1 ++ build-depends: bytestring ^>=0.10.12 || ^>=0.11.3 hs-source-dirs: src/ default-language: Haskell2010 ``` @@ -93,7 +94,8 @@ ``` Here we pin the compiler version and the precise view of Hackage repo to get -reproducible results. You can imagine a separate tool that regularly updates these time stamps. +reproducible results. You can imagine a separate tool that regularly updates +these time stamps. Similarly, we can pull in stackage configurations, simply by importing the corresponding `cabal.config`, which also pins down the compiler @@ -118,14 +120,17 @@ $ cabal-plan-bounds --help Derives dependency bounds from build plans -Usage: cabal-plan-bounds [-n|--dry-run] [--extend] [PLAN] [-c|--cabal CABALFILE] +Usage: cabal-plan-bounds [-n|--dry-run] [--extend] [--also ARG] [PLAN] + [-c|--cabal CABALFILE] Available options: -h,--help Show this help text -n,--dry-run do not actually write .cabal files --extend only extend version ranges + --also ARG additional versions (pkg-1.2.3 or "pkg ==1.2.3") PLAN plan file to read (.json) -c,--cabal CABALFILE cabal file to update (.cabal) + ``` Features and limitations @@ -135,11 +140,14 @@ * It edits the `.cabal` file in place. -* It leaves the `.cabal` file as is: No reformatting, all comments are preserved. +* It leaves the `.cabal` file as is: No reformatting, all comments are + preserved. -* Only the `build-depends` fields are touched. They are reformatted (one dependency per line). +* Only the `build-depends` fields are touched. They are reformatted (one + dependency per line). - It does not add, remove or reorder the packages mentioned in the dependencies. + It does not add, remove or reorder the packages mentioned in the + dependencies. * It will apply the same bounds to _all_ mentions of a dependency in the `.cabal` file (e.g. in different components, or in conditionals). @@ -150,6 +158,9 @@ This means some behaviour cannot be achieved. Maybe this needs to be revised (especially with regard to conditionals). + +* It strips the patch level from the bound, and will write `^>= 1.2.3` instead + of `^>= 1.2.3.4`, assuming the package follows the PVP. Future work (contributions welcome!) ------------------------------------ diff --git a/cabal-plan-bounds.cabal b/cabal-plan-bounds.cabal --- a/cabal-plan-bounds.cabal +++ b/cabal-plan-bounds.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cabal-plan-bounds -version: 0.1.3.1 +version: 0.1.5 synopsis: Derives cabal bounds from build plans description: Manually curated dependency version ranges tend to become a lie: They likely @@ -29,17 +29,16 @@ executable cabal-plan-bounds import: warnings - main-is: Main.hs - ghc-options: -Wall + main-is: cabal-plan-bounds.hs other-modules: ReplaceDependencies - build-depends: base ^>=4.14.3.0 || ^>=4.15.1.0 || ^>=4.16.3.0 || ^>=4.17.0.0 || ^>=4.18.0.0, - bytestring ^>=0.10.12.0 || ^>=0.11.3.1, - containers ^>=0.6.4.1, - text ^>=1.2.4.1 || ^>=2.0.1, - Cabal-syntax ^>=3.8.1.0 || ^>=3.10.1.0, - cabal-plan ^>=0.7.2.3, - optparse-applicative ^>=0.17.0.0 || ^>=0.18.1.0, - pretty ^>=1.1.3.6 + build-depends: base ^>=4.14.3 || ^>=4.15.1 || ^>=4.16.3 || ^>=4.17.0 || ^>=4.18.0, + bytestring ^>=0.10.12 || ^>=0.11.3 || ^>=0.12.0, + containers ^>=0.6.4, + text ^>=1.2.4 || ^>=2.0.1, + Cabal-syntax ^>=3.8.1 || ^>=3.10.1, + cabal-plan ^>=0.7.2, + optparse-applicative ^>=0.17.0 || ^>=0.18.1, + pretty ^>=1.1.3 hs-source-dirs: src/ default-language: Haskell2010 diff --git a/src/Main.hs b/src/Main.hs deleted file mode 100644 --- a/src/Main.hs +++ /dev/null @@ -1,128 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Main where - - -import qualified Data.Map as M -import qualified Data.Set as S -import qualified Data.ByteString.Char8 as BS -import qualified Data.Text as T -import Options.Applicative -import Control.Monad -import Data.List -import Cabal.Plan -import Text.PrettyPrint hiding ((<>)) - -import qualified Distribution.PackageDescription.Parsec as C -import qualified Distribution.Package as C -import qualified Distribution.Types.Version as C -import qualified Distribution.Types.VersionRange as C -import Distribution.Pretty (pretty) - -import ReplaceDependencies - - -main :: IO () -main = join . customExecParser (prefs showHelpOnError) $ - info (helper <*> parser) - ( fullDesc - <> header "Derives dependency bounds from build plans" --- <> progDesc "What does this thing do?" - ) - where - parser :: Parser (IO ()) - parser = pure work - <*> switch (long "dry-run" <> short 'n' <> help "do not actually write .cabal files") - <*> switch (long "extend" <> help "only extend version ranges") - <*> many (argument - (is ".json") - (metavar "PLAN" <> help "plan file to read (.json)")) - <*> many (strOption - (short 'c' <> long "cabal" <> - metavar "CABALFILE" <> help "cabal file to update (.cabal)")) - - is :: String -> ReadM FilePath - is suffix = maybeReader $ \s -> do - guard (suffix `isSuffixOf` s) - pure s - -cabalPackageName :: BS.ByteString -> C.PackageName -cabalPackageName contents = - case C.runParseResult (C.parseGenericPackageDescription contents) of - (_warn, Left err) -> error (show err) - (_warn, Right gpd) -> C.packageName gpd - -depsOf :: C.PackageName -> PlanJson -> M.Map C.PackageName C.Version -depsOf pname plan = M.fromList -- TODO: What if different units of the package have different deps? - [ (C.mkPackageName (T.unpack depName), C.mkVersion depVersion) - | unit <- M.elems (pjUnits plan) - , let PkgId (PkgName pname') _ = uPId unit - , pname' == T.pack (C.unPackageName pname) - , comp <- M.elems (uComps unit) - , depUid <- S.toList (ciLibDeps comp) - , let depunit = pjUnits plan M.! depUid - , let PkgId (PkgName depName) (Ver depVersion) = uPId depunit - ] - -unionMajorBounds1 :: [C.Version] -> C.VersionRange -unionMajorBounds1 [] = C.anyVersion -unionMajorBounds1 vs = foldr1 C.unionVersionRanges (map C.majorBoundVersion vs) - -unionMajorBounds :: C.VersionRange -> [C.Version] -> C.VersionRange -unionMajorBounds vr [] = vr -unionMajorBounds vr vs = C.unionVersionRanges vr (unionMajorBounds1 vs) - --- assumes sorted input -pruneVersionRanges :: [C.Version] -> [C.Version] -pruneVersionRanges [] = [] -pruneVersionRanges [v] = [v] -pruneVersionRanges (v1:v2:vs) - | v2 `C.withinRange` C.majorBoundVersion v1 = pruneVersionRanges (v1 : vs) - | otherwise = v1 : pruneVersionRanges (v2 : vs) - - --- Assumes that the “new” range is always the same -cleanChanges :: [(C.PackageName, C.VersionRange, C.VersionRange)] - -> [(C.PackageName, ([C.VersionRange], C.VersionRange))] -cleanChanges changes = - M.toList $ - M.map (\(old, new) -> (nub old, new)) $ -- No Ord C.VersionRange - M.fromListWith (\(olds1, new1) (olds2, _new2) -> (olds1 <> olds2, new1)) $ - [ (pname, ([old], new)) | (pname, old, new) <- changes, old /= new ] - - -work :: Bool -> Bool -> [FilePath] -> [FilePath] -> IO () -work dry_run extend planfiles cabalfiles = do - plans <- mapM decodePlanJson planfiles - - forM_ cabalfiles $ \cabalfile -> do - contents <- BS.readFile cabalfile - - -- Figure out package name - let pname = cabalPackageName contents - - let deps = fmap (pruneVersionRanges . sort) $ - M.unionsWith (++) $ - map (fmap pure) $ - map (depsOf pname) plans - - let new_deps pn vr - | pn == pname = C.anyVersion -- self-dependency - | Just vs' <- M.lookup pn deps - = if extend - then unionMajorBounds vr [ v | v <- vs' , not (v `C.withinRange` vr) ] - else unionMajorBounds1 vs' - | otherwise = vr -- fallback - - let (contents', fieldChanges) = replaceDependencies new_deps contents - - forM_ (cleanChanges fieldChanges) $ \(pn, (olds, new)) -> - putStrLn $ render $ - hang (pretty pn) 4 $ vcat $ - [ char '-' <+> pretty old | old <- olds ] <> - [ char '+' <+> pretty new ] - - unless dry_run $ - unless (contents == contents') $ - -- TODO: Use atomic-write - BS.writeFile cabalfile contents' diff --git a/src/cabal-plan-bounds.hs b/src/cabal-plan-bounds.hs new file mode 100644 --- /dev/null +++ b/src/cabal-plan-bounds.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + + +import qualified Data.Map as M +import qualified Data.Set as S +import qualified Data.ByteString.Char8 as BS +import qualified Data.Text as T +import Options.Applicative +import Control.Monad +import Data.List +import Cabal.Plan +import Text.PrettyPrint hiding ((<>)) + +import qualified Distribution.PackageDescription.Parsec as C +import qualified Distribution.Package as C +import qualified Distribution.Parsec as C +import qualified Distribution.Types.Version as C +import qualified Distribution.Types.VersionRange as C +import qualified Distribution.Types.PackageVersionConstraint as C +import Distribution.Pretty (pretty) + +import ReplaceDependencies + + +main :: IO () +main = join . customExecParser (prefs showHelpOnError) $ + info (helper <*> parser) + ( fullDesc + <> header "Derives dependency bounds from build plans" +-- <> progDesc "What does this thing do?" + ) + where + parser :: Parser (IO ()) + parser = pure work + <*> switch (long "dry-run" <> short 'n' <> help "do not actually write .cabal files") + <*> switch (long "extend" <> help "only extend version ranges") + <*> many (option packageVersionP (long "also" <> help "additional versions (pkg-1.2.3 or \"pkg ==1.2.3\")")) + <*> many (argument + (is ".json") + (metavar "PLAN" <> help "plan file to read (.json)")) + <*> many (strOption + (short 'c' <> long "cabal" <> + metavar "CABALFILE" <> help "cabal file to update (.cabal)")) + + is :: String -> ReadM FilePath + is suffix = maybeReader $ \s -> do + guard (suffix `isSuffixOf` s) + pure s + +packageVersionP :: ReadM (C.PackageName, C.Version) +packageVersionP = eitherReader $ \s -> do + C.PackageVersionConstraint pkg vr <- C.eitherParsec s + case C.projectVersionRange vr of + C.ThisVersionF v -> pure (pkg, v) + C.MajorBoundVersionF v -> pure (pkg, v) + _ -> Left "Please pass exactly one version to the --also flag." + +cabalPackageName :: BS.ByteString -> C.PackageName +cabalPackageName contents = + case C.runParseResult (C.parseGenericPackageDescription contents) of + (_warn, Left err) -> error (show err) + (_warn, Right gpd) -> C.packageName gpd + +depsOf :: C.PackageName -> PlanJson -> M.Map C.PackageName C.Version +depsOf pname plan = M.fromList -- TODO: What if different units of the package have different deps? + [ (C.mkPackageName (T.unpack depName), C.mkVersion depVersion) + | unit <- M.elems (pjUnits plan) + , let PkgId (PkgName pname') _ = uPId unit + , pname' == T.pack (C.unPackageName pname) + , comp <- M.elems (uComps unit) + , depUid <- S.toList (ciLibDeps comp) + , let depunit = pjUnits plan M.! depUid + , let PkgId (PkgName depName) (Ver depVersion) = uPId depunit + ] + +unionMajorBounds1 :: [C.Version] -> C.VersionRange +unionMajorBounds1 [] = C.anyVersion +unionMajorBounds1 vs = foldr1 C.unionVersionRanges (map C.majorBoundVersion vs) + +extendVersionRanges :: C.VersionRange -> [C.Version] -> C.VersionRange +extendVersionRanges vr1 [] = vr1 +extendVersionRanges vr1 vr2 + | C.UnionVersionRangesF vr1a vr1b <- C.projectVersionRange vr1 + = C.unionVersionRanges vr1a (extendVersionRanges vr1b vr2) + | otherwise + = C.unionVersionRanges vr1 (unionMajorBounds1 vr2) + +-- assumes sorted input +pruneVersionRanges :: [C.Version] -> [C.Version] +pruneVersionRanges [] = [] +pruneVersionRanges [v] = [v] +pruneVersionRanges (v1:v2:vs) + | v2 `C.withinRange` C.majorBoundVersion v1 = pruneVersionRanges (v1 : vs) + | otherwise = v1 : pruneVersionRanges (v2 : vs) + +stripPatchLevel :: C.Version -> C.Version +stripPatchLevel = C.alterVersion (take 3) + +-- Assumes that the “new” range is always the same +cleanChanges :: [(C.PackageName, C.VersionRange, C.VersionRange)] + -> [(C.PackageName, ([C.VersionRange], C.VersionRange))] +cleanChanges changes = + M.toList $ + M.map (\(old, new) -> (nub old, new)) $ -- No Ord C.VersionRange + M.fromListWith (\(olds1, new1) (olds2, _new2) -> (olds1 <> olds2, new1)) $ + [ (pname, ([old], new)) | (pname, old, new) <- changes, old /= new ] + +work :: Bool -> Bool -> [(C.PackageName, C.Version)] -> [FilePath] -> [FilePath] -> IO () +work dry_run extend explicits planfiles cabalfiles = do + plans <- mapM decodePlanJson planfiles + + forM_ cabalfiles $ \cabalfile -> do + contents <- BS.readFile cabalfile + + -- Figure out package name + let pname = cabalPackageName contents + + let deps = fmap (pruneVersionRanges . sort . map stripPatchLevel) $ + M.unionsWith (++) $ map (fmap pure) $ + M.fromList explicits : map (depsOf pname) plans + + let new_deps pn vr + | pn == pname = C.anyVersion -- self-dependency + | Just vs' <- M.lookup pn deps + = if extend + then extendVersionRanges vr [ v | v <- vs' , not (v `C.withinRange` vr) ] + else unionMajorBounds1 vs' + | otherwise = vr -- fallback + + let (contents', fieldChanges) = replaceDependencies new_deps contents + + forM_ (cleanChanges fieldChanges) $ \(pn, (olds, new)) -> + putStrLn $ render $ + hang (pretty pn) 4 $ vcat $ + [ char '-' <+> pretty old | old <- olds ] <> + [ char '+' <+> pretty new ] + + unless dry_run $ + unless (contents == contents') $ + -- TODO: Use atomic-write + BS.writeFile cabalfile contents'