pyrox.dev
1#! /usr/bin/env nix-shell
2#! nix-shell -p "haskellPackages.ghcWithPackages (p: [p.aeson p.req])"
3#! nix-shell -p hydra-unstable
4#! nix-shell -i runhaskell
5
6{-
7
8The purpose of this script is
9
101) download the state of the nixpkgs/haskell-updates job from hydra (with get-report)
112) print a summary of the state suitable for pasting into a github comment (with ping-maintainers)
123) print a list of broken packages suitable for pasting into configuration-hackage2nix.yaml
13
14Because step 1) is quite expensive and takes roughly ~5 minutes the result is cached in a json file in XDG_CACHE.
15
16-}
17{-# LANGUAGE BlockArguments #-}
18{-# LANGUAGE DeriveAnyClass #-}
19{-# LANGUAGE DeriveGeneric #-}
20{-# LANGUAGE DerivingStrategies #-}
21{-# LANGUAGE DuplicateRecordFields #-}
22{-# LANGUAGE LambdaCase #-}
23{-# LANGUAGE MultiWayIf #-}
24{-# LANGUAGE NamedFieldPuns #-}
25{-# LANGUAGE OverloadedStrings #-}
26{-# LANGUAGE ScopedTypeVariables #-}
27{-# LANGUAGE TupleSections #-}
28{-# OPTIONS_GHC -Wall #-}
29{-# LANGUAGE ViewPatterns #-}
30{-# LANGUAGE TupleSections #-}
31
32import Control.Monad (forM_, (<=<))
33import Control.Monad.Trans (MonadIO (liftIO))
34import Data.Aeson (
35 FromJSON,
36 ToJSON,
37 decodeFileStrict',
38 eitherDecodeStrict',
39 encodeFile,
40 )
41import Data.Foldable (Foldable (toList), foldl')
42import Data.List.NonEmpty (NonEmpty, nonEmpty)
43import qualified Data.List.NonEmpty as NonEmpty
44import Data.Map.Strict (Map)
45import qualified Data.Map.Strict as Map
46import Data.Maybe (fromMaybe, mapMaybe, isNothing)
47import Data.Monoid (Sum (Sum, getSum))
48import Data.Sequence (Seq)
49import qualified Data.Sequence as Seq
50import Data.Set (Set)
51import qualified Data.Set as Set
52import Data.Text (Text)
53import qualified Data.Text as Text
54import Data.Text.Encoding (encodeUtf8)
55import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)
56import Data.Time.Clock (UTCTime)
57import GHC.Generics (Generic)
58import Network.HTTP.Req (
59 GET (GET),
60 NoReqBody (NoReqBody),
61 defaultHttpConfig,
62 header,
63 https,
64 jsonResponse,
65 req,
66 responseBody,
67 responseTimeout,
68 runReq,
69 (/:),
70 )
71import System.Directory (XdgDirectory (XdgCache), getXdgDirectory)
72import System.Environment (getArgs)
73import System.Process (readProcess)
74import Prelude hiding (id)
75import Data.List (sortOn)
76import Control.Concurrent.Async (concurrently)
77import Control.Exception (evaluate)
78import qualified Data.IntMap.Strict as IntMap
79import qualified Data.IntSet as IntSet
80import Data.Bifunctor (second)
81
82newtype JobsetEvals = JobsetEvals
83 { evals :: Seq Eval
84 }
85 deriving (Generic, ToJSON, FromJSON, Show)
86
87newtype Nixpkgs = Nixpkgs {revision :: Text}
88 deriving (Generic, ToJSON, FromJSON, Show)
89
90newtype JobsetEvalInputs = JobsetEvalInputs {nixpkgs :: Nixpkgs}
91 deriving (Generic, ToJSON, FromJSON, Show)
92
93data Eval = Eval
94 { id :: Int
95 , jobsetevalinputs :: JobsetEvalInputs
96 }
97 deriving (Generic, ToJSON, FromJSON, Show)
98
99data Build = Build
100 { job :: Text
101 , buildstatus :: Maybe Int
102 , finished :: Int
103 , id :: Int
104 , nixname :: Text
105 , system :: Text
106 , jobsetevals :: Seq Int
107 }
108 deriving (Generic, ToJSON, FromJSON, Show)
109
110main :: IO ()
111main = do
112 args <- getArgs
113 case args of
114 ["get-report"] -> getBuildReports
115 ["ping-maintainers"] -> printMaintainerPing
116 ["mark-broken-list"] -> printMarkBrokenList
117 _ -> putStrLn "Usage: get-report | ping-maintainers | mark-broken-list"
118
119reportFileName :: IO FilePath
120reportFileName = getXdgDirectory XdgCache "haskell-updates-build-report.json"
121
122showT :: Show a => a -> Text
123showT = Text.pack . show
124
125getBuildReports :: IO ()
126getBuildReports = runReq defaultHttpConfig do
127 evalMay <- Seq.lookup 0 . evals <$> myReq (https "hydra.nixos.org" /: "jobset" /: "nixpkgs" /: "haskell-updates" /: "evals") mempty
128 eval@Eval{id} <- maybe (liftIO $ fail "No Evalution found") pure evalMay
129 liftIO . putStrLn $ "Fetching evaluation " <> show id <> " from Hydra. This might take a few minutes..."
130 buildReports :: Seq Build <- myReq (https "hydra.nixos.org" /: "eval" /: showT id /: "builds") (responseTimeout 600000000)
131 liftIO do
132 fileName <- reportFileName
133 putStrLn $ "Finished fetching all builds from Hydra, saving report as " <> fileName
134 now <- getCurrentTime
135 encodeFile fileName (eval, now, buildReports)
136 where
137 myReq query option = responseBody <$> req GET query NoReqBody jsonResponse (header "User-Agent" "hydra-report.hs/v1 (nixpkgs;maintainers/scripts/haskell)" <> option)
138
139hydraEvalCommand :: FilePath
140hydraEvalCommand = "hydra-eval-jobs"
141
142hydraEvalParams :: [String]
143hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"]
144
145nixExprCommand :: FilePath
146nixExprCommand = "nix-instantiate"
147
148nixExprParams :: [String]
149nixExprParams = ["--eval", "--strict", "--json"]
150
151-- | This newtype is used to parse a Hydra job output from @hydra-eval-jobs@.
152-- The only field we are interested in is @maintainers@, which is why this
153-- is just a newtype.
154--
155-- Note that there are occasionally jobs that don't have a maintainers
156-- field, which is why this has to be @Maybe Text@.
157newtype Maintainers = Maintainers { maintainers :: Maybe Text }
158 deriving stock (Generic, Show)
159 deriving anyclass (FromJSON, ToJSON)
160
161-- | This is a 'Map' from Hydra job name to maintainer email addresses.
162--
163-- It has values similar to the following:
164--
165-- @@
166-- fromList
167-- [ ("arion.aarch64-linux", Maintainers (Just "robert@example.com"))
168-- , ("bench.x86_64-linux", Maintainers (Just ""))
169-- , ("conduit.x86_64-linux", Maintainers (Just "snoy@man.com, web@ber.com"))
170-- , ("lens.x86_64-darwin", Maintainers (Just "ek@category.com"))
171-- ]
172-- @@
173--
174-- Note that Hydra jobs without maintainers will have an empty string for the
175-- maintainer list.
176type HydraJobs = Map Text Maintainers
177
178-- | Map of email addresses to GitHub handles.
179-- This is built from the file @../../maintainer-list.nix@.
180--
181-- It has values similar to the following:
182--
183-- @@
184-- fromList
185-- [ ("robert@example.com", "rob22")
186-- , ("ek@category.com", "edkm")
187-- ]
188-- @@
189type EmailToGitHubHandles = Map Text Text
190
191-- | Map of Hydra jobs to maintainer GitHub handles.
192--
193-- It has values similar to the following:
194--
195-- @@
196-- fromList
197-- [ ("arion.aarch64-linux", ["rob22"])
198-- , ("conduit.x86_64-darwin", ["snoyb", "webber"])
199-- ]
200-- @@
201type MaintainerMap = Map Text (NonEmpty Text)
202
203-- | Information about a package which lists its dependencies and whether the
204-- package is marked broken.
205data 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.
214type 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).
218type 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.
222calculateReverseDependencies :: DependencyMap -> ReverseDependencyMap
223calculateReverseDependencies 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.
240getMaintainerMap :: IO MaintainerMap
241getMaintainerMap = do
242 hydraJobs :: HydraJobs <-
243 readJSONProcess hydraEvalCommand hydraEvalParams "Failed to decode hydra-eval-jobs output: "
244 handlesMap :: EmailToGitHubHandles <-
245 readJSONProcess nixExprCommand ("maintainers/scripts/haskell/maintainer-handles.nix":nixExprParams) "Failed to decode nix output for lookup of github handles: "
246 pure $ Map.mapMaybe (splitMaintainersToGitHubHandles handlesMap) hydraJobs
247 where
248 -- Split a comma-spearated string of Maintainers into a NonEmpty list of
249 -- GitHub handles.
250 splitMaintainersToGitHubHandles
251 :: EmailToGitHubHandles -> Maintainers -> Maybe (NonEmpty Text)
252 splitMaintainersToGitHubHandles handlesMap (Maintainers maint) =
253 nonEmpty . mapMaybe (`Map.lookup` handlesMap) . Text.splitOn ", " $ fromMaybe "" maint
254
255-- | Get the a map of all dependencies of every package by calling the nix
256-- script ./dependencies.nix.
257getDependencyMap :: IO DependencyMap
258getDependencyMap =
259 readJSONProcess nixExprCommand ("maintainers/scripts/haskell/dependencies.nix":nixExprParams) "Failed to decode nix output for lookup of dependencies: "
260
261-- | Run a process that produces JSON on stdout and and decode the JSON to a
262-- data type.
263--
264-- If the JSON-decoding fails, throw the JSON-decoding error.
265readJSONProcess
266 :: FromJSON a
267 => FilePath -- ^ Filename of executable.
268 -> [String] -- ^ Arguments
269 -> String -- ^ String to prefix to JSON-decode error.
270 -> IO a
271readJSONProcess exe args err = do
272 output <- readProcess exe args ""
273 let eitherDecodedOutput = eitherDecodeStrict' . encodeUtf8 . Text.pack $ output
274 case eitherDecodedOutput of
275 Left decodeErr -> error $ err <> decodeErr <> "\nRaw: '" <> take 1000 output <> "'"
276 Right decodedOutput -> pure decodedOutput
277
278-- BuildStates are sorted by subjective importance/concerningness
279data BuildState
280 = Failed
281 | DependencyFailed
282 | OutputLimitExceeded
283 | Unknown (Maybe Int)
284 | TimedOut
285 | Canceled
286 | HydraFailure
287 | Unfinished
288 | Success
289 deriving stock (Show, Eq, Ord)
290
291icon :: BuildState -> Text
292icon = \case
293 Failed -> ":x:"
294 DependencyFailed -> ":heavy_exclamation_mark:"
295 OutputLimitExceeded -> ":warning:"
296 Unknown x -> "unknown code " <> showT x
297 TimedOut -> ":hourglass::no_entry_sign:"
298 Canceled -> ":no_entry_sign:"
299 Unfinished -> ":hourglass_flowing_sand:"
300 HydraFailure -> ":construction:"
301 Success -> ":heavy_check_mark:"
302
303platformIcon :: Platform -> Text
304platformIcon (Platform x) = case x of
305 "x86_64-linux" -> ":penguin:"
306 "aarch64-linux" -> ":iphone:"
307 "x86_64-darwin" -> ":apple:"
308 _ -> x
309
310data BuildResult = BuildResult {state :: BuildState, id :: Int} deriving (Show, Eq, Ord)
311newtype Platform = Platform {platform :: Text} deriving (Show, Eq, Ord)
312newtype Table row col a = Table (Map (row, col) a)
313data SummaryEntry = SummaryEntry {
314 summaryBuilds :: Table Text Platform BuildResult,
315 summaryMaintainers :: Set Text,
316 summaryReverseDeps :: Int,
317 summaryUnbrokenReverseDeps :: Int
318}
319type StatusSummary = Map Text SummaryEntry
320
321instance (Ord row, Ord col, Semigroup a) => Semigroup (Table row col a) where
322 Table l <> Table r = Table (Map.unionWith (<>) l r)
323instance (Ord row, Ord col, Semigroup a) => Monoid (Table row col a) where
324 mempty = Table Map.empty
325instance Functor (Table row col) where
326 fmap f (Table a) = Table (fmap f a)
327instance Foldable (Table row col) where
328 foldMap f (Table a) = foldMap f a
329
330buildSummary :: MaintainerMap -> ReverseDependencyMap -> Seq Build -> StatusSummary
331buildSummary maintainerMap reverseDependencyMap = foldl (Map.unionWith unionSummary) Map.empty . fmap toSummary
332 where
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)
335 where
336 state :: BuildState
337 state = case (finished, buildstatus) of
338 (0, _) -> Unfinished
339 (_, Just 0) -> Success
340 (_, Just 1) -> Failed
341 (_, Just 2) -> DependencyFailed
342 (_, Just 3) -> HydraFailure
343 (_, Just 4) -> Canceled
344 (_, Just 7) -> TimedOut
345 (_, Just 11) -> OutputLimitExceeded
346 (_, i) -> Unknown i
347 packageName = fromMaybe job (Text.stripSuffix ("." <> system) job)
348 splitted = nonEmpty $ Text.splitOn "." packageName
349 name = maybe packageName NonEmpty.last splitted
350 set = maybe "" (Text.intercalate "." . NonEmpty.init) splitted
351 maintainers = maybe mempty (Set.fromList . toList) (Map.lookup job maintainerMap)
352 (reverseDeps, unbrokenReverseDeps) = Map.findWithDefault (0,0) name reverseDependencyMap
353
354readBuildReports :: IO (Eval, UTCTime, Seq Build)
355readBuildReports = do
356 file <- reportFileName
357 fromMaybe (error $ "Could not decode " <> file) <$> decodeFileStrict' file
358
359sep :: Text
360sep = " | "
361joinTable :: [Text] -> Text
362joinTable t = sep <> Text.intercalate sep t <> sep
363
364type NumSummary = Table Platform BuildState Int
365
366printTable :: (Ord rows, Ord cols) => Text -> (rows -> Text) -> (cols -> Text) -> (entries -> Text) -> Table rows cols entries -> [Text]
367printTable name showR showC showE (Table mapping) = joinTable <$> (name : map showC cols) : replicate (length cols + sepsInName + 1) "---" : map printRow rows
368 where
369 sepsInName = Text.count "|" name
370 printRow row = showR row : map (\col -> maybe "" showE (Map.lookup (row, col) mapping)) cols
371 rows = toList $ Set.fromList (fst <$> Map.keys mapping)
372 cols = toList $ Set.fromList (snd <$> Map.keys mapping)
373
374printJob :: Int -> Text -> (Table Text Platform BuildResult, Text) -> [Text]
375printJob evalId name (Table mapping, maintainers) =
376 if length sets <= 1
377 then map printSingleRow sets
378 else ["- [ ] " <> makeJobSearchLink "" name <> " " <> maintainers] <> map printRow sets
379 where
380 printRow set = " - " <> printState set <> " " <> makeJobSearchLink set (if Text.null set then "toplevel" else set)
381 printSingleRow set = "- [ ] " <> printState set <> " " <> makeJobSearchLink set (makePkgName set) <> " " <> maintainers
382 makePkgName set = (if Text.null set then "" else set <> ".") <> name
383 printState set = Text.intercalate " " $ map (\pf -> maybe "" (label pf) $ Map.lookup (set, pf) mapping) platforms
384 makeJobSearchLink set linkLabel= makeSearchLink evalId linkLabel (makePkgName set)
385 sets = toList $ Set.fromList (fst <$> Map.keys mapping)
386 platforms = toList $ Set.fromList (snd <$> Map.keys mapping)
387 label pf (BuildResult s i) = "[[" <> platformIcon pf <> icon s <> "]](https://hydra.nixos.org/build/" <> showT i <> ")"
388
389makeSearchLink :: Int -> Text -> Text -> Text
390makeSearchLink evalId linkLabel query = "[" <> linkLabel <> "](" <> "https://hydra.nixos.org/eval/" <> showT evalId <> "?filter=" <> query <> ")"
391
392statusToNumSummary :: StatusSummary -> NumSummary
393statusToNumSummary = fmap getSum . foldMap (fmap Sum . jobTotals)
394
395jobTotals :: SummaryEntry -> Table Platform BuildState Int
396jobTotals (summaryBuilds -> Table mapping) = getSum <$> Table (Map.foldMapWithKey (\(_, platform) (BuildResult buildstate _) -> Map.singleton (platform, buildstate) (Sum 1)) mapping)
397
398details :: Text -> [Text] -> [Text]
399details summary content = ["<details><summary>" <> summary <> " </summary>", ""] <> content <> ["</details>", ""]
400
401printBuildSummary :: Eval -> UTCTime -> StatusSummary -> [(Text, Int)] -> Text
402printBuildSummary
403 Eval{id, jobsetevalinputs = JobsetEvalInputs{nixpkgs = Nixpkgs{revision}}}
404 fetchTime
405 summary
406 topBrokenRdeps =
407 Text.unlines $
408 headline <> [""] <> tldr <> ((" * "<>) <$> (errors <> warnings)) <> [""]
409 <> totals
410 <> optionalList "#### Maintained packages with build failure" (maintainedList fails)
411 <> optionalList "#### Maintained packages with failed dependency" (maintainedList failedDeps)
412 <> optionalList "#### Maintained packages with unknown error" (maintainedList unknownErr)
413 <> optionalHideableList "#### Unmaintained packages with build failure" (unmaintainedList fails)
414 <> optionalHideableList "#### Unmaintained packages with failed dependency" (unmaintainedList failedDeps)
415 <> optionalHideableList "#### Unmaintained packages with unknown error" (unmaintainedList unknownErr)
416 <> optionalHideableList "#### Top 50 broken packages, sorted by number of reverse dependencies" (brokenLine <$> topBrokenRdeps)
417 <> ["","*: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.*",""]
418 <> footer
419 where
420 footer = ["*Report generated with [maintainers/scripts/haskell/hydra-report.hs](https://github.com/NixOS/nixpkgs/blob/haskell-updates/maintainers/scripts/haskell/hydra-report.sh)*"]
421 totals =
422 [ "#### Build summary"
423 , ""
424 ]
425 <> printTable "Platform" (\x -> makeSearchLink id (platform x <> " " <> platformIcon x) ("." <> platform x)) (\x -> showT x <> " " <> icon x) showT numSummary
426 headline =
427 [ "### [haskell-updates build report from hydra](https://hydra.nixos.org/jobset/nixpkgs/haskell-updates)"
428 , "*evaluation ["
429 <> showT id
430 <> "](https://hydra.nixos.org/eval/"
431 <> showT id
432 <> ") of nixpkgs commit ["
433 <> Text.take 7 revision
434 <> "](https://github.com/NixOS/nixpkgs/commits/"
435 <> revision
436 <> ") as of "
437 <> Text.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" fetchTime)
438 <> "*"
439 ]
440 brokenLine (name, rdeps) = "[" <> name <> "](https://packdeps.haskellers.com/reverse/" <> name <> ") :arrow_heading_up: " <> Text.pack (show rdeps) <> " "
441 numSummary = statusToNumSummary summary
442 jobsByState predicate = Map.filter (predicate . worstState) summary
443 worstState = foldl' min Success . fmap state . summaryBuilds
444 fails = jobsByState (== Failed)
445 failedDeps = jobsByState (== DependencyFailed)
446 unknownErr = jobsByState (\x -> x > DependencyFailed && x < TimedOut)
447 withMaintainer = Map.mapMaybe (\e -> (summaryBuilds e,) <$> nonEmpty (Set.toList (summaryMaintainers e)))
448 withoutMaintainer = Map.mapMaybe (\e -> if Set.null (summaryMaintainers e) then Just e else Nothing)
449 optionalList heading list = if null list then mempty else [heading] <> list
450 optionalHideableList heading list = if null list then mempty else [heading] <> details (showT (length list) <> " job(s)") list
451 maintainedList = showMaintainedBuild <=< Map.toList . withMaintainer
452 unmaintainedList = showBuild <=< sortOn (\(snd -> x) -> (negate (summaryUnbrokenReverseDeps x), negate (summaryReverseDeps x))) . Map.toList . withoutMaintainer
453 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 ""))
454 showMaintainedBuild (name, (table, maintainers)) = printJob id name (table, Text.intercalate " " (fmap ("@" <>) (toList maintainers)))
455 tldr = case (errors, warnings) of
456 ([],[]) -> [":green_circle: **Ready to merge**"]
457 ([],_) -> [":yellow_circle: **Potential issues**"]
458 _ -> [":red_circle: **Branch not mergeable**"]
459 warnings =
460 if' (Unfinished > maybe Success worstState maintainedJob) "`maintained` jobset failed." <>
461 if' (Unfinished == maybe Success worstState mergeableJob) "`mergeable` jobset is not finished." <>
462 if' (Unfinished == maybe Success worstState maintainedJob) "`maintained` jobset is not finished."
463 errors =
464 if' (isNothing mergeableJob) "No `mergeable` job found." <>
465 if' (isNothing maintainedJob) "No `maintained` job found." <>
466 if' (Unfinished > maybe Success worstState mergeableJob) "`mergeable` jobset failed." <>
467 if' (outstandingJobs (Platform "x86_64-linux") > 100) "Too many outstanding jobs on x86_64-linux." <>
468 if' (outstandingJobs (Platform "aarch64-linux") > 100) "Too many outstanding jobs on aarch64-linux."
469 if' p e = if p then [e] else mempty
470 outstandingJobs platform | Table m <- numSummary = Map.findWithDefault 0 (platform, Unfinished) m
471 maintainedJob = Map.lookup "maintained" summary
472 mergeableJob = Map.lookup "mergeable" summary
473
474printMaintainerPing :: IO ()
475printMaintainerPing = do
476 (maintainerMap, (reverseDependencyMap, topBrokenRdeps)) <- concurrently getMaintainerMap do
477 depMap <- getDependencyMap
478 rdepMap <- evaluate . calculateReverseDependencies $ depMap
479 let tops = take 50 . sortOn (negate . snd) . fmap (second fst) . filter (\x -> maybe False broken $ Map.lookup (fst x) depMap) . Map.toList $ rdepMap
480 pure (rdepMap, tops)
481 (eval, fetchTime, buildReport) <- readBuildReports
482 putStrLn (Text.unpack (printBuildSummary eval fetchTime (buildSummary maintainerMap reverseDependencyMap buildReport) topBrokenRdeps))
483
484printMarkBrokenList :: IO ()
485printMarkBrokenList = do
486 (_, _, buildReport) <- readBuildReports
487 forM_ buildReport \Build{buildstatus, job} ->
488 case (buildstatus, Text.splitOn "." job) of
489 (Just 1, ["haskellPackages", name, "x86_64-linux"]) -> putStrLn $ " - " <> Text.unpack name
490 _ -> pure ()