diff --git a/maintainers/scripts/haskell/hydra-report.hs b/maintainers/scripts/haskell/hydra-report.hs index 83c415d86196..c1f96c6ce3ec 100755 --- a/maintainers/scripts/haskell/hydra-report.hs +++ b/maintainers/scripts/haskell/hydra-report.hs @@ -1,6 +1,6 @@ #! /usr/bin/env nix-shell #! nix-shell -p "haskellPackages.ghcWithPackages (p: [p.aeson p.req])" -#! nix-shell -p hydra +#! nix-shell -p nix-eval-jobs #! nix-shell -i runhaskell {- @@ -33,7 +33,9 @@ Because step 1) is quite expensive and takes roughly ~5 minutes the result is ca import Control.Monad (forM_, forM, (<=<)) import Control.Monad.Trans (MonadIO (liftIO)) import Data.Aeson ( - FromJSON, + FromJSON (..), + withObject, + (.:), FromJSONKey, ToJSON, decodeFileStrict', @@ -41,11 +43,13 @@ import Data.Aeson ( ) import Data.Aeson.Decoding (eitherDecodeStrictText) import Data.Foldable (Foldable (toList), foldl') +import Data.Either (rights) +import Data.Functor ((<&>)) import Data.List.NonEmpty (NonEmpty, nonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (fromMaybe, mapMaybe, isNothing) +import Data.Maybe (fromMaybe, mapMaybe, isNothing, catMaybes) import Data.Monoid (Sum (Sum, getSum)) import Data.Sequence (Seq) import qualified Data.Sequence as Seq @@ -217,11 +221,22 @@ hydraJSONQuery = hydraQuery jsonResponse hydraPlainQuery :: [Text] -> Req ByteString hydraPlainQuery = hydraQuery bsResponse mempty -hydraEvalCommand :: FilePath -hydraEvalCommand = "hydra-eval-jobs" +nixEvalJobsCommand :: FilePath +nixEvalJobsCommand = "nix-eval-jobs" -hydraEvalParams :: [String] -hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"] +nixEvalJobsParams :: [String] +nixEvalJobsParams = + [ + -- options necessary to make nix-eval-jobs behave like hydra-eval-jobs used to + -- https://github.com/NixOS/hydra/commit/d84ff32ce600204c6473889a3ff16cd6053533c9 + "--meta", + "--constituents", + "--force-recurse", + "--max-jobs", "1", + + "-I", ".", + "pkgs/top-level/release-haskell.nix" + ] nixExprCommand :: FilePath nixExprCommand = "nix-instantiate" @@ -229,47 +244,27 @@ nixExprCommand = "nix-instantiate" nixExprParams :: [String] nixExprParams = ["--eval", "--strict", "--json"] --- | This newtype is used to parse a Hydra job output from @hydra-eval-jobs@. --- The only field we are interested in is @maintainers@, which is why this --- is just a newtype. +-- | Holds a list of the GitHub handles of the maintainers of a given 'JobName'. -- --- Note that there are occasionally jobs that don't have a maintainers --- field, which is why this has to be @Maybe Text@. -newtype Maintainers = Maintainers { maintainers :: Maybe Text } +-- @ +-- JobMaintainers (JobName "haskellPackages.cabal-install.x86_64-linux") ["sternenseemann"] +-- @ +data JobMaintainers = JobMaintainers JobName [Text] deriving stock (Generic, Show) - deriving anyclass (FromJSON, ToJSON) --- | This is a 'Map' from Hydra job name to maintainer email addresses. --- --- It has values similar to the following: --- --- @@ --- fromList --- [ ("arion.aarch64-linux", Maintainers (Just "robert@example.com")) --- , ("bench.x86_64-linux", Maintainers (Just "")) --- , ("conduit.x86_64-linux", Maintainers (Just "snoy@man.com, web@ber.com")) --- , ("lens.x86_64-darwin", Maintainers (Just "ek@category.com")) --- ] --- @@ --- --- Note that Hydra jobs without maintainers will have an empty string for the --- maintainer list. -type HydraJobs = Map JobName Maintainers +-- | Parse the entries produced by @nix-eval-jobs@, discarding all information +-- except the name of the job (@attr@) and the @github@ attributes of the +-- maintainer objects in @meta.maintainers@. +instance FromJSON JobMaintainers where + parseJSON = withObject "HydraJob" $ \h -> do + jobName <- h .: "attr" + maintainers <- (h .: "meta") + >>= (withObject "Meta" $ \meta -> + meta .: "maintainers" + >>= mapM (withObject "Maintainer" $ \mt -> mt .: "github")) + pure $ JobMaintainers jobName maintainers --- | Map of email addresses to GitHub handles. --- This is built from the file @../../maintainer-list.nix@. --- --- It has values similar to the following: --- --- @@ --- fromList --- [ ("robert@example.com", "rob22") --- , ("ek@category.com", "edkm") --- ] --- @@ -type EmailToGitHubHandles = Map Text Text - --- | Map of Hydra jobs to maintainer GitHub handles. +-- | Map of maintained Hydra jobs to maintainer GitHub handles. -- -- It has values similar to the following: -- @@ -330,22 +325,16 @@ calculateReverseDependencies depMap = go pkg = IntSet.unions (oneStep:((resultList IntMap.!) <$> IntSet.toList oneStep)) where oneStep = IntMap.findWithDefault mempty pkg oneStepMap --- | Generate a mapping of Hydra job names to maintainer GitHub handles. Calls --- hydra-eval-jobs and the nix script ./maintainer-handles.nix. +-- | Generate a mapping of Hydra job names to maintainer GitHub handles. getMaintainerMap :: IO MaintainerMap -getMaintainerMap = do - hydraJobs :: HydraJobs <- - readJSONProcess hydraEvalCommand hydraEvalParams "Failed to decode hydra-eval-jobs output: " - handlesMap :: EmailToGitHubHandles <- - readJSONProcess nixExprCommand ("maintainers/scripts/haskell/maintainer-handles.nix":nixExprParams) "Failed to decode nix output for lookup of github handles: " - pure $ Map.mapMaybe (splitMaintainersToGitHubHandles handlesMap) hydraJobs - where - -- Split a comma-spearated string of Maintainers into a NonEmpty list of - -- GitHub handles. - splitMaintainersToGitHubHandles - :: EmailToGitHubHandles -> Maintainers -> Maybe (NonEmpty Text) - splitMaintainersToGitHubHandles handlesMap (Maintainers maint) = - nonEmpty . mapMaybe (`Map.lookup` handlesMap) . Text.splitOn ", " $ fromMaybe "" maint +getMaintainerMap = + readJSONLinesProcess nixEvalJobsCommand nixEvalJobsParams + -- we ignore unparseable lines since fromJSON will fail on { "attr": …, "error": … } + -- entries since they don't have a @meta@ attribute. + <&> rights + <&> map (\(JobMaintainers name maintainers) -> (,) name <$> nonEmpty maintainers) + <&> catMaybes + <&> Map.fromList -- | Get the a map of all dependencies of every package by calling the nix -- script ./dependencies.nix. @@ -373,6 +362,18 @@ readJSONProcess exe args err = do Left decodeErr -> error $ err <> decodeErr <> "\nRaw: '" <> take 1000 output <> "'" Right decodedOutput -> pure decodedOutput +-- | Run a process that produces many JSON values, one per line. +-- Error and success is reported per line via a list of 'Either's. +readJSONLinesProcess + :: FromJSON a + => FilePath -- ^ Filename of executable. + -> [String] -- ^ Arguments + -> IO [Either String a] +readJSONLinesProcess exe args = do + output <- readProcess exe args "" + -- TODO: slow, doesn't stream at all + pure . map (eitherDecodeStrictText . Text.pack) . lines $ output + -- BuildStates are sorted by subjective importance/concerningness data BuildState = Failed diff --git a/maintainers/scripts/haskell/maintainer-handles.nix b/maintainers/scripts/haskell/maintainer-handles.nix deleted file mode 100644 index ced93a1233be..000000000000 --- a/maintainers/scripts/haskell/maintainer-handles.nix +++ /dev/null @@ -1,23 +0,0 @@ -# Nix script to lookup maintainer github handles from their email address. Used by ./hydra-report.hs. -# -# This script produces an attr set mapping of email addresses to GitHub handles: -# -# ```nix -# > import ./maintainer-handles.nix -# { "cdep.illabout@gmail.com" = "cdepillabout"; "john@smith.com" = "johnsmith"; ... } -# ``` -# -# This mapping contains all maintainers in ../../mainatainer-list.nix, but it -# ignores maintainers who don't have a GitHub account or an email address. -let - pkgs = import ../../.. { }; - maintainers = import ../../maintainer-list.nix; - inherit (pkgs) lib; - mkMailGithubPair = - _: maintainer: - if (maintainer ? email) && (maintainer ? github) then - { "${maintainer.email}" = maintainer.github; } - else - { }; -in -lib.zipAttrsWith (_: builtins.head) (lib.mapAttrsToList mkMailGithubPair maintainers)