@@ -26,6 +26,8 @@ Because step 1) is quite expensive and takes roughly ~5 minutes the result is ca
2626{-# LANGUAGE ScopedTypeVariables #-}
2727{-# LANGUAGE TupleSections #-}
2828{-# OPTIONS_GHC -Wall #-}
29+{-# LANGUAGE ViewPatterns #-}
30+{-# LANGUAGE TupleSections #-}
2931
3032import Control.Monad (forM_, (<=<))
3133import Control.Monad.Trans (MonadIO (liftIO))
@@ -70,6 +72,12 @@ import System.Directory (XdgDirectory (XdgCache), getXdgDirectory)
7072import System.Environment (getArgs)
7173import System.Process (readProcess)
7274import Prelude hiding (id)
75+import Data.List (sortOn)
76+import Control.Concurrent.Async (concurrently)
77+import Control.Exception (evaluate)
78+import qualified Data.IntMap.Strict as IntMap
79+import qualified Data.IntSet as IntSet
80+import Data.Bifunctor (second)
7381
7482newtype JobsetEvals = JobsetEvals
7583 { evals :: Seq Eval
@@ -134,20 +142,17 @@ hydraEvalCommand = "hydra-eval-jobs"
134142hydraEvalParams :: [String]
135143hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"]
136144
137−handlesCommand :: FilePath
138−handlesCommand = "nix-instantiate"
139−
140−handlesParams :: [String]
141−handlesParams = ["--eval", "--strict", "--json", "-"]
145+nixExprCommand :: FilePath
146+nixExprCommand = "nix-instantiate"
142147
143−handlesExpression :: String
144−handlesExpression = "with import ./. {}; with lib; zipAttrsWith (_: builtins.head) (mapAttrsToList (_: v: if v ? github then { \"${v.email}\" = v.github; } else {}) (import maintainers/maintainer-list.nix))"
148+nixExprParams :: [String]
149+nixExprParams = ["--eval", "--strict", "--json"]
145150
146151-- | This newtype is used to parse a Hydra job output from @hydra-eval-jobs@.
147152-- The only field we are interested in is @maintainers@, which is why this
148153-- is just a newtype.
149154--
150−-- Note that there are occassionally jobs that don't have a maintainers
155+-- Note that there are occasionally jobs that don't have a maintainers
151156-- field, which is why this has to be @Maybe Text@.
152157newtype Maintainers = Maintainers { maintainers :: Maybe Text }
153158 deriving stock (Generic, Show)
@@ -195,13 +200,49 @@ type EmailToGitHubHandles = Map Text Text
195200-- @@
196201type MaintainerMap = Map Text (NonEmpty Text)
197202
198−-- | Generate a mapping of Hydra job names to maintainer GitHub handles.
203+-- | Information about a package which lists its dependencies and whether the
204+-- package is marked broken.
205+data DepInfo = DepInfo {
206+ deps :: Set Text,
207+ broken :: Bool
208+}
209+ deriving stock (Generic, Show)
210+ deriving anyclass (FromJSON, ToJSON)
211+
212+-- | Map from package names to their DepInfo. This is the data we get out of a
213+-- nix call.
214+type DependencyMap = Map Text DepInfo
215+
216+-- | Map from package names to its broken state, number of reverse dependencies (fst) and
217+-- unbroken reverse dependencies (snd).
218+type ReverseDependencyMap = Map Text (Int, Int)
219+
220+-- | Calculate the (unbroken) reverse dependencies of a package by transitively
221+-- going through all packages if it’s a dependency of them.
222+calculateReverseDependencies :: DependencyMap -> ReverseDependencyMap
223+calculateReverseDependencies depMap = Map.fromDistinctAscList $ zip keys (zip (rdepMap False) (rdepMap True))
224+ where
225+ -- This code tries to efficiently invert the dependency map and calculate
226+ -- it’s transitive closure by internally identifying every pkg with it’s index
227+ -- in the package list and then using memoization.
228+ keys = Map.keys depMap
229+ pkgToIndexMap = Map.fromDistinctAscList (zip keys [0..])
230+ intDeps = zip [0..] $ (\DepInfo{broken,deps} -> (broken,mapMaybe (`Map.lookup` pkgToIndexMap) $ Set.toList deps)) <$> Map.elems depMap
231+ rdepMap onlyUnbroken = IntSet.size <$> resultList
232+ where
233+ resultList = go <$> [0..]
234+ oneStepMap = IntMap.fromListWith IntSet.union $ (\(key,(_,deps)) -> (,IntSet.singleton key) <$> deps) <=< filter (\(_, (broken,_)) -> not (broken && onlyUnbroken)) $ intDeps
235+ go pkg = IntSet.unions (oneStep:((resultList !!) <$> IntSet.toList oneStep))
236+ where oneStep = IntMap.findWithDefault mempty pkg oneStepMap
237+
238+-- | Generate a mapping of Hydra job names to maintainer GitHub handles. Calls
239+-- hydra-eval-jobs and the nix script ./maintainer-handles.nix.
199240getMaintainerMap :: IO MaintainerMap
200241getMaintainerMap = do
201242 hydraJobs :: HydraJobs <-
202− readJSONProcess hydraEvalCommand hydraEvalParams "" "Failed to decode hydra-eval-jobs output: "
243+ readJSONProcess hydraEvalCommand hydraEvalParams "Failed to decode hydra-eval-jobs output: "
203244 handlesMap :: EmailToGitHubHandles <-
204− readJSONProcess handlesCommand handlesParams handlesExpression "Failed to decode nix output for lookup of github handles: "
245+ readJSONProcess nixExprCommand ("maintainers/scripts/haskell/maintainer-handles.nix":nixExprParams) "Failed to decode nix output for lookup of github handles: "
205246 pure $ Map.mapMaybe (splitMaintainersToGitHubHandles handlesMap) hydraJobs
206247 where
207248 -- Split a comma-spearated string of Maintainers into a NonEmpty list of
@@ -211,6 +252,12 @@ getMaintainerMap = do
211252 splitMaintainersToGitHubHandles handlesMap (Maintainers maint) =
212253 nonEmpty . mapMaybe (`Map.lookup` handlesMap) . Text.splitOn ", " $ fromMaybe "" maint
213254
255+-- | Get the a map of all dependencies of every package by calling the nix
256+-- script ./dependencies.nix.
257+getDependencyMap :: IO DependencyMap
258+getDependencyMap =
259+ readJSONProcess nixExprCommand ("maintainers/scripts/haskell/dependencies.nix":nixExprParams) "Failed to decode nix output for lookup of dependencies: "
260+
214261-- | Run a process that produces JSON on stdout and and decode the JSON to a
215262-- data type.
216263--
@@ -219,11 +266,10 @@ readJSONProcess
219266 :: FromJSON a
220267 => FilePath -- ^ Filename of executable.
221268 -> [String] -- ^ Arguments
222− -> String -- ^ stdin to pass to the process
223269 -> String -- ^ String to prefix to JSON-decode error.
224270 -> IO a
225−readJSONProcess exe args input err = do
226− output <- readProcess exe args input
271+readJSONProcess exe args err = do
272+ output <- readProcess exe args ""
227273 let eitherDecodedOutput = eitherDecodeStrict' . encodeUtf8 . Text.pack $ output
228274 case eitherDecodedOutput of
229275 Left decodeErr -> error $ err <> decodeErr <> "\nRaw: '" <> take 1000 output <> "'"
@@ -264,7 +310,13 @@ platformIcon (Platform x) = case x of
264310data BuildResult = BuildResult {state :: BuildState, id :: Int} deriving (Show, Eq, Ord)
265311newtype Platform = Platform {platform :: Text} deriving (Show, Eq, Ord)
266312newtype Table row col a = Table (Map (row, col) a)
267−type StatusSummary = Map Text (Table Text Platform BuildResult, Set Text)
313+data SummaryEntry = SummaryEntry {
314+ summaryBuilds :: Table Text Platform BuildResult,
315+ summaryMaintainers :: Set Text,
316+ summaryReverseDeps :: Int,
317+ summaryUnbrokenReverseDeps :: Int
318+}
319+type StatusSummary = Map Text SummaryEntry
268320
269321instance (Ord row, Ord col, Semigroup a) => Semigroup (Table row col a) where
270322 Table l <> Table r = Table (Map.unionWith (<>) l r)
@@ -275,11 +327,11 @@ instance Functor (Table row col) where
275327instance Foldable (Table row col) where
276328 foldMap f (Table a) = foldMap f a
277329
278−buildSummary :: MaintainerMap -> Seq Build -> StatusSummary
279−buildSummary maintainerMap = foldl (Map.unionWith unionSummary) Map.empty . fmap toSummary
330+buildSummary :: MaintainerMap -> ReverseDependencyMap -> Seq Build -> StatusSummary
331+buildSummary maintainerMap reverseDependencyMap = foldl (Map.unionWith unionSummary) Map.empty . fmap toSummary
280332 where
281− unionSummary (Table l, l') (Table r, r') = (Table $ Map.union l r, l' <> r')
282− toSummary Build{finished, buildstatus, job, id, system} = Map.singleton name (Table (Map.singleton (set, Platform system) (BuildResult state id)), maintainers)
333+ unionSummary (SummaryEntry (Table lb) lm lr lu) (SummaryEntry (Table rb) rm rr ru) = SummaryEntry (Table $ Map.union lb rb) (lm <> rm) (max lr rr) (max lu ru)
334+ toSummary Build{finished, buildstatus, job, id, system} = Map.singleton name (SummaryEntry (Table (Map.singleton (set, Platform system) (BuildResult state id))) maintainers reverseDeps unbrokenReverseDeps)
283335 where
284336 state :: BuildState
285337 state = case (finished, buildstatus) of
@@ -297,6 +349,7 @@ buildSummary maintainerMap = foldl (Map.unionWith unionSummary) Map.empty . fmap
297349 name = maybe packageName NonEmpty.last splitted
298350 set = maybe "" (Text.intercalate "." . NonEmpty.init) splitted
299351 maintainers = maybe mempty (Set.fromList . toList) (Map.lookup job maintainerMap)
352+ (reverseDeps, unbrokenReverseDeps) = Map.findWithDefault (0,0) name reverseDependencyMap
300353
301354readBuildReports :: IO (Eval, UTCTime, Seq Build)
302355readBuildReports = do
@@ -339,17 +392,18 @@ makeSearchLink evalId linkLabel query = "[" <> linkLabel <> "](" <> "https://hyd
339392statusToNumSummary :: StatusSummary -> NumSummary
340393statusToNumSummary = fmap getSum . foldMap (fmap Sum . jobTotals)
341394
342−jobTotals :: (Table Text Platform BuildResult, a) -> Table Platform BuildState Int
343−jobTotals (Table mapping, _) = getSum <$> Table (Map.foldMapWithKey (\(_, platform) (BuildResult buildstate _) -> Map.singleton (platform, buildstate) (Sum 1)) mapping)
395+jobTotals :: SummaryEntry -> Table Platform BuildState Int
396+jobTotals (summaryBuilds -> Table mapping) = getSum <$> Table (Map.foldMapWithKey (\(_, platform) (BuildResult buildstate _) -> Map.singleton (platform, buildstate) (Sum 1)) mapping)
344397
345398details :: Text -> [Text] -> [Text]
346399details summary content = ["<details><summary>" <> summary <> " </summary>", ""] <> content <> ["</details>", ""]
347400
348−printBuildSummary :: Eval -> UTCTime -> StatusSummary -> Text
401+printBuildSummary :: Eval -> UTCTime -> StatusSummary -> [(Text, Int)] -> Text
349402printBuildSummary
350403 Eval{id, jobsetevalinputs = JobsetEvalInputs{nixpkgs = Nixpkgs{revision}}}
351404 fetchTime
352− summary =
405+ summary
406+ topBrokenRdeps =
353407 Text.unlines $
354408 headline <> totals
355409 <> optionalList "#### Maintained packages with build failure" (maintainedList fails)
@@ -358,6 +412,8 @@ printBuildSummary
358412 <> optionalHideableList "#### Unmaintained packages with build failure" (unmaintainedList fails)
359413 <> optionalHideableList "#### Unmaintained packages with failed dependency" (unmaintainedList failedDeps)
360414 <> optionalHideableList "#### Unmaintained packages with unknown error" (unmaintainedList unknownErr)
415+ <> optionalHideableList "#### Top 50 broken packages, sorted by number of reverse dependencies" (brokenLine <$> topBrokenRdeps)
416+ <> ["","*:arrow_heading_up:: The number of packages that depend (directly or indirectly) on this package (if any). If two numbers are shown the first (lower) number considers only packages which currently have enabled hydra jobs, i.e. are not marked broken. The second (higher) number considers all packages.*",""]
361417 <> footer
362418 where
363419 footer = ["*Report generated with [maintainers/scripts/haskell/hydra-report.hs](https://github.com/NixOS/nixpkgs/blob/haskell-updates/maintainers/scripts/haskell/hydra-report.sh)*"]
@@ -380,24 +436,29 @@ printBuildSummary
380436 <> Text.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" fetchTime)
381437 <> "*"
382438 ]
383− jobsByState predicate = Map.filter (predicate . foldl' min Success . fmap state . fst) summary
439+ brokenLine (name, rdeps) = "[" <> name <> "](https://search.nixos.org/packages?channel=unstable&show=haskellPackages." <> name <> "&query=haskellPackages." <> name <> ") :arrow_heading_up: " <> Text.pack (show rdeps)
440+ jobsByState predicate = Map.filter (predicate . foldl' min Success . fmap state . summaryBuilds) summary
384441 fails = jobsByState (== Failed)
385442 failedDeps = jobsByState (== DependencyFailed)
386443 unknownErr = jobsByState (\x -> x > DependencyFailed && x < TimedOut)
387− withMaintainer = Map.mapMaybe (\(x, m) -> (x,) <$> nonEmpty (Set.toList m))
388− withoutMaintainer = Map.mapMaybe (\(x, m) -> if Set.null m then Just x else Nothing)
444+ withMaintainer = Map.mapMaybe (\e -> (summaryBuilds e,) <$> nonEmpty (Set.toList (summaryMaintainers e)))
445+ withoutMaintainer = Map.mapMaybe (\e -> if Set.null (summaryMaintainers e) then Just e else Nothing)
389446 optionalList heading list = if null list then mempty else [heading] <> list
390447 optionalHideableList heading list = if null list then mempty else [heading] <> details (showT (length list) <> " job(s)") list
391448 maintainedList = showMaintainedBuild <=< Map.toList . withMaintainer
392− unmaintainedList = showBuild <=< Map.toList . withoutMaintainer
393− showBuild (name, table) = printJob id name (table, "")
449+ unmaintainedList = showBuild <=< sortOn (\(snd -> x) -> (negate (summaryUnbrokenReverseDeps x), negate (summaryReverseDeps x))) . Map.toList . withoutMaintainer
450+ showBuild (name, entry) = printJob id name (summaryBuilds entry, Text.pack (if summaryReverseDeps entry > 0 then " :arrow_heading_up: " <> show (summaryUnbrokenReverseDeps entry) <>" | "<> show (summaryReverseDeps entry) else ""))
394451 showMaintainedBuild (name, (table, maintainers)) = printJob id name (table, Text.intercalate " " (fmap ("@" <>) (toList maintainers)))
395452
396453printMaintainerPing :: IO ()
397454printMaintainerPing = do
398− maintainerMap <- getMaintainerMap
455+ (maintainerMap, (reverseDependencyMap, topBrokenRdeps)) <- concurrently getMaintainerMap do
456+ depMap <- getDependencyMap
457+ rdepMap <- evaluate . calculateReverseDependencies $ depMap
458+ let tops = take 50 . sortOn (negate . snd) . fmap (second fst) . filter (\x -> maybe False broken $ Map.lookup (fst x) depMap) . Map.toList $ rdepMap
459+ pure (rdepMap, tops)
399460 (eval, fetchTime, buildReport) <- readBuildReports
400− putStrLn (Text.unpack (printBuildSummary eval fetchTime (buildSummary maintainerMap buildReport)))
461+ putStrLn (Text.unpack (printBuildSummary eval fetchTime (buildSummary maintainerMap reverseDependencyMap buildReport) topBrokenRdeps))
401462
402463printMarkBrokenList :: IO ()
403464printMarkBrokenList = do