From 39d04243e213a00ea1a644b486e4a330cc27ac64 Mon Sep 17 00:00:00 2001 From: "(cdep)illabout" Date: Sat, 15 May 2021 15:53:19 +0900 Subject: [PATCH] hydra-report.hs: small formatting changes --- maintainers/scripts/haskell/hydra-report.hs | 92 ++++++++++++++++++--- 1 file changed, 82 insertions(+), 10 deletions(-) diff --git a/maintainers/scripts/haskell/hydra-report.hs b/maintainers/scripts/haskell/hydra-report.hs index 3772b230f86..bb16b109818 100755 --- a/maintainers/scripts/haskell/hydra-report.hs +++ b/maintainers/scripts/haskell/hydra-report.hs @@ -17,6 +17,7 @@ Because step 1) is quite expensive and takes roughly ~5 minutes the result is ca {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} @@ -36,8 +37,6 @@ import Data.Aeson ( encodeFile, ) import Data.Foldable (Foldable (toList), foldl') -import Data.Function ((&)) -import Data.Functor ((<&>)) import Data.List.NonEmpty (NonEmpty, nonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Map.Strict (Map) @@ -71,7 +70,6 @@ import System.Directory (XdgDirectory (XdgCache), getXdgDirectory) import System.Environment (getArgs) import System.Process (readProcess) import Prelude hiding (id) -import qualified Prelude newtype JobsetEvals = JobsetEvals { evals :: Seq Eval @@ -132,30 +130,104 @@ getBuildReports = runReq defaultHttpConfig do hydraEvalCommand :: FilePath hydraEvalCommand = "hydra-eval-jobs" + hydraEvalParams :: [String] hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"] + handlesCommand :: FilePath handlesCommand = "nix-instantiate" + handlesParams :: [String] handlesParams = ["--eval", "--strict", "--json", "-"] + handlesExpression :: String handlesExpression = "with import ./. {}; with lib; zipAttrsWith (_: builtins.head) (mapAttrsToList (_: v: if v ? github then { \"${v.email}\" = v.github; } else {}) (import maintainers/maintainer-list.nix))" -newtype Maintainers = Maintainers {maintainers :: Maybe Text} deriving (Generic, ToJSON, FromJSON) +newtype Maintainers = Maintainers {maintainers :: Text} + deriving stock (Generic) + 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 "robert@example.com") +-- , ("bench.x86_64-linux", Maintainers "") +-- , ("conduit.x86_64-linux", Maintainers "snoy@man.com, web@ber.com") +-- , ("lens.x86_64-darwin", Maintainers "ek@category.com") +-- ] +-- @@ +-- +-- Note that Hydra jobs without maintainers will have an empty string for the +-- maintainer list. type HydraJobs = Map Text 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. +-- +-- It has values similar to the following: +-- +-- @@ +-- fromList +-- [ ("arion.aarch64-linux", ["rob22"]) +-- , ("conduit.x86_64-darwin", ["snoyb", "webber"]) +-- ] +-- @@ type MaintainerMap = Map Text (NonEmpty Text) +-- | Generate a mapping of Hydra job names to maintainer GitHub handles. getMaintainerMap :: IO MaintainerMap getMaintainerMap = do - hydraJobs :: HydraJobs <- get hydraEvalCommand hydraEvalParams "" "Failed to decode hydra-eval-jobs output: " - handlesMap :: Map Text Text <- get handlesCommand handlesParams handlesExpression "Failed to decode nix output for lookup of github handles: " - pure $ hydraJobs & Map.mapMaybe (nonEmpty . mapMaybe (`Map.lookup` handlesMap) . Text.splitOn ", " . fromMaybe "" . maintainers) - where - get c p i e = readProcess c p i <&> \x -> either (error . (<> " Raw:'" <> take 1000 x <> "'") . (e <>)) Prelude.id . eitherDecodeStrict' . encodeUtf8 . Text.pack $ x + hydraJobs :: HydraJobs <- + readJSONProcess hydraEvalCommand hydraEvalParams "" "Failed to decode hydra-eval-jobs output: " + handlesMap :: EmailToGitHubHandles <- + readJSONProcess handlesCommand handlesParams handlesExpression "Failed to decode nix output for lookup of github handles: " + pure $ Map.mapMaybe (nonEmpty . mapMaybe (`Map.lookup` handlesMap) . Text.splitOn ", " . maintainers) hydraJobs + +-- | Run a process that produces JSON on stdout and and decode the JSON to a +-- data type. +-- +-- If the JSON-decoding fails, throw the JSON-decoding error. +readJSONProcess + :: FromJSON a + => FilePath -- ^ Filename of executable. + -> [String] -- ^ Arguments + -> String -- ^ stdin to pass to the process + -> String -- ^ String to prefix to JSON-decode error. + -> IO a +readJSONProcess exe args input err = do + output <- readProcess exe args input + let eitherDecodedOutput = eitherDecodeStrict' . encodeUtf8 . Text.pack $ output + case eitherDecodedOutput of + Left decodeErr -> error $ err <> decodeErr <> "\nRaw: '" <> take 1000 output <> "'" + Right decodedOutput -> pure decodedOutput -- BuildStates are sorted by subjective importance/concerningness -data BuildState = Failed | DependencyFailed | OutputLimitExceeded | Unknown (Maybe Int) | TimedOut | Canceled | HydraFailure | Unfinished | Success deriving (Show, Eq, Ord) +data BuildState + = Failed + | DependencyFailed + | OutputLimitExceeded + | Unknown (Maybe Int) + | TimedOut + | Canceled + | HydraFailure + | Unfinished + | Success + deriving stock (Show, Eq, Ord) icon :: BuildState -> Text icon = \case