Fri Sep 25 00:27:01 CEST 2009 vandijk.roel@gmail.com * Implemented reverse dependencies (#576) New patches: [Implemented reverse dependencies (#576) vandijk.roel@gmail.com**20090924222701 Ignore-this: f9e5e358a4c8db9d5ae17c47a1a49565 ] { hunk ./Locations.hs 63 pkgScriptURL :: URL pkgScriptURL = "/package" +-- URL of the CGI script to show reverse dependencies of a package +pkgRevDepsURL :: URL +pkgRevDepsURL = "/revdeps" + -- URL of the list of recent additions to the database recentAdditionsURL :: URL recentAdditionsURL = "/packages/archive/recent.html" hunk ./Makefile 4 SHELL = /bin/sh HC = ghc HCFLAGS = -O -Wall -CGI_PROGS = upload-pkg check-pkg package search -AUX_PROGS = pkg-list recent-adds rss-feed latest-versions splitDistroMap +CGI_PROGS = upload-pkg check-pkg package revdeps search +AUX_PROGS = pkg-list pkg-rev-deps recent-adds rss-feed latest-versions splitDistroMap GEN_PROGS = $(CGI_PROGS) $(AUX_PROGS) PROGS = $(GEN_PROGS) post-upload-hook preferred-versions hunk ./Makefile 29 install: $(PROGS) scp -C $(PROGS) $(HACKAGE_HOST):$(TMPDIR) ssh $(HACKAGE_HOST) mv $(TMPDIR)/package $(CGIDIR) + ssh $(HACKAGE_HOST) mv $(TMPDIR)/revdeps $(CGIDIR) ssh $(HACKAGE_HOST) mv $(TMPDIR)/check-pkg $(CGIDIR) ssh $(HACKAGE_HOST) mv $(TMPDIR)/upload-pkg $(CGIDIR)/protected ssh $(HACKAGE_HOST) mv $(TMPDIR)/search $(CGIDIR) hunk ./Makefile 35 ssh $(HACKAGE_HOST) mv $(TMPDIR)/post-upload-hook $(BINDIR) ssh $(HACKAGE_HOST) mv $(TMPDIR)/pkg-list $(BINDIR) + ssh $(HACKAGE_HOST) mv $(TMPDIR)/pkg-rev-deps $(BINDIR) ssh $(HACKAGE_HOST) mv $(TMPDIR)/recent-adds $(BINDIR) ssh $(HACKAGE_HOST) mv $(TMPDIR)/rss-feed $(BINDIR) ssh $(HACKAGE_HOST) mv $(TMPDIR)/latest-versions $(BINDIR) hunk ./Makefile 56 $(HC) --make $(HCFLAGS) -o $@ package.hs strip $@ +revdeps: revdeps.hs Locations.hs Util.hs RevDepsPage.hs + $(HC) --make $(HCFLAGS) -o $@ revdeps.hs + strip $@ + search: search.hs SearchAlgorithm.hs SearchMatchingFunctions.hs SearchUtils.hs SearchHackage.hs SearchTypes.hs Locations.hs Util.hs $(HC) --make $(HCFLAGS) -o $@ search.hs strip $@ hunk ./Makefile 70 $(HC) --make $(HCFLAGS) -o $@ pkg-list.hs strip $@ +pkg-rev-deps: pkg-rev-deps.hs RevDepMap.hs Locations.hs Util.hs + $(HC) --make $(HCFLAGS) -o $@ pkg-rev-deps.hs + strip $@ + recent-adds: recent-adds.hs Locations.hs Util.hs $(HC) --make $(HCFLAGS) -o $@ recent-adds.hs strip $@ hunk ./PackagePage.hs 7 import Control.Monad ( guard, liftM2 ) import qualified Data.Foldable as Foldable import Data.Char ( toLower, toUpper, isSpace ) -import Data.List ( delete, intersperse, isPrefixOf, +import Data.List ( intersperse, isPrefixOf, partition, sort, sortBy ) import Data.Maybe import Data.Map ( Map ) hunk ./PackagePage.hs 28 import Util ( cabalFile, packageFile, dirContents, getDependencies, availableVersions, maybeLast, packageURL, - packageDir, splitOn, catLabel ) + packageDir, splitOn, catLabel, + getReverseDependencies, revDepsURL + ) import TagMap import DistroInfo hunk ./PackagePage.hs 53 , pdDependencies :: Map PackageName [Version] -- ^ dependent packages from 'pdDescription', each paired -- with available versions of that package (if any). + , pdRevDeps :: [(PackageIdentifier, Int, Int, Bool)] + -- ^ List of packages that depend on this package, the number + -- of direct reverse dependencies per package, the number of + -- indirect reverse dependencies per package and a flag + -- indicating whether the package directly depends on the + -- package in question. The first item in this list contains + -- information about the original package. , pdDocURL :: Maybe URL -- ^ URL of Haddock documentation for this version of the -- package (if available). hunk ./PackagePage.hs 89 vs <- availableVersions (pkgName pkgId) deps <- getDependencies pkg + revDeps <- getReverseDependencies pkgId let htmldir = pkgDir `slash` "doc" `slash` "html" docExists <- doesDirectoryExist $ localFile htmldir hunk ./PackagePage.hs 106 , pdTags = tags tag_map , pdAllVersions = vs , pdDependencies = deps + , pdRevDeps = revDeps , pdDocURL = mbHtmlURL , pdBuilds = builds , pdBuildFailures = failures hunk ./PackagePage.hs 185 (bold << display pversion) : map linkVers later_vs))] ++ [("Dependencies", html_deps_list)] ++ + [("Reverse deps.", html_rev_deps)] ++ [(fname, f_value) | (fname, htmlField) <- showFields, let f_value = htmlField pkg, hunk ./PackagePage.hs 214 intersperse (toHtml " " +++ bold (toHtml "or") +++ br) $ map (showDependencies vmap) deps_list deps_list = flatDependencies (pdDescription pd) + html_rev_deps | null revDeps = toHtml "No reverse dependencies" + | otherwise = concatHtml [ anchor ! [href $ revDepsURL pkgId ++ "#direct"] << + (showStrong numD +++ toHtml " direct") + , toHtml " and " + , anchor ! [href $ revDepsURL pkgId ++ "#indirect"] << + (showStrong numI +++ toHtml " indirect") + , toHtml " dependencies on " + , anchor ! [href $ revDepsURL pkgId] << + toHtml (display pkgId) + ] + where ((_,numD,numI,_):_) = revDeps + revDeps = pdRevDeps pd successes = Map.keys (pdBuilds pd) failures = Map.toList (Map.difference (pdBuildFailures pd) (pdBuilds pd)) showLog (desc, url) = hunk ./PackagePage.hs 242 dispTagVal "superseded by" v = anchor ! [href (packageURL (PackageIdentifier (PackageName v) (Version [] [])))] << v dispTagVal _ v = toHtml v +showStrong :: Show a => a -> Html +showStrong = strong . toHtml . show + tabulate :: [(String, Html)] -> Html -- tabulate items = dlist << concat [[dterm << t, ddef << d] | (t, d) <- items] tabulate items = table ! [theclass "properties"] << addfile ./RevDepMap.hs hunk ./RevDepMap.hs 1 +{-# LANGUAGE ScopedTypeVariables #-} + +module RevDepMap ( RevDepMap + , calcRevDeps + , lookup + , latestVersions + , totalRevDeps + , totalRevDeps_st + ) where + +import Control.Monad ( filterM, fmap, foldM, mapM ) +import Control.Monad.ST ( ST, runST ) +import Control.Monad.State.Lazy ( State, evalState, get, put ) +import Data.Function ( on ) +import Data.List ( nub, groupBy ) +import Data.Maybe ( fromMaybe ) +import Data.STRef ( STRef, newSTRef + , readSTRef, writeSTRef + ) +import Distribution.Package ( Dependency(..) + , PackageIdentifier(..) + , PackageId + , PackageName(..) + ) +import Distribution.Version ( withinRange ) +import Prelude hiding ( lookup ) + +import qualified Data.Map as Mp +import qualified Data.Set as S + + +------------------------------------------------------------------------------- +-- Types + +-- |A RevDepMap maps a package 'x' to a set of packages which depend +-- on 'x' in some way. +type RevDepMap = Mp.Map PackageId (S.Set PackageId) + +------------------------------------------------------------------------------- + +-- |Transforms a reverse dependency map so that it contains only the last +-- versions of every reverse dependency. +latestVersions :: RevDepMap -> RevDepMap +latestVersions = fmap ( S.fromDistinctAscList + . map maximum + . groupBy ((==) `on` pkgName) + . S.toAscList + ) + +------------------------------------------------------------------------------- +-- Direct reverse dependencies + +-- |Calculates the direct reverse dependencies of every package in the +-- input list. +calcRevDeps :: [(PackageId, [Dependency])] -> RevDepMap +calcRevDeps pkgs = + foldr (\(pkg, deps) -> + -- Per package on which this package depends, add this package as a + -- reverse dependency. + foldr2 (foldr2 (addRevDep pkg) . depToPkgs) + (nub deps) + ) + emptyRevDepMap + pkgs + where + -- A variant of foldr with the list and the default value flipped. + foldr2 :: (a -> b -> b) -> [a] -> b -> b + foldr2 = flip . foldr + + {- + -- If emptyRevDepMap is set to initRevDeps then the result of calcRevDeps + -- will also contain packages with 0 reverse dependencies. + initRevDeps :: RevDepMap + initRevDeps = Mp.fromList [(pkg, S.empty) | (pkg, _) <- pkgs] + -} + + emptyRevDepMap = Mp.empty -- initRevDeps + + addRevDep :: PackageId -> PackageId -> (RevDepMap -> RevDepMap) + addRevDep src pkg = Mp.insertWith (const $ S.insert src) + pkg + $ S.singleton src + + -- List of packages matching the dependency. + depToPkgs :: Dependency -> [PackageId] + depToPkgs (Dependency pkg vrange) = + maybe [] + (filter (\depPkg -> withinRange (pkgVersion depPkg) vrange)) + $ Mp.lookup pkg nameToPkg + + -- Maps a package name to ALL versions of the package in the database. + nameToPkg :: Mp.Map PackageName [PackageId] + nameToPkg = foldr ( \(pkg, _) -> Mp.insertWith (const (pkg :)) + (pkgName pkg) + [pkg] + ) + Mp.empty + pkgs + +------------------------------------------------------------------------------- +-- Total reverse dependencies (using Sets) + +-- |Transforms a direct reverse dependencies map into a total reverse +-- dependencies map. +totalRevDeps :: RevDepMap -> RevDepMap +totalRevDeps mp = Mp.mapWithKey (const . lookupAll mp) mp + +lookup :: RevDepMap -> PackageId -> S.Set PackageId +lookup mp k = fromMaybe S.empty $ Mp.lookup k mp + +lookupAll :: RevDepMap -> PackageId -> S.Set PackageId +lookupAll = dfs . lookup + + +-- |Depth first search +-- Given a graph and a starting node this function finds all nodes reachable +-- from that starting node. The graph is represented by a function from a node +-- to a set of nodes reachable from that node. +dfs :: forall a. Ord a => (a -> S.Set a) -> a -> S.Set a +dfs g r = evalState (search r) $ S.singleton r + where search :: a -> State (S.Set a) (S.Set a) + search n = do visited <- get + let new = S.difference (g n) visited + put $ S.union visited new + deep <- mapM search $ S.toList new + return $ S.union (S.unions deep) new + + +------------------------------------------------------------------------------- +-- Total reverse dependencies (using the ST monad) + +-- |Transforms a direct reverse dependencies map into a total reverse +-- dependencies map. It does this using an algorithm which is much more +-- efficient than the one using Sets. +totalRevDeps_st :: [PackageId] -> RevDepMap -> RevDepMap +totalRevDeps_st universe mp = runST go + where + go :: forall s. ST s RevDepMap + go = do -- refMap :: Mp.Map PackageId (STRef s Bool) + refMap <- fmap Mp.fromList + $ mapM (tagNode False) universe + + -- Like the original RevDepMap, except the collection of reverse + -- dependencies is represented by a list and associated with a + -- tag. + let tagged :: Mp.Map PackageId [(PackageId, STRef s Bool)] + tagged = Mp.map (map (\x -> (x, refMap Mp.! x)) . S.toList) + mp + + -- Calculate the total reverse dependencies by performing a depth + -- first search per package and inserting the results in a newly + -- constructed map. + totalMp <- foldM (\mp' pkgId -> do + -- Mark the initial node. + writeSTRef (refMap Mp.! pkgId) True + -- Calculate total reverse dependencies for current pkgId. + revDeps <- dfs_st (\n -> fromMaybe [] $ Mp.lookup n tagged) pkgId + -- Reset all tags for the next package. + mapM_ (\r -> writeSTRef r False) $ Mp.elems refMap + return $ Mp.insert pkgId (S.fromList revDeps) mp' + ) + Mp.empty + $ Mp.keys mp + + return totalMp + + tagNode :: t -> n -> ST s (n, STRef s t) + tagNode t n = newSTRef t >>= \r -> return (n, r) + + +-- |Depth first search +-- Given a graph and a starting node this function finds all nodes reachable +-- from that starting node. The graph is represented by a function from a node +-- to a list of nodes reachable from that node. Each node in that list is +-- associated with a mutable variable which marks whether that node was visited +-- before. +-- Precondition: All nodes are unmarked. +dfs_st :: forall a s. (a -> [(a, STRef s Bool)]) -> a -> ST s [a] +dfs_st g r = search r + where search :: a -> ST s [a] + search n = do new <- fmap (map fst) . filterM checkAndMark $ g n + deep <- mapM search new + return $ new ++ concat deep + + checkAndMark :: (a, STRef s Bool) -> ST s Bool + checkAndMark (_, ref) = do b <- readSTRef ref + if b + then return False + else writeSTRef ref True >> return True addfile ./RevDepsPage.hs hunk ./RevDepsPage.hs 1 +-- Body of the HTML page for the reverse dependencies of a package +module RevDepsPage (getPkgRevDepsBody) where + +import Data.Function ( on ) +import Data.List ( intersperse, sortBy, takeWhile, dropWhile ) +import Distribution.Package ( PackageIdentifier(..), PackageId ) +import Distribution.Text ( display ) +import Distribution.Version ( Version ) +import Text.XHtml +import Util ( availableVersions, packageURL, revDepsURL + , getReverseDependencies + ) + + +getPkgRevDepsBody :: PackageId -> IO [Html] +getPkgRevDepsBody pkgId = do vs <- availableVersions (pkgName pkgId) + revDeps <- getReverseDependencies pkgId + return $ pkgRevDepsBody pkgId vs revDeps + +pkgRevDepsBody :: PackageId -> [Version] -> [(PackageId, Int, Int, Bool)] -> [Html] +pkgRevDepsBody pkgId vs revDeps = (h2 << pageTitle) + : paragraph << + anchor ! [href $ packageURL pkgId] << + toHtml "Package description" + : go revDeps + where + pageTitle = "Reverse Dependencies of " ++ display (pkgName pkgId) + + go [] = noRevDeps + go [_] = noRevDeps + go (x:xs) = withRevDeps x $ sortDeps xs + + noRevDeps = [toHtml "No reverse dependencies"] + + withRevDeps x xs = overviewSection x vs + : directRevDepSection pkgId xs + ++ indirectRevDepSection pkgId xs + + sortDeps = sortBy (flip compare `on` (\(_,numD,numI,_) -> numD + numI)) + + +overviewSection :: (PackageId, Int, Int, Bool) -> [Version] -> Html +overviewSection (pkgId, numD, numI, _) vs = + table << + [ tr ! [theclass "odd"] << + [ th ! [theclass "horizontal"] << + if null earlier_vs && null later_vs then "Version" else "Versions" + , td << commaList (map linkVers earlier_vs + ++ ((strong << display pversion) : map linkVers later_vs)) + ] + , tr ! [theclass "even"] << + [ th ! [theclass "horizontal"] << "Direct reverse deps." + , td << anchor ! [href "#direct"] << toHtml (show numD) + ] + , tr ! [theclass "odd"] << + [ th ! [theclass "horizontal"] << "Indirect reverse deps." + , td << anchor ! [href "#indirect"] << toHtml (show numI) + ] + ] + where + pversion = pkgVersion pkgId + pname = pkgName pkgId + + earlier_vs = takeWhile (< pversion) vs + later_vs = dropWhile (<= pversion) vs + + linkVers v = anchor ! [href (revDepsURL (PackageIdentifier pname v))] << + display v + +directRevDepSection :: PackageId -> [(PackageId, Int, Int, Bool)] -> [Html] +directRevDepSection pkgId xs = + revDepSection xs + True + "direct" + "Direct reverse dependencies" + $ concatHtml [ toHtml "A package is a direct reverse dependency of " + , packageLink pkgId + , toHtml " if it directly depend on " + , packageLink pkgId + ] + +indirectRevDepSection :: PackageId -> [(PackageId, Int, Int, Bool)] -> [Html] +indirectRevDepSection pkgId xs = + revDepSection xs + False + "indirect" + "Indirect reverse dependencies" + $ concatHtml [ toHtml "A package is an indirect reverse dependency of " + , packageLink pkgId + , toHtml " if it depends on either a direct reverse dependency or an indirect reverse dependency of " + , packageLink pkgId + ] + +revDepSection :: [(PackageId, Int, Int, Bool)] -> Bool -> String -> String -> Html -> [Html] +revDepSection revDeps direct sname sectionTitle desc + | null filteredRevDeps = [sectionAnchor] + | otherwise = [ sectionAnchor + , h3 << sectionTitle + , paragraph << desc + , revDepList filteredRevDeps + ] + where + filteredRevDeps = filterOnDirect direct revDeps + + filterOnDirect :: Bool -> [(PackageId, Int, Int, Bool)] -> [(PackageId, Int, Int)] + filterOnDirect x = map (\(pkgId, numD, numI, _) -> (pkgId, numD, numI)) + . filter (\(_,_,_,isD) -> isD == x) + + sectionAnchor = anchor ! [name sname] << noHtml + +revDepList :: [(PackageId, Int, Int)] -> Html +revDepList deps = + table << + ( tr << [ th << stringToHtml "Package" + , th << stringToHtml "Direct" + , th << stringToHtml "Indirect" + ] + : [ tr ! [theclass $ rowClass row] << + [ td << packageLink depPkgId + , td << revDepsLink depPkgId "#direct" (toHtml $ show numD) + , td << revDepsLink depPkgId "#indirect" (toHtml $ show numI) + ] + | (row, (depPkgId, numD, numI)) <- zip [1..] deps + ] + ) + +packageLink :: PackageId -> Html +packageLink pkgId = anchor ! [href $ packageURL pkgId] << + toHtml (display pkgId) + +revDepsLink :: PackageId -> String -> Html -> Html +revDepsLink pkgId extra contents = anchor ! [href $ revDepsURL pkgId ++ extra] << contents + +rowClass :: Int -> String +rowClass n | odd n = "odd" + | otherwise = "even" + +-- Copied from PackagePage +commaList :: [Html] -> Html +commaList = concatHtml . intersperse (toHtml ", ") hunk ./Util.hs 4 module Util where import Control.Exception ( bracket ) -import Control.Monad ( unless, filterM, liftM ) +import Control.Monad ( unless, filterM, liftM, guard ) import Data.Bits ( (.&.), complement ) import Data.Char ( isSpace, toLower ) import Data.List ( (\\), sort ) hunk ./Util.hs 10 import Data.Map ( Map ) import qualified Data.Map as Map -import Data.Maybe ( listToMaybe ) +import Data.Maybe ( listToMaybe, fromMaybe ) import qualified Data.Set as Set ( fromList, toList ) import Distribution.Compat.ReadP( readP_to_S ) import Distribution.Package ( PackageName(..), PackageIdentifier(..), hunk ./Util.hs 31 import Text.XHtml ( URL ) import PublicFile -import Locations ( archiveDir, pkgScriptURL ) +import Locations ( archiveDir, pkgScriptURL, pkgRevDepsURL ) -- | Registered top-level nodes in the class hierarchy. allocatedTopLevelNodes :: [String] hunk ./Util.hs 48 packageNameURL :: PackageName -> URL packageNameURL pkg = pkgScriptURL ++ "/" ++ display pkg +-- | URL describing the reverse dependencies of a package, including version. +revDepsURL :: PackageIdentifier -> URL +revDepsURL pkgId = pkgRevDepsURL ++ "/" ++ display pkgId + +-- | URL describing the cached reverse dependencies of a package. +revDepsFile :: PackageIdentifier -> PublicFile +revDepsFile pkgId = packageDir pkgId `slash` "revdeps.csv" + -- package utilities -- | Available versions (if any) for each package mentioned in this one. hunk ./Util.hs 76 vs <- availableVersions n return (n, vs) +-- | List of packages that depend on this one. +getReverseDependencies :: PackageIdentifier -> IO [(PackageIdentifier, Int, Int, Bool)] +getReverseDependencies pkgId = do hasRevDeps <- doesFileExist fp + if hasRevDeps + then do revDepFile <- readFile fp + let xs = lines revDepFile + return . fromMaybe [] . sequence $ map parseLine xs + else return [] + where + -- This could be made much simpler by using functions from the "split" package. + parseLine :: String -> Maybe (PackageIdentifier, Int, Int, Bool) + parseLine l = do let (pname, rest1) = spanTillComma l + guard (not $ null rest1) + let (direct, rest2) = spanTillComma (tail rest1) + guard (not $ null rest2) + let (indirect, rest3) = spanTillComma (tail rest2) + guard (not $ null rest3) + let isDirect = tail rest3 + guard (isDirect `elem` ["D", "I"]) + let xs = readP_to_S parse pname + guard ( not (null xs) + && length direct > 0 + && length indirect > 0 + ) + return ( fst $ last xs + , read direct + , read indirect + , isDirect == "D" + ) + spanTillComma = span (/= ',') + fp = localFile $ revDepsFile pkgId + -- | All package names available in the archive availablePackages :: IO [PackageName] availablePackages = do hunk ./hackage-scripts.cabal 30 other-modules: HaddockLex HaddockParse HaddockHtml HackagePage Locations ModuleForest PackagePage Unpack Util +executable: revdeps +main-is: revdeps.hs +other-modules: Locations RevDepsPage Util + executable: search main-is: search.hs other-modules: SearchAlgorithm SearchMatchingFunctions SearchUtils hunk ./hackage-scripts.cabal 50 executable: rss-feed main-is: rss-feed.hs other-modules: Locations Util + +executable: pkg-rev-deps +main-is: pkg-rev-deps.hs +other-modules: Util addfile ./pkg-rev-deps.hs hunk ./pkg-rev-deps.hs 1 +-- Generate a .csv file in every package directory containing the +-- reverse dependencies of that package. + +module Main where + +import Control.Monad ( fmap, mapM ) +import Data.List ( intercalate ) +import Distribution.Package ( Dependency(..) + , PackageIdentifier(..) + , PackageId + , PackageName(..) + ) +import Distribution.PackageDescription ( PackageDescription(..) ) +import Distribution.PackageDescription.Configuration + ( flattenPackageDescription ) +import Distribution.Text ( display ) +import PublicFile ( PublicFile, localFile ) +import System.IO ( writeFile ) +import Util ( availablePackages + , availableVersions + , loadPackageDescription + , revDepsFile + ) + +import qualified Data.Map as Mp +import qualified Data.Set as S +import qualified RevDepMap as RD + +------------------------------------------------------------------------------- +-- Main + +main :: IO () +main = do pkgs <- allPackages + let revDepMap = RD.calcRevDeps pkgs + directRevDeps = RD.latestVersions revDepMap + -- Reference implementation, but much slower than the ST monad version. + -- allRevDeps = RD.latestVersions $ RD.totalRevDeps revDepMap + allRevDeps = RD.latestVersions $ RD.totalRevDeps_st (map fst pkgs) revDepMap + writeRevDepFiles directRevDeps allRevDeps + +------------------------------------------------------------------------------- + +allPackages :: IO [(PackageId, [Dependency])] +allPackages = do pkgNames <- availablePackages + pkgDescs <- mapM availablePkgs pkgNames + return $ concat pkgDescs + +availablePkgIds :: PackageName -> IO [PackageId] +availablePkgIds p = fmap (map $ PackageIdentifier p) $ availableVersions p + +availablePkgs :: PackageName -> IO [(PackageId, [Dependency])] +availablePkgs p = mapM perPkgId =<< availablePkgIds p + where perPkgId pkgId = do + genDesc <- loadPackageDescription pkgId + let desc = flattenPackageDescription genDesc + deps = buildDepends desc + result = pkgId `seq` deps `seq` (pkgId, deps) + -- Strict evaluation of PackageId and [Dependency] so that the now + -- useless PackageDescription is no longer retained. + result `seq` return result + +------------------------------------------------------------------------------- + +-- |Stores the reverse dependency information of all packages in the database. +writeRevDepFiles :: RD.RevDepMap -> RD.RevDepMap -> IO () +writeRevDepFiles direct total = mapM_ (uncurry $ writeRevDepFile direct total) + $ Mp.assocs total + +{-| Stores the reverse dependency information of a package in the database. + +The first line in the file contains information about the package itself. The +following lines pertain to its reverse dependencies. + +Each line consists of 4 fields, separated by ',': + +1. The PackageIdentifier +2. Number of direct reverse dependencies +3. Number of indirect reverse dependencies (total - direct) +4. Flag indicating whether this package is a direct reverse dependency or an + indirect one ('D' or 'I'). +-} +writeRevDepFile :: RD.RevDepMap -> RD.RevDepMap -> PackageId -> S.Set PackageId -> IO () +writeRevDepFile direct total pkgId totalRevDeps = + writeFile (localFile $ revDepsFile pkgId) fileContents + where + directDeps :: S.Set PackageId + directDeps = RD.lookup direct pkgId + + fileContents :: String + fileContents = unlines + . map (\dep -> let numDirect = S.size $ RD.lookup direct dep + numTotal = S.size $ RD.lookup total dep + numIndirect = numTotal - numDirect + in intercalate "," + [ display dep + , show numDirect + , show numIndirect + , if S.member dep directDeps + then "D" -- (D)irect + else "I" -- (I)ndirect + ] + ) + $ pkgId : S.toAscList totalRevDeps addfile ./revdeps.hs hunk ./revdeps.hs 1 +-- CGI program listing package reverse dependencies +module Main (main) where + +import Distribution.Package ( PackageIdentifier(..) ) +import Distribution.Version ( Version(..) ) +import Distribution.Text ( display ) +import HackagePage ( hackagePage ) +import Locations ( pkgListURL ) +import Network.CGI ( CGI, CGIResult, runCGI, handleErrors + , liftIO, output, outputNotFound + , pathInfo, redirect + ) +import PublicFile ( localFile ) +import RevDepsPage ( getPkgRevDepsBody ) +import System.Directory ( doesFileExist ) +import Text.XHtml ( renderHtml ) +import Util ( splitOn, availableVersions + , cabalFile, maybeLast + , readPackageId, revDepsURL + ) + +main :: IO () +main = runCGI . handleErrors $ do + path <- pathInfo + let pathParts = filter (not . null) $ splitOn '/' path + case pathParts of + [] -> redirect pkgListURL + [pname] -> + case readPackageId pname of + Just pkgId -> showRevDeps pkgId + Nothing -> outputNotFound "malformed package identifier" + _ -> outputNotFound "malformed URL" + +showRevDeps :: PackageIdentifier -> CGI CGIResult +showRevDeps (PackageIdentifier pname (Version [] [])) = do + -- name only: get the most recent version + vs <- liftIO (availableVersions pname) + case maybeLast vs of + Just v -> redirect (revDepsURL (PackageIdentifier pname v)) + Nothing -> outputNotFound $ + "no such package '" ++ display pname ++ "'" +showRevDeps pkgId = do e <- liftIO $ doesFileExist (localFile $ cabalFile pkgId) + if e + then do page <- liftIO $ getPkgRevDepsBody pkgId + output . renderHtml + . hackagePage pkgIdStr + $ page + else outputNotFound ("no such package '" ++ pkgIdStr ++ "'") + where pkgIdStr = display pkgId + } Context: [compile with -O Ross Paterson **20090824150826 Ignore-this: 67ea1327df7bd8df059694d45a16dc0e ] [tweak locations of distromaps Ross Paterson **20090824150257 Ignore-this: d642276f3667e3a90065e57005089bd6 ] [Mention splitDistroMap in README Joachim Breitner **20090822165007 Ignore-this: 4af14467aa9dc0267dde9b6b886de4dc ] [Avoid compiler warnings in code added by me Joachim Breitner **20090822164654 Ignore-this: c144ce4997793fefc1bcfb006c21abca ] [Add splitDistroMap to Makefile Joachim Breitner **20090822164644 Ignore-this: 11d7c96d0158487d03285cb6cb6a366 ] [Use the new per-package DistroInfo API in PackagePage Joachim Breitner **20090822164057 Ignore-this: 918119c885ae61604bbeb7e8806a5642 ] [Binary program to split the distro map Joachim Breitner **20090822163821 Ignore-this: 6c0d2733d78e772582f8a8f142ebbee4 ] [DistroInfo.splitDistroInfo Joachim Breitner **20090822163712 Ignore-this: 7340701ff507210abfe06cb3048d4935 Add a function to DistroInfo to split the all-archive-distro-maps per package, and write out short files per PackageName (not package+version) with only the information for that package, to reduce parsing time. ] [New function Util.unversionedPackageDir Joachim Breitner **20090822163609 Ignore-this: bf246d5c43642614884da3a26bbd001f This is like packageDir, but takes a PackageName instead of a PackageIdentifier and thus returns the parent directory of packageDir. This new function is then also used in packageDir. ] [Implement DistroInfo Joachim Breitner **20090726132613 Ignore-this: 1e2fee85bbad474dc2eef2377e50a1e1 ] [Add a note in the README about the files Joachim Breitner **20090726131937 Ignore-this: 7d581e418b9c82a24d1367946ac81f50 ] [Set up DistroInfo module Joachim Breitner **20090726113015 Ignore-this: 4c4e6a6fe6fa5a9044363097b5005159 ] [fix haddock lexer (fixes #569) Ross Paterson **20090801141552 Ignore-this: 561b885aea712bf59fedac5e0928740a ] [show source repository Ross Paterson **20090706170551 Ignore-this: 234c01bf707eaec9ac4efc8ca33ae7e6 Only shows the development repo, and may be a bit simplistic. ] [shorter package URL Ross Paterson **20090611154034 Ignore-this: c812b49a1ca575e9c952d768860f3e2a ] [canonicalize category links Ross Paterson **20090611154013 Ignore-this: 4b320ba32d1aee8b92ca9c96e76bf112 ] [use display instead of show on license field Ross Paterson **20090119134457] [handle WildcardVersion Ross Paterson **20081225024413] [explicit imports to avoid clash with Cabal-1.7 Ross Paterson **20081222124657] [add bug tracker link (#415) Ross Paterson **20081126232839] [non-semantic changes to sync lexer and parser with versions in GHC Ross Paterson **20081115170018] [update Haddock parser to 0.9 (fixes #406) Ross Paterson **20081114235827] [record times in UTC Ross Paterson **20081109151646] [show build failures and sucesses on different versions of GHC Ross Paterson **20081109135425] [Read the .cabal file as UTF8 when unpacking (from Duncan Coutts) Ross Paterson **20081101154633 Previously the upload check preview displayed incorrect encoding of people's names and did not validate incorrect UTF8 encodings. ] [use sparklines generated on an upload Ross Paterson **20081024122101] [add graph to Recent additions page Ross Paterson **20081024001245] [uniform layout whether or not haddock present, with italics for non-module nodes Ross Paterson **20081014100238] [reformat the module list to look a bit more like Haddock's Ross Paterson **20081014083632] [Render exposed modules as a nested list (#308) Ross Paterson **20081014074946 Written by Bas van Dijk. ] [Marking packages deprecated Chry Cheng **20080828145516 Fixes ticket no. 261 as discussed in its annotations. Packages with "deprecated" "true" are excluded from the package list. Packages with "superseded by" tags provide links to their superseding packages in the package page. ] [Update deps to require Cabal-1.6 Duncan Coutts **20081011002506] [Update install procedure to install the preferred-versions Duncan Coutts **20081010000322] [Add the initial preferred-versions list Duncan Coutts **20081010000306] [Add the preferred-versions file into the 00-index.tar.gz file Duncan Coutts **20081009235419 Old clients should ignore it. ] [update files using mv to avoid corruption Ross Paterson **20080907114910] [put synopsis in header, show version in context Ross Paterson **20080905162925] [fix warning Ross Paterson **20080905162858] [eliminate redundant dependencies Ross Paterson **20080902001615] [update for Cabal 1.5 Ross Paterson **20080827020703] [use "none" for unmaintained packages Ross Paterson **20080723224421] [add Hayoo to menu bar Ross Paterson **20080723214433] [use a single methods to get the package info for display Ross Paterson **20080628231737] [don't build index asynchronously Ross Paterson **20080628231704] [flag null maintainer field on package page Ross Paterson **20080628231424] [use non-versioned links in the package index (#271, #278) Ross Paterson **20080510234607] [if a package has built, ignore any failures Ross Paterson **20080425154935] [track changes to checkPackage Ross Paterson **20080424003335] [add a meta tag declaring the charset as ISO-8859-1, as that's what Text.XHtml generates Ross Paterson **20080328154601] [make parse warnings fatal Ross Paterson **20080328121040] [update to Cabal 1.3.9 Ross Paterson **20080328120711] [disallow updating an existing package Ross Paterson **20080328120600] [generate 00-index.tar.gz asynchronously Ross Paterson **20080302105639] [prune the search for cabal files to make it go faster Ross Paterson **20080302105432] [add small latest-versions lister Ross Paterson **20080221134229] [use absolute filenames when looking for packages Ross Paterson **20080221124040] [longer label on the search button Ross Paterson **20080221123956] [simple implementation of tags, starting with upload info Ross Paterson **20080216021131] [swap arguments to extraChecks Ross Paterson **20080214182808] [fix warning Ross Paterson **20080214182753] [Update to latest Cabal lib API and use new package checking code Duncan Coutts **20080213201347 Compiles but otherwise totally untested. ] [remove private copies of functions now in ghc 6.8 Ross Paterson **20080212011430] [introduce PublicFile for files visible through the web Ross Paterson **20080212005643] [refactoring of upload and check scripts Ross Paterson **20080211131109] [unpack the whole directory, not just the .cabal file Ross Paterson **20080211131009] [add a Google search box to the package list page Ross Paterson **20080203021954] [swap depends-on and required-by maps Ross Paterson **20080202012507] [list successful and unsuccessful builds, with logs Ross Paterson **20080126013443] [blacklist Application, Tool and Type categories Ross Paterson **20071213074800] [add author Ross Paterson **20071213074632] [correct and simplify the library and programs test Ross Paterson **20071210104009] [capitalize category names Ross Paterson **20071130143321] [merge category names that differ only in case Ross Paterson **20071130142342] [render equality constraints concisely Ross Paterson **20071128005652] [ignore case when sorting lists of dependent packages Ross Paterson **20071120123549] [display dependencies in disjunctive normal form Ross Paterson **20071024225216] [Oops, need the flattened package description to get exposed modules and executables Ross Paterson **20071024070848] [use GenericPackageDescription instead of PackageDescription Ross Paterson **20071024064933] [now need Cabal >= 1.2.1 Ross Paterson **20071021155643] [update for Cabal 1.2.1 Ross Paterson **20071021155322] [cabal packaging (based on work of Trevor Elliott) Ross Paterson **20071019124210] [also install search Ross Paterson **20070909185526] [Added search functionality (by Sascha Böhme), but not yet in main menu Ross Paterson **20070909140603] [update for Cabal-1.2 Ross Paterson **20070907234506] [ensure the package list contains latest versions, plus some refacting Ross Paterson **20070723204248] [add link to build log to package page Ross Paterson **20070720124702] [minor build updates Ross Paterson **20070617213315] [fix rendering of identifiers Ross Paterson **20070617213249] [add missing file Ross Paterson **20070530140019] [bugfix for previous commit Ross Paterson **20070510142803] [fix error in building index Ross Paterson **20070508165611] [include a package in the list only if it has a Cabal file Ross Paterson **20070506180938] [change the directory layout of the HackageDB data Ross Paterson **20070506151844 Put version in a separate directory (to simplify future expansion). This will not affect users of the web interface, but will be a breaking change for those who reference the files directly, notably cabal-install. Here's how the positions of the files of the binary package change (-> denotes a symbolic link): Old layout New layout -------------------------------------------------------------------- binary/binary-0.2.cabal binary/0.2/binary.cabal binary/binary-0.2.tar.gz binary/0.2/binary-0.2.tar.gz binary/binary-0.2.misc/doc/html/ binary/0.2/doc/html/ binary/binary-0.3.cabal binary/0.3/binary.cabal binary/binary-0.3.tar.gz binary/0.3/binary-0.3.tar.gz binary/binary-0.3.misc/doc/html/ binary/0.3/doc/html/ binary/latest.misc -> binary-0.3.misc binary/latest -> 0.3 ] [catch "Unclassified" category Ross Paterson **20070307011355] [use local copy of Cabal logo Ross Paterson **20070225125801] [make "recent additions" a generated page instead of a CGI script Ross Paterson **20070220235702] [tweaks to package list Ross Paterson **20070220235601] [generate RSS feed of recent updates Ross Paterson **20070214185538] [bug fix: show preview even if no warnings Ross Paterson **20070213180708] [check-pkg also returns plain text if requested Ross Paterson **20070213001039] [for plain text clients, return only the warnings Ross Paterson **20070211171633] [use CGI type synonym Ross Paterson **20070210152353] [refactor pkgBody arguments as a record Ross Paterson **20070208194243] [strip executables Ross Paterson **20070207233429] [mark property table Ross Paterson **20070207233402] [point to accounts page Ross Paterson **20070207230638] [install upload-pkg in the correct place Ross Paterson **20070206001525] [new location .misc/doc for docs Ross Paterson **20070205004623] [versioned haddock documentation Ross Paterson **20070203202526] [if PACKAGE/doc/html exists, module names are links into it Ross Paterson **20070203170215 (Generation of haddock documentation is not yet automated, though) ] [minor refactoring Ross Paterson **20070202121300] [change package links from pkg/vers to pkg-vers Ross Paterson **20070201143905] [package-ids are unambiguous Ross Paterson **20070201132112] [allow version tags (they seem harmless) Ross Paterson **20070201131251] [trim long synopses in package list Ross Paterson **20070201100052] [tag category list Ross Paterson **20070131121652] [some re-arrangement Ross Paterson **20070131003654] [add category index to package list Ross Paterson **20070130180021] [tweak Cabal logo Ross Paterson **20070129130941] [add Cabal branding to package page Ross Paterson **20070129122133] [mark package lists with an element class Ross Paterson **20070129092724] [revert to textual indication of package type Ross Paterson **20070129080416] [cleanup Ross Paterson **20070129025127] [more compact presentation of package list Ross Paterson **20070129021339] [show other versions on package page Ross Paterson **20070129020229] [move cabalFile to Util Ross Paterson **20070129014325] [pkg-list: only read the most recent Cabal file for each package Ross Paterson **20070129012719] [trim unused functions Ross Paterson **20070129012355] [add export lists for Main modules Ross Paterson **20070129012315] [fix dependency Ross Paterson **20070129005924] [refactoring of version search Ross Paterson **20070129005845] [switch to Text.XHtml Ross Paterson **20070129001802] [more graceful error on missing package Ross Paterson **20070127171227] [minor simplification Ross Paterson **20070127164406] [minor refactoring Ross Paterson **20070127143750] [shuffle stuff between modules Ross Paterson **20070127142603] [change install to scp + mv Ross Paterson **20070127131030] [reword check output Ross Paterson **20070127130746] [add upload.html Ross Paterson **20070126210510] [re-order things on package page Ross Paterson **20070126204017] [minor refactoring Ross Paterson **20070126202141] [tabulate fields Ross Paterson **20070126201050] [remove superfluous thehtml Ross Paterson **20070126174820] [ensure that showPackageId produces the original pkg-id Ross Paterson **20070126150901 Rule out version numbers like "1.00" -> [1,0] -> "1.0". These ought to be rejected by the parser. ] [add boilerplate header to each page Ross Paterson **20070126143901] [remove old form-based parameters to package script Ross Paterson **20070126115030] [tweak category headings Ross Paterson **20070126112054] [make package URLs a bit shorter Ross Paterson **20070125105147 * remove .cgi from CGI scripts in cgi-bin * use PATHINFO instead of form data to identify packages. So now its .../package// or just .../package/ ] [some refactoring Ross Paterson **20070118102430] [append a preview of the package page to the check-pkg output Ross Paterson **20070118003003] [add a README file with overview and install instructions Ross Paterson **20070116153445] [clean up locations a bit Ross Paterson **20070116123020] [parse and markup package descriptions with code stolen from Haddock Ross Paterson **20070116105520] [temporarily downgrade repeated-upload check to a warning Ross Paterson **20070116073009 The check seems like a good idea in the longer term, but It's a bit cumbersome while we're all still experimenting. ] [more compact log lines Ross Paterson **20070113010328] [fix previous commit Ross Paterson **20070112155632] [use errorOutput for error cases Ross Paterson **20070112151251] [basename: strip to slash or backslash (which IE includes in filenames) Ross Paterson **20070112143846] [use a different tmp directory for each process Ross Paterson **20070111010943] [don't accept "Foreign binding" as a category Ross Paterson **20070110233221] [fix stylesheet location Ross Paterson **20070110182307] [change locations to match install on hackage.haskell.org Ross Paterson **20070110170036] [repair post-upload-hook Ross Paterson **20070109224215] [fallback for category: top-level of module hierarchy Ross Paterson **20070109224115] [initial import Ross Paterson **20070109004703 This is a crude first cut at an interface to the Hackage package database: * generating a package list (pkg-list) * page describing a package (package.cgi) * apply basic checks to a Cabal package (check-pkg.cgi) * upload a Cabal package to the database (upload-pkg.cgi) ] Patch bundle hash: f05a1fe98f4435a882637311727ab5bf0759f891