arch-hs 0.13 → 0.14

raw patch · 18 files changed

+714/−188 lines, 18 filesdep +hspecdep ~DiffPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec

Dependency ranges changed: Diff

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• README.md +27/−1
• arch-hs.cabal +23/−2
• diff/Diff.hs +6/−38
• rdepcheck/Check.hs +13/−102
• src/Distribution/ArchHs/Core.hs +2/−1
• src/Distribution/ArchHs/DepCheck.hs +76/−0
• src/Distribution/ArchHs/ExtraDB.hs +4/−3
• src/Distribution/ArchHs/Hackage.hs +12/−0
• src/Distribution/ArchHs/PkgBuild.hs +2/−2
• src/Distribution/ArchHs/PkgDesc.hs +3/−1
• src/Distribution/ArchHs/RDepCheck.hs +161/−0
• src/Distribution/ArchHs/Types.hs +1/−0
• sync/Args.hs +7/−3
• sync/Check.hs +194/−30
• sync/Main.hs +12/−3
• sync/Utils.hs +9/−2
• test/Main.hs +148/−0

@@ -3,6 +3,20 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.14++- Teach `arch-hs-sync check` to report all newer non-deprecated Hackage versions++- Add `arch-hs-sync check --depcheck` and `--verbose` to show whether newer Hackage versions are currently upgradable and list blocking dependency and reverse dependency ranges++- Preserve Arch pkgrel in `arch-hs-sync check` output++- Show package licenses in `arch-hs-diff` output and handle unparseable [extra] versions without crashing++- Sort generated dependencies by mapped Arch package name++- Allow Diff 1.0 and add live extra database and CI test coverage+ ## 0.13  - Speed up the internal pacman database parser and restore the original explicit `--alpm` opt-in model for ALPM-enabled builds

@@ -538,7 +538,33 @@  ## Sync -For hackage distribution maintainers only, see `arch-hs-sync --help` for details.+For Hackage distribution maintainers, `arch-hs-sync check` compares Haskell package versions in [extra] with Hackage:++```+$ arch-hs-sync check+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.++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)+```++Add `--verbose` with `--depcheck` to list the dependency and reverse dependency ranges that block a version:++```+$ 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)+  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+```++Other sync commands, including `submit` and `list`, are documented in `arch-hs-sync --help`.  ## Limitations 

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               arch-hs-version:            0.13+version:            0.14 synopsis:           Distribute hackage packages to archlinux description:   @arch-hs@ is a command-line program, which simplifies the process of producing@@ -46,7 +46,7 @@     , conduit-extra                ^>=1.3.5     , containers     , deepseq                      ^>=1.4.4 || ^>=1.5.0-    , Diff                         ^>=0.4.0 || ^>=0.5+    , Diff                         ^>=0.4.0 || ^>=0.5 || ^>= 1.0     , directory                    ^>=1.3.6     , filepath                     ^>=1.4.2     , hackage-db                   ^>=2.1.0@@ -101,6 +101,7 @@     Distribution.ArchHs.Aur     Distribution.ArchHs.Compat     Distribution.ArchHs.Core+    Distribution.ArchHs.DepCheck     Distribution.ArchHs.Exception     Distribution.ArchHs.ExtraDB     Distribution.ArchHs.FilesDB@@ -112,6 +113,7 @@     Distribution.ArchHs.PkgBuild     Distribution.ArchHs.PkgDesc     Distribution.ArchHs.PP+    Distribution.ArchHs.RDepCheck     Distribution.ArchHs.Types     Distribution.ArchHs.Utils @@ -165,3 +167,22 @@    build-depends:  arch-hs   ghc-options:    -threaded -rtsopts -with-rtsopts=-N++test-suite arch-hs-tests+  import:          common-options+  type:            exitcode-stdio-1.0+  hs-source-dirs:+    test+    diff+    sync++  main-is:         Main.hs+  other-modules:+    Diff+    Submit.CSV++  build-depends:+    , arch-hs+    , hspec++  ghc-options:     -threaded -rtsopts -with-rtsopts=-N

@@ -4,6 +4,7 @@ module Diff   ( CabalSource (..),     diffCabal,+    inRange,   ) where @@ -14,11 +15,10 @@ import qualified Data.Conduit.Tar as Tar import Data.IORef (modifyIORef', newIORef, readIORef) import qualified Data.Map.Strict as Map-import Data.Maybe (catMaybes, fromJust)+import Data.Maybe (catMaybes) import Conduit-import Distribution.ArchHs.Core+import Distribution.ArchHs.DepCheck import Distribution.ArchHs.Exception-import Distribution.ArchHs.ExtraDB (versionInExtra) import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.PP import Distribution.ArchHs.Types@@ -27,8 +27,6 @@ import Distribution.Utils.ShortText (fromShortText) import Network.HTTP.Client -type VersionedList = [(PackageName, VersionRange)]- data CabalSource   = Online Manager   | Offline FilePath@@ -94,33 +92,6 @@         Just cabal -> return cabal         Nothing -> throw $ VersionNotFound name version -directDependencies ::-  Members [KnownGHCVersion, FlagAssignmentsEnv, Trace, DependencyRecord] r =>-  GenericPackageDescription ->-  Sem r (VersionedList, VersionedList)-directDependencies cabal = do-  (libDeps, libToolsDeps, _) <- collectLibDeps id cabal-  (subLibDeps, subLibToolsDeps, _) <- collectSubLibDeps id cabal []-  (exeDeps, exeToolsDeps, _) <- collectExeDeps id cabal []-  (testDeps, testToolsDeps, _) <- collectTestDeps id cabal []-  setupDeps <- collectSetupDeps id cabal-  let flatten = mconcat . fmap snd-      l = libDeps-      lt = libToolsDeps-      sl = flatten subLibDeps-      slt = flatten subLibToolsDeps-      e = flatten exeDeps-      et = flatten exeToolsDeps-      t = flatten testDeps-      tt = flatten testToolsDeps-      mySubLibs = fmap (unqualComponentNameToPackageName . fst) subLibDeps-      notMyselfOrSubLib = (&&) <$> (/= getPkgName' cabal) <*> (`notElem` mySubLibs)-      distinct = filter (notMyselfOrSubLib . fst) . nub-      depends = distinct $ l <> sl <> e-      makedepends = distinct (lt <> slt <> et <> t <> tt <> setupDeps) \\ depends-      sort' = sortBy (\x y -> uncurry compare $ getTwo _1 x y)-  return (sort' depends, sort' makedepends)- -----------------------------------------------------------------------------  diffCabal :: Members [KnownGHCVersion, ExtraEnv, FlagAssignmentsEnv, WithMyErr, Trace, DependencyRecord, Reader CabalSource, Embed IO] r => PackageName -> Version -> Version -> Sem r ()@@ -139,6 +110,7 @@       [ annMagneta "Package" <> colon <+> viaPretty name,         ver pa pb,         desc pa pb,+        lic pa pb,         url pa pb,         dep "Depends" ba bb,         queryb,@@ -166,12 +138,8 @@ url :: PackageDescription -> PackageDescription -> Doc AnsiStyle url = diffTerm "URL" getUrl -inRange :: Members [ExtraEnv, WithMyErr] r => (PackageName, VersionRange) -> Sem r (Either (PackageName, VersionRange) (PackageName, VersionRange, Version, Bool))-inRange (name, hRange) =-  try @MyException (versionInExtra name)-    >>= \case-      Right y -> let version = fromJust . simpleParsec $ y in return . Right $ (name, hRange, version, withinRange version hRange)-      Left _ -> return . Left $ (name, hRange)+lic :: PackageDescription -> PackageDescription -> Doc AnsiStyle+lic = diffTerm "License" (prettyShow . license)  lookupDiffExtra :: Members [ExtraEnv, WithMyErr] r => VersionedList -> VersionedList -> Sem r (Doc AnsiStyle) lookupDiffExtra va vb = do

@@ -1,34 +1,15 @@-{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ViewPatterns #-}  module Check (check) where -import Control.Monad (forM, unless)-import Data.List (find)-import qualified Data.Map.Strict as Map-import Data.Maybe (catMaybes)-import Distribution.ArchHs.ExtraDB-import Distribution.ArchHs.Core+import Control.Monad (forM) import Distribution.ArchHs.Exception-import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.Name import Distribution.ArchHs.PP-import Distribution.ArchHs.PkgDesc+import Distribution.ArchHs.RDepCheck import Distribution.ArchHs.Types -data DepSrc = Check | Make | Run-  deriving stock (Show, Eq, Ord)--instance Pretty DepSrc where-  pretty = \case-    Check -> "CheckDepends"-    Make -> "MakeDepends"-    Run -> "Depends"- check ::   Members     [ ExtraEnv,@@ -45,48 +26,17 @@   PackageName ->   Sem r Int check mVersion target = do-  let aTarget = toArchLinuxName target-  exists <- isInExtra aTarget-  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-  failures <- forM reverseDeps $ \(PkgDesc {..}, src) -> do-    eCabal <--      try @MyException $-        getCabal (toHackageName _name) =<< case simpleParsec _version of-          Just v -> pure v-          _ -> throw $ VersionNoParse _version-    case eCabal of-      Right cabal -> do-        result <- getDepVersion cabal target src-        let failedRanges = versionFailures mVersion result-        embed . putDoc $-          vsep-            ( annMagneta "Reverse dependency" <> colon-                <+> pretty (unArchLinuxName _name)-                : (rangeDocs result <> versionErrors mVersion failedRanges)-            )-            <> line-        pure $ length failedRanges-      Left e -> do-        printWarn $ "Skip" <+> pretty (unArchLinuxName _name) <> colon <+> viaShow e-        pure 0+  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]@@ -95,14 +45,6 @@     | (s, r) <- result   ] -versionFailures :: Maybe Version -> [(DepSrc, VersionRange)] -> [(DepSrc, VersionRange)]-versionFailures Nothing _ = []-versionFailures (Just version) result =-  [ (src, range)-    | (src, range) <- result,-      not $ withinRange version range-  ]- versionErrors :: Maybe Version -> [(DepSrc, VersionRange)] -> [Doc AnsiStyle] versionErrors Nothing _ = [] versionErrors (Just version) result =@@ -115,34 +57,3 @@         <+> parens (viaPretty range)     | (src, range) <- result   ]--getDepVersion ::-  Members-    [ KnownGHCVersion,-      FlagAssignmentsEnv,-      DependencyRecord,-      Trace-    ]-    r =>-  GenericPackageDescription ->-  PackageName ->-  [DepSrc] ->-  Sem r [(DepSrc, VersionRange)]-getDepVersion cabal name src = do-  (libDeps, libToolsDeps, _) <- collectLibDeps id cabal-  (subLibDeps, subLibToolsDeps, _) <- collectSubLibDeps id cabal []-  (exeDeps, exeToolsDeps, _) <- collectExeDeps id cabal []-  (testDeps, testToolsDeps, _) <- collectTestDeps id cabal []-  setupDeps <- collectSetupDeps id cabal-  let flatten = mconcat . fmap snd-      deps = libDeps <> concatMap flatten [exeDeps, subLibDeps]-      makeOrCheckDeps = libToolsDeps <> setupDeps <> concatMap flatten [subLibToolsDeps, exeToolsDeps, testDeps, testToolsDeps]-  pure $-    catMaybes-      [ case s of-          Check -> f makeOrCheckDeps-          Make -> f makeOrCheckDeps-          Run -> f deps-        | s <- src,-          let f xs = (_1 .~ s) <$> find ((== name) . fst) xs-      ]

@@ -27,6 +27,7 @@ import Data.Bifunctor (second) import Data.Containers.ListUtils (nubOrd) import qualified Data.Map as Map+import Data.List (sort) import Data.Maybe (fromMaybe) import Data.Set (Set) import qualified Data.Set as Set@@ -336,7 +337,7 @@                            || depIsKind Setup x                        )               )-      depsToString k deps = deps <&> (wrap . unArchLinuxName . toArchLinuxName . k) & mconcat+      depsToString k deps = (sort $ deps <&> (wrap . unArchLinuxName . toArchLinuxName . k)) & mconcat       _depends = depsToString _depName depends <> depsToString id sysDeps       _makeDepends = (if uusi then " 'uusi'" else "") <> depsToString _depName makeDepends       _url = getUrl cabal

@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Distribution.ArchHs.DepCheck+  ( DependencyFailure (..),+    VersionedList,+    dependencyFailures,+    directDependencies,+    inRange,+  )+where++import Distribution.ArchHs.Core+import Distribution.ArchHs.Exception+import Distribution.ArchHs.ExtraDB (versionInExtra)+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Types+import Distribution.ArchHs.Utils++type VersionedList = [(PackageName, VersionRange)]++data DependencyFailure+  = MissingDependency PackageName VersionRange+  | DependencyOutOfRange PackageName VersionRange Version++dependencyFailures ::+  Members [KnownGHCVersion, ExtraEnv, FlagAssignmentsEnv, WithMyErr, Trace, DependencyRecord] r =>+  GenericPackageDescription ->+  Sem r [DependencyFailure]+dependencyFailures cabal = do+  (depends, makedepends) <- directDependencies cabal+  concat <$> traverse dependencyFailure (depends <> makedepends)++dependencyFailure :: Members [ExtraEnv, WithMyErr] r => (PackageName, VersionRange) -> Sem r [DependencyFailure]+dependencyFailure dep =+  inRange dep <&> \case+    Left (name, range) -> [MissingDependency name range]+    Right (name, range, version, False) -> [DependencyOutOfRange name range version]+    Right _ -> []++directDependencies ::+  Members [KnownGHCVersion, FlagAssignmentsEnv, Trace, DependencyRecord] r =>+  GenericPackageDescription ->+  Sem r (VersionedList, VersionedList)+directDependencies cabal = do+  (libDeps, libToolsDeps, _) <- collectLibDeps id cabal+  (subLibDeps, subLibToolsDeps, _) <- collectSubLibDeps id cabal []+  (exeDeps, exeToolsDeps, _) <- collectExeDeps id cabal []+  (testDeps, testToolsDeps, _) <- collectTestDeps id cabal []+  setupDeps <- collectSetupDeps id cabal+  let flatten = mconcat . fmap snd+      l = libDeps+      lt = libToolsDeps+      sl = flatten subLibDeps+      slt = flatten subLibToolsDeps+      e = flatten exeDeps+      et = flatten exeToolsDeps+      t = flatten testDeps+      tt = flatten testToolsDeps+      mySubLibs = fmap (unqualComponentNameToPackageName . fst) subLibDeps+      notMyselfOrSubLib = (&&) <$> (/= getPkgName' cabal) <*> (`notElem` mySubLibs)+      distinct = filter (notMyselfOrSubLib . fst) . nub+      depends = distinct $ l <> sl <> e+      makedepends = distinct (lt <> slt <> et <> t <> tt <> setupDeps) \\ depends+      sort' = sortBy (\x y -> uncurry compare $ getTwo _1 x y)+  return (sort' depends, sort' makedepends)++inRange :: Members [ExtraEnv, WithMyErr] r => (PackageName, VersionRange) -> Sem r (Either (PackageName, VersionRange) (PackageName, VersionRange, Version, Bool))+inRange (name, hRange) =+  try @MyException (versionInExtra name)+    >>= \case+      Right rawVersion ->+        case simpleParsec rawVersion of+          Just version -> return . Right $ (name, hRange, version, withinRange version hRange)+          Nothing -> throw $ VersionNoParse rawVersion+      Left _ -> return . Left $ (name, hRange)

@@ -46,7 +46,7 @@ foreign import ccall "clib.h query_extra"   query_extra :: FunPtr (CString -> CString -> CString -> CString -> IO ()) -> FunPtr (CString -> CString -> CString -> CString -> IO ()) -> IO () -type RawPkgSet = IORef (Map.Map ArchLinuxName ((ArchLinuxVersion, String, String), IORef (Map.Map String [(ArchLinuxName, Maybe ArchLinuxVersion)])))+type RawPkgSet = IORef (Map.Map ArchLinuxName ((ArchLinuxVersion, ArchLinuxVersion, String, String), IORef (Map.Map String [(ArchLinuxName, Maybe ArchLinuxVersion)])))  pkgCallback :: RawPkgSet -> CString -> CString -> CString -> CString -> IO () pkgCallback ref name version desc url = do@@ -55,7 +55,7 @@   desc' <- peekCString desc   url' <- peekCString url   m <- newIORef Map.empty-  modifyIORef' ref (Map.insert (ArchLinuxName name') ((extractFromEVR version', desc', url'), m))+  modifyIORef' ref (Map.insert (ArchLinuxName name') ((extractFromEVR version', version', desc', url'), m))  listCallback :: RawPkgSet -> CString -> CString -> CString -> CString -> IO () listCallback ref name key dm dv = do@@ -78,7 +78,7 @@   s <- readIORef ref   re <-     mapM-      ( \(name, ((ver, desc, url), r)) -> do+      ( \(name, ((ver, rawVer, desc, url), r)) -> do           l <- readIORef r           let f (Just xs) = uncurry PkgDependent <$> xs               f Nothing = []@@ -87,6 +87,7 @@               PkgDesc                 { _name = name,                   _version = ver,+                  _rawVersion = rawVer,                   _desc = desc,                   _url = if null url then Nothing else Just url,                   _depends = f $ l Map.!? "depends",

@@ -12,6 +12,7 @@     insertDB,     parseCabalFile,     getLatestCabal,+    getNewerVersions,     getCabal,     getPackageFlag,     traverseHackage,@@ -108,6 +109,17 @@ -- | Get the latest 'GenericPackageDescription'. getLatestCabal :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r GenericPackageDescription getLatestCabal = withLatestVersion cabalFile++-- | Get all Hackage versions newer than the given version.+--+-- The parsed 'HackageDB' has already applied Hackage's preferred-version+-- range, which excludes deprecated versions.+getNewerVersions :: Members [HackageEnv, WithMyErr] r => PackageName -> Version -> Sem r [Version]+getNewerVersions name version = do+  db <- ask @HackageDB+  case Map.lookup name db of+    Just packageData -> return [hackageVersion | hackageVersion <- Map.keys packageData, hackageVersion > version]+    Nothing -> throw $ PkgNotFound name  -- | Get the latest SHA256 sum of the tarball . getLatestSHA256 :: Members [HackageEnv, WithMyErr] r => PackageName -> Sem r (Maybe String)

@@ -577,8 +577,8 @@   pkgname=$pkgname   pkgver=$pkgver   pkgrel=1-  pkgdesc="$pkgdesc"-  url="$url"+  pkgdesc='${pkgdesc}'+  url='${url}'   license=("$license")   arch=('x86_64')   depends=('ghc-libs'$depends)

@@ -53,6 +53,7 @@       PkgDesc         { _name = _pdName,           _version = ver,+          _rawVersion = ver,           _desc = "",           _url = Nothing,           _provides = [],@@ -91,7 +92,8 @@ parseDescEntry :: T.Text -> Maybe PkgDesc parseDescEntry txt = do   _name <- ArchLinuxName . T.unpack <$> lookupSingle "NAME"-  _version <- extractFromEVR . T.unpack <$> lookupSingle "VERSION"+  _rawVersion <- T.unpack <$> lookupSingle "VERSION"+  let _version = extractFromEVR _rawVersion   _desc <- T.unpack <$> lookupSingle "DESC"   _depends <- toDepList $ lookupList "DEPENDS"   _makeDepends <- toDepList $ lookupList "MAKEDEPENDS"

@@ -0,0 +1,161 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-}++module Distribution.ArchHs.RDepCheck+  ( DepSrc (..),+    ReverseDep (..),+    SkippedReverseDep (..),+    prettySkippedReverseDep,+    reverseDependencyRanges,+    reverseDependencyRangesWithSkips,+    versionFailures,+  )+where++import Control.Monad (forM, unless)+import Data.Either (partitionEithers)+import Data.List (find)+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes)+import Distribution.ArchHs.Core+import Distribution.ArchHs.Exception+import Distribution.ArchHs.ExtraDB+import Distribution.ArchHs.Hackage+import Distribution.ArchHs.Internal.Prelude+import Distribution.ArchHs.Name+import Distribution.ArchHs.PkgDesc+import Distribution.ArchHs.PP+import Distribution.ArchHs.Types++data DepSrc = Check | Make | Run+  deriving stock (Show, Eq, Ord)++instance Pretty DepSrc where+  pretty = \case+    Check -> "CheckDepends"+    Make -> "MakeDepends"+    Run -> "Depends"++data ReverseDep = ReverseDep+  { reverseDepName :: ArchLinuxName,+    reverseDepRanges :: [(DepSrc, VersionRange)]+  }++data SkippedReverseDep = SkippedReverseDep+  { skippedReverseDepName :: ArchLinuxName,+    skippedReverseDepError :: MyException+  }++prettySkippedReverseDep :: SkippedReverseDep -> Doc AnsiStyle+prettySkippedReverseDep SkippedReverseDep {..} =+  "Skip" <+> pretty (unArchLinuxName skippedReverseDepName) <> colon <+> viaShow skippedReverseDepError++reverseDependencyRanges ::+  Members+    [ ExtraEnv,+      HackageEnv,+      KnownGHCVersion,+      FlagAssignmentsEnv,+      Trace,+      DependencyRecord,+      WithMyErr,+      Embed IO+    ]+    r =>+  PackageName ->+  Sem r [ReverseDep]+reverseDependencyRanges target = do+  (reverseDeps, skipped) <- reverseDependencyRangesWithSkips target+  mapM_ (printWarn . prettySkippedReverseDep) skipped+  pure reverseDeps++reverseDependencyRangesWithSkips ::+  Members+    [ ExtraEnv,+      HackageEnv,+      KnownGHCVersion,+      FlagAssignmentsEnv,+      Trace,+      DependencyRecord,+      WithMyErr,+      Embed IO+    ]+    r =>+  PackageName ->+  Sem r ([ReverseDep], [SkippedReverseDep])+reverseDependencyRangesWithSkips target = do+  let aTarget = toArchLinuxName target+  exists <- isInExtra aTarget+  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+  results <-+    forM reverseDeps $ \(PkgDesc {..}, src) -> do+      eCabal <-+        try @MyException $+          getCabal (toHackageName _name) =<< case simpleParsec _version of+            Just v -> pure v+            _ -> throw $ VersionNoParse _version+      case eCabal of+        Right cabal -> Right . ReverseDep _name <$> getDepVersion cabal target src+        Left e -> pure . Left $ SkippedReverseDep _name e+  pure $ case partitionEithers results of+    (skipped, reverseDeps') -> (reverseDeps', skipped)++versionFailures :: Maybe Version -> [(DepSrc, VersionRange)] -> [(DepSrc, VersionRange)]+versionFailures Nothing _ = []+versionFailures (Just version) result =+  [ (src, range)+    | (src, range) <- result,+      not $ withinRange version range+  ]++getDepVersion ::+  Members+    [ KnownGHCVersion,+      FlagAssignmentsEnv,+      DependencyRecord,+      Trace+    ]+    r =>+  GenericPackageDescription ->+  PackageName ->+  [DepSrc] ->+  Sem r [(DepSrc, VersionRange)]+getDepVersion cabal name src = do+  (libDeps, libToolsDeps, _) <- collectLibDeps id cabal+  (subLibDeps, subLibToolsDeps, _) <- collectSubLibDeps id cabal []+  (exeDeps, exeToolsDeps, _) <- collectExeDeps id cabal []+  (testDeps, testToolsDeps, _) <- collectTestDeps id cabal []+  setupDeps <- collectSetupDeps id cabal+  let flatten = mconcat . fmap snd+      deps = libDeps <> concatMap flatten [exeDeps, subLibDeps]+      makeOrCheckDeps = libToolsDeps <> setupDeps <> concatMap flatten [subLibToolsDeps, exeToolsDeps, testDeps, testToolsDeps]+  pure $+    catMaybes+      [ case s of+          Check -> f makeOrCheckDeps+          Make -> f makeOrCheckDeps+          Run -> f deps+        | s <- src,+          let f xs = (_1 .~ s) <$> find ((== name) . fst) xs+      ]

@@ -82,6 +82,7 @@ data PkgDesc = PkgDesc   { _name :: ArchLinuxName,     _version :: ArchLinuxVersion,+    _rawVersion :: ArchLinuxVersion,     _desc :: String,     _url :: Maybe String,     _provides :: PkgDependentList,

@@ -48,14 +48,18 @@  ----------------------------------------------------------------------------- -newtype CheckOptions = CheckOptions-  { optShowGHCLibs :: Bool+data CheckOptions = CheckOptions+  { optShowGHCLibs :: Bool,+    optDepCheck :: Bool,+    optVerbose :: Bool   }  checkOptionsParser :: Parser CheckOptions checkOptionsParser =   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")  ----------------------------------------------------------------------------- @@ -91,7 +95,7 @@           (Submit <$> commonOptionsParser <*> submitOptionsParser)         addCommand           "check"-          "check inconsistencies of Haskell packages version"+          "check newer Hackage versions for Haskell packages in [extra]"           id           (Check <$> commonOptionsParser <*> checkOptionsParser)         addCommand

@@ -1,46 +1,210 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  module Check (check) where -import Data.Maybe (maybeToList)+import Control.Monad (forM)+import qualified Data.Map.Strict as Map+import Distribution.ArchHs.DepCheck import Distribution.ArchHs.Exception+import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Name (isGHCLibs) import Distribution.ArchHs.PP+import Distribution.ArchHs.RDepCheck import Distribution.ArchHs.Types-import Distribution.Package (packageName, packageVersion)+import Distribution.Package (packageName) import Utils -check :: Members [HackageEnv, ExtraEnv, WithMyErr, Embed IO] r => Bool -> Sem r ()-check includeGHC = do-  linked <- linkedHaskellPackages-  let result =-        [ annMagneta (pretty (unArchLinuxName archName))-            <+> "in"-            <+> ppExtra-            <+> "has version"-            <+> (if isHackageNewer then annRed else annGreen)-              (viaPretty archVersion)-            <> comma-              <+> "but linked"-              <+> annMagneta (pretty (unPackageName hackageName))-              <+> "in"-              <+> annCyan "Hackage"-              <+> "has"-              <+> (if isHackageNewer then "a newer" else "an older")-              <+> "version"-              <+> (if isHackageNewer then annGreen else annRed)-                (viaPretty hackageVersion)-          | (archName, rawArchVersion, cabal) <- linked,-            let hackageName = packageName cabal-                hackageVersion = packageVersion cabal,-            includeGHC || not (isGHCLibs hackageName),-            archVersion <- maybeToList $ simpleParsec rawArchVersion,-            archVersion /= hackageVersion,-            let isHackageNewer = hackageVersion > archVersion-        ]+data NewerVersion = NewerVersion Version (Maybe CheckResult)++data CheckResult = CheckResult+  { depFailures :: [DependencyFailure],+    rdepFailures :: [ReverseDependencyFailure]+  }++data ReverseDependencyFailure = ReverseDependencyFailure ArchLinuxName DepSrc VersionRange++check ::+  Members+    [ HackageEnv,+      ExtraEnv,+      KnownGHCVersion,+      FlagAssignmentsEnv,+      Trace,+      DependencyRecord,+      WithMyErr,+      Embed IO+    ]+    r =>+  Bool ->+  Bool ->+  Bool ->+  Sem r ()+check includeGHC runDepCheck verbose = do+  linked <- linkedHaskellPackageDescs+  checked <-+    traverse+      ( \(archName, desc, cabal) -> do+          let hackageName = packageName cabal+              rawArchVersion = _version desc+          case simpleParsec rawArchVersion of+            Just archVersion+              | includeGHC || not (isGHCLibs hackageName) -> do+                  hackageVersions <- getNewerVersions hackageName archVersion+                  if null hackageVersions+                    then pure ([], [])+                    else do+                      (newerVersions, skipped) <- checkNewerVersions runDepCheck hackageName hackageVersions+                      pure ([prettyNewerVersions verbose archName (_rawVersion desc) hackageName archVersion newerVersions], skipped)+            _ -> pure ([], [])+      )+      linked+  let result = concatMap fst checked+      skipped = uniqueSkippedReverseDeps $ concatMap snd checked+  mapM_ (printWarn . prettySkippedReverseDep) skipped   if null result     then printSuccess "Finished checking"     else do       printWarn "Finished checking with inconsistenc(ies):"       embed $ putDoc $ vcat result <> line++checkNewerVersions ::+  Members+    [ ExtraEnv,+      HackageEnv,+      KnownGHCVersion,+      FlagAssignmentsEnv,+      Trace,+      DependencyRecord,+      WithMyErr,+      Embed IO+    ]+    r =>+  Bool ->+  PackageName ->+  [Version] ->+  Sem r ([NewerVersion], [SkippedReverseDep])+checkNewerVersions False _ hackageVersions =+  pure ((\hackageVersion -> NewerVersion hackageVersion Nothing) <$> hackageVersions, [])+checkNewerVersions True hackageName 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+                }+          )+  pure (newerVersions, skipped)++uniqueSkippedReverseDeps :: [SkippedReverseDep] -> [SkippedReverseDep]+uniqueSkippedReverseDeps =+  Map.elems+    . Map.fromList+    . fmap+      ( \skipped ->+          ( (skippedReverseDepName skipped, show $ skippedReverseDepError skipped),+            skipped+          )+      )++rdepFailureDetails :: Version -> [ReverseDep] -> [ReverseDependencyFailure]+rdepFailureDetails version reverseDeps =+  [ ReverseDependencyFailure name src range+    | ReverseDep name ranges <- reverseDeps,+      (src, range) <- versionFailures (Just version) ranges+    ]++prettyNewerVersions :: Bool -> ArchLinuxName -> ArchLinuxVersion -> PackageName -> Version -> [NewerVersion] -> Doc AnsiStyle+prettyNewerVersions verbose archName rawArchVersion hackageName archVersion hackageVersions =+  base <> verboseDetails+  where+    base =+      annMagneta (pretty (unArchLinuxName archName))+        <+> "in"+        <+> ppExtra+        <+> "has version"+        <+> prettyArchVersion rawArchVersion archVersion+        <> comma+          <+> "but linked"+          <+> annMagneta (pretty (unPackageName hackageName))+          <+> "in"+          <+> annCyan "Hackage"+          <+> (if length hackageVersions == 1 then "has newer version" else "has newer versions")+          <+> hsep (punctuate comma $ prettyNewerVersion <$> hackageVersions)++    verboseDetails =+      case concatMap prettyVerboseNewerVersion hackageVersions of+        details | verbose && not (null details) -> line <> indent 2 (vsep details)+        _ -> mempty++prettyArchVersion :: ArchLinuxVersion -> Version -> Doc AnsiStyle+prettyArchVersion rawVersion archVersion =+  annRed (viaPretty archVersion) <> maybe mempty (annBlue . pretty) (pkgrelSuffix rawVersion)++pkgrelSuffix :: ArchLinuxVersion -> Maybe String+pkgrelSuffix rawVersion =+  case splitOn "-" withoutEpoch of+    _ : pkgrelParts@(_ : _) -> Just $ "-" <> intercalate "-" pkgrelParts+    _ -> Nothing+  where+    withoutEpoch =+      case splitOn ":" rawVersion of+        [_epoch, versionRelease] -> versionRelease+        _ -> rawVersion++prettyNewerVersion :: NewerVersion -> Doc AnsiStyle+prettyNewerVersion (NewerVersion version Nothing) = annGreen $ viaPretty version+prettyNewerVersion (NewerVersion version (Just CheckResult {depFailures = [], rdepFailures = []})) =+  annGreen $ viaPretty version <+> parens "ok"+prettyNewerVersion (NewerVersion version (Just failures)) =+  annRed $ viaPretty version <+> parens ("blocked:" <+> prettyCheckFailures failures)++prettyCheckFailures :: CheckResult -> Doc AnsiStyle+prettyCheckFailures CheckResult {..} =+  hsep . punctuate comma $+    ["dep=" <> pretty (length depFailures) | not (null depFailures)]+      <> ["rdep=" <> pretty (length rdepFailures) | not (null rdepFailures)]++prettyVerboseNewerVersion :: NewerVersion -> [Doc AnsiStyle]+prettyVerboseNewerVersion (NewerVersion _ Nothing) = []+prettyVerboseNewerVersion (NewerVersion _ (Just CheckResult {depFailures = [], rdepFailures = []})) = []+prettyVerboseNewerVersion (NewerVersion version (Just CheckResult {..})) =+  (viaPretty version <> colon)+    : fmap (indent 2 . prettyDependencyFailure) depFailures+      <> fmap (indent 2 . prettyReverseDependencyFailure) rdepFailures++prettyDependencyFailure :: DependencyFailure -> Doc AnsiStyle+prettyDependencyFailure = \case+  MissingDependency name range ->+    annRed "dep:"+      <+> viaPretty name+      <+> "requires"+      <+> viaPretty range+      <> comma+      <+> ppExtra+      <+> "missing"+  DependencyOutOfRange name range version ->+    annRed "dep:"+      <+> viaPretty name+      <+> "requires"+      <+> viaPretty range+      <> comma+      <+> ppExtra+      <+> "has"+      <+> viaPretty version++prettyReverseDependencyFailure :: ReverseDependencyFailure -> Doc AnsiStyle+prettyReverseDependencyFailure (ReverseDependencyFailure name src range) =+  annRed "rdep:"+    <+> pretty (unArchLinuxName name)+    <+> pretty src+    <+> "requires"+    <+> viaPretty range

@@ -9,6 +9,7 @@ import Check import Control.Monad (unless) import qualified Data.Map.Strict as Map+import Distribution.ArchHs.Core (subsumeGHCVersion) import Distribution.ArchHs.Exception import Distribution.ArchHs.Hackage import Distribution.ArchHs.Internal.Prelude@@ -29,15 +30,23 @@   ExtraDB ->   HackageDB ->   Bool ->+  Bool ->+  Bool ->   IO (Either MyException ())-runCheck extra hackage includeGHC =+runCheck extra hackage includeGHC runDepCheck verbose =   ( runFinal       . embedToFinal @IO       . errorToIOFinal+      . evalState (Map.empty :: Map.Map PackageName [VersionRange])+      . ignoreTrace+      . runReader (Map.empty :: FlagAssignments)       . runReader hackage       . runReader extra   )-    (check includeGHC)+    ( if runDepCheck+        then subsumeGHCVersion $ check includeGHC runDepCheck verbose+        else runReader nullVersion $ check includeGHC runDepCheck verbose+    )  runSubmit ::   ExtraDB ->@@ -85,7 +94,7 @@   Check CommonOptions {..} CheckOptions {..} -> do     extra <- loadExtraDBFromOptions optExtraDB     hackage <- loadHackageDBFromOptions optHackage-    runCheck extra hackage optShowGHCLibs & printAppResult+    runCheck extra hackage optShowGHCLibs optDepCheck optVerbose & printAppResult   List ExtraDBOptions {..} ListOptions {..} -> do     extra <- loadExtraDBFromOptions     putStrLn $

@@ -3,6 +3,7 @@  module Utils   ( linkedHaskellPackages,+    linkedHaskellPackageDescs,   ) where @@ -18,13 +19,19 @@ linkedHaskellPackages ::   Members [ExtraEnv, HackageEnv, WithMyErr, Embed IO] r =>   Sem r [(ArchLinuxName, ArchLinuxVersion, GenericPackageDescription)]-linkedHaskellPackages = do+linkedHaskellPackages =+  fmap (\(name, desc, cabal) -> (name, _version desc, cabal)) <$> linkedHaskellPackageDescs++linkedHaskellPackageDescs ::+  Members [ExtraEnv, HackageEnv, WithMyErr, Embed IO] r =>+  Sem r [(ArchLinuxName, PkgDesc, GenericPackageDescription)]+linkedHaskellPackageDescs = do   extraHaskellPackages <- filter (isHaskellPackage . fst) . Map.toList <$> ask @ExtraDB   hackagePackages <- Map.keys <$> ask @HackageDB   let go xs ys ((name, desc) : pkgs) =         let hName = toHackageName name          in if hName `elem` hackagePackages-              then getLatestCabal hName >>= \cabal -> go ((name, _version desc, cabal) : xs) ys pkgs+              then getLatestCabal hName >>= \cabal -> go ((name, desc, cabal) : xs) ys pkgs               else go xs (name : ys) pkgs       go xs ys [] = pure (xs, ys)   (linked, unlinked) <- go [] [] extraHaskellPackages

@@ -0,0 +1,148 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeApplications #-}++module Main (main) where++import Control.Monad (forM_)+import Data.List (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.Name (isGHCLibs, isHaskellPackage, toHackageName)+import Distribution.ArchHs.Types+import Distribution.Parsec (simpleParsec)+import Distribution.Types.PackageName (PackageName, unPackageName)+import Distribution.Types.Version (Version)+import Distribution.Types.VersionRange (VersionRange, anyVersion)+import Polysemy (run)+import Polysemy.Error (runError)+import Polysemy.Reader (runReader)+import Submit.CSV+import System.Directory (doesFileExist)+import Test.Hspec++main :: IO ()+main = hspec $ do+  describe "live pacman extra database" $ do+    it "loads current extra.db and finds parseable Haskell package metadata" $ do+      extra <- loadLiveExtraDB+      samples <- requireHaskellSamples extra++      forM_ samples $ \(archName, desc@PkgDesc {_version}) -> do+        _name desc `shouldBe` archName+        _version `shouldSatisfy` not . null+        unPackageName (toHackageName archName) `shouldSatisfy` not . null+        archName `shouldSatisfy` isHaskellPackage++    it "keeps raw Arch EVR for a real Haskell package with pkgrel" $ do+      extra <- loadLiveExtraDB+      (_, PkgDesc {_version, _rawVersion}) <- requireHaskellPackage extra+      _rawVersion `shouldSatisfy` (_version `isPrefixOf`)+      drop (length _version) _rawVersion `shouldSatisfy` isPkgrelSuffix++    it "renders Hackage distro CSV rows from current extra.db and parses them back" $ do+      extra <- loadLiveExtraDB+      let rows = take 20 $ liveDistroRows extra+      rows `shouldSatisfy` not . null+      parseDistroCSV (renderDistroCSV rows) `shouldBe` rows++  describe "diff dependency range checks" $ do+    it "uses a live extra.db version when checking a Hackage dependency range" $ do+      extra <- loadLiveExtraDB+      (hackageName, expectedVersion) <- requireParseableHackagePackage extra++      case runInRange extra hackageName anyVersion of+        Right (Right (actualName, _, actualVersion, inBounds)) -> do+          actualName `shouldBe` hackageName+          actualVersion `shouldBe` expectedVersion+          inBounds `shouldBe` True+        result ->+          expectationFailure $ "expected successful range check, got: " <> show result++    it "reports a malformed live package version as VersionNoParse instead of crashing" $ do+      extra <- loadLiveExtraDB+      (archName, desc) <- requireHaskellPackage extra+      let hackageName = toHackageName archName+          badVersion = _version desc <> "_not_cabal"+          poisonedExtra = Map.insert archName (desc {_version = badVersion}) extra++      case runInRange poisonedExtra hackageName anyVersion of+        Left (VersionNoParse rawVersion) ->+          rawVersion `shouldBe` badVersion+        result ->+          expectationFailure $ "expected VersionNoParse, got: " <> show result++loadLiveExtraDB :: IO ExtraDB+loadLiveExtraDB = do+  exists <- doesFileExist defaultExtraDBPath+  if exists+    then loadExtraDB defaultExtraDBPath+    else skip $ "pacman database not found: " <> defaultExtraDBPath++requireHaskellSamples :: ExtraDB -> IO [(ArchLinuxName, PkgDesc)]+requireHaskellSamples extra = do+  let samples = take 20 . sortOn (unArchLinuxName . fst) $ haskellPackages extra+  if null samples+    then skip "current extra.db has no Haskell packages"+    else pure samples++requireHaskellPackage :: ExtraDB -> IO (ArchLinuxName, PkgDesc)+requireHaskellPackage extra =+  case listToMaybe $ haskellPackages extra of+    Just sample -> pure sample+    Nothing -> skip "current extra.db has no Haskell packages"++requireParseableHackagePackage :: ExtraDB -> IO (PackageName, Version)+requireParseableHackagePackage extra =+  case listToMaybe $ parseableHaskellPackages extra of+    Just sample -> pure sample+    Nothing -> skip "current extra.db has no Haskell packages with Cabal-style versions"++isPkgrelSuffix :: String -> Bool+isPkgrelSuffix ('-' : rest) = not (null rest)+isPkgrelSuffix _ = False++haskellPackages :: ExtraDB -> [(ArchLinuxName, PkgDesc)]+haskellPackages =+  filter (isHaskellPackage . fst) . Map.toList++parseableHaskellPackages :: ExtraDB -> [(PackageName, Version)]+parseableHaskellPackages =+  mapMaybe+    ( \(archName, PkgDesc {_version}) ->+        case simpleParsec _version of+          Just version -> Just (toHackageName archName, version)+          Nothing -> Nothing+    )+    . haskellPackages++liveDistroRows :: ExtraDB -> DistroCSV+liveDistroRows =+  sortOn+    (\(name, _, _) -> name)+    . fmap toRow+    . haskellPackages+  where+    toRow (archName, PkgDesc {_version}) =+      ( unPackageName hackageName,+        _version,+        "https://archlinux.org/packages/extra/x86_64/" <> packagePath hackageName archName+      )+      where+        hackageName = toHackageName archName++    packagePath hackageName archName+      | isGHCLibs hackageName = "ghc"+      | otherwise = unArchLinuxName archName++runInRange :: ExtraDB -> PackageName -> VersionRange -> Either MyException (Either (PackageName, VersionRange) (PackageName, VersionRange, Version, Bool))+runInRange extra name range =+  run+    . runError @MyException+    . runReader extra+    $ inRange (name, range)++skip :: String -> IO a+skip reason = pendingWith reason >> error "unreachable"