diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,25 @@ +# Changelog for hackage-cli + +## 0.1.0.0 + +_Andreas Abel, 2023-01-15_ + +- Skip errors when running `add-bound` on several files. + (PR [#42](https://github.com/hackage-trustees/hackage-cli/pull/42)) + +- If no version range is given for a dependency, interpret it as `-any` rather than _none_ (`<0`). + (PR [#48](https://github.com/hackage-trustees/hackage-cli/pull/48)) + +Builds with `Cabal 3.4 - 3.8` and `GHC 8.2 - 9.4`. + + +## 0.0.3.6 + +_Andreas Abel, 2022-04-30_ + +First release to hackage. +Builds with `Cabal 3.4 - 3.6` and `GHC 8.2 - 9.2`. + # Pre-release versions (February 2022) ## 0.0.3.4 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,3 +1,9 @@ +[![Hackage version](https://img.shields.io/hackage/v/hackage-cli.svg?label=Hackage&color=informational)](http://hackage.haskell.org/package/hackage-cli) +[![Stackage LTS version](https://www.stackage.org/package/hackage-cli/badge/lts?label=Stackage)](https://www.stackage.org/package/hackage-cli) +[![hackage-cli on Stackage Nightly](https://stackage.org/package/hackage-cli/badge/nightly)](https://stackage.org/nightly/package/hackage-cli) +[![Cabal build](https://github.com/hackage-trustees/hackage-cli/workflows/Haskell-CI/badge.svg)](https://github.com/hackage-trustees/hackage-cli/actions) +[![Stack build](https://github.com/hackage-trustees/hackage-cli/workflows/Build%20with%20Stack/badge.svg)](https://github.com/hackage-trustees/hackage-cli/actions) + # `hackage-cli` A command-line tool to manage package metadata @@ -70,8 +76,10 @@ build-depends: pkg-y < 4.5.6 ``` to the `library` section of each of the `.cabal` files. - There must be exactly one `library` section, otherwise `hackage-cli` will crash - or produce a garbage result. + If files without a `library` section are encountered (as in ancient `.cabal` formats), + they will be skipped, but the final exitcode of `hackage-cli` will be 1 (error). + If a file contains more than one `library` section, `hackage-cli` will take the first + such section. (This might not produce the intended result, so double-checking is advised.) If this bound does not further constrain the existing version range for `pkg-y`, it will not be added unless `--force` is used. diff --git a/hackage-cli.cabal b/hackage-cli.cabal --- a/hackage-cli.cabal +++ b/hackage-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hackage-cli -version: 0.0.3.6 +version: 0.1.0.0 synopsis: CLI tool for Hackage description: @@ -10,14 +10,16 @@ bug-reports: https://github.com/hackage-trustees/hackage-cli/issues license: GPL-3.0-or-later license-file: LICENSE -author: Herbert Valerio Riedel +author: Herbert Valerio Riedel, Andreas Abel maintainer: Andreas Abel category: Development build-type: Simple +-- Supported GHC versions when building with cabal: tested-with: -- Keep in descending order. - GHC == 9.2.2 + GHC == 9.4.4 + GHC == 9.2.5 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4 @@ -30,6 +32,12 @@ README.md fixtures/*.diff fixtures/*.cabal + -- Supported GHC versions when building with stack: + stack-9.4.4.yaml + stack-9.2.5.yaml + stack-9.2.4.yaml + stack-9.0.2.yaml + stack-8.10.7.yaml source-repository head Type: git @@ -42,11 +50,11 @@ ghc-options: -Wall -Wcompat build-depends: - , base >= 4.10.0.0 && < 4.17 + , base >= 4.10.0.0 && < 4.18 , bytestring >= 0.10.4.0 && < 0.12 - , Cabal >= 3.4 && < 3.7 + , Cabal >= 3.4 && < 3.10 , containers >= 0.5.0.0 && < 0.7 - , mtl >= 2.2.2 && < 2.4 + , mtl >= 2.2.2 && < 2.3 || >= 2.3.1 && < 2.4 , pretty ^>= 1.1.2 exposed-modules: @@ -70,9 +78,13 @@ executable hackage-cli default-language: Haskell2010 + default-extensions: + DeriveFunctor + LambdaCase + NamedFieldPuns + other-extensions: CPP - LambdaCase OverloadedStrings RecordWildCards TemplateHaskell @@ -97,7 +109,7 @@ , mtl build-depends: - , aeson >= 1.2.4.0 && < 2.1 + , aeson >= 1.2.4.0 && < 2.2 -- aeson-1.2.4.0 for stack-8.2.2.yaml , deepseq ^>= 1.4.0.0 , directory ^>= 1.2.0.1 || ^>= 1.3.0.0 diff --git a/lib/Distribution/Server/Util/CabalRevisions.hs b/lib/Distribution/Server/Util/CabalRevisions.hs --- a/lib/Distribution/Server/Util/CabalRevisions.hs +++ b/lib/Distribution/Server/Util/CabalRevisions.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -39,6 +40,9 @@ import Distribution.Compiler (CompilerFlavor) import Distribution.FieldGrammar (prettyFieldGrammar) import Distribution.Fields.Pretty (PrettyField (..), showFields) +#if MIN_VERSION_Cabal(3,7,0) +import Distribution.Fields.Pretty (pattern NoComment) +#endif import Distribution.PackageDescription import Distribution.PackageDescription.Parsec (parseGenericPackageDescription, runParseResult) import Distribution.PackageDescription.FieldGrammar (sourceRepoFieldGrammar) @@ -340,7 +344,7 @@ checkSame "The package-url field is unused, don't bother changing it." pkgUrlA pkgUrlB changesOk "bug-reports" fromShortText bugReportsA bugReportsB - changesOkList changesOk "source-repository" (showFields (const []) . (:[]) . ppSourceRepo) + changesOkList changesOk "source-repository" (showFields noComment . (:[]) . ppSourceRepo) sourceReposA sourceReposB changesOk "synopsis" fromShortText synopsisA synopsisB changesOk "description" fromShortText descriptionA descriptionB @@ -357,14 +361,20 @@ extraDocFilesA extraDocFilesB checkSame "Cannot change custom/extension fields" - (filter (\(f,_) -> not (f `elem` ["x-revision","x-curation"])) customFieldsPDA) - (filter (\(f,_) -> not (f `elem` ["x-revision","x-curation"])) customFieldsPDB) + (filter (\(f,_) -> f `notElem` ["x-revision","x-curation"]) customFieldsPDA) + (filter (\(f,_) -> f `notElem` ["x-revision","x-curation"]) customFieldsPDB) checkSpecVersionRaw pdA pdB checkSetupBuildInfo setupBuildInfoA setupBuildInfoB when checkXRevision $ checkRevision customFieldsPDA customFieldsPDB checkCuration customFieldsPDA customFieldsPDB + where +#if MIN_VERSION_Cabal(3,7,0) + noComment _ = NoComment +#else + noComment _ = [] +#endif checkSpecVersionRaw :: Check PackageDescription checkSpecVersionRaw pdA pdB @@ -573,15 +583,15 @@ checkSetupBuildInfo Nothing (Just (SetupBuildInfo setupDependsA _internalA)) = logChange $ Change Normal - ("added a 'custom-setup' section with 'setup-depends'") + "added a 'custom-setup' section with 'setup-depends'" "[implicit]" (intercalate ", " (map prettyShow setupDependsA)) checkSetupBuildInfo (Just (SetupBuildInfo setupDependsA _internalA)) (Just (SetupBuildInfo setupDependsB _internalB)) = do forM_ removed $ \dep -> - logChange $ Change Normal ("removed 'custom-setup' dependency on") (prettyShow dep) "" + logChange $ Change Normal "removed 'custom-setup' dependency on" (prettyShow dep) "" forM_ added $ \dep -> - logChange $ Change Normal ("added 'custom-setup' dependency on") "" (prettyShow dep) + logChange $ Change Normal "added 'custom-setup' dependency on" "" (prettyShow dep) forM_ changed $ \(pkgn, (verA, verB)) -> changesOk ("the 'custom-setup' dependency on " ++ prettyShow'' pkgn) prettyShow verA verB @@ -625,10 +635,20 @@ checkTestSuite :: ComponentName -> Check TestSuite checkTestSuite componentName +#if MIN_VERSION_Cabal(3,7,0) + (TestSuite _nameA interfaceA buildInfoA testGeneratorsA) + (TestSuite _nameB interfaceB buildInfoB testGeneratorsB) +#else (TestSuite _nameA interfaceA buildInfoA) - (TestSuite _nameB interfaceB buildInfoB) = do + (TestSuite _nameB interfaceB buildInfoB) +#endif + = do checkSame "Cannot change test-suite type" interfaceA interfaceB checkBuildInfo componentName buildInfoA buildInfoB +#if MIN_VERSION_Cabal(3,7,0) + -- @test-generators@ + checkSame "Cannot change test-generators" testGeneratorsA testGeneratorsB +#endif checkBenchmark :: ComponentName -> Check Benchmark checkBenchmark componentName diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -13,12 +13,15 @@ -- module Main where -import qualified Data.Aeson as J -import qualified Data.Aeson.Types as J -import qualified Data.ByteString.Builder as Builder +import Prelude hiding (log) + +import qualified Data.Aeson as J +import qualified Data.Aeson.Types as J +import qualified Data.ByteString.Builder as Builder import Control.DeepSeq import Control.Exception import Control.Monad +import Control.Monad.Except (MonadError(..), ExceptT, runExceptT) import Control.Monad.State.Strict import Data.Bits import Data.ByteString (ByteString) @@ -45,6 +48,9 @@ import qualified Distribution.Verbosity as C import qualified Distribution.Version as C import qualified Distribution.Text as C +#if MIN_VERSION_Cabal(3,7,0) +import qualified Distribution.Simple.PackageDescription as C +#endif import Lens.Micro import Lens.Micro.Mtl @@ -58,6 +64,7 @@ import System.Environment (lookupEnv) import System.Exit (ExitCode (..), exitFailure) import System.FilePath +import System.IO (hPutStrLn, stderr) import System.IO.Error (tryIOError, isDoesNotExistError) import qualified System.IO.Streams as Streams import System.Process.ByteString (readProcessWithExitCode) @@ -442,6 +449,10 @@ where i = fromMaybe (error "nsplitAt: overflow") $ toIntegralSized n +-- | Returns the position @(line, indentation)@ where to insert the +-- new @build-depends:@ immediately after the first @library@ section, +-- if any. +-- findLibrarySection :: [C.Field C.Position] -> Maybe (Int, Int) findLibrarySection [] = Nothing findLibrarySection (C.Section (C.Name (C.Position row _) "library") [] fs : _) = @@ -495,13 +506,14 @@ , optCROrig :: FilePath } deriving Show -data AddBoundOptions = AddBoundOptions +type AddBoundOptions = AddBoundOptions' [FilePath] +data AddBoundOptions' a = AddBoundOptions { optABPackageName :: C.PackageName , optABVersionRange :: C.VersionRange , optForce :: Bool -- ^ Disable the check whether bound is subsumed by existing constraints. , optABMessage :: [String] - , optABFiles :: [FilePath] - } deriving Show + , optABFiles :: a -- ^ One or several files. + } deriving (Show, Functor) data Command = ListCabal !ListCOptions @@ -782,65 +794,14 @@ IndexShaSum opts -> IndexShaSum.run opts - - AddBound AddBoundOptions {..} -> forM_ optABFiles $ \fp -> do - old <- BS.readFile fp - - -- idea is simple: - -- - .cabal is line oriented file - -- - find "library" section start - -- - bonus: look of an indentation used from the next field/section there - -- - insert data into a bytestring "manually" - fs <- either (exitFailureWith . show) return $ C.readFields old - (lin, indent) <- maybe - (exitFailureWith $ "Cannot find library section in " ++ fp) - return - (findLibrarySection fs) - - let msgLines = map ("-- " ++) optABMessage - bdLine = "build-depends: " ++ C.prettyShow optABPackageName ++ " " ++ C.prettyShow optABVersionRange - midLines = [ BS8.pack $ replicate indent ' ' ++ l - | l <- msgLines ++ [bdLine] - ] ++ [""] -- also add an empty line separator - (preLines, postLines) = splitAt lin $ BS8.lines old - new = BS8.unlines (preLines ++ midLines ++ postLines) - - -- interpretation of version ranges - let oldGpd = parseGenericPackageDescription' old - newGpd = parseGenericPackageDescription' new - - oldRange = extractRange oldGpd optABPackageName - newRange = extractRange newGpd optABPackageName - - oldRange' = C.intersectVersionRanges oldRange optABVersionRange - - -- Canonical forms (semantics) - oldSem = C.toVersionIntervals oldRange -- existing range - oldSem' = C.toVersionIntervals oldRange' -- range after adding the bound (theory) - newSem = C.toVersionIntervals newRange -- range after adding the bound (practice) - - -- Necessity check: does the addition of the bound change the semantics? - -- if not, it can be skipped. - - if not optForce && oldSem' == oldSem then do - - putStrLn $ concat [ "Skipping ", fp, ": bound already subsumed by existing constraints (use --force to add nevertheless)." ] - - else do - -- sanity check: did the addition have the intended outcome? - unless (newSem == oldSem') $ - exitFailureWith $ unwords - [ "Edit failed, version ranges don't match: " - , C.prettyShow oldRange - , "&&" - , C.prettyShow optABVersionRange - , "=/=" - , C.prettyShow newRange - ] - - -- write new version - putStrLn $ unwords [ "Adding bound to", fp ] - BS.writeFile fp new + AddBound ab@AddBoundOptions{ optABFiles } -> do + -- Run add-bound for all given cabal files, skipping to next on error. + results <- forM optABFiles $ \fp -> do + runExceptT (addBound (fp <$ ab)) >>= \case + Left err -> False <$ log err + Right () -> return True + -- If add-bound failed for one cabal file, report failure. + unless (and results) $ exitFailure return () where @@ -904,27 +865,95 @@ pdesc0 = parseGenericPackageDescription' cabdata0 (_,_,xrev0) = pkgDescToPkgIdXrev pdesc0 - exitFailureWith e = do - putStrLn e - exitFailure +parseGenericPackageDescription' :: ByteString -> LC.GenericPackageDescription +parseGenericPackageDescription' bs = + case snd $ C.runParseResult $ C.parseGenericPackageDescription bs of + Left (_, es) -> error $ List.intercalate "\n" $ map (C.showPError "<.cabal>") $ toList es + Right x -> x - parseGenericPackageDescription' bs = - case snd $ C.runParseResult $ C.parseGenericPackageDescription bs of - Left (_, es) -> error $ List.intercalate "\n" $ map (C.showPError "<.cabal>") $ toList es - Right x -> x +extractRange :: LC.GenericPackageDescription -> C.PackageName -> C.VersionRange +extractRange gpd pkgName = + List.foldl' C.intersectVersionRanges C.anyVersion vss + where + vss = gpd ^.. LC.condLibrary . _Just . condTreeDataL . LC.targetBuildDepends . traverse . to ext . _Just + ext (C.Dependency pkgName' vr _) + | pkgName == pkgName' = Just vr + | otherwise = Nothing - extractRange gpd pkgName = case vss of - [] -> C.noVersion - (v:vs) -> List.foldl' C.intersectVersionRanges v vs - where - vss = gpd ^.. LC.condLibrary . _Just . condTreeDataL . LC.targetBuildDepends . traverse . to ext . _Just - ext (C.Dependency pkgName' vr _) - | pkgName == pkgName' = Just vr - | otherwise = Nothing +condTreeDataL :: Functor f => (a -> f a) -> C.CondTree v c a -> f (C.CondTree v c a) +condTreeDataL f (C.CondNode x c cs) = f x <&> \y -> C.CondNode y c cs - condTreeDataL :: Functor f => (a -> f a) -> C.CondTree v c a -> f (C.CondTree v c a) - condTreeDataL f (C.CondNode x c cs) = f x <&> \y -> C.CondNode y c cs +-- | Try to add the given bound to the given cabal file. +-- +-- Non-fatal errors (like parse errors) are reported in the Except monad. +-- +addBound :: AddBoundOptions' FilePath -> ExceptT String IO () +addBound AddBoundOptions{ optABPackageName, optABVersionRange, optForce, optABMessage, optABFiles = fp } = do + + old <- liftIO $ BS.readFile fp + + -- idea is simple: + -- - .cabal is line oriented file + -- - find "library" section start + -- - bonus: look of an indentation used from the next field/section there + -- - insert data into a bytestring "manually" + fs <- either (\ err -> throwError $ unwords ["Parsing", fp, "failed:", show err]) return $ + C.readFields old + (lin, indent) <- maybe + (throwError $ "Cannot find library section in " ++ fp) + return + (findLibrarySection fs) + + let msgLines = map ("-- " ++) optABMessage + bdLine = "build-depends: " ++ C.prettyShow optABPackageName ++ " " ++ C.prettyShow optABVersionRange + midLines = [ BS8.pack $ replicate indent ' ' ++ l + | l <- msgLines ++ [bdLine] + ] ++ [""] -- also add an empty line separator + (preLines, postLines) = splitAt lin $ BS8.lines old + new = BS8.unlines (preLines ++ midLines ++ postLines) + + -- interpretation of version ranges + let oldGpd = parseGenericPackageDescription' old + newGpd = parseGenericPackageDescription' new + + oldRange = extractRange oldGpd optABPackageName + newRange = extractRange newGpd optABPackageName + + oldRange' = C.intersectVersionRanges oldRange optABVersionRange + + -- Canonical forms (semantics) + oldSem = C.toVersionIntervals oldRange -- existing range + oldSem' = C.toVersionIntervals oldRange' -- range after adding the bound (theory) + newSem = C.toVersionIntervals newRange -- range after adding the bound (practice) + + -- Necessity check: does the addition of the bound change the semantics? + -- if not, it can be skipped. + + if not optForce && oldSem' == oldSem then do + + log $ concat [ "Skipping ", fp, ": bound already subsumed by existing constraints (use --force to add nevertheless)." ] + + else do + -- sanity check: did the addition have the intended outcome? + unless (newSem == oldSem') $ + (if optForce then log . ("Ignoring check: " ++) else throwError . ("Edit failed, " ++)) $ + unwords + [ "version ranges don't match: " + , C.prettyShow oldRange + , "&&" + , C.prettyShow optABVersionRange + , "=/=" + , C.prettyShow newRange + ] + + -- write new version + log $ unwords [ "Adding bound to", fp ] + liftIO $ BS.writeFile fp new + +-- | Print line to 'stderr'. +log :: MonadIO m => String -> m () +log = liftIO . hPutStrLn stderr -- | Try to clean-up HTML fragments to be more readable tidyHtml :: ByteString -> ByteString diff --git a/stack-8.10.7.yaml b/stack-8.10.7.yaml new file mode 100644 --- /dev/null +++ b/stack-8.10.7.yaml @@ -0,0 +1,16 @@ +resolver: lts-18.28 +compiler: ghc-8.10.7 +compiler-check: match-exact + +packages: +- . + +extra-deps: +- Cabal-3.4.1.0 +- brotli-0.0.0.0 +- brotli-streams-0.0.0.0 +- http-io-streams-0.1.6.0@rev:0 +- netrc-0.2.0.0 +- xor-0.0.1.0 +# For http-io-streams-0.1.6.0@rev:1 +# - base64-bytestring-1.2.1.0 diff --git a/stack-9.0.2.yaml b/stack-9.0.2.yaml new file mode 100644 --- /dev/null +++ b/stack-9.0.2.yaml @@ -0,0 +1,6 @@ +resolver: lts-19.33 +compiler: ghc-9.0.2 +compiler-check: match-exact + +packages: +- . diff --git a/stack-9.2.4.yaml b/stack-9.2.4.yaml new file mode 100644 --- /dev/null +++ b/stack-9.2.4.yaml @@ -0,0 +1,6 @@ +resolver: nightly-2022-11-12 +compiler: ghc-9.2.4 +compiler-check: match-exact + +packages: +- . diff --git a/stack-9.2.5.yaml b/stack-9.2.5.yaml new file mode 100644 --- /dev/null +++ b/stack-9.2.5.yaml @@ -0,0 +1,3 @@ +resolver: lts-20.6 +compiler: ghc-9.2.5 +compiler-check: match-exact diff --git a/stack-9.4.4.yaml b/stack-9.4.4.yaml new file mode 100644 --- /dev/null +++ b/stack-9.4.4.yaml @@ -0,0 +1,3 @@ +resolver: nightly-2023-01-14 +compiler: ghc-9.4.4 +compiler-check: match-exact