diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for cabal-plan-bounds + +## 0.1 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2023, Joachim Breitner +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the + distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,158 @@ +cabal-plan-bounds: generate cabal bounds from actual build plans +================================================================ + +TL;DR: Updates the `.cabal` file’s `build-depends` and (not yet) `tested-with` based on the +`build.json` of actual build paths. You never have to edit the build depends +manually again. + +The problem +----------- + +Manually curated dependency version ranges tend to become a lie: They likely +include versions of your the dependencies that are neither longer tested by your CI +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). + +There are ways to mitigate this problem, such as being very careful, and maybe +using Cabals new [`--prefer-oldest`] flag. But these are not reliable. + +[PVP]: https://pvp.haskell.org/ +[`--prefer-oldest`]: https://cabal.readthedocs.io/en/latest/cabal-project.html#cfg-field-prefer-oldest + +The solution +------------ + +So the conclusion must be to **not write build-depends ranges by hand.** +Which is an unpleaseant chore instead. + +Instead, **derive the build-depends from your actual CI builds**. + +Presumably you test your code in different situations anyways – different +versions of GHC, stackage releases etc. Keep doing that, collect the _actual_ +build plans used in these CI systems. Then pass them to `cabal-plan-bounds` which +will update the bounds accordingly. + +Simple example +-------------- + +For a simple example, you can just call `cabal build` with different compilers: + + + $ cabal build -w ghc-8.10.7 --builddir dist-8.10.7 + $ cabal build -w ghc-9.0.2 --builddir dist-9.0.2 + $ cabal build -w ghc-9.2.5 --builddir dist-9.2.5 + $ cabal build -w ghc-9.4.4 --builddir dist-9.4.4 + +and then update the cabal file + + $ cabal-plan-bounds dist-{8.10.7,9.0.2,9.2.5,9.4.4}/cache/plan.json -c cabal-plan-bounds.cabal + +This will lead to the following diff: + +```diff +diff --git a/cabal-plan-bounds.cabal b/cabal-plan-bounds.cabal +index 1db21ca..a99e7bc 100644 +--- a/cabal-plan-bounds.cabal ++++ b/cabal-plan-bounds.cabal +@@ -20,9 +20,12 @@ executable cabal-plan-bounds + import: warnings + main-is: Main.hs + other-modules: ReplaceDependencies +- build-depends: base, Cabal-syntax, cabal-plan, +- 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 + hs-source-dirs: src/ + default-language: Haskell2010 +``` + +More sophisticated setup +------------------------ + +For a more sophisticated setup, you can create multiple `cabal.project` files, +one for each setting: + +``` +$ ls ci-configs/ +ghc-8.10.7.config ghc-9.2.5.config stackage-nightly.config +ghc-9.0.2.config ghc-9.4.4.config +$ cat ci-configs/ghc-9.4.4.config +import: cabal.project +active-repositories: hackage.haskell.org:merge +index-state: hackage.haskell.org 2022-12-21T10:40:48Z +with-compiler: ghc-9.4.4 +``` + +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. + +Similarly, we can pull in stackage configurations, simply by importing the +corresponding `cabal.config`, which also pins down the compiler + +``` +$ cat ci-configs/stackage-nightly.config +import: cabal.project +import: https://www.stackage.org/nightly-2023-01-03/cabal.config +``` + +(TODO: Probably these should also pin the `index-state` for reproducibility.) + +Now you can configure your CI system to run one job for each of these configs, +collect the `plan.json` files, and finally check that the version bounds in your +`.cabal` file match, and if not, complain or auto-update them. + +Usage +----- + +``` +cabal-plan-bounds -- --help +Derives dependency bounds from build plans + +Usage: cabal-plan-bounds [PLAN] [-c|--cabal CABALFILE] + +Available options: + -h,--help Show this help text + PLAN plan file to read (.json) + -c,--cabal CABALFILE cabal file to pdate (.cabal) +``` + +Features and limitations +------------------------ + +* It edits the `.cabal` file in place + +* It leaves the `.cabal` file as is: No reformatting, all comments are preserved. + +* Only the `build-dependens` fiels are touched. They are reformatted (one dependency per line). + + 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). + + It does not support different ranges in different components. (Maybe it could + be smarter here, but due to `common` sections and conditionals, it cannot be + complete.) + + This means some behaviour cannot be achieved. Maybe this needs to be revised + (especially with regard to conditionals). + +Future work (contributions welcome!) +------------------------------------ + +* Proper error handling, e.g. while parsing. +* A test suite +* Printing a nice human readable summary of dependency changes. +* A `--dry-run` mode that does not touch the `.cabal` file. +* A `--check` mode that does not touch the `.cabal` file, but fails if it would + change it (for CI). +* Update the `tested-with` field accordig to the compiler versions used. diff --git a/cabal-plan-bounds.cabal b/cabal-plan-bounds.cabal new file mode 100644 --- /dev/null +++ b/cabal-plan-bounds.cabal @@ -0,0 +1,47 @@ +cabal-version: 3.0 +name: cabal-plan-bounds +version: 0.1 +synopsis: Derives cabal bounds from build plans +description: + Manually curated dependency version ranges tend to become a lie: They likely + include versions of your the dependencies that are neither longer tested by your CI + system, or implied by compatibility with the tested versions. + + So the conclusion must be to __not write build-depends ranges by hand!__ + Which is an unpleaseant chore instead. + + Instead, __derive the build-depends from your actual CI builds!__ + + This tool helps with that. See the README for more information. + +license: BSD-2-Clause +license-file: LICENSE +author: Joachim Breitner +maintainer: mail@joachim-breitner.de +homepage: https://github.com/nomeata/cabal-plan-bounds +copyright: 2023 +category: Distribution +build-type: Simple +extra-doc-files: README.md CHANGELOG.md + +common warnings + ghc-options: -Wall + +executable cabal-plan-bounds + import: warnings + main-is: Main.hs + ghc-options: -Wall + other-modules: ReplaceDependencies + 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 + hs-source-dirs: src/ + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/nomeata/cabal-plan-bounds diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,98 @@ +{-# 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 Data.Maybe +import Cabal.Plan + +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 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 = + work + <$> many (argument + (is ".json") + (metavar "PLAN" <> help "plan file to read (.json)")) + <*> many (strOption + (short 'c' <> long "cabal" <> + metavar "CABALFILE" <> help "cabal file to pdate (.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 + ] + + +unionMajorBounds :: [C.Version] -> C.VersionRange +unionMajorBounds [] = C.anyVersion +unionMajorBounds vs = foldr1 C.unionVersionRanges (map C.majorBoundVersion 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) + + +work :: [FilePath] -> [FilePath] -> IO () +work 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 (unionMajorBounds . pruneVersionRanges . sort) $ + M.unionsWith (++) $ + map (fmap pure) $ + map (depsOf pname) plans + + let contents' = replaceDependencies (\pn vr -> fromMaybe vr $ M.lookup pn deps) contents + + unless (contents == contents') $ + -- TODO: Use atomic-write + BS.writeFile cabalfile contents' diff --git a/src/ReplaceDependencies.hs b/src/ReplaceDependencies.hs new file mode 100644 --- /dev/null +++ b/src/ReplaceDependencies.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module ReplaceDependencies (replaceDependencies) where + +import qualified Data.ByteString.Char8 as BS +import Data.List +import Data.Maybe + +import qualified Distribution.Fields as C +import qualified Distribution.Fields.Field as C +import qualified Distribution.FieldGrammar.Newtypes as C +import qualified Distribution.Compat.Prelude as C +import qualified Distribution.Compat.Newtype as C +import qualified Distribution.Parsec as C +import qualified Distribution.Pretty as C +import qualified Distribution.Parsec.Position as C +import qualified Distribution.Types.Dependency as C +import qualified Distribution.Types.PackageName as C +import qualified Distribution.Types.VersionRange as C + +-- | This is the simple and clean entry point to this ugly and hacky module. +-- I hope by the time this tool becomes practically relevant I can replace this module +-- with something cleaner (e.g. based on the Cabal exact-print work) +-- Contributions are highly welcome! +-- +-- TODO: Error handling +replaceDependencies :: + (C.PackageName -> C.VersionRange -> C.VersionRange) -> BS.ByteString -> BS.ByteString +replaceDependencies f contents = changed + where + fields = case C.readFields contents of + Left err -> error (show err) + Right fields' -> fields' + + buildDeps = findBuildDeps fields + changed = replaceFieldValues + [ (fv, BS.pack $ C.prettyShow @DependencyField $ C.pack deps') + | fv <- buildDeps + , let deps = parseFieldValue fv + , let deps' = map (\(C.Dependency name range libSet) -> C.Dependency name (f name range) libSet) deps + ] contents + +type FieldValue a = [C.FieldLine a] +type DependencyField = C.List C.CommaVCat (C.Identity C.Dependency) C.Dependency + +findBuildDeps :: [C.Field a] -> [FieldValue a] +findBuildDeps = concatMap go + where + go (C.Field (C.Name _ "build-depends") []) = [] -- ignore empty build-depends + go (C.Field (C.Name _ "build-depends") val) = [val] + go (C.Field _ _) = [] + go (C.Section _ _ fs) = concatMap go fs + +parseFieldValue :: FieldValue a -> [C.Dependency] +parseFieldValue fv = + case C.eitherParsec @DependencyField s of + Left err -> error $ "Parsing field failed: " ++ show err + Right depList -> C.unpack depList + where + s = BS.unpack $ BS.unlines $ map C.fieldLineBS fv -- BS.unpack for lack of eitherParsecBS + + +replaceFieldValues :: [(FieldValue C.Position, BS.ByteString)] -> BS.ByteString -> BS.ByteString +replaceFieldValues valueSubsts input = + BS.unlines $ mapMaybe substLine $ byLine lineSubsts (BS.lines input) + where + lineSubsts :: [(C.FieldLine C.Position, BS.ByteString)] + lineSubsts = + sortOn (C.fieldLineAnn . fst) $ concat + [ (l, r) : [ (l', "") | l' <- ls ] | (l:ls, r) <- valueSubsts ] + + byLine :: [(C.FieldLine C.Position, a)] -> [BS.ByteString] -> + [ ([(C.FieldLine C.Position, a)], BS.ByteString) ] + byLine = go 1 + where + go _ [] ls = unchanged ls + go _ _ [] = error "Left over field values" + go i ss ls@(l:ls') + | r > i = let (ls1, ls2) = splitAt (r - i) ls + in unchanged ls1 ++ go (i + length ls1) ss ls2 + | r == i = let (ss1, ss2) = span isHere ss + in (ss1, l) : go (i+1) ss2 ls' + | otherwise = error $ "Field value out of order" + where + isHere (fl, _) = C.positionRow (C.fieldLineAnn fl) == i + r = C.positionRow (C.fieldLineAnn (fst (head ss))) + + + unchanged ls = [ ([], l) | l <- ls ] + + substLine ([], line) = Just line + substLine (substs, line) = + let l' = go 1 substs line in + if BS.all C.isSpace l' then Nothing else Just l' + where + go :: Int -> [(C.FieldLine C.Position, BS.ByteString)] -> BS.ByteString -> BS.ByteString + go _ [] l = l + go _ _ "" = error "Left over subst" + go i ((fl,r):ss) l = case BS.stripPrefix old l' of + Just l2 -> l1 <> r' <> go (i + BS.length l1 + BS.length old) ss l2 + Nothing -> error $ "Did not find expected field value " ++ show old + where + c = C.positionCol (C.fieldLineAnn fl) + (l1, l') = BS.splitAt (c - i) l + old = C.fieldLineBS fl + rlines = BS.lines r + r' = BS.intercalate ("\n" <> BS.replicate (c - 1) ' ') rlines +