diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +## 0.2 + +* Overhaul the API. + ## 0.1.1 * Replace dependency on `cabal-install-parsers` with `cabal-install` proper. diff --git a/app/History.hs b/app/History.hs --- a/app/History.hs +++ b/app/History.hs @@ -5,19 +5,19 @@ main, ) where -import Data.ByteString.Char8 qualified as B import Data.Foldable (for_) import Data.List qualified as L import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map.Strict qualified as M +import Data.Set qualified as S import Data.Time (Day, UTCTime (..), addDays, getCurrentTime) import Distribution.Client.Config (loadConfig, savedGlobalFlags) import Distribution.Client.GlobalFlags (globalCacheDir) import Distribution.Simple.Flag (fromFlag) -import Distribution.Types.PackageName (PackageName, unPackageName) -import Hackage.RevDeps (extractDependencies, latestReleases) -import Options.Applicative (Parser, auto, execParser, fullDesc, help, helper, info, long, metavar, option, progDesc, showDefault, strArgument, value) +import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName) +import Hackage.RevDeps (getReverseDependencies, getTransitiveReverseDependencies) +import Options.Applicative (Parser, auto, execParser, fullDesc, help, helper, info, long, metavar, option, progDesc, showDefault, strArgument, switch, value) import Options.Applicative.NonEmpty (some1) import System.Console.ANSI (hSupportsANSI, hyperlinkCode) import System.FilePath (()) @@ -28,6 +28,7 @@ , cnfFinish :: !Day , cnfStep :: !Word , cnfPackageNames :: !(NonEmpty PackageName) + , cnfTransitive :: !Bool } parseArgs :: Day -> Parser Config @@ -55,6 +56,10 @@ strArgument $ metavar "PKGS" <> help "Package names to scan Hackage for their reverse dependencies" + cnfTransitive <- + switch $ + long "transitive" + <> help "Count transitive (both direct and indirect) dependencies" pure Config {..} main :: IO () @@ -72,11 +77,11 @@ let cacheDir = fromFlag $ globalCacheDir $ savedGlobalFlags cnf idx = cacheDir hackageHaskellOrg "01-index.tar" putStrLn $ unwords $ "Date " : map (showPackage supportsAnsi) args - let needles = map (B.pack . unPackageName) args for_ dates $ \date -> do - releases <- latestReleases needles idx (Just $ UTCTime date 0) - let pkgs = fmap (extractDependencies args) releases - pkgs' = M.mapWithKey M.delete pkgs + let utcTime = Just $ UTCTime date 0 + func = if cnfTransitive then getTransitiveReverseDependencies else getReverseDependencies + pkgs <- func (S.fromList args) idx utcTime + let pkgs' = M.delete (mkPackageName "acme-everything") pkgs counters = M.unionsWith (+) $ fmap (fmap (const (1 :: Int))) pkgs' putStrLn $ unwords $ show date : map (\pkg -> showPair (pkg, M.findWithDefault 0 pkg counters)) args diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -5,11 +5,12 @@ main, ) where -import Data.ByteString.Char8 qualified as B import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) import Data.Map.Strict qualified as M +import Data.Set (Set) +import Data.Set qualified as S import Data.Time (Day, UTCTime (..)) import Distribution.Client.Config (loadConfig, savedGlobalFlags) import Distribution.Client.GlobalFlags (globalCacheDir) @@ -18,10 +19,10 @@ import Distribution.Simple.Flag (fromFlag) import Distribution.Types.Dependency (Dependency (..)) import Distribution.Types.LibraryName (LibraryName (..)) -import Distribution.Types.PackageName (PackageName, unPackageName) +import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName) import Distribution.Types.VersionRange (VersionRange) -import Hackage.RevDeps (extractDependencies, latestReleases) -import Options.Applicative (Parser, ReadM, auto, execParser, fullDesc, help, helper, info, long, metavar, option, optional, progDesc, strArgument) +import Hackage.RevDeps (getReverseDependencies, getTransitiveReverseDependencies) +import Options.Applicative (Parser, ReadM, auto, execParser, fullDesc, help, helper, info, long, metavar, option, optional, progDesc, strArgument, switch) import Options.Applicative.NonEmpty (some1) import System.Console.ANSI (hSupportsANSI, hyperlinkCode) import System.FilePath (()) @@ -30,6 +31,7 @@ data Config = Config { cnfIndexState :: !(Maybe UTCTime) , cnfPackageNames :: !(NonEmpty PackageName) + , cnfTransitive :: !Bool } parseArgs :: Parser Config @@ -44,6 +46,10 @@ strArgument $ metavar "PKGS" <> help "Package names to scan Hackage for their reverse dependencies" + cnfTransitive <- + switch $ + long "transitive" + <> help "Count transitive (both direct and indirect) dependencies" pure Config {..} main :: IO () @@ -52,19 +58,17 @@ Config {..} <- execParser $ info (helper <*> parseArgs) (fullDesc <> progDesc desc) - let args = NE.toList cnfPackageNames + let args = S.fromList $ NE.toList cnfPackageNames cnf <- loadConfig minBound mempty let cacheDir = fromFlag $ globalCacheDir $ savedGlobalFlags cnf idx = cacheDir hackageHaskellOrg "01-index.tar" - needles = map (B.pack . unPackageName) args - releases <- latestReleases needles idx cnfIndexState - let pkgs = fmap (extractDependencies args) releases - pkgs' = M.mapWithKey M.delete pkgs - report $ M.filter (not . null) pkgs' + func = if cnfTransitive then getTransitiveReverseDependencies else getReverseDependencies + pkgs <- func args idx cnfIndexState + report args $ M.delete (mkPackageName "acme-everything") pkgs -report :: Map PackageName (Map PackageName VersionRange) -> IO () -report pkgs +report :: Set PackageName -> Map PackageName (Map PackageName VersionRange) -> IO () +report args pkgs | M.null pkgs = putStrLn "No reverse dependencies found" | otherwise = do supportsAnsi <- hSupportsANSI stdout @@ -73,7 +77,10 @@ pkgs' = fmap (map prettify . M.toAscList) pkgs reportTable supportsAnsi pkgs' putStrLn "Total count:" - let counters = M.unionsWith (+) $ fmap (fmap (const (1 :: Int))) pkgs + let counters = + flip M.restrictKeys args $ + M.unionsWith (+) $ + fmap (fmap (const (1 :: Int))) pkgs reportTable supportsAnsi counters reportTable :: Show v => Bool -> Map PackageName v -> IO () diff --git a/hackage-revdeps.cabal b/hackage-revdeps.cabal --- a/hackage-revdeps.cabal +++ b/hackage-revdeps.cabal @@ -1,13 +1,12 @@ cabal-version: 2.2 name: hackage-revdeps -version: 0.1.1 +version: 0.2 license: BSD-3-Clause license-file: LICENSE maintainer: andrew.lelechenko@gmail.com author: Bodigrim tested-with: - ghc ==9.12.2 ghc ==9.10.1 ghc ==9.8.4 ghc ==9.6.7 ghc ==9.4.8 - ghc ==9.2.8 + ghc ==9.12.2 ghc ==9.10.2 ghc ==9.8.4 ghc ==9.6.7 ghc ==9.4.8 synopsis: List Hackage reverse dependencies description: @@ -28,9 +27,6 @@ type: git location: https://github.com/Bodigrim/hackage-revdeps.git -flag cabal-syntax - default: False - library exposed-modules: Hackage.RevDeps hs-source-dirs: src @@ -38,19 +34,14 @@ ghc-options: -Wall -Wunused-packages build-depends: alfred-margaret >=2.0 && <2.2, - base >=4.16 && <5, + base >=4.17 && <5, bytestring <0.13, - containers <0.9, + containers >=0.5.8 && <0.9, filepath <1.6, tar <0.7, text >=2.0 && <2.2, - time <1.15 - - if flag(cabal-syntax) - build-depends: Cabal-syntax >=3.8 && <3.15 - - else - build-depends: Cabal <3.7 + time <1.16, + Cabal-syntax >=3.8 && <3.17 executable hackage-revdeps main-is: Main.hs @@ -60,15 +51,14 @@ build-depends: base, ansi-terminal >=0.11.3 && <1.2, - bytestring, - cabal-install >=3.8 && <3.15, + cabal-install >=3.8 && <3.17, containers, filepath, hackage-revdeps, - optparse-applicative >=0.16 && <0.19, - time <1.15, - Cabal-syntax >=3.8 && <3.15, - Cabal >=3.8 && <3.15 + optparse-applicative >=0.16 && <0.20, + time <1.16, + Cabal-syntax >=3.8 && <3.17, + Cabal >=3.8 && <3.17 executable hackage-revdeps-history main-is: History.hs @@ -78,12 +68,11 @@ build-depends: base, ansi-terminal >=0.11.3 && <1.2, - bytestring, - cabal-install >=3.8 && <3.15, + cabal-install >=3.8 && <3.17, containers, filepath, hackage-revdeps, - optparse-applicative >=0.16 && <0.19, - time <1.15, - Cabal-syntax >=3.8 && <3.15, - Cabal >=3.8 && <3.15 + optparse-applicative >=0.16 && <0.20, + time <1.16, + Cabal-syntax >=3.8 && <3.17, + Cabal >=3.8 && <3.17 diff --git a/src/Hackage/RevDeps.hs b/src/Hackage/RevDeps.hs --- a/src/Hackage/RevDeps.hs +++ b/src/Hackage/RevDeps.hs @@ -1,19 +1,26 @@ -- | Functions to list Hackage reverse dependencies. module Hackage.RevDeps ( - latestReleases, + lastVersions, + allLastVersions, extractDependencies, + getReverseDependencies, + getTransitiveReverseDependencies, ) where import Codec.Archive.Tar qualified as Tar import Codec.Archive.Tar.Entry qualified as Tar import Control.Exception (throwIO) import Data.ByteString (ByteString) +import Data.ByteString.Char8 qualified as B import Data.ByteString.Lazy qualified as BL -import Data.Char (isPunctuation, isSpace) +import Data.Char (isPunctuation, isSpace, ord) +import Data.Foldable (fold) import Data.List (isSuffixOf) import Data.Map.Strict (Map) import Data.Map.Strict qualified as M import Data.Maybe (mapMaybe) +import Data.Set (Set) +import Data.Set qualified as S import Data.Text (Text) import Data.Text qualified as T import Data.Text.AhoCorasick.Automaton qualified as Aho @@ -26,22 +33,22 @@ import Distribution.Types.BuildInfo (targetBuildDepends) import Distribution.Types.BuildInfo.Lens qualified as Lens import Distribution.Types.Dependency (Dependency (..)) -import Distribution.Types.PackageName (PackageName, mkPackageName) +import Distribution.Types.PackageName (PackageName, mkPackageName, unPackageName) import Distribution.Types.VersionRange (VersionRange) -import Distribution.Version (intersectVersionRanges, simplifyVersionRange) +import Distribution.Version (Version, intersectVersionRanges, mkVersion, simplifyVersionRange) import System.FilePath (isPathSeparator) -- | Scan Cabal index @01-index.tar@ and return Cabal files --- of latest releases / revisions (not necessarily largest versions), which +-- of last versions (not necessarily latest releases or revisions), which -- contain one of the needles as an entire word (separated by spaces -- or punctuation). -- --- To avoid ambiguity: we first select the latest releases, +-- To avoid ambiguity: we first select the last versions, -- then filter them by needles. -- --- @since 0.1 -latestReleases - :: [ByteString] +-- @since 0.2 +lastVersions + :: Set ByteString -- ^ Needles to search in Cabal files. -> FilePath -- ^ Path to @01-index.tar@. @@ -50,25 +57,39 @@ -> Maybe UTCTime -- ^ Timestamp of index state at which to stop scanning. -> IO (Map PackageName ByteString) - -- ^ Map from latest releases to their Cabal files. -latestReleases needles idx indexState = - M.filter (containsAnyAsWholeWord machine . decodeUtf8Lenient) - <$> allLatestReleases idx indexState + -- ^ Map from packages with largest versions to their Cabal files. +lastVersions needles idx indexState = + filterByNeedles needles <$> allLastVersions idx indexState + +filterByNeedles + :: Set ByteString + -> Map k ByteString + -> Map k ByteString +filterByNeedles needles = M.filter (containsAnyAsWholeWord machine . decodeUtf8Lenient) where - machine = Aho.build (map ((\x -> (x, x)) . decodeUtf8Lenient) needles) + machine = Aho.build (map ((\x -> (x, x)) . decodeUtf8Lenient) (S.toList needles)) -- | Scan Cabal index @01-index.tar@ and return Cabal files --- of latest releases / revisions (not necessarily largest versions). -allLatestReleases +-- of last versions (not necessarily latest releases or revisions). +-- +-- @since 0.2 +allLastVersions :: FilePath -> Maybe UTCTime -> IO (Map PackageName ByteString) -allLatestReleases idx indexState = foldCabalFilesInIndex idx indexState mempty M.insert +allLastVersions idx indexState = + fmap (fmap snd) $ + foldCabalFilesInIndex idx indexState mempty go + where + go pkg ver cnt = M.alter (Just . f) pkg + where + new = (ver, cnt) + f = maybe new (\old@(ver', _) -> if ver' <= ver then new else old) containsAnyAsWholeWord :: Aho.AcMachine Text -> Text -> Bool containsAnyAsWholeWord machine hay = Aho.runText False go machine hay where - isWordBoundary c = isSpace c || isPunctuation c + isWordBoundary c = (isSpace c || isPunctuation c || c `elem` "^>=<") && c /= '-' go :: Bool -> Aho.Match Text -> Aho.Next Bool go _ (Aho.Match pos val) = @@ -88,7 +109,7 @@ :: FilePath -> Maybe UTCTime -> a - -> (PackageName -> ByteString -> a -> a) + -> (PackageName -> Version -> ByteString -> a -> a) -> IO a foldCabalFilesInIndex fp indexState ini action = do contents <- BL.readFile fp @@ -106,14 +127,26 @@ go acc entry = case Tar.entryContent entry of Tar.NormalFile contents _ -> - if isCabalFile then action pkgName bs acc else acc + if isCabalFile then action pkgName version bs acc else acc where bs = BL.toStrict contents fpath = Tar.entryPath entry isCabalFile = ".cabal" `isSuffixOf` fpath - pkgName = mkPackageName $ takeWhile (not . isPathSeparator) fpath + (rawPkgName, fpath') = break isPathSeparator fpath + pkgName = mkPackageName rawPkgName + rawVersion = takeWhile (not . isPathSeparator) $ dropWhile isPathSeparator fpath' + version = mkVersion $ readVersion rawVersion _ -> acc +readVersion :: String -> [Int] +readVersion = (\(acc, _mult, rest) -> acc : rest) . foldr go (0, 1, []) + where + go c (acc, mult, rest) + | fromIntegral d < (10 :: Word) = (acc + d * mult, mult * 10, rest) + | otherwise = (0, 1, acc : rest) + where + d = ord c - ord '0' + tarTakeWhile :: (Tar.Entry -> Bool) -> Tar.Entries a @@ -129,7 +162,7 @@ -- -- @since 0.1 extractDependencies - :: [PackageName] + :: Set PackageName -- ^ Needles to search. -> ByteString -- ^ Content of a Cabal file. @@ -142,10 +175,77 @@ Nothing -> mempty Just descr -> foldMap targetBuildDepends $ toListOf Lens.traverseBuildInfos descr -relevantDeps :: [PackageName] -> [Dependency] -> Map PackageName VersionRange +relevantDeps :: Set PackageName -> [Dependency] -> Map PackageName VersionRange relevantDeps needles = fmap simplifyVersionRange . M.fromListWith intersectVersionRanges . mapMaybe go where go (Dependency pkg ver _) | pkg `elem` needles = Just (pkg, ver) | otherwise = Nothing + +-- | Combination of 'lastVersions' and 'extractDependencies'. +-- +-- @since 0.2 +getReverseDependencies + :: Set PackageName + -- ^ Needles to search in Cabal files. + -> FilePath + -- ^ Path to @01-index.tar@. + -- One can use @Cabal.Config.cfgRepoIndex@ from @cabal-install-parsers@ + -- to obtain it. + -> Maybe UTCTime + -- ^ Timestamp of index state at which to stop scanning. + -> IO (Map PackageName (Map PackageName VersionRange)) + -- ^ Outer keys are reverse dependencies, + -- inner keys are needles, + -- inner values are accepted version ranges. +getReverseDependencies args fp indexState = do + releases <- lastVersions (S.map (B.pack . unPackageName) args) fp indexState + pure $ extractDependencies' args releases + +extractDependencies' + :: Set PackageName + -> Map PackageName ByteString + -> Map PackageName (Map PackageName VersionRange) +extractDependencies' args releases = + M.filter (not . null) $ + -- Most of packages trivially depend on themselves + -- (e. g., test suite depends on a library); skip it. + M.mapWithKey M.delete $ + fmap (extractDependencies args) releases + +-- | Same as 'getReverseDependencies', but +-- returns not only direct, but also indirect reverse dependencies. +-- +-- @since 0.2 +getTransitiveReverseDependencies + :: Set PackageName + -- ^ Needles to search in Cabal files. + -> FilePath + -- ^ Path to @01-index.tar@. + -- One can use @Cabal.Config.cfgRepoIndex@ from @cabal-install-parsers@ + -- to obtain it. + -> Maybe UTCTime + -- ^ Timestamp of index state at which to stop scanning. + -> IO (Map PackageName (Map PackageName VersionRange)) + -- ^ Reverse dependencies, including transitive ones. +getTransitiveReverseDependencies args fp indexState = do + releases <- allLastVersions fp indexState + go mempty releases args + where + go + :: Map PackageName (Map PackageName VersionRange) + -> Map PackageName ByteString + -> Set PackageName + -> IO (Map PackageName (Map PackageName VersionRange)) + go acc releases xs = do + let rawRevDeps = extractDependencies' xs releases + revDeps = M.map (\ys -> ys <> fold (M.restrictKeys acc (M.keysSet ys))) rawRevDeps + revDepsKeys = M.keysSet revDeps + if revDepsKeys `S.isSubsetOf` M.keysSet acc + then pure acc + else + go + (M.unionWith (M.unionWith intersectVersionRanges) acc revDeps) + (M.withoutKeys releases revDepsKeys) + revDepsKeys