mirror of
https://github.com/NixOS/nixpkgs.git
synced 2024-11-24 07:53:19 +00:00
maintainers/scripts/haskell/hydra-report.hs: Enable warnings and small refactoring
This commit is contained in:
parent
277bb664de
commit
df0572cf3a
@ -24,8 +24,9 @@ Because step 1) is quite expensive and takes roughly ~5 minutes the result is ca
|
|||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
{-# OPTIONS_GHC -Wall #-}
|
||||||
|
|
||||||
import Control.Monad (forM, forM_, when, (<=<))
|
import Control.Monad (forM_, (<=<))
|
||||||
import Control.Monad.Trans (MonadIO (liftIO))
|
import Control.Monad.Trans (MonadIO (liftIO))
|
||||||
import Data.Aeson (
|
import Data.Aeson (
|
||||||
FromJSON,
|
FromJSON,
|
||||||
@ -34,9 +35,7 @@ import Data.Aeson (
|
|||||||
eitherDecodeStrict',
|
eitherDecodeStrict',
|
||||||
encodeFile,
|
encodeFile,
|
||||||
)
|
)
|
||||||
import qualified Data.ByteString.Char8 as ByteString
|
import Data.Foldable (Foldable (toList), foldl')
|
||||||
import Data.Either (fromRight)
|
|
||||||
import Data.Foldable (Foldable (toList), fold, foldl')
|
|
||||||
import Data.Function ((&))
|
import Data.Function ((&))
|
||||||
import Data.Functor ((<&>))
|
import Data.Functor ((<&>))
|
||||||
import Data.List.NonEmpty (NonEmpty, nonEmpty)
|
import Data.List.NonEmpty (NonEmpty, nonEmpty)
|
||||||
@ -45,7 +44,6 @@ import Data.Map.Strict (Map)
|
|||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Data.Maybe (fromMaybe, mapMaybe)
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
import Data.Monoid (Sum (Sum, getSum))
|
import Data.Monoid (Sum (Sum, getSum))
|
||||||
import Data.Semigroup (Min (Min, getMin))
|
|
||||||
import Data.Sequence (Seq)
|
import Data.Sequence (Seq)
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
@ -72,6 +70,8 @@ import Network.HTTP.Req (
|
|||||||
import System.Directory (XdgDirectory (XdgCache), getXdgDirectory)
|
import System.Directory (XdgDirectory (XdgCache), getXdgDirectory)
|
||||||
import System.Environment (getArgs)
|
import System.Environment (getArgs)
|
||||||
import System.Process (readProcess)
|
import System.Process (readProcess)
|
||||||
|
import Prelude hiding (id)
|
||||||
|
import qualified Prelude
|
||||||
|
|
||||||
newtype JobsetEvals = JobsetEvals
|
newtype JobsetEvals = JobsetEvals
|
||||||
{ evals :: Seq Eval
|
{ evals :: Seq Eval
|
||||||
@ -130,10 +130,15 @@ getBuildReports = runReq defaultHttpConfig do
|
|||||||
where
|
where
|
||||||
myReq query option = responseBody <$> req GET query NoReqBody jsonResponse (header "User-Agent" "hydra-report.hs/v1 (nixkpgs;maintainers/scripts/haskell)" <> option)
|
myReq query option = responseBody <$> req GET query NoReqBody jsonResponse (header "User-Agent" "hydra-report.hs/v1 (nixkpgs;maintainers/scripts/haskell)" <> option)
|
||||||
|
|
||||||
|
hydraEvalCommand :: FilePath
|
||||||
hydraEvalCommand = "hydra-eval-jobs"
|
hydraEvalCommand = "hydra-eval-jobs"
|
||||||
|
hydraEvalParams :: [String]
|
||||||
hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"]
|
hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"]
|
||||||
|
handlesCommand :: FilePath
|
||||||
handlesCommand = "nix-instantiate"
|
handlesCommand = "nix-instantiate"
|
||||||
|
handlesParams :: [String]
|
||||||
handlesParams = ["--eval", "--strict", "--json", "-"]
|
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))"
|
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 :: Text} deriving (Generic, ToJSON, FromJSON)
|
newtype Maintainers = Maintainers {maintainers :: Text} deriving (Generic, ToJSON, FromJSON)
|
||||||
@ -159,7 +164,7 @@ icon = \case
|
|||||||
OutputLimitExceeded -> ":warning:"
|
OutputLimitExceeded -> ":warning:"
|
||||||
Unknown x -> "unknown code " <> showT x
|
Unknown x -> "unknown code " <> showT x
|
||||||
Aborted -> ":no_entry:"
|
Aborted -> ":no_entry:"
|
||||||
Unfinished -> ":hourglas_flowing_sand:"
|
Unfinished -> ":hourglass_flowing_sand:"
|
||||||
Success -> ":heavy_check_mark:"
|
Success -> ":heavy_check_mark:"
|
||||||
|
|
||||||
platformIcon :: Platform -> Text
|
platformIcon :: Platform -> Text
|
||||||
@ -187,7 +192,7 @@ buildSummary :: MaintainerMap -> Seq Build -> StatusSummary
|
|||||||
buildSummary maintainerMap = foldl (Map.unionWith unionSummary) Map.empty . fmap toSummary
|
buildSummary maintainerMap = foldl (Map.unionWith unionSummary) Map.empty . fmap toSummary
|
||||||
where
|
where
|
||||||
unionSummary (Table l, l') (Table r, r') = (Table $ Map.union l r, l' <> r')
|
unionSummary (Table l, l') (Table r, r') = (Table $ Map.union l r, l' <> r')
|
||||||
toSummary Build{finished, buildstatus, job, id, system, nixname} = Map.singleton name (Table (Map.singleton (set, Platform system) (BuildResult state id)), maintainers)
|
toSummary Build{finished, buildstatus, job, id, system} = Map.singleton name (Table (Map.singleton (set, Platform system) (BuildResult state id)), maintainers)
|
||||||
where
|
where
|
||||||
state = case (finished, buildstatus) of
|
state = case (finished, buildstatus) of
|
||||||
(0, _) -> Unfinished
|
(0, _) -> Unfinished
|
||||||
@ -240,7 +245,7 @@ statusToNumSummary :: StatusSummary -> NumSummary
|
|||||||
statusToNumSummary = fmap getSum . foldMap (fmap Sum . jobTotals)
|
statusToNumSummary = fmap getSum . foldMap (fmap Sum . jobTotals)
|
||||||
|
|
||||||
jobTotals :: (Table Text Platform BuildResult, a) -> Table Platform BuildState Int
|
jobTotals :: (Table Text Platform BuildResult, a) -> Table Platform BuildState Int
|
||||||
jobTotals (Table mapping, _) = getSum <$> Table (Map.foldMapWithKey (\(set, platform) (BuildResult buildstate _) -> Map.singleton (platform, buildstate) (Sum 1)) mapping)
|
jobTotals (Table mapping, _) = getSum <$> Table (Map.foldMapWithKey (\(_, platform) (BuildResult buildstate _) -> Map.singleton (platform, buildstate) (Sum 1)) mapping)
|
||||||
|
|
||||||
details :: Text -> [Text] -> [Text]
|
details :: Text -> [Text] -> [Text]
|
||||||
details summary content = ["<details><summary>" <> summary <> " </summary>", ""] <> content <> ["</details>", ""]
|
details summary content = ["<details><summary>" <> summary <> " </summary>", ""] <> content <> ["</details>", ""]
|
||||||
@ -251,7 +256,7 @@ printBuildSummary
|
|||||||
fetchTime
|
fetchTime
|
||||||
summary =
|
summary =
|
||||||
Text.unlines $
|
Text.unlines $
|
||||||
header <> totals
|
headline <> totals
|
||||||
<> optionalList "#### Maintained packages with build failure" (maintainedList fails)
|
<> optionalList "#### Maintained packages with build failure" (maintainedList fails)
|
||||||
<> optionalList "#### Maintained packages with failed dependency" (maintainedList failedDeps)
|
<> optionalList "#### Maintained packages with failed dependency" (maintainedList failedDeps)
|
||||||
<> optionalList "#### Maintained packages with unknown error" (maintainedList unknownErr)
|
<> optionalList "#### Maintained packages with unknown error" (maintainedList unknownErr)
|
||||||
@ -266,10 +271,9 @@ printBuildSummary
|
|||||||
, ""
|
, ""
|
||||||
]
|
]
|
||||||
<> printTable "Platform" (\x -> platform x <> " " <> platformIcon x) (\x -> showT x <> " " <> icon x) showT (statusToNumSummary summary)
|
<> printTable "Platform" (\x -> platform x <> " " <> platformIcon x) (\x -> showT x <> " " <> icon x) showT (statusToNumSummary summary)
|
||||||
header =
|
headline =
|
||||||
[ "### [haskell-updates build report from hydra](https://hydra.nixos.org/jobset/nixpkgs/haskell-updates)"
|
[ "### [haskell-updates build report from hydra](https://hydra.nixos.org/jobset/nixpkgs/haskell-updates)"
|
||||||
, "*"
|
, "*evaluation ["
|
||||||
<> "evaluation ["
|
|
||||||
<> showT id
|
<> showT id
|
||||||
<> "](https://hydra.nixos.org/eval/"
|
<> "](https://hydra.nixos.org/eval/"
|
||||||
<> showT id
|
<> showT id
|
||||||
@ -281,14 +285,14 @@ printBuildSummary
|
|||||||
<> Text.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" fetchTime)
|
<> Text.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" fetchTime)
|
||||||
<> "*"
|
<> "*"
|
||||||
]
|
]
|
||||||
jobsByState pred = Map.filter (pred . foldl' min Success . fmap state . fst) summary
|
jobsByState predicate = Map.filter (predicate . foldl' min Success . fmap state . fst) summary
|
||||||
fails = jobsByState (== Failed)
|
fails = jobsByState (== Failed)
|
||||||
failedDeps = jobsByState (== DependencyFailed)
|
failedDeps = jobsByState (== DependencyFailed)
|
||||||
unknownErr = jobsByState (\x -> x > DependencyFailed && x < Aborted)
|
unknownErr = jobsByState (\x -> x > DependencyFailed && x < Aborted)
|
||||||
withMaintainer = Map.mapMaybe (\(x, m) -> (x,) <$> nonEmpty (Set.toList m))
|
withMaintainer = Map.mapMaybe (\(x, m) -> (x,) <$> nonEmpty (Set.toList m))
|
||||||
withoutMaintainer = Map.mapMaybe (\(x, m) -> if Set.null m then Just x else Nothing)
|
withoutMaintainer = Map.mapMaybe (\(x, m) -> if Set.null m then Just x else Nothing)
|
||||||
optionalList header list = if null list then mempty else [header] <> list
|
optionalList heading list = if null list then mempty else [heading] <> list
|
||||||
optionalHideableList header list = if null list then mempty else [header] <> details (showT (length list) <> " job(s)") list
|
optionalHideableList heading list = if null list then mempty else [heading] <> details (showT (length list) <> " job(s)") list
|
||||||
maintainedList = showMaintainedBuild <=< Map.toList . withMaintainer
|
maintainedList = showMaintainedBuild <=< Map.toList . withMaintainer
|
||||||
unmaintainedList = showBuild <=< Map.toList . withoutMaintainer
|
unmaintainedList = showBuild <=< Map.toList . withoutMaintainer
|
||||||
showBuild (name, table) = printJob name (table, "")
|
showBuild (name, table) = printJob name (table, "")
|
||||||
|
Loading…
Reference in New Issue
Block a user