maintainers/hydra-report.hs: migrate to nix-eval-jobs

Hydra unilaterally removed hydra-eval-jobs, so we need to figure out how
to migrate to nix-eval-jobs. I can't shake the feeling that it's slower.
Maybe we need to increase the resource limitations for nix-eval-jobs.

nix-eval-jobs no longer produces a big JSON object, but instead one
object per line (one for each job). This is supported in a simple way by
readJSONLinesProcess. It'd be possible to implement this without
presupposing that there's one object per line, however, it is not an
usecase exactly intended by aeson, it seems.

nix-eval-jobs makes our job easier in some ways, e.g. jobs have a proper
meta set now, so we no longer need to cross reference a mail address to
github handle map. There is even room for further improvement, e.g.
attribute paths can just be queried instead of generating them using
Text.splitOn.

See also https://github.com/NixOS/hydra/pull/1421.

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
+nixEvalJobsCommand :: FilePath
-hydraEvalCommand = "hydra-eval-jobs"
+nixEvalJobsCommand = "nix-eval-jobs"
 
-hydraEvalParams :: [String]
+nixEvalJobsParams :: [String]
-hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"]
+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@.
+-- | Holds a list of the GitHub handles of the maintainers of a given 'JobName'.
--- The only field we are interested in is @maintainers@, which is why this
--- is just a newtype.
 --
--- Note that there are occasionally jobs that don't have a maintainers
+--   @
--- field, which is why this has to be @Maybe Text@.
+--     JobMaintainers (JobName "haskellPackages.cabal-install.x86_64-linux") ["sternenseemann"]
-newtype Maintainers = Maintainers { maintainers :: Maybe Text }
+--   @
+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.
+-- | Parse the entries produced by @nix-eval-jobs@, discarding all information
---
+--   except the name of the job (@attr@) and the @github@ attributes of the
--- It has values similar to the following:
+--   maintainer objects in @meta.maintainers@.
---
+instance FromJSON JobMaintainers where
--- @@
+  parseJSON = withObject "HydraJob" $ \h -> do
---  fromList
+    jobName <- h .: "attr"
---    [ ("arion.aarch64-linux", Maintainers (Just "robert@example.com"))
+    maintainers <- (h .: "meta")
---    , ("bench.x86_64-linux", Maintainers (Just ""))
+      >>= (withObject "Meta" $ \meta ->
---    , ("conduit.x86_64-linux", Maintainers (Just "snoy@man.com, web@ber.com"))
+        meta .: "maintainers"
---    , ("lens.x86_64-darwin", Maintainers (Just "ek@category.com"))
+        >>= mapM (withObject "Maintainer" $ \mt -> mt .: "github"))
---    ]
+    pure $ JobMaintainers jobName maintainers
--- @@
---
--- Note that Hydra jobs without maintainers will have an empty string for the
--- maintainer list.
-type HydraJobs = Map JobName Maintainers
 
--- | Map of email addresses to GitHub handles.
+-- | Map of maintained Hydra jobs to maintainer 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.
 --
 -- 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
+-- | Generate a mapping of Hydra job names to maintainer GitHub handles.
--- hydra-eval-jobs and the nix script ./maintainer-handles.nix.
 getMaintainerMap :: IO MaintainerMap
-getMaintainerMap = do
+getMaintainerMap =
-   hydraJobs :: HydraJobs <-
+  readJSONLinesProcess nixEvalJobsCommand nixEvalJobsParams
-      readJSONProcess hydraEvalCommand hydraEvalParams "Failed to decode hydra-eval-jobs output: "
+  -- we ignore unparseable lines since fromJSON will fail on { "attr": …, "error": … }
-   handlesMap :: EmailToGitHubHandles <-
+  -- entries since they don't have a @meta@ attribute.
-      readJSONProcess nixExprCommand ("maintainers/scripts/haskell/maintainer-handles.nix":nixExprParams) "Failed to decode nix output for lookup of github handles: "
+  <&> rights
-   pure $ Map.mapMaybe (splitMaintainersToGitHubHandles handlesMap) hydraJobs
+  <&> map (\(JobMaintainers name maintainers) -> (,) name <$> nonEmpty maintainers)
-  where
+  <&> catMaybes
-   -- Split a comma-spearated string of Maintainers into a NonEmpty list of
+  <&> Map.fromList
-   -- GitHub handles.
-   splitMaintainersToGitHubHandles
-      :: EmailToGitHubHandles -> Maintainers -> Maybe (NonEmpty Text)
-   splitMaintainersToGitHubHandles handlesMap (Maintainers maint) =
-      nonEmpty .  mapMaybe (`Map.lookup` handlesMap) .  Text.splitOn ", " $ fromMaybe "" maint
 
 -- | 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

maintainers/scripts/haskell/maintainer-handles.nix

@@ -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)