From b2af201c0e70b28d59e26becd18b3095dc7f9636 Mon Sep 17 00:00:00 2001 From: Dennis Gosnell Date: Sat, 25 Mar 2023 19:24:13 +0900 Subject: [PATCH 1/4] haskellPackages: add newtype for JobName in hydra-report.hs This commits changes the `job` field in `Build` to a newtype. This is mostly just to have a place to document exactly what a job name consists of. --- maintainers/scripts/haskell/hydra-report.hs | 39 ++++++++++++++------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/maintainers/scripts/haskell/hydra-report.hs b/maintainers/scripts/haskell/hydra-report.hs index 7cec26598362..7d6a13c77125 100755 --- a/maintainers/scripts/haskell/hydra-report.hs +++ b/maintainers/scripts/haskell/hydra-report.hs @@ -20,6 +20,7 @@ Because step 1) is quite expensive and takes roughly ~5 minutes the result is ca {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -33,6 +34,7 @@ import Control.Monad (forM_, (<=<)) import Control.Monad.Trans (MonadIO (liftIO)) import Data.Aeson ( FromJSON, + FromJSONKey, ToJSON, decodeFileStrict', eitherDecodeStrict', @@ -92,13 +94,16 @@ import Distribution.Simple.Utils (safeLast, fromUTF8BS) newtype JobsetEvals = JobsetEvals { evals :: Seq Eval } - deriving (Generic, ToJSON, FromJSON, Show) + deriving stock (Generic, Show) + deriving anyclass (ToJSON, FromJSON) newtype Nixpkgs = Nixpkgs {revision :: Text} - deriving (Generic, ToJSON, FromJSON, Show) + deriving stock (Generic, Show) + deriving anyclass (ToJSON, FromJSON) newtype JobsetEvalInputs = JobsetEvalInputs {nixpkgs :: Nixpkgs} - deriving (Generic, ToJSON, FromJSON, Show) + deriving stock (Generic, Show) + deriving anyclass (ToJSON, FromJSON) data Eval = Eval { id :: Int @@ -106,18 +111,24 @@ data Eval = Eval } deriving (Generic, ToJSON, FromJSON, Show) +-- | Hydra job name. +-- +-- Examples: +-- - @"haskellPackages.lens.x86_64-linux"@ +-- - @"haskell.packages.ghc925.cabal-install.aarch64-darwin"@ +-- - @"pkgsMusl.haskell.compiler.ghc90.x86_64-linux"@ +-- - @"arion.aarch64-linux"@ +newtype JobName = JobName { unJobName :: Text } + deriving stock (Generic, Show) + deriving newtype (Eq, FromJSONKey, FromJSON, Ord, ToJSON) + -- | Datatype representing the result of querying the build evals of the -- haskell-updates Hydra jobset. -- -- The URL (where @EVAL_ID@ is a -- value like 1792418) returns a list of 'Build'. data Build = Build - { job :: Text - -- ^ Hydra job name. - -- - -- Examples: - -- - @"haskellPackages.lens.x86_64-linux"@ - -- - @"haskell.packages.ghc925.cabal-install.aarch64-darwin"@ + { job :: JobName , buildstatus :: Maybe Int -- ^ Status of the build. See 'getBuildState' for the meaning of each state. , finished :: Int @@ -221,7 +232,7 @@ newtype Maintainers = Maintainers { maintainers :: Maybe Text } -- -- Note that Hydra jobs without maintainers will have an empty string for the -- maintainer list. -type HydraJobs = Map Text Maintainers +type HydraJobs = Map JobName Maintainers -- | Map of email addresses to GitHub handles. -- This is built from the file @../../maintainer-list.nix@. @@ -246,7 +257,7 @@ type EmailToGitHubHandles = Map Text Text -- , ("conduit.x86_64-darwin", ["snoyb", "webber"]) -- ] -- @@ -type MaintainerMap = Map Text (NonEmpty Text) +type MaintainerMap = Map JobName (NonEmpty Text) -- | Information about a package which lists its dependencies and whether the -- package is marked broken. @@ -406,8 +417,10 @@ buildToStatusSummary :: MaintainerMap -> ReverseDependencyMap -> Build -> Status buildToStatusSummary maintainerMap reverseDependencyMap build@Build{job, id, system} = Map.singleton name summaryEntry where + jobName = unJobName job + packageName :: Text - packageName = fromMaybe job (Text.stripSuffix ("." <> system) job) + packageName = fromMaybe jobName (Text.stripSuffix ("." <> system) jobName) splitted :: Maybe (NonEmpty Text) splitted = nonEmpty $ Text.splitOn "." packageName @@ -580,7 +593,7 @@ printMarkBrokenList :: IO () printMarkBrokenList = do (_, fetchTime, buildReport) <- readBuildReports runReq defaultHttpConfig $ forM_ buildReport \build@Build{job, id} -> - case (getBuildState build, Text.splitOn "." job) of + case (getBuildState build, Text.splitOn "." $ unJobName job) of (Failed, ["haskellPackages", name, "x86_64-linux"]) -> do -- Fetch build log from hydra to figure out the cause of the error. build_log <- ByteString.lines <$> hydraPlainQuery ["build", showT id, "nixlog", "1", "raw"] From 19b567636119e6dac41a770370bd5e58a60c8f59 Mon Sep 17 00:00:00 2001 From: Dennis Gosnell Date: Sat, 25 Mar 2023 23:00:56 +0900 Subject: [PATCH 2/4] haskellPackages: add newtype for PkgName and PkgSet in hydra-report.hs Add a newtype for a package name and a package set. This is less for correctness, and more just to make the code a little easier to read through without having to keep in mind what each Text refers to. --- maintainers/scripts/haskell/hydra-report.hs | 221 ++++++++++++++++---- 1 file changed, 180 insertions(+), 41 deletions(-) diff --git a/maintainers/scripts/haskell/hydra-report.hs b/maintainers/scripts/haskell/hydra-report.hs index 7d6a13c77125..0c847a6154ae 100755 --- a/maintainers/scripts/haskell/hydra-report.hs +++ b/maintainers/scripts/haskell/hydra-report.hs @@ -262,7 +262,7 @@ type MaintainerMap = Map JobName (NonEmpty Text) -- | Information about a package which lists its dependencies and whether the -- package is marked broken. data DepInfo = DepInfo { - deps :: Set Text, + deps :: Set PkgName, broken :: Bool } deriving stock (Generic, Show) @@ -270,23 +270,37 @@ data DepInfo = DepInfo { -- | Map from package names to their DepInfo. This is the data we get out of a -- nix call. -type DependencyMap = Map Text DepInfo +type DependencyMap = Map PkgName DepInfo -- | Map from package names to its broken state, number of reverse dependencies (fst) and -- unbroken reverse dependencies (snd). -type ReverseDependencyMap = Map Text (Int, Int) +type ReverseDependencyMap = Map PkgName (Int, Int) -- | Calculate the (unbroken) reverse dependencies of a package by transitively -- going through all packages if it’s a dependency of them. calculateReverseDependencies :: DependencyMap -> ReverseDependencyMap -calculateReverseDependencies depMap = Map.fromDistinctAscList $ zip keys (zip (rdepMap False) (rdepMap True)) +calculateReverseDependencies depMap = + Map.fromDistinctAscList $ zip keys (zip (rdepMap False) (rdepMap True)) where -- This code tries to efficiently invert the dependency map and calculate -- it’s transitive closure by internally identifying every pkg with it’s index -- in the package list and then using memoization. + keys :: [PkgName] keys = Map.keys depMap + + pkgToIndexMap :: Map PkgName Int pkgToIndexMap = Map.fromDistinctAscList (zip keys [0..]) - intDeps = zip [0..] $ (\DepInfo{broken,deps} -> (broken,mapMaybe (`Map.lookup` pkgToIndexMap) $ Set.toList deps)) <$> Map.elems depMap + + depInfos :: [DepInfo] + depInfos = Map.elems depMap + + depInfoToIdx :: DepInfo -> (Bool, [Int]) + depInfoToIdx DepInfo{broken,deps} = + (broken, mapMaybe (`Map.lookup` pkgToIndexMap) $ Set.toList deps) + + intDeps :: [(Int, (Bool, [Int]))] + intDeps = zip [0..] (fmap depInfoToIdx depInfos) + rdepMap onlyUnbroken = IntSet.size <$> resultList where resultList = go <$> [0..] @@ -315,7 +329,10 @@ getMaintainerMap = do -- script ./dependencies.nix. getDependencyMap :: IO DependencyMap getDependencyMap = - readJSONProcess nixExprCommand ("maintainers/scripts/haskell/dependencies.nix":nixExprParams) "Failed to decode nix output for lookup of dependencies: " + readJSONProcess + nixExprCommand + ("maintainers/scripts/haskell/dependencies.nix" : nixExprParams) + "Failed to decode nix output for lookup of dependencies: " -- | Run a process that produces JSON on stdout and and decode the JSON to a -- data type. @@ -367,15 +384,52 @@ platformIcon (Platform x) = case x of "aarch64-darwin" -> ":green_apple:" _ -> x +-- | A package name. This is parsed from a 'JobName'. +-- +-- Examples: +-- +-- - The 'JobName' @"haskellPackages.lens.x86_64-linux"@ produces the 'PkgName' +-- @"lens"@. +-- - The 'JobName' @"haskell.packages.ghc925.cabal-install.aarch64-darwin"@ +-- produces the 'PkgName' @"cabal-install"@. +-- - The 'JobName' @"pkgsMusl.haskell.compiler.ghc90.x86_64-linux"@ produces +-- the 'PkgName' @"ghc90"@. +-- - The 'JobName' @"arion.aarch64-linux"@ produces the 'PkgName' @"arion"@. +-- +-- 'PkgName' is also used as a key in 'DependencyMap' and 'ReverseDependencyMap'. +-- In this case, 'PkgName' originally comes from attribute names in @haskellPackages@ +-- in Nixpkgs. +newtype PkgName = PkgName Text + deriving stock (Generic, Show) + deriving newtype (Eq, FromJSON, FromJSONKey, Ord, ToJSON) + +-- | A package set name. This is parsed from a 'JobName'. +-- +-- Examples: +-- +-- - The 'JobName' @"haskellPackages.lens.x86_64-linux"@ produces the 'PkgSet' +-- @"haskellPackages"@. +-- - The 'JobName' @"haskell.packages.ghc925.cabal-install.aarch64-darwin"@ +-- produces the 'PkgSet' @"haskell.packages.ghc925"@. +-- - The 'JobName' @"pkgsMusl.haskell.compiler.ghc90.x86_64-linux"@ produces +-- the 'PkgSet' @"pkgsMusl.haskell.compiler"@. +-- - The 'JobName' @"arion.aarch64-linux"@ produces the 'PkgSet' @""@. +-- +-- As you can see from the last example, 'PkgSet' can be empty (@""@) for +-- top-level jobs. +newtype PkgSet = PkgSet Text + deriving stock (Generic, Show) + deriving newtype (Eq, FromJSON, FromJSONKey, Ord, ToJSON) + data BuildResult = BuildResult {state :: BuildState, id :: Int} deriving (Show, Eq, Ord) newtype Platform = Platform {platform :: Text} deriving (Show, Eq, Ord) data SummaryEntry = SummaryEntry { - summaryBuilds :: Table Text Platform BuildResult, + summaryBuilds :: Table PkgSet Platform BuildResult, summaryMaintainers :: Set Text, summaryReverseDeps :: Int, summaryUnbrokenReverseDeps :: Int } -type StatusSummary = Map Text SummaryEntry +type StatusSummary = Map PkgName SummaryEntry newtype Table row col a = Table (Map (row, col) a) @@ -413,32 +467,36 @@ combineStatusSummaries = foldl (Map.unionWith unionSummary) Map.empty unionSummary (SummaryEntry lb lm lr lu) (SummaryEntry rb rm rr ru) = SummaryEntry (unionTable lb rb) (lm <> rm) (max lr rr) (max lu ru) -buildToStatusSummary :: MaintainerMap -> ReverseDependencyMap -> Build -> StatusSummary -buildToStatusSummary maintainerMap reverseDependencyMap build@Build{job, id, system} = - Map.singleton name summaryEntry +buildToPkgNameAndSet :: Build -> (PkgName, PkgSet) +buildToPkgNameAndSet Build{job = JobName jobName, system} = (name, set) where - jobName = unJobName job - packageName :: Text packageName = fromMaybe jobName (Text.stripSuffix ("." <> system) jobName) splitted :: Maybe (NonEmpty Text) splitted = nonEmpty $ Text.splitOn "." packageName - name :: Text - name = maybe packageName NonEmpty.last splitted + name :: PkgName + name = PkgName $ maybe packageName NonEmpty.last splitted - set :: Text - set = maybe "" (Text.intercalate "." . NonEmpty.init) splitted + set :: PkgSet + set = PkgSet $ maybe "" (Text.intercalate "." . NonEmpty.init) splitted + +buildToStatusSummary :: MaintainerMap -> ReverseDependencyMap -> Build -> StatusSummary +buildToStatusSummary maintainerMap reverseDependencyMap build@Build{job, id, system} = + Map.singleton pkgName summaryEntry + where + (pkgName, pkgSet) = buildToPkgNameAndSet build maintainers :: Set Text maintainers = maybe mempty (Set.fromList . toList) (Map.lookup job maintainerMap) - (reverseDeps, unbrokenReverseDeps) = Map.findWithDefault (0,0) name reverseDependencyMap + (reverseDeps, unbrokenReverseDeps) = + Map.findWithDefault (0,0) pkgName reverseDependencyMap - buildTable :: Table Text Platform BuildResult + buildTable :: Table PkgSet Platform BuildResult buildTable = - singletonTable set (Platform system) (BuildResult (getBuildState build) id) + singletonTable pkgSet (Platform system) (BuildResult (getBuildState build) id) summaryEntry = SummaryEntry buildTable maintainers reverseDeps unbrokenReverseDeps @@ -462,19 +520,36 @@ printTable name showR showC showE (Table mapping) = joinTable <$> (name : map sh rows = toList $ Set.fromList (fst <$> Map.keys mapping) cols = toList $ Set.fromList (snd <$> Map.keys mapping) -printJob :: Int -> Text -> (Table Text Platform BuildResult, Text) -> [Text] -printJob evalId name (Table mapping, maintainers) = +printJob :: Int -> PkgName -> (Table PkgSet Platform BuildResult, Text) -> [Text] +printJob evalId (PkgName name) (Table mapping, maintainers) = if length sets <= 1 then map printSingleRow sets - else ["- [ ] " <> makeJobSearchLink "" name <> " " <> maintainers] <> map printRow sets + else ["- [ ] " <> makeJobSearchLink (PkgSet "") name <> " " <> maintainers] <> map printRow sets where - printRow set = " - " <> printState set <> " " <> makeJobSearchLink set (if Text.null set then "toplevel" else set) - printSingleRow set = "- [ ] " <> printState set <> " " <> makeJobSearchLink set (makePkgName set) <> " " <> maintainers - makePkgName set = (if Text.null set then "" else set <> ".") <> name - printState set = Text.intercalate " " $ map (\pf -> maybe "" (label pf) $ Map.lookup (set, pf) mapping) platforms - makeJobSearchLink set linkLabel= makeSearchLink evalId linkLabel (makePkgName set) + printRow :: PkgSet -> Text + printRow (PkgSet set) = + " - " <> printState (PkgSet set) <> " " <> + makeJobSearchLink (PkgSet set) (if Text.null set then "toplevel" else set) + + printSingleRow set = + "- [ ] " <> printState set <> " " <> + makeJobSearchLink set (makePkgName set) <> " " <> maintainers + + makePkgName :: PkgSet -> Text + makePkgName (PkgSet set) = (if Text.null set then "" else set <> ".") <> name + + printState set = + Text.intercalate " " $ map (\pf -> maybe "" (label pf) $ Map.lookup (set, pf) mapping) platforms + + makeJobSearchLink :: PkgSet -> Text -> Text + makeJobSearchLink set linkLabel = makeSearchLink evalId linkLabel (makePkgName set) + + sets :: [PkgSet] sets = toList $ Set.fromList (fst <$> Map.keys mapping) + + platforms :: [Platform] platforms = toList $ Set.fromList (snd <$> Map.keys mapping) + label pf (BuildResult s i) = "[[" <> platformIcon pf <> icon s <> "]](https://hydra.nixos.org/build/" <> showT i <> ")" makeSearchLink :: Int -> Text -> Text -> Text @@ -503,7 +578,7 @@ evalLine Eval{id, jobsetevalinputs = JobsetEvalInputs{nixpkgs = Nixpkgs{revision <> Text.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" fetchTime) <> "*" -printBuildSummary :: Eval -> UTCTime -> StatusSummary -> [(Text, Int)] -> Text +printBuildSummary :: Eval -> UTCTime -> StatusSummary -> [(PkgName, Int)] -> Text printBuildSummary eval@Eval{id} fetchTime summary topBrokenRdeps = Text.unlines $ headline <> [""] <> tldr <> ((" * "<>) <$> (errors <> warnings)) <> [""] @@ -519,36 +594,100 @@ printBuildSummary eval@Eval{id} fetchTime summary topBrokenRdeps = <> footer where footer = ["*Report generated with [maintainers/scripts/haskell/hydra-report.hs](https://github.com/NixOS/nixpkgs/blob/haskell-updates/maintainers/scripts/haskell/hydra-report.hs)*"] + headline = [ "### [haskell-updates build report from hydra](https://hydra.nixos.org/jobset/nixpkgs/haskell-updates)" - , evalLine eval fetchTime ] + , evalLine eval fetchTime + ] + + totals :: [Text] totals = [ "#### Build summary" , "" - ] - <> printTable "Platform" (\x -> makeSearchLink id (platform x <> " " <> platformIcon x) ("." <> platform x)) (\x -> showT x <> " " <> icon x) showT numSummary - brokenLine (name, rdeps) = "[" <> name <> "](https://packdeps.haskellers.com/reverse/" <> name <> ") :arrow_heading_up: " <> Text.pack (show rdeps) <> " " + ] <> + printTable + "Platform" + (\x -> makeSearchLink id (platform x <> " " <> platformIcon x) ("." <> platform x)) + (\x -> showT x <> " " <> icon x) + showT + numSummary + + brokenLine :: (PkgName, Int) -> Text + brokenLine (PkgName name, rdeps) = + "[" <> name <> "](https://packdeps.haskellers.com/reverse/" <> name <> + ") :arrow_heading_up: " <> Text.pack (show rdeps) <> " " + numSummary = statusToNumSummary summary - jobsByState :: (BuildState -> Bool) -> Map Text SummaryEntry + jobsByState :: (BuildState -> Bool) -> StatusSummary jobsByState predicate = Map.filter (predicate . worstState) summary worstState :: SummaryEntry -> BuildState worstState = foldl' min Success . fmap state . summaryBuilds - fails :: Map Text SummaryEntry + fails :: StatusSummary fails = jobsByState (== Failed) + failedDeps :: StatusSummary failedDeps = jobsByState (== DependencyFailed) + + unknownErr :: StatusSummary unknownErr = jobsByState (\x -> x > DependencyFailed && x < TimedOut) - withMaintainer = Map.mapMaybe (\e -> (summaryBuilds e,) <$> nonEmpty (Set.toList (summaryMaintainers e))) + + withMaintainer :: StatusSummary -> Map PkgName (Table PkgSet Platform BuildResult, NonEmpty Text) + withMaintainer = + Map.mapMaybe + (\e -> (summaryBuilds e,) <$> nonEmpty (Set.toList (summaryMaintainers e))) + + withoutMaintainer :: StatusSummary -> StatusSummary withoutMaintainer = Map.mapMaybe (\e -> if Set.null (summaryMaintainers e) then Just e else Nothing) + + optionalList :: Text -> [Text] -> [Text] optionalList heading list = if null list then mempty else [heading] <> list + + optionalHideableList :: Text -> [Text] -> [Text] optionalHideableList heading list = if null list then mempty else [heading] <> details (showT (length list) <> " job(s)") list + + maintainedList :: StatusSummary -> [Text] maintainedList = showMaintainedBuild <=< Map.toList . withMaintainer - unmaintainedList = showBuild <=< sortOn (\(snd -> x) -> (negate (summaryUnbrokenReverseDeps x), negate (summaryReverseDeps x))) . Map.toList . withoutMaintainer - 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 "")) - showMaintainedBuild (name, (table, maintainers)) = printJob id name (table, Text.intercalate " " (fmap ("@" <>) (toList maintainers))) + + summaryEntryGetReverseDeps :: SummaryEntry -> (Int, Int) + summaryEntryGetReverseDeps sumEntry = + ( negate $ summaryUnbrokenReverseDeps sumEntry + , negate $ summaryReverseDeps sumEntry + ) + + sortOnReverseDeps :: [(PkgName, SummaryEntry)] -> [(PkgName, SummaryEntry)] + sortOnReverseDeps = sortOn (\(_, sumEntry) -> summaryEntryGetReverseDeps sumEntry) + + unmaintainedList :: StatusSummary -> [Text] + unmaintainedList = showBuild <=< sortOnReverseDeps . Map.toList . withoutMaintainer + + showBuild :: (PkgName, SummaryEntry) -> [Text] + 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 "" + ) + ) + + showMaintainedBuild + :: (PkgName, (Table PkgSet Platform BuildResult, NonEmpty Text)) -> [Text] + showMaintainedBuild (name, (table, maintainers)) = + printJob + id + name + ( table + , Text.intercalate " " (fmap ("@" <>) (toList maintainers)) + ) + tldr = case (errors, warnings) of ([],[]) -> [":green_circle: **Ready to merge** (if there are no [evaluation errors](https://hydra.nixos.org/jobset/nixpkgs/haskell-updates))"] ([],_) -> [":yellow_circle: **Potential issues** (and possibly [evaluation errors](https://hydra.nixos.org/jobset/nixpkgs/haskell-updates))"] @@ -566,8 +705,8 @@ printBuildSummary eval@Eval{id} fetchTime summary topBrokenRdeps = if' (outstandingJobs (Platform "aarch64-darwin") > 100) "Too many outstanding jobs on aarch64-darwin." if' p e = if p then [e] else mempty outstandingJobs platform | Table m <- numSummary = Map.findWithDefault 0 (platform, Unfinished) m - maintainedJob = Map.lookup "maintained" summary - mergeableJob = Map.lookup "mergeable" summary + maintainedJob = Map.lookup (PkgName "maintained") summary + mergeableJob = Map.lookup (PkgName "mergeable") summary printEvalInfo :: IO () printEvalInfo = do From bd9bb50ad22102b92e3a6e2231343a6550c7fc62 Mon Sep 17 00:00:00 2001 From: Dennis Gosnell Date: Sun, 26 Mar 2023 17:25:54 +0900 Subject: [PATCH 3/4] haskellPackages: remove error about outstanding jobs on aarch64-darwin in hydra-report.hs --- maintainers/scripts/haskell/hydra-report.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/maintainers/scripts/haskell/hydra-report.hs b/maintainers/scripts/haskell/hydra-report.hs index 0c847a6154ae..037b4980c502 100755 --- a/maintainers/scripts/haskell/hydra-report.hs +++ b/maintainers/scripts/haskell/hydra-report.hs @@ -701,10 +701,12 @@ printBuildSummary eval@Eval{id} fetchTime summary topBrokenRdeps = if' (isNothing maintainedJob) "No `maintained` job found." <> if' (Unfinished > maybe Success worstState mergeableJob) "`mergeable` jobset failed." <> if' (outstandingJobs (Platform "x86_64-linux") > 100) "Too many outstanding jobs on x86_64-linux." <> - if' (outstandingJobs (Platform "aarch64-linux") > 100) "Too many outstanding jobs on aarch64-linux." <> - if' (outstandingJobs (Platform "aarch64-darwin") > 100) "Too many outstanding jobs on aarch64-darwin." + if' (outstandingJobs (Platform "aarch64-linux") > 100) "Too many outstanding jobs on aarch64-linux." + if' p e = if p then [e] else mempty + outstandingJobs platform | Table m <- numSummary = Map.findWithDefault 0 (platform, Unfinished) m + maintainedJob = Map.lookup (PkgName "maintained") summary mergeableJob = Map.lookup (PkgName "mergeable") summary From 35295aed71ed588fb3b998110ab89e072aac731f Mon Sep 17 00:00:00 2001 From: Dennis Gosnell Date: Sun, 26 Mar 2023 17:21:54 +0900 Subject: [PATCH 4/4] haskellPackages: in hydra-report.hs, split Linux and Darwin build failures This commit changes hydra-report.hs to split up Linux and Darwin build failures into two different sections. Darwin failures are hidden by default. --- maintainers/scripts/haskell/hydra-report.hs | 67 +++++++++++++++++---- 1 file changed, 56 insertions(+), 11 deletions(-) diff --git a/maintainers/scripts/haskell/hydra-report.hs b/maintainers/scripts/haskell/hydra-report.hs index 037b4980c502..5f7e40a28bcd 100755 --- a/maintainers/scripts/haskell/hydra-report.hs +++ b/maintainers/scripts/haskell/hydra-report.hs @@ -384,6 +384,15 @@ platformIcon (Platform x) = case x of "aarch64-darwin" -> ":green_apple:" _ -> x +platformIsOS :: OS -> Platform -> Bool +platformIsOS os (Platform x) = case (os, x) of + (Linux, "x86_64-linux") -> True + (Linux, "aarch64-linux") -> True + (Darwin, "x86_64-darwin") -> True + (Darwin, "aarch64-darwin") -> True + _ -> False + + -- | A package name. This is parsed from a 'JobName'. -- -- Examples: @@ -431,6 +440,8 @@ data SummaryEntry = SummaryEntry { } type StatusSummary = Map PkgName SummaryEntry +data OS = Linux | Darwin + newtype Table row col a = Table (Map (row, col) a) singletonTable :: row -> col -> a -> Table row col a @@ -439,6 +450,12 @@ singletonTable row col a = Table $ Map.singleton (row, col) a unionTable :: (Ord row, Ord col) => Table row col a -> Table row col a -> Table row col a unionTable (Table l) (Table r) = Table $ Map.union l r +filterWithKeyTable :: (row -> col -> a -> Bool) -> Table row col a -> Table row col a +filterWithKeyTable f (Table t) = Table $ Map.filterWithKey (\(r,c) a -> f r c a) t + +nullTable :: Table row col a -> Bool +nullTable (Table t) = Map.null t + instance (Ord row, Ord col, Semigroup a) => Semigroup (Table row col a) where Table l <> Table r = Table (Map.unionWith (<>) l r) instance (Ord row, Ord col, Semigroup a) => Monoid (Table row col a) where @@ -583,12 +600,15 @@ printBuildSummary eval@Eval{id} fetchTime summary topBrokenRdeps = Text.unlines $ headline <> [""] <> tldr <> ((" * "<>) <$> (errors <> warnings)) <> [""] <> totals - <> optionalList "#### Maintained packages with build failure" (maintainedList fails) - <> optionalList "#### Maintained packages with failed dependency" (maintainedList failedDeps) - <> optionalList "#### Maintained packages with unknown error" (maintainedList unknownErr) - <> optionalHideableList "#### Unmaintained packages with build failure" (unmaintainedList fails) - <> optionalHideableList "#### Unmaintained packages with failed dependency" (unmaintainedList failedDeps) - <> optionalHideableList "#### Unmaintained packages with unknown error" (unmaintainedList unknownErr) + <> optionalList "#### Maintained Linux packages with build failure" (maintainedList (fails summaryLinux)) + <> optionalList "#### Maintained Linux packages with failed dependency" (maintainedList (failedDeps summaryLinux)) + <> optionalList "#### Maintained Linux packages with unknown error" (maintainedList (unknownErr summaryLinux)) + <> optionalHideableList "#### Maintained Darwin packages with build failure" (maintainedList (fails summaryDarwin)) + <> optionalHideableList "#### Maintained Darwin packages with failed dependency" (maintainedList (failedDeps summaryDarwin)) + <> optionalHideableList "#### Maintained Darwin packages with unknown error" (maintainedList (unknownErr summaryDarwin)) + <> optionalHideableList "#### Unmaintained packages with build failure" (unmaintainedList (fails summary)) + <> optionalHideableList "#### Unmaintained packages with failed dependency" (unmaintainedList (failedDeps summary)) + <> optionalHideableList "#### Unmaintained packages with unknown error" (unmaintainedList (unknownErr summary)) <> optionalHideableList "#### Top 50 broken packages, sorted by number of reverse dependencies" (brokenLine <$> topBrokenRdeps) <> ["","*: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.*",""] <> footer @@ -619,19 +639,44 @@ printBuildSummary eval@Eval{id} fetchTime summary topBrokenRdeps = numSummary = statusToNumSummary summary - jobsByState :: (BuildState -> Bool) -> StatusSummary - jobsByState predicate = Map.filter (predicate . worstState) summary + summaryLinux :: StatusSummary + summaryLinux = withOS Linux summary + + summaryDarwin :: StatusSummary + summaryDarwin = withOS Darwin summary + + -- Remove all BuildResult from the Table that have Platform that isn't for + -- the given OS. + tableForOS :: OS -> Table PkgSet Platform BuildResult -> Table PkgSet Platform BuildResult + tableForOS os = filterWithKeyTable (\_ platform _ -> platformIsOS os platform) + + -- Remove all BuildResult from the StatusSummary that have a Platform that + -- isn't for the given OS. Completely remove all PkgName from StatusSummary + -- that end up with no BuildResults. + withOS + :: OS + -> StatusSummary + -> StatusSummary + withOS os = + Map.mapMaybe + (\e@SummaryEntry{summaryBuilds} -> + let buildsForOS = tableForOS os summaryBuilds + in if nullTable buildsForOS then Nothing else Just e { summaryBuilds = buildsForOS } + ) + + jobsByState :: (BuildState -> Bool) -> StatusSummary -> StatusSummary + jobsByState predicate = Map.filter (predicate . worstState) worstState :: SummaryEntry -> BuildState worstState = foldl' min Success . fmap state . summaryBuilds - fails :: StatusSummary + fails :: StatusSummary -> StatusSummary fails = jobsByState (== Failed) - failedDeps :: StatusSummary + failedDeps :: StatusSummary -> StatusSummary failedDeps = jobsByState (== DependencyFailed) - unknownErr :: StatusSummary + unknownErr :: StatusSummary -> StatusSummary unknownErr = jobsByState (\x -> x > DependencyFailed && x < TimedOut) withMaintainer :: StatusSummary -> Map PkgName (Table PkgSet Platform BuildResult, NonEmpty Text)