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.
This commit is contained in:
Dennis Gosnell 2023-03-25 19:24:13 +09:00
parent 28f22d86d7
commit b2af201c0e
No known key found for this signature in database
GPG Key ID: 462E0C03D11422F4

View File

@ -20,6 +20,7 @@ Because step 1) is quite expensive and takes roughly ~5 minutes the result is ca
{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
@ -33,6 +34,7 @@ import Control.Monad (forM_, (<=<))
import Control.Monad.Trans (MonadIO (liftIO)) import Control.Monad.Trans (MonadIO (liftIO))
import Data.Aeson ( import Data.Aeson (
FromJSON, FromJSON,
FromJSONKey,
ToJSON, ToJSON,
decodeFileStrict', decodeFileStrict',
eitherDecodeStrict', eitherDecodeStrict',
@ -92,13 +94,16 @@ import Distribution.Simple.Utils (safeLast, fromUTF8BS)
newtype JobsetEvals = JobsetEvals newtype JobsetEvals = JobsetEvals
{ evals :: Seq Eval { evals :: Seq Eval
} }
deriving (Generic, ToJSON, FromJSON, Show) deriving stock (Generic, Show)
deriving anyclass (ToJSON, FromJSON)
newtype Nixpkgs = Nixpkgs {revision :: Text} newtype Nixpkgs = Nixpkgs {revision :: Text}
deriving (Generic, ToJSON, FromJSON, Show) deriving stock (Generic, Show)
deriving anyclass (ToJSON, FromJSON)
newtype JobsetEvalInputs = JobsetEvalInputs {nixpkgs :: Nixpkgs} newtype JobsetEvalInputs = JobsetEvalInputs {nixpkgs :: Nixpkgs}
deriving (Generic, ToJSON, FromJSON, Show) deriving stock (Generic, Show)
deriving anyclass (ToJSON, FromJSON)
data Eval = Eval data Eval = Eval
{ id :: Int { id :: Int
@ -106,18 +111,24 @@ data Eval = Eval
} }
deriving (Generic, ToJSON, FromJSON, Show) 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 -- | Datatype representing the result of querying the build evals of the
-- haskell-updates Hydra jobset. -- haskell-updates Hydra jobset.
-- --
-- The URL <https://hydra.nixos.org/eval/EVAL_ID/builds> (where @EVAL_ID@ is a -- The URL <https://hydra.nixos.org/eval/EVAL_ID/builds> (where @EVAL_ID@ is a
-- value like 1792418) returns a list of 'Build'. -- value like 1792418) returns a list of 'Build'.
data Build = Build data Build = Build
{ job :: Text { job :: JobName
-- ^ Hydra job name.
--
-- Examples:
-- - @"haskellPackages.lens.x86_64-linux"@
-- - @"haskell.packages.ghc925.cabal-install.aarch64-darwin"@
, buildstatus :: Maybe Int , buildstatus :: Maybe Int
-- ^ Status of the build. See 'getBuildState' for the meaning of each state. -- ^ Status of the build. See 'getBuildState' for the meaning of each state.
, finished :: Int , 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 -- Note that Hydra jobs without maintainers will have an empty string for the
-- maintainer list. -- maintainer list.
type HydraJobs = Map Text Maintainers type HydraJobs = Map JobName Maintainers
-- | Map of email addresses to GitHub handles. -- | Map of email addresses to GitHub handles.
-- This is built from the file @../../maintainer-list.nix@. -- This is built from the file @../../maintainer-list.nix@.
@ -246,7 +257,7 @@ type EmailToGitHubHandles = Map Text Text
-- , ("conduit.x86_64-darwin", ["snoyb", "webber"]) -- , ("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 -- | Information about a package which lists its dependencies and whether the
-- package is marked broken. -- package is marked broken.
@ -406,8 +417,10 @@ buildToStatusSummary :: MaintainerMap -> ReverseDependencyMap -> Build -> Status
buildToStatusSummary maintainerMap reverseDependencyMap build@Build{job, id, system} = buildToStatusSummary maintainerMap reverseDependencyMap build@Build{job, id, system} =
Map.singleton name summaryEntry Map.singleton name summaryEntry
where where
jobName = unJobName job
packageName :: Text packageName :: Text
packageName = fromMaybe job (Text.stripSuffix ("." <> system) job) packageName = fromMaybe jobName (Text.stripSuffix ("." <> system) jobName)
splitted :: Maybe (NonEmpty Text) splitted :: Maybe (NonEmpty Text)
splitted = nonEmpty $ Text.splitOn "." packageName splitted = nonEmpty $ Text.splitOn "." packageName
@ -580,7 +593,7 @@ printMarkBrokenList :: IO ()
printMarkBrokenList = do printMarkBrokenList = do
(_, fetchTime, buildReport) <- readBuildReports (_, fetchTime, buildReport) <- readBuildReports
runReq defaultHttpConfig $ forM_ buildReport \build@Build{job, id} -> 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 (Failed, ["haskellPackages", name, "x86_64-linux"]) -> do
-- Fetch build log from hydra to figure out the cause of the error. -- Fetch build log from hydra to figure out the cause of the error.
build_log <- ByteString.lines <$> hydraPlainQuery ["build", showT id, "nixlog", "1", "raw"] build_log <- ByteString.lines <$> hydraPlainQuery ["build", showT id, "nixlog", "1", "raw"]