packages feed

arch-hs 0.14.1 → 0.15

raw patch · 15 files changed

+778/−153 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Distribution.ArchHs.Hackage: loadRawHackageRevisions :: [(PackageName, Version)] -> FilePath -> IO (RawHackageDB, RawHackageDB)
+ Distribution.ArchHs.Options: [loadRawHackageRevisionsFromOptions] :: HackageDBOptions -> [(PackageName, Version)] -> IO (RawHackageDB, RawHackageDB)
+ Distribution.ArchHs.RDepCheck: reverseDependencyPackages :: ExtraDB -> PackageName -> [(PkgDesc, [DepSrc])]
- Distribution.ArchHs.Options: HackageDBOptions :: IO HackageDB -> IO RawHackageDB -> IO (HackageDB, RawHackageDB) -> HackageDBOptions
+ Distribution.ArchHs.Options: HackageDBOptions :: IO HackageDB -> IO RawHackageDB -> IO (HackageDB, RawHackageDB) -> ([(PackageName, Version)] -> IO (RawHackageDB, RawHackageDB)) -> HackageDBOptions

Files

CHANGELOG.md view
@@ -3,6 +3,18 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.15++- Handle unsupported Cabal formats in `arch-hs-sync` using Hackage index metadata for version checks and marking unparseable `--depcheck` candidates as unchecked++- Count newly unmet reverse dependency ranges as `rdep` and already unmet ranges as `rdep-old` in `arch-hs-sync check --depcheck` and `arch-hs-rdepcheck`++- Show existing reverse dependency failures as warnings and let `arch-hs-rdepcheck` exit successfully when no newly unmet ranges remain++- Compare the latest cabal revision with revision 0 in `arch-hs-rdepcheck`, showing differing ranges and results while keeping final totals and exit status based on the latest revision++- Improve colors and readability of reverse dependency checks and revision comparisons+ ## 0.14.1  - Keep `arch-hs-sync check --depcheck` suggestions on Hackage's non-deprecated preferred versions while still reading exact deprecated cabal files for current reverse dependency checks
README.md view
@@ -525,17 +525,38 @@ ... ``` -Pass an optional version to check whether that version satisfies every listed range. Out-of-range entries are printed as errors, and the command exits with a non-zero status if any range fails:+For each reverse dependency's version in [extra], the command reads both the latest `.cabal` revision and revision 0 from the local Hackage index. When their dependency ranges differ, both are shown under `latest revision` and `revision 0`. Equivalent ranges are shown only once. This also works without a candidate version. +Pass an optional version to check whether that version satisfies every listed range. Ranges that accept the current [extra] version but reject the candidate are marked in red as `rdep`. Ranges that reject both versions are marked in yellow as `rdep-old`. Both are counted separately, and the command exits with a non-zero status only for newly unmet ranges (or runtime errors):+ ``` $ arch-hs-rdepcheck aeson 3.0 Reverse dependency: agda   Depends: >=1.1.2.0 && <2.3-  Error: 3.0 is outside Depends range (>=1.1.2.0 && <2.3)+  rdep: 3.0 is outside Depends range (>=1.1.2.0 && <2.3)+Reverse dependency: haskell-example+  Depends: <2.2+  rdep-old: 3.0 is outside Depends range (<2.2) ...-68 reverse dependency range check(s) failed.+Reverse dependency range check(s) failed: rdep=60, rdep-old=8 ``` +This example assumes the current [extra] version is 2.2.3.0. If only existing failures remain, the command prints a warning such as `Existing reverse dependency range failure(s): rdep=0, rdep-old=8` and exits successfully. Ranges satisfied by the candidate are not counted, even if they reject the current version.++When revisions differ, each revision's counts accompany its ranges:++```+Reverse dependency: haskell-example+  latest revision (rdep=1, rdep-old=0):+    Depends: <3+    rdep: 3.0 is outside Depends range (<3)+  revision 0 (rdep=0, rdep-old=1):+    Depends: <2.2+    rdep-old: 3.0 is outside Depends range (<2.2)+```++The final totals and exit status use the latest revision; revision 0 is shown for comparison. If only one revision can be parsed, its ranges are still shown and the other revision is labeled `unchecked` with the lookup error.+ ## Sync  For Hackage distribution maintainers, `arch-hs-sync check` compares Haskell package versions in [extra] with Hackage:@@ -545,23 +566,30 @@ haskell-aeson in [extra] has version 2.2.3.0, but linked aeson in Hackage has newer versions 2.2.3.1, 2.2.3.2 ``` -Only non-deprecated Hackage versions newer than the [extra] version are reported.+Only non-deprecated Hackage versions newer than the [extra] version are reported. Version checks use Hackage index metadata, so they also report packages whose `.cabal` format is newer than the Cabal library used to build `arch-hs`.  Pass `--depcheck` to check whether each newer Hackage version is currently upgradable with the packages already in [extra]. A version is shown as `ok` only when both its dependency ranges are satisfied by [extra] and all current reverse dependency ranges accept that version:  ``` $ arch-hs-sync check --depcheck-haskell-aeson in [extra] has version 2.2.3.0, but linked aeson in Hackage has newer versions 2.2.3.1 (ok), 2.2.3.2 (blocked: dep=1, rdep=3)+haskell-aeson in [extra] has version 2.2.3.0, but linked aeson in Hackage has newer versions 2.2.3.1 (existing: rdep-old=2), 2.2.3.2 (blocked: dep=1, rdep=1, rdep-old=2) ``` -Add `--verbose` with `--depcheck` to list the dependency and reverse dependency ranges that block a version:+`rdep` counts ranges that accept the current [extra] version but reject the candidate. `rdep-old` counts ranges that reject both versions. Each failing range is counted separately, including different dependency sources of the same reverse dependency. Ranges satisfied by the candidate are not counted, even if they reject the current version. +Candidates with only existing reverse dependency failures are shown in yellow as `existing: rdep-old=N`. Candidates with direct dependency failures or newly unmet reverse dependency ranges are shown in red as `blocked`, with existing failures counted separately when present.++If a candidate's `.cabal` file cannot be parsed, `--depcheck` marks it as `unchecked: cabal parse failed` and continues checking the other candidates. Use `--verbose` to include the lookup error.++Add `--verbose` with `--depcheck` to list the dependency and reverse dependency ranges that fail for a version, with existing reverse dependency failures labeled `rdep-old:`:+ ``` $ arch-hs-sync check --depcheck --verbose-haskell-aeson in [extra] has version 2.2.3.0, but linked aeson in Hackage has newer versions 2.2.3.2 (blocked: dep=1, rdep=1)+haskell-aeson in [extra] has version 2.2.3.0, but linked aeson in Hackage has newer versions 2.2.3.2 (blocked: dep=1, rdep=1, rdep-old=1)   2.2.3.2:     dep: scientific requires >=0.3 && <0.4, [extra] has 0.4-    rdep: agda Depends requires >=1.1.2.0 && <2.3+    rdep: haskell-example Depends requires >=2.2 && <2.2.3.2+    rdep-old: agda Depends requires >=1.1.2.0 && <2.2 ```  Other sync commands, including `submit` and `list`, are documented in `arch-hs-sync --help`.
arch-hs.cabal view
@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               arch-hs-version:            0.14.1+version:            0.15 synopsis:           Distribute hackage packages to archlinux description:   @arch-hs@ is a command-line program, which simplifies the process of producing@@ -163,7 +163,7 @@   main-is:        Main.hs   other-modules:     Args-    Check+    RDepCheck    build-depends:  arch-hs   ghc-options:    -threaded -rtsopts -with-rtsopts=-N@@ -174,12 +174,16 @@   hs-source-dirs:     test     diff+    rdepcheck     sync    main-is:         Main.hs   other-modules:+    Check     Diff+    RDepCheck     Submit.CSV+    Utils    build-depends:     , arch-hs
rdepcheck/Args.hs view
@@ -33,7 +33,7 @@     simpleOptions       archHsVersion       "arch-hs-rdepcheck - inspect reverse dependency version ranges"-      "arch-hs-rdepcheck shows all reverse dependencies of a Haskell package in [extra] and the version ranges they require. If VERSION is provided, it reports ranges that do not accept VERSION and exits with failure."+      "arch-hs-rdepcheck shows all reverse dependencies of a Haskell package in [extra] and the version ranges they require. It compares the latest cabal revision with revision 0 and shows both when their ranges differ. If VERSION is provided, it counts newly unmet ranges as rdep and already unmet ranges as rdep-old. The final counts and exit status use the latest revision, with failure only for newly unmet ranges."       cmdOptions       empty   pure x
− rdepcheck/Check.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module Check (check) where--import Control.Monad (forM)-import Distribution.ArchHs.Exception-import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.PP-import Distribution.ArchHs.RDepCheck-import Distribution.ArchHs.Types--check ::-  Members-    [ ExtraEnv,-      RawHackageEnv,-      KnownGHCVersion,-      FlagAssignmentsEnv,-      Trace,-      DependencyRecord,-      WithMyErr,-      Embed IO-    ]-    r =>-  Maybe Version ->-  PackageName ->-  Sem r Int-check mVersion target = do-  reverseDeps <- reverseDependencyRanges target-  failures <- forM reverseDeps $ \ReverseDep {..} -> do-    let failedRanges = versionFailures mVersion reverseDepRanges-    embed . putDoc $-      vsep-        ( annMagneta "Reverse dependency" <> colon-            <+> pretty (unArchLinuxName reverseDepName)-            : (rangeDocs reverseDepRanges <> versionErrors mVersion failedRanges)-        )-        <> line-    pure $ length failedRanges-  pure $ sum failures--rangeDocs :: [(DepSrc, VersionRange)] -> [Doc AnsiStyle]-rangeDocs result =-  [ indent 2 $ pretty s <> colon <+> viaPretty r-    | (s, r) <- result-  ]--versionErrors :: Maybe Version -> [(DepSrc, VersionRange)] -> [Doc AnsiStyle]-versionErrors Nothing _ = []-versionErrors (Just version) result =-  [ indent 2 $-      annRed "Error:"-        <+> viaPretty version-        <+> "is outside"-        <+> pretty src-        <+> "range"-        <+> parens (viaPretty range)-    | (src, range) <- result-  ]
rdepcheck/Main.hs view
@@ -4,19 +4,20 @@ module Main (main) where  import Args-import Check import Control.Monad (unless) import qualified Data.Map.Strict as Map import Distribution.ArchHs.Core import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Name (toHackageName) import Distribution.ArchHs.Options import Distribution.ArchHs.PP+import Distribution.ArchHs.RDepCheck (reverseDependencyPackages) import Distribution.ArchHs.Types import GHC.IO.Encoding (setLocaleEncoding) import GHC.IO.Encoding.UTF8 (utf8)-import System.Exit (exitFailure)+import RDepCheck  main :: IO () main = printHandledIOException $@@ -29,23 +30,16 @@       printInfo "You assigned flags:"       putDoc $ prettyFlagAssignments optFlags <> line -    hackage <- loadRawHackageDBFromOptions optHackage     extra <- loadExtraDBFromOptions optExtraDB+    let packages =+          [ (toHackageName $ _name desc, version)+            | (desc, _) <- reverseDependencyPackages extra optPackageName,+              Just version <- [simpleParsec $ _version desc]+          ]+    (hackage, revision0) <- loadRawHackageRevisionsFromOptions optHackage packages      printInfo "Start running..."-    runCheck hackage extra optFlags (subsumeGHCVersion $ check optCheckVersion optPackageName) & printRdepcheckResult--printRdepcheckResult :: IO (Either MyException Int) -> IO ()-printRdepcheckResult io = do-  result <- io-  case result of-    Left x -> do-      printError $ "Runtime Exception" <> colon <+> viaShow x-      exitFailure-    Right 0 -> printSuccess "Success!"-    Right n -> do-      printError $ pretty n <+> "reverse dependency range check(s) failed."-      exitFailure+    runCheck hackage extra optFlags (subsumeGHCVersion $ check revision0 optCheckVersion optPackageName) & printRdepcheckResult  runCheck ::   RawHackageDB ->
+ rdepcheck/RDepCheck.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++module RDepCheck (FailureCounts (..), check, checkReverseDep, checkReverseDepRevisions, printRdepcheckResult) where++import Control.Monad (forM)+import Data.List (partition)+import qualified Data.Map.Strict as Map+import Distribution.ArchHs.Exception+import Distribution.ArchHs.ExtraDB (versionInExtra)+import Distribution.ArchHs.Hackage (RawHackageDB)+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.PP+import Distribution.ArchHs.RDepCheck+import Distribution.ArchHs.Types+import Distribution.Version (asVersionIntervals)+import System.Exit (exitFailure)++data FailureCounts = FailureCounts+  { newFailures :: Int,+    oldFailures :: Int+  }+  deriving stock (Eq, Show)++check ::+  Members+    [ ExtraEnv,+      RawHackageEnv,+      KnownGHCVersion,+      FlagAssignmentsEnv,+      Trace,+      DependencyRecord,+      WithMyErr,+      Embed IO+    ]+    r =>+  RawHackageDB ->+  Maybe Version ->+  PackageName ->+  Sem r FailureCounts+check revision0 mVersion target = do+  latest <- indexResults <$> reverseDependencyRangesWithSkips target+  original <- indexResults <$> local @RawHackageDB (const revision0) (reverseDependencyRangesWithSkips target)+  versions <- forM mVersion $ \candidate -> do+    rawVersion <- versionInExtra target+    case simpleParsec rawVersion of+      Just current -> pure (current, candidate)+      Nothing -> throw $ VersionNoParse rawVersion+  failures <- forM (Map.toList latest) $ \(name, latestResult) -> do+    let originalResult = Map.findWithDefault (Left $ PkgNotFound name) name original+        (doc, counts) = checkReverseDepRevisions versions name latestResult originalResult+    embed $ putDoc $ doc <> line+    pure counts+  pure $ FailureCounts (sum $ newFailures <$> failures) (sum $ oldFailures <$> failures)++indexResults :: ([ReverseDep], [SkippedReverseDep]) -> Map.Map ArchLinuxName (Either MyException ReverseDep)+indexResults (checked, skipped) =+  Map.fromList $+    [(reverseDepName dep, Right dep) | dep <- checked]+      <> [(skippedReverseDepName dep, Left $ skippedReverseDepError dep) | dep <- skipped]++checkReverseDep :: Maybe (Version, Version) -> ReverseDep -> (Doc AnsiStyle, FailureCounts)+checkReverseDep versions ReverseDep {..} =+  let (docs, counts) = checkRanges versions reverseDepRanges+   in (vsep $ reverseDepHeader reverseDepName : docs, counts)++checkReverseDepRevisions ::+  Maybe (Version, Version) ->+  ArchLinuxName ->+  Either MyException ReverseDep ->+  Either MyException ReverseDep ->+  (Doc AnsiStyle, FailureCounts)+checkReverseDepRevisions versions name latest original+  | sameResult latest original =+      case latest of+        Right dep -> checkReverseDep versions dep+        Left err -> (annYellow $ "Skip" <+> pretty (unArchLinuxName name) <> colon <+> viaShow err, FailureCounts 0 0)+  | otherwise =+      ( vsep $+          reverseDepHeader name+            : revisionDocs annCyan "latest revision" latest+              <> revisionDocs annBlue "revision 0" original,+        snd $ resultDetails latest+      )+  where+    sameResult (Right a) (Right b) =+      [(src, asVersionIntervals range) | (src, range) <- reverseDepRanges a]+        == [(src, asVersionIntervals range) | (src, range) <- reverseDepRanges b]+    sameResult (Left a) (Left b) = show a == show b+    sameResult _ _ = False++    resultDetails (Right dep) = checkRanges versions $ reverseDepRanges dep+    resultDetails (Left err) = ([indent 2 $ annYellow $ "unchecked:" <+> viaShow err], FailureCounts 0 0)++    revisionDocs style label result =+      let (docs, counts) = resultDetails result+          status = case (versions, result) of+            (Just _, Right _) -> space <> parens (prettyFailureCounts counts)+            _ -> mempty+       in indent 2 (style $ annBold label <> status <> colon) : fmap (indent 2) docs++reverseDepHeader :: ArchLinuxName -> Doc AnsiStyle+reverseDepHeader name = annMagneta $ "Reverse dependency" <> colon <+> annBold (pretty $ unArchLinuxName name)++checkRanges :: Maybe (Version, Version) -> [(DepSrc, VersionRange)] -> ([Doc AnsiStyle], FailureCounts)+checkRanges versions ranges =+  ( rangeDocs versions ranges <> errors,+    FailureCounts (length newRanges) (length oldRanges)+  )+  where+    (newRanges, oldRanges) =+      case versions of+        Nothing -> ([], [])+        Just (current, candidate) ->+          partition (withinRange current . snd) $ versionFailures (Just candidate) ranges+    errors =+      case versions of+        Nothing -> []+        Just (_, candidate) ->+          versionErrors annRed "rdep:" candidate newRanges+            <> versionErrors annYellow "rdep-old:" candidate oldRanges++printRdepcheckResult :: IO (Either MyException FailureCounts) -> IO ()+printRdepcheckResult io = do+  result <- io+  case result of+    Left err -> do+      printError $ "Runtime Exception" <> colon <+> viaShow err+      exitFailure+    Right counts@FailureCounts {..}+      | newFailures > 0 -> do+          printError $ "Reverse dependency range check(s) failed:" <+> prettyFailureCounts counts+          exitFailure+      | oldFailures > 0 ->+          printWarn $ "Existing reverse dependency range failure(s):" <+> prettyFailureCounts counts+      | otherwise -> printSuccess "Success!"++prettyFailureCounts :: FailureCounts -> Doc AnsiStyle+prettyFailureCounts FailureCounts {..} =+  (if newFailures == 0 then annGreen else annRed) ("rdep=" <> pretty newFailures)+    <> comma+      <+> (if oldFailures == 0 then annGreen else annYellow) ("rdep-old=" <> pretty oldFailures)++rangeDocs :: Maybe (Version, Version) -> [(DepSrc, VersionRange)] -> [Doc AnsiStyle]+rangeDocs versions result =+  [ indent 2 $ pretty s <> colon <+> rangeColor r (viaPretty r)+    | (s, r) <- result+  ]+  where+    rangeColor range =+      case versions of+        Nothing -> annBlue+        Just (current, candidate)+          | withinRange candidate range -> annGreen+          | withinRange current range -> annRed+          | otherwise -> annYellow++versionErrors :: (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Version -> [(DepSrc, VersionRange)] -> [Doc AnsiStyle]+versionErrors style label version result =+  [ indent 2 $ style $+      label+        <+> annBold (viaPretty version)+        <+> "is outside"+        <+> pretty src+        <+> "range"+        <+> parens (viaPretty range)+    | (src, range) <- result+  ]
src/Distribution/ArchHs/Hackage.hs view
@@ -10,6 +10,7 @@   ( lookupHackagePath,     loadHackageDB,     loadRawHackageDB,+    loadRawHackageRevisions,     loadHackageDBs,     insertDB,     parseCabalFile,@@ -26,7 +27,9 @@ where  import Control.Monad (filterM)+import Conduit import qualified Data.ByteString as BS+import qualified Data.Conduit.Tar as Tar import Data.List (maximumBy) import qualified Data.Map as Map import Data.Maybe (catMaybes, fromJust)@@ -91,6 +94,42 @@ -- | Read the Hackage index tarball without applying preferred-version ranges. loadRawHackageDB :: FilePath -> IO RawHackageDB loadRawHackageDB = Unparsed.readTarball Nothing++-- | Read the latest revision and revision 0 for exact package versions in one+-- pass. Hackage appends revisions under the same tar entry path.+loadRawHackageRevisions :: [(PackageName, Version)] -> FilePath -> IO (RawHackageDB, RawHackageDB)+loadRawHackageRevisions [] _ = pure (Map.empty, Map.empty)+loadRawHackageRevisions packages path = do+  revisions <-+    runConduitRes $+      sourceFileBS path+        .| Tar.untarChunks+        .| Tar.withEntries readCabal+        .| foldlC insertRevision Map.empty+  pure (toDB snd revisions, toDB fst revisions)+  where+    paths =+      Map.fromList+        [ (pkg </> prettyShow version </> (pkg <> ".cabal"), (name, version))+          | (name, version) <- packages,+            let pkg = unPackageName name+        ]++    readCabal header+      | Tar.FTNormal <- Tar.headerFileType header,+        Just key <- Map.lookup (Tar.headerFilePath header) paths = do+          bytes <- mconcat <$> sinkList+          yield (key, bytes)+      | otherwise = pure ()++    insertRevision revisions (key, bytes) =+      Map.alter (Just . maybe (bytes, bytes) (\(original, _) -> (original, bytes))) key revisions++    toDB revision =+      Map.map (Unparsed.PackageData BS.empty)+        . Map.fromListWith Map.union+        . fmap (\((name, version), bytes) -> (name, Map.singleton version $ Unparsed.VersionData (revision bytes) BS.empty))+        . Map.toList  -- | Read Hackage once and expose both preferred and raw views. loadHackageDBs :: FilePath -> IO (HackageDB, RawHackageDB)
src/Distribution/ArchHs/Options.hs view
@@ -148,7 +148,8 @@ data HackageDBOptions = HackageDBOptions   { loadHackageDBFromOptions :: IO HackageDB,     loadRawHackageDBFromOptions :: IO RawHackageDB,-    loadHackageDBsFromOptions :: IO (HackageDB, RawHackageDB)+    loadHackageDBsFromOptions :: IO (HackageDB, RawHackageDB),+    loadRawHackageRevisionsFromOptions :: [(PackageName, Version)] -> IO (RawHackageDB, RawHackageDB)   }  -- | CLI options parser that reads a string option @hackage@.@@ -175,7 +176,8 @@       HackageDBOptions         { loadHackageDBFromOptions = withHackagePath s loadHackageDB,           loadRawHackageDBFromOptions = withHackagePath s loadRawHackageDB,-          loadHackageDBsFromOptions = withHackagePath s loadHackageDBs+          loadHackageDBsFromOptions = withHackagePath s loadHackageDBs,+          loadRawHackageRevisionsFromOptions = \packages -> withHackagePath s (loadRawHackageRevisions packages)         }  -----------------------------------------------------------------------------
src/Distribution/ArchHs/RDepCheck.hs view
@@ -9,6 +9,7 @@     ReverseDep (..),     SkippedReverseDep (..),     prettySkippedReverseDep,+    reverseDependencyPackages,     reverseDependencyRanges,     reverseDependencyRangesWithSkips,     versionFailures,@@ -87,27 +88,9 @@   PackageName ->   Sem r ([ReverseDep], [SkippedReverseDep]) reverseDependencyRangesWithSkips target = do-  let aTarget = toArchLinuxName target-  exists <- isInExtra aTarget+  exists <- isInExtra target   unless exists $ throw $ PkgNotFound target-  reverseDeps <--    ( \xs ->-        [ (desc, [Make | md] <> [Check | cd] <> [Run | d])-          | ( _,-              desc@PkgDesc-                { _name = isHaskellPackage -> isHs,-                  _makeDepends = flip containsDep aTarget -> md,-                  _checkDepends = flip containsDep aTarget -> cd,-                  _depends = flip containsDep aTarget -> d-                }-              ) <--              xs,-            isHs,-            md || cd || d-        ]-      )-      . Map.toList-      <$> ask @ExtraDB+  reverseDeps <- flip reverseDependencyPackages target <$> ask @ExtraDB   results <-     forM reverseDeps $ \(PkgDesc {..}, src) -> do       eCabal <-@@ -120,6 +103,21 @@         Left e -> pure . Left $ SkippedReverseDep _name e   pure $ case partitionEithers results of     (skipped, reverseDeps') -> (reverseDeps', skipped)++reverseDependencyPackages :: ExtraDB -> PackageName -> [(PkgDesc, [DepSrc])]+reverseDependencyPackages extra target =+  [ (desc, [Make | md] <> [Check | cd] <> [Run | d])+    | desc@PkgDesc+        { _name = isHaskellPackage -> isHs,+          _makeDepends = flip containsDep aTarget -> md,+          _checkDepends = flip containsDep aTarget -> cd,+          _depends = flip containsDep aTarget -> d+        } <- Map.elems extra,+      isHs,+      md || cd || d+  ]+  where+    aTarget = toArchLinuxName target  versionFailures :: Maybe Version -> [(DepSrc, VersionRange)] -> [(DepSrc, VersionRange)] versionFailures Nothing _ = []
sync/Args.hs view
@@ -59,7 +59,7 @@   CheckOptions     <$> switch (long "show-ghc-libs" <> help "Include GHC and GHC libs")     <*> switch (long "depcheck" <> help "Check whether newer Hackage versions are currently upgradable")-    <*> switch (long "verbose" <> help "Show dependency and reverse dependency ranges that block --depcheck candidates")+    <*> switch (long "verbose" <> help "Show failing dependency and reverse dependency ranges for --depcheck candidates")  ----------------------------------------------------------------------------- 
sync/Check.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-} -module Check (check) where+module Check (check, checkNewerVersions, prettyNewerVersions) where  import Control.Monad (forM)+import Data.List (partition) import qualified Data.Map.Strict as Map import Distribution.ArchHs.DepCheck import Distribution.ArchHs.Exception@@ -13,14 +15,16 @@ import Distribution.ArchHs.PP import Distribution.ArchHs.RDepCheck import Distribution.ArchHs.Types-import Distribution.Package (packageName) import Utils -data NewerVersion = NewerVersion Version (Maybe CheckResult)+data NewerVersion+  = NewerVersion Version (Maybe CheckResult)+  | UncheckedVersion Version MyException  data CheckResult = CheckResult   { depFailures :: [DependencyFailure],-    rdepFailures :: [ReverseDependencyFailure]+    rdepFailures :: [ReverseDependencyFailure],+    existingRdepFailures :: [ReverseDependencyFailure]   }  data ReverseDependencyFailure = ReverseDependencyFailure ArchLinuxName DepSrc VersionRange@@ -46,9 +50,8 @@   linked <- linkedHaskellPackageDescs   checked <-     traverse-      ( \(archName, desc, cabal) -> do-          let hackageName = packageName cabal-              rawArchVersion = _version desc+      ( \(archName, desc, hackageName) -> do+          let rawArchVersion = _version desc           case simpleParsec rawArchVersion of             Just archVersion               | includeGHC || not (isGHCLibs hackageName) -> do@@ -56,7 +59,7 @@                   if null hackageVersions                     then pure ([], [])                     else do-                      (newerVersions, skipped) <- checkNewerVersions runDepCheck hackageName hackageVersions+                      (newerVersions, skipped) <- checkNewerVersions runDepCheck hackageName archVersion hackageVersions                       pure ([prettyNewerVersions verbose archName (_rawVersion desc) hackageName archVersion newerVersions], skipped)             _ -> pure ([], [])       )@@ -85,25 +88,36 @@     r =>   Bool ->   PackageName ->+  Version ->   [Version] ->   Sem r ([NewerVersion], [SkippedReverseDep])-checkNewerVersions False _ hackageVersions =+checkNewerVersions False _ _ hackageVersions =   pure ((\hackageVersion -> NewerVersion hackageVersion Nothing) <$> hackageVersions, [])-checkNewerVersions True hackageName hackageVersions = do+checkNewerVersions True hackageName archVersion hackageVersions = do   (reverseDeps, skipped) <- reverseDependencyRangesWithSkips hackageName   newerVersions <-     forM hackageVersions $ \hackageVersion -> do-      cabal <- getCabal hackageName hackageVersion-      depFailureDetails <- dependencyFailures cabal-      pure $-        NewerVersion-          hackageVersion-          ( Just-              CheckResult-                { depFailures = depFailureDetails,-                  rdepFailures = rdepFailureDetails hackageVersion reverseDeps-                }-          )+      -- Candidates are already filtered by preferred versions. Parse the raw+      -- cabal here so failures use MyException instead of hackage-db's throws.+      eCabal <- try @MyException $ getCabalIncludingDeprecated hackageName hackageVersion+      case eCabal of+        Left err -> pure $ UncheckedVersion hackageVersion err+        Right cabal -> do+          depFailureDetails <- dependencyFailures cabal+          let (newRdepFailures, oldRdepFailures) =+                partition+                  (\(ReverseDependencyFailure _ _ range) -> withinRange archVersion range)+                  (rdepFailureDetails hackageVersion reverseDeps)+          pure $+            NewerVersion+              hackageVersion+              ( Just+                  CheckResult+                    { depFailures = depFailureDetails,+                      rdepFailures = newRdepFailures,+                      existingRdepFailures = oldRdepFailures+                    }+              )   pure (newerVersions, skipped)  uniqueSkippedReverseDeps :: [SkippedReverseDep] -> [SkippedReverseDep]@@ -163,9 +177,13 @@         _ -> rawVersion  prettyNewerVersion :: NewerVersion -> Doc AnsiStyle+prettyNewerVersion (UncheckedVersion version _) =+  annRed $ viaPretty version <+> parens "unchecked: cabal parse failed" prettyNewerVersion (NewerVersion version Nothing) = annGreen $ viaPretty version-prettyNewerVersion (NewerVersion version (Just CheckResult {depFailures = [], rdepFailures = []})) =+prettyNewerVersion (NewerVersion version (Just CheckResult {depFailures = [], rdepFailures = [], existingRdepFailures = []})) =   annGreen $ viaPretty version <+> parens "ok"+prettyNewerVersion (NewerVersion version (Just failures@CheckResult {depFailures = [], rdepFailures = []})) =+  annYellow $ viaPretty version <+> parens ("existing:" <+> prettyCheckFailures failures) prettyNewerVersion (NewerVersion version (Just failures)) =   annRed $ viaPretty version <+> parens ("blocked:" <+> prettyCheckFailures failures) @@ -174,14 +192,18 @@   hsep . punctuate comma $     ["dep=" <> pretty (length depFailures) | not (null depFailures)]       <> ["rdep=" <> pretty (length rdepFailures) | not (null rdepFailures)]+      <> ["rdep-old=" <> pretty (length existingRdepFailures) | not (null existingRdepFailures)]  prettyVerboseNewerVersion :: NewerVersion -> [Doc AnsiStyle]+prettyVerboseNewerVersion (UncheckedVersion version err) =+  [viaPretty version <> colon, indent 2 $ viaShow err] prettyVerboseNewerVersion (NewerVersion _ Nothing) = []-prettyVerboseNewerVersion (NewerVersion _ (Just CheckResult {depFailures = [], rdepFailures = []})) = []+prettyVerboseNewerVersion (NewerVersion _ (Just CheckResult {depFailures = [], rdepFailures = [], existingRdepFailures = []})) = [] prettyVerboseNewerVersion (NewerVersion version (Just CheckResult {..})) =   (viaPretty version <> colon)     : fmap (indent 2 . prettyDependencyFailure) depFailures-      <> fmap (indent 2 . prettyReverseDependencyFailure) rdepFailures+      <> fmap (indent 2 . prettyReverseDependencyFailure (annRed "rdep:")) rdepFailures+      <> fmap (indent 2 . prettyReverseDependencyFailure (annYellow "rdep-old:")) existingRdepFailures  prettyDependencyFailure :: DependencyFailure -> Doc AnsiStyle prettyDependencyFailure = \case@@ -203,9 +225,9 @@       <+> "has"       <+> viaPretty version -prettyReverseDependencyFailure :: ReverseDependencyFailure -> Doc AnsiStyle-prettyReverseDependencyFailure (ReverseDependencyFailure name src range) =-  annRed "rdep:"+prettyReverseDependencyFailure :: Doc AnsiStyle -> ReverseDependencyFailure -> Doc AnsiStyle+prettyReverseDependencyFailure label (ReverseDependencyFailure name src range) =+  label     <+> pretty (unArchLinuxName name)     <+> pretty src     <+> "requires"
sync/Submit.hs view
@@ -16,7 +16,6 @@ import Distribution.ArchHs.PP import Distribution.ArchHs.Types import Distribution.ArchHs.Utils-import Distribution.Package (packageName) import Network.HTTP.Client import Network.HTTP.Types.Status (statusCode, statusIsSuccessful, statusMessage) import Submit.CSV@@ -30,7 +29,7 @@     sortOn       (^. _1)       [ (unPackageName hackageName, version, prefix <> tweakedName)-        | (archLinuxName, version, packageName -> hackageName) <- linked,+        | (archLinuxName, version, hackageName) <- linked,           let tweakedName =                 if isGHCLibs hackageName                   then "ghc"
sync/Utils.hs view
@@ -9,7 +9,6 @@  import Control.Monad (unless) import qualified Data.Map.Strict as Map-import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Name@@ -17,21 +16,22 @@ import Distribution.ArchHs.Types  linkedHaskellPackages ::-  Members [ExtraEnv, HackageEnv, WithMyErr, Embed IO] r =>-  Sem r [(ArchLinuxName, ArchLinuxVersion, GenericPackageDescription)]+  Members [ExtraEnv, HackageEnv, Embed IO] r =>+  Sem r [(ArchLinuxName, ArchLinuxVersion, PackageName)] linkedHaskellPackages =-  fmap (\(name, desc, cabal) -> (name, _version desc, cabal)) <$> linkedHaskellPackageDescs+  fmap (\(name, desc, hName) -> (name, _version desc, hName)) <$> linkedHaskellPackageDescs  linkedHaskellPackageDescs ::-  Members [ExtraEnv, HackageEnv, WithMyErr, Embed IO] r =>-  Sem r [(ArchLinuxName, PkgDesc, GenericPackageDescription)]+  Members [ExtraEnv, HackageEnv, Embed IO] r =>+  Sem r [(ArchLinuxName, PkgDesc, PackageName)] linkedHaskellPackageDescs = do   extraHaskellPackages <- filter (isHaskellPackage . fst) . Map.toList <$> ask @ExtraDB-  hackagePackages <- Map.keys <$> ask @HackageDB+  hackage <- ask @HackageDB+  -- Linking needs only index keys; newer cabal formats may not be parseable.   let go xs ys ((name, desc) : pkgs) =         let hName = toHackageName name-         in if hName `elem` hackagePackages-              then getLatestCabal hName >>= \cabal -> go ((name, desc, cabal) : xs) ys pkgs+         in if Map.member hName hackage+              then go ((name, desc, hName) : xs) ys pkgs               else go xs (name : ys) pkgs       go xs ys [] = pure (xs, ys)   (linked, unlinked) <- go [] [] extraHaskellPackages
test/Main.hs view
@@ -3,16 +3,22 @@  module Main (main) where -import Control.Monad (forM_)+import qualified Check as Sync+import qualified Conduit as C+import Control.Exception (bracket, try)+import Control.Monad (forM_, void) import qualified Data.ByteString.Char8 as B8-import Data.List (isPrefixOf, sortOn)+import qualified Data.Conduit.Tar as Tar+import Data.List (intercalate, isPrefixOf, sortOn) import qualified Data.Map.Strict as Map import Data.Maybe (listToMaybe, mapMaybe) import Diff (inRange) import Distribution.ArchHs.Exception import Distribution.ArchHs.ExtraDB (defaultExtraDBPath, loadExtraDB)-import Distribution.ArchHs.Hackage (getCabalIncludingDeprecated, getNewerVersions)-import Distribution.ArchHs.Name (isGHCLibs, isHaskellPackage, toHackageName)+import Distribution.ArchHs.Hackage (getCabalIncludingDeprecated, getNewerVersions, loadRawHackageRevisions)+import Distribution.ArchHs.Name (isGHCLibs, isHaskellPackage, toArchLinuxName, toHackageName)+import Distribution.ArchHs.PP (AnsiStyle, Doc)+import Distribution.ArchHs.RDepCheck (DepSrc (..), ReverseDep (..)) import Distribution.ArchHs.Types import qualified Distribution.Hackage.DB.Parsed as Hackage import qualified Distribution.Hackage.DB.Unparsed as RawHackage@@ -22,12 +28,18 @@ import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName) import Distribution.Types.Version (Version) import Distribution.Types.VersionRange (VersionRange, anyVersion)-import Polysemy (run)+import Polysemy (run, runM) import Polysemy.Error (runError) import Polysemy.Reader (runReader)+import Polysemy.State (evalState)+import Polysemy.Trace (ignoreTrace)+import qualified RDepCheck import Submit.CSV-import System.Directory (doesFileExist)+import System.Directory (doesFileExist, getTemporaryDirectory, removeFile)+import System.Exit (ExitCode (..))+import System.IO (hClose, openBinaryTempFile) import Test.Hspec+import Utils (linkedHaskellPackageDescs)  main :: IO () main = hspec $ do@@ -96,6 +108,200 @@         Left err ->           expectationFailure $ "expected masked cabal lookup to succeed, got: " <> show err +  describe "sync with unsupported cabal formats" $ do+    it "lists newer versions without parsing their cabal files" $ do+      let (preferred, _, _, name) = unsupportedHackageDBs+      assertGetNewerVersions preferred name (parseVersion "1.0") [parseVersion "1.1", parseVersion "2.0.0"]++    it "links packages by index name without parsing the latest cabal file" $ do+      let (preferred, _, extra, name) = unsupportedHackageDBs+      linked <- runM . runReader preferred . runReader extra $ linkedHaskellPackageDescs+      [(archName, _version desc, hackageName) | (archName, desc, hackageName) <- linked]+        `shouldBe` [(toArchLinuxName name, "1.0", name)]++    it "finishes a version check with an unsupported latest cabal file" $ do+      let (preferred, _, extra, _) = unsupportedHackageDBs+      result <- runSyncCheck extra preferred Map.empty False+      show result `shouldBe` "Right ()"++    it "continues dependency checking past an unsupported cabal file" $ do+      let (preferred, raw, extra, _) = unsupportedHackageDBs+      result <- runSyncCheck extra preferred raw True+      show result `shouldBe` "Right ()"++  describe "sync reverse dependency failure classification" $ do+    it "counts newly broken and already unmet ranges separately" $ do+      output <- runSyncDepCheck True [] [("new", [Run], "<2"), ("old", [Run], "<1")]+      output `shouldContain` "2.0 (blocked: rdep=1, rdep-old=1)"+      output `shouldContain` "rdep: haskell-new Depends requires <2"+      output `shouldContain` "rdep-old: haskell-old Depends requires <1"+      output `shouldNotContain` "rdep: haskell-old"+      output `shouldNotContain` "rdep-old: haskell-new"++    it "marks candidates with only existing failures differently from new blockers" $ do+      output <- runSyncDepCheck False [] [("old", [Run], "<1")]+      output `shouldContain` "1.1 (existing: rdep-old=1)"+      output `shouldContain` "2.0 (existing: rdep-old=1)"+      output `shouldNotContain` "blocked:"+      output `shouldNotContain` "(ok)"+      output `shouldNotContain` "rdep-old:"++    it "stops counting an existing failure once the candidate satisfies its range" $ do+      output <- runSyncDepCheck False [] [("recovered", [Run], ">=2")]+      output `shouldContain` "1.1 (existing: rdep-old=1)"+      output `shouldContain` "2.0 (ok)"+      output `shouldContain` "3.0 (ok)"++    it "compares every candidate against the installed version" $ do+      output <- runSyncDepCheck False [] [("new", [Run], "<2")]+      output `shouldContain` "1.1 (ok)"+      output `shouldContain` "2.0 (blocked: rdep=1)"+      output `shouldContain` "3.0 (blocked: rdep=1)"+      output `shouldNotContain` "rdep-old="++    it "classifies each dependency source separately and counts failing ranges" $ do+      output <- runSyncDepCheck True [] [("both", [Run], "<2"), ("both", [Make, Check], "<1")]+      output `shouldContain` "2.0 (blocked: rdep=1, rdep-old=2)"+      output `shouldContain` "rdep: haskell-both Depends requires <2"+      output `shouldContain` "rdep-old: haskell-both MakeDepends requires <1"+      output `shouldContain` "rdep-old: haskell-both CheckDepends requires <1"++    it "keeps direct dependency failures blocking alongside existing reverse failures" $ do+      output <- runSyncDepCheck False ["missing >=1"] [("old", [Run], "<1")]+      output `shouldContain` "2.0 (blocked: dep=1, rdep-old=1)"++  describe "standalone reverse dependency failure classification" $ do+    it "marks and counts new and existing failures separately for each source" $ do+      let reverseDep =+            ReverseDep (toArchLinuxName $ mkPackageName "both")+              [(Run, parseRange "<2"), (Make, parseRange "<1"), (Check, parseRange "<1")]+          (doc, counts) = RDepCheck.checkReverseDep (Just (parseVersion "1.0", parseVersion "2.0")) reverseDep+      counts `shouldBe` RDepCheck.FailureCounts 1 2+      show doc `shouldContain` "rdep: 2.0 is outside Depends range (<2)"+      show doc `shouldContain` "rdep-old: 2.0 is outside MakeDepends range (<1)"+      show doc `shouldContain` "rdep-old: 2.0 is outside CheckDepends range (<1)"++    it "uses the current extra version and totals failures across reverse dependencies" $ do+      let (_, raw, extra, name) = syncDepCheckDBs [] [("new", [Run], "<2"), ("old", [Make, Check], "<1")]+      result <- runRdepCheck extra raw (Just $ parseVersion "2.0") name+      case result of+        Right counts -> counts `shouldBe` RDepCheck.FailureCounts 1 2+        Left err -> expectationFailure $ show err++    it "drops existing failures when the candidate satisfies the range" $ do+      let (_, raw, extra, name) = syncDepCheckDBs [] [("recovered", [Run], ">=2")]+      result <- runRdepCheck extra raw (Just $ parseVersion "2.0") name+      case result of+        Right counts -> counts `shouldBe` RDepCheck.FailureCounts 0 0+        Left err -> expectationFailure $ show err++    it "lists ranges without checking or parsing the current version when no candidate is given" $ do+      let (_, raw, extra, name) = syncDepCheckDBs [] [("old", [Run], "<1")]+          badExtra = Map.adjust (\desc -> desc {_version = "not-a-version"}) (toArchLinuxName name) extra+          reverseDep = ReverseDep (toArchLinuxName $ mkPackageName "old") [(Run, parseRange "<1")]+          (doc, counts) = RDepCheck.checkReverseDep Nothing reverseDep+      counts `shouldBe` RDepCheck.FailureCounts 0 0+      show doc `shouldContain` "Depends: <1"+      show doc `shouldNotContain` "rdep:"+      show doc `shouldNotContain` "rdep-old:"+      result <- runRdepCheck badExtra raw Nothing name+      case result of+        Right actual -> actual `shouldBe` RDepCheck.FailureCounts 0 0+        Left err -> expectationFailure $ show err++    it "reports an unparseable current version instead of guessing the failure classification" $ do+      let (_, raw, extra, name) = syncDepCheckDBs [] [("old", [Run], "<1")]+          badExtra = Map.adjust (\desc -> desc {_version = "not-a-version"}) (toArchLinuxName name) extra+      result <- runRdepCheck badExtra raw (Just $ parseVersion "2.0") name+      case result of+        Left (VersionNoParse version) -> version `shouldBe` "not-a-version"+        other -> expectationFailure $ "expected VersionNoParse, got: " <> show other++    it "exits unsuccessfully only for newly unmet ranges" $ do+      forM_+        [ (RDepCheck.FailureCounts 0 0, Right ()),+          (RDepCheck.FailureCounts 0 2, Right ()),+          (RDepCheck.FailureCounts 1 0, Left $ ExitFailure 1),+          (RDepCheck.FailureCounts 1 2, Left $ ExitFailure 1)+        ]+        $ \(counts, expected) -> do+          result <- try @ExitCode $ RDepCheck.printRdepcheckResult $ pure $ Right counts+          result `shouldBe` expected++  describe "reverse dependency revision comparisons" $ do+    it "loads the first and last index entries for exact versions, including deprecated releases" $ do+      let name = mkPackageName "revised"+          version = parseVersion "1.0"+          cabal range = B8.pack $ unlines ["cabal-version: 1.24", "name: revised", "version: 1.0", "build-type: Simple", "library", "  build-depends: Diff " <> range]+          entries =+            [ ("revised/1.0/revised.cabal", cabal "<2"),+              ("revised/preferred-versions", B8.pack "revised <1"),+              ("revised/1.0/revised.cabal", cabal "<3"),+              ("revised/2.0/revised.cabal", B8.pack "unrequested version"),+              ("revised/1.0/revised.cabal", cabal "<1")+            ]+          (_, _, extra, target) = syncDepCheckDBs [] [("revised", [Run], "<1")]+      withIndexEntries entries $ \path -> do+        (latest, original) <- loadRawHackageRevisions [(name, version)] path+        result <- runRdepCheckRevisions extra latest original (Just $ parseVersion "2.0") target+        case result of+          Right counts -> counts `shouldBe` RDepCheck.FailureCounts 0 1+          Left err -> expectationFailure $ show err+        originalResult <- runRdepCheck extra original (Just $ parseVersion "2.0") target+        case originalResult of+          Right counts -> counts `shouldBe` RDepCheck.FailureCounts 1 0+          Left err -> expectationFailure $ show err+        case runGetCabalIncludingDeprecated latest name (parseVersion "2.0") of+          Left (VersionNotFound _ _) -> pure ()+          other -> expectationFailure $ "expected unrequested version to be absent, got: " <> show other++    it "shows both ranges and their new/old classifications while returning latest counts" $ do+      let (doc, counts) = revisionComparison (Just $ parseVersion "2.0") "<1" "<2"+      counts `shouldBe` RDepCheck.FailureCounts 0 1+      show doc `shouldContain` "latest revision (rdep=0, rdep-old=1):"+      show doc `shouldContain` "revision 0 (rdep=1, rdep-old=0):"+      show doc `shouldContain` "rdep-old: 2.0 is outside Depends range (<1)"+      show doc `shouldContain` "rdep: 2.0 is outside Depends range (<2)"++    it "shows when a revision changes whether the candidate is accepted" $ do+      let (doc, counts) = revisionComparison (Just $ parseVersion "2.0") "<2" "<3"+      counts `shouldBe` RDepCheck.FailureCounts 1 0+      show doc `shouldContain` "latest revision (rdep=1, rdep-old=0):"+      show doc `shouldContain` "revision 0 (rdep=0, rdep-old=0):"+      show doc `shouldContain` "Depends: <3"++    it "does not duplicate equal or equivalent dependency ranges" $ do+      forM_ ["<2", ">=0 && <2"] $ \original -> do+        let (doc, counts) = revisionComparison (Just $ parseVersion "2.0") "<2" original+        counts `shouldBe` RDepCheck.FailureCounts 1 0+        show doc `shouldContain` "Depends: <2"+        show doc `shouldNotContain` "latest revision"+        show doc `shouldNotContain` "revision 0"++    it "shows changed ranges when listing without a candidate version" $ do+      let (doc, counts) = revisionComparison Nothing "<2" "<3"+      counts `shouldBe` RDepCheck.FailureCounts 0 0+      show doc `shouldContain` "latest revision:"+      show doc `shouldContain` "revision 0:"+      show doc `shouldContain` "Depends: <2"+      show doc `shouldContain` "Depends: <3"+      show doc `shouldNotContain` "rdep="++    it "shows the available result if either revision cannot be parsed" $ do+      let name = mkPackageName "revised"+          archName = toArchLinuxName name+          parsed = Right $ ReverseDep archName [(Run, parseRange "<2")]+          failed = Left $ CabalNoParse name $ parseVersion "1.0"+          versions = Just (parseVersion "1.0", parseVersion "2.0")+      forM_ [(parsed, failed, RDepCheck.FailureCounts 1 0), (failed, parsed, RDepCheck.FailureCounts 0 0)] $+        \(latest, original, expected) -> do+          let (doc, counts) = RDepCheck.checkReverseDepRevisions versions archName latest original+          counts `shouldBe` expected+          show doc `shouldContain` "latest revision"+          show doc `shouldContain` "revision 0"+          show doc `shouldContain` "unchecked: Unable to parse"+          show doc `shouldContain` "rdep: 2.0 is outside Depends range (<2)"+ loadLiveExtraDB :: IO ExtraDB loadLiveExtraDB = do   exists <- doesFileExist defaultExtraDBPath@@ -200,6 +406,12 @@     Just version -> version     Nothing -> error $ "test fixture version does not parse: " <> raw +parseRange :: String -> VersionRange+parseRange raw =+  case simpleParsec raw of+    Just range -> range+    Nothing -> error $ "test fixture range does not parse: " <> raw+ runGetNewerVersions :: Hackage.HackageDB -> PackageName -> Version -> Either MyException [Version] runGetNewerVersions hackage name version =   run@@ -219,6 +431,210 @@     . runError @MyException     . runReader hackage     $ getCabalIncludingDeprecated name version++unsupportedHackageDBs :: (Hackage.HackageDB, RawHackage.HackageDB, ExtraDB, PackageName)+unsupportedHackageDBs =+  (Hackage.parseDB raw, raw, Map.singleton archName desc, name)+  where+    name = mkPackageName "Diff"+    archName = toArchLinuxName name+    raw =+      Map.singleton name $+        RawHackage.PackageData+          (B8.pack "Diff <3")+          ( Map.fromList+              [ (parseVersion "1.1", versionData "1.12" "1.1"),+                (parseVersion "2.0.0", versionData "999.0" "2.0.0"),+                (parseVersion "3.0", versionData "999.0" "3.0")+              ]+          )++    -- Use a future format so the regression survives upgrades of Cabal itself.+    versionData format version =+      RawHackage.VersionData+        ( B8.pack $+            unlines+              [ "cabal-version: " <> format,+                "name: Diff",+                "version: " <> version,+                "build-type: Simple"+              ]+        )+        B8.empty++    desc =+      PkgDesc+        { _name = archName,+          _version = "1.0",+          _rawVersion = "1.0-1",+          _desc = "Diff algorithm in pure Haskell",+          _url = Nothing,+          _provides = [],+          _optDepends = [],+          _replaces = [],+          _conflicts = [],+          _depends = [],+          _makeDepends = [],+          _checkDepends = []+        }++runSyncCheck :: ExtraDB -> Hackage.HackageDB -> RawHackage.HackageDB -> Bool -> IO (Either MyException ())+runSyncCheck extra hackage raw depCheck =+  runM+    . runError @MyException+    . evalState (Map.empty :: Map.Map PackageName [VersionRange])+    . ignoreTrace+    . runReader (Map.empty :: FlagAssignments)+    . runReader (parseVersion "9.6.6")+    . runReader raw+    . runReader hackage+    . runReader extra+    $ Sync.check False depCheck True++runRdepCheck :: ExtraDB -> RawHackage.HackageDB -> Maybe Version -> PackageName -> IO (Either MyException RDepCheck.FailureCounts)+runRdepCheck extra raw = runRdepCheckRevisions extra raw raw++runRdepCheckRevisions :: ExtraDB -> RawHackage.HackageDB -> RawHackage.HackageDB -> Maybe Version -> PackageName -> IO (Either MyException RDepCheck.FailureCounts)+runRdepCheckRevisions extra latest original version name =+  runM+    . runError @MyException+    . evalState (Map.empty :: Map.Map PackageName [VersionRange])+    . ignoreTrace+    . runReader (Map.empty :: FlagAssignments)+    . runReader (parseVersion "9.6.6")+    . runReader latest+    . runReader extra+    $ RDepCheck.check original version name++revisionComparison :: Maybe Version -> String -> String -> (Doc AnsiStyle, RDepCheck.FailureCounts)+revisionComparison candidate latest original =+  RDepCheck.checkReverseDepRevisions+    ((\version -> (parseVersion "1.0", version)) <$> candidate)+    name+    (Right $ ReverseDep name [(Run, parseRange latest)])+    (Right $ ReverseDep name [(Run, parseRange original)])+  where+    name = toArchLinuxName $ mkPackageName "revised"++withIndexEntries :: [(FilePath, B8.ByteString)] -> (FilePath -> IO a) -> IO a+withIndexEntries entries action = do+  tmp <- getTemporaryDirectory+  bracket (openBinaryTempFile tmp "arch-hs-index.tar") (\(path, handle) -> hClose handle >> removeFile path) $ \(path, handle) -> do+    hClose handle+    C.runConduitRes $+      forM_ entries+        ( \(entryPath, bytes) -> do+            C.yield $ Left $+              Tar.FileInfo+                { Tar.filePath = B8.pack entryPath,+                  Tar.fileUserId = 0,+                  Tar.fileUserName = B8.empty,+                  Tar.fileGroupId = 0,+                  Tar.fileGroupName = B8.empty,+                  Tar.fileMode = 0o644,+                  Tar.fileSize = fromIntegral $ B8.length bytes,+                  Tar.fileType = Tar.FTNormal,+                  Tar.fileModTime = 0+                }+            C.yield $ Right bytes+        )+        C..| void Tar.tar+        C..| C.sinkFile path+    action path++runSyncDepCheck :: Bool -> [String] -> [(String, [DepSrc], String)] -> IO String+runSyncDepCheck verbose deps reverseDeps = do+  let (hackage, raw, extra, name) = syncDepCheckDBs deps reverseDeps+      currentVersion = parseVersion "1.0"+  result <-+    runM+      . runError @MyException+      . evalState (Map.empty :: Map.Map PackageName [VersionRange])+      . ignoreTrace+      . runReader (Map.empty :: FlagAssignments)+      . runReader (parseVersion "9.6.6")+      . runReader raw+      . runReader hackage+      . runReader extra+      $ do+        versions <- getNewerVersions name currentVersion+        (checked, skipped) <- Sync.checkNewerVersions True name currentVersion versions+        pure (show $ Sync.prettyNewerVersions verbose (toArchLinuxName name) "1.0-7" name currentVersion checked, length skipped)+  case result of+    Right (output, skipped) -> do+      skipped `shouldBe` 0+      pure output+    Left err -> do+      expectationFailure $ "expected dependency check to succeed, got: " <> show err+      pure ""++syncDepCheckDBs :: [String] -> [(String, [DepSrc], String)] -> (Hackage.HackageDB, RawHackage.HackageDB, ExtraDB, PackageName)+syncDepCheckDBs deps reverseDeps =+  (Hackage.parseDB raw, raw, extra, name)+  where+    name = mkPackageName "Diff"+    archName = toArchLinuxName name+    grouped = Map.fromListWith (<>) [(rdep, [(sources, range)]) | (rdep, sources, range) <- reverseDeps]+    raw =+      Map.fromList $+        (name, packageData [(version, candidate) | version <- ["1.1", "2.0", "3.0"]] "Diff")+          : [(mkPackageName rdep, packageData [("1.0", components ranges)] rdep) | (rdep, ranges) <- Map.toList grouped]++    packageData versions package =+      RawHackage.PackageData B8.empty . Map.fromList $+        [ ( parseVersion version,+            RawHackage.VersionData+              (B8.pack $ unlines $ ["cabal-version: 1.24", "name: " <> package, "version: " <> version, "build-type: Simple"] <> body)+              B8.empty+          )+          | (version, body) <- versions+        ]++    candidate =+      if null deps+        then []+        else ["library", "  build-depends: " <> intercalate ", " deps]++    components ranges =+      concat+        [ body+          | (sources, range) <- ranges,+            (include, body) <-+              [ (Run `elem` sources, ["library", "  build-depends: Diff " <> range]),+                (Make `elem` sources || Check `elem` sources, ["custom-setup", "  setup-depends: Diff " <> range])+              ],+            include+        ]++    extra =+      Map.fromList $+        (archName, desc archName)+          : [ ( rdepName,+                (desc rdepName)+                  { _depends = [PkgDependent archName Nothing | any (elem Run . fst) ranges],+                    _makeDepends = [PkgDependent archName Nothing | any (elem Make . fst) ranges],+                    _checkDepends = [PkgDependent archName Nothing | any (elem Check . fst) ranges]+                  }+              )+              | (rdep, ranges) <- Map.toList grouped,+                let rdepName = toArchLinuxName $ mkPackageName rdep+            ]++    desc package =+      PkgDesc+        { _name = package,+          _version = "1.0",+          _rawVersion = "1.0-7",+          _desc = "Dependency check fixture",+          _url = Nothing,+          _provides = [],+          _optDepends = [],+          _replaces = [],+          _conflicts = [],+          _depends = [],+          _makeDepends = [],+          _checkDepends = []+        }  skip :: String -> IO a skip reason = pendingWith reason >> error "unreachable"