From 19b567636119e6dac41a770370bd5e58a60c8f59 Mon Sep 17 00:00:00 2001 From: Dennis Gosnell Date: Sat, 25 Mar 2023 23:00:56 +0900 Subject: [PATCH] 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