commit 4de9b2bfcbbefe4dd4b3aa25332b9561c3164a09 · pyrox.dev/nixpkgs

+10

maintainers/scripts/haskell/dependencies.nix

···

       1
       +
       # Nix script to calculate the Haskell dependencies of every haskellPackage. Used by ./hydra-report.hs.

     

       2
       +
       let

     

       3
       +
         pkgs = import ../../.. {};

     

       4
       +
         inherit (pkgs) lib;

     

       5
       +
         getDeps = _: pkg: {

     

       6
       +
           deps = builtins.filter (x: !isNull x) (map (x: x.pname or null) (pkg.propagatedBuildInputs or []));

     

       7
       +
           broken = (pkg.meta.hydraPlatforms or [null]) == [];

     

       8
       +
         };

     

       9
       +
       in

     

       10
       +
         lib.mapAttrs getDeps pkgs.haskellPackages

+91 -30

maintainers/scripts/haskell/hydra-report.hs

···

       26
        
       {-# LANGUAGE ScopedTypeVariables #-}

     

       27
        
       {-# LANGUAGE TupleSections #-}

     

       28
        
       {-# OPTIONS_GHC -Wall #-}

     

       0
        
       
     

       0
        
       
     

       29
        
       

     

       30
        
       import Control.Monad (forM_, (<=<))

     

       31
        
       import Control.Monad.Trans (MonadIO (liftIO))

     
···

       70
        
       import System.Environment (getArgs)

     

       71
        
       import System.Process (readProcess)

     

       72
        
       import Prelude hiding (id)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       73
        
       

     

       74
        
       newtype JobsetEvals = JobsetEvals

     

       75
        
          { evals :: Seq Eval

     
···

       134
        
       hydraEvalParams :: [String]

     

       135
        
       hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"]

     

       136
        
       

     

       137
       -
       handlesCommand :: FilePath

     

       138
       -
       handlesCommand = "nix-instantiate"

     

       139
        
       

     

       140
       -
       handlesParams :: [String]

     

       141
       -
       handlesParams = ["--eval", "--strict", "--json", "-"]

     

       142
       -
       

     

       143
       -
       handlesExpression :: String

     

       144
       -
       handlesExpression = "with import ./. {}; with lib; zipAttrsWith (_: builtins.head) (mapAttrsToList (_: v: if v ? github then { \"${v.email}\" = v.github; } else {}) (import maintainers/maintainer-list.nix))"

     

       145
        
       

     

       146
        
       -- | This newtype is used to parse a Hydra job output from @hydra-eval-jobs@.

     

       147
        
       -- The only field we are interested in is @maintainers@, which is why this

     

       148
        
       -- is just a newtype.

     

       149
        
       --

     

       150
       -
       -- Note that there are occassionally jobs that don't have a maintainers

     

       151
        
       -- field, which is why this has to be @Maybe Text@.

     

       152
        
       newtype Maintainers = Maintainers { maintainers :: Maybe Text }

     

       153
        
         deriving stock (Generic, Show)

     
···

       195
        
       -- @@

     

       196
        
       type MaintainerMap = Map Text (NonEmpty Text)

     

       197
        
       

     

       198
       -
       -- | Generate a mapping of Hydra job names to maintainer GitHub handles.

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       199
        
       getMaintainerMap :: IO MaintainerMap

     

       200
        
       getMaintainerMap = do

     

       201
        
          hydraJobs :: HydraJobs <-

     

       202
       -
             readJSONProcess hydraEvalCommand hydraEvalParams "" "Failed to decode hydra-eval-jobs output: "

     

       203
        
          handlesMap :: EmailToGitHubHandles <-

     

       204
       -
             readJSONProcess handlesCommand handlesParams handlesExpression "Failed to decode nix output for lookup of github handles: "

     

       205
        
          pure $ Map.mapMaybe (splitMaintainersToGitHubHandles handlesMap) hydraJobs

     

       206
        
          where

     

       207
        
          -- Split a comma-spearated string of Maintainers into a NonEmpty list of

     
···

       211
        
          splitMaintainersToGitHubHandles handlesMap (Maintainers maint) =

     

       212
        
             nonEmpty .  mapMaybe (`Map.lookup` handlesMap) .  Text.splitOn ", " $ fromMaybe "" maint

     

       213
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       214
        
       -- | Run a process that produces JSON on stdout and and decode the JSON to a

     

       215
        
       -- data type.

     

       216
        
       --

     
···

       219
        
          :: FromJSON a

     

       220
        
          => FilePath -- ^ Filename of executable.

     

       221
        
          -> [String] -- ^ Arguments

     

       222
       -
          -> String -- ^ stdin to pass to the process

     

       223
        
          -> String -- ^ String to prefix to JSON-decode error.

     

       224
        
          -> IO a

     

       225
       -
       readJSONProcess exe args input err = do

     

       226
       -
          output <- readProcess exe args input

     

       227
        
          let eitherDecodedOutput = eitherDecodeStrict' . encodeUtf8 . Text.pack $ output

     

       228
        
          case eitherDecodedOutput of

     

       229
        
            Left decodeErr -> error $ err <> decodeErr <> "\nRaw: '" <> take 1000 output <> "'"

     
···

       264
        
       data BuildResult = BuildResult {state :: BuildState, id :: Int} deriving (Show, Eq, Ord)

     

       265
        
       newtype Platform = Platform {platform :: Text} deriving (Show, Eq, Ord)

     

       266
        
       newtype Table row col a = Table (Map (row, col) a)

     

       267
       -
       type StatusSummary = Map Text (Table Text Platform BuildResult, Set Text)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       268
        
       

     

       269
        
       instance (Ord row, Ord col, Semigroup a) => Semigroup (Table row col a) where

     

       270
        
          Table l <> Table r = Table (Map.unionWith (<>) l r)

     
···

       275
        
       instance Foldable (Table row col) where

     

       276
        
          foldMap f (Table a) = foldMap f a

     

       277
        
       

     

       278
       -
       buildSummary :: MaintainerMap -> Seq Build -> StatusSummary

     

       279
       -
       buildSummary maintainerMap = foldl (Map.unionWith unionSummary) Map.empty . fmap toSummary

     

       280
        
         where

     

       281
       -
          unionSummary (Table l, l') (Table r, r') = (Table $ Map.union l r, l' <> r')

     

       282
       -
          toSummary Build{finished, buildstatus, job, id, system} = Map.singleton name (Table (Map.singleton (set, Platform system) (BuildResult state id)), maintainers)

     

       283
        
            where

     

       284
        
             state :: BuildState

     

       285
        
             state = case (finished, buildstatus) of

     
···

       297
        
             name = maybe packageName NonEmpty.last splitted

     

       298
        
             set = maybe "" (Text.intercalate "." . NonEmpty.init) splitted

     

       299
        
             maintainers = maybe mempty (Set.fromList . toList) (Map.lookup job maintainerMap)

     

       0
        
       
     

       300
        
       

     

       301
        
       readBuildReports :: IO (Eval, UTCTime, Seq Build)

     

       302
        
       readBuildReports = do

     
···

       339
        
       statusToNumSummary :: StatusSummary -> NumSummary

     

       340
        
       statusToNumSummary = fmap getSum . foldMap (fmap Sum . jobTotals)

     

       341
        
       

     

       342
       -
       jobTotals :: (Table Text Platform BuildResult, a) -> Table Platform BuildState Int

     

       343
       -
       jobTotals (Table mapping, _) = getSum <$> Table (Map.foldMapWithKey (\(_, platform) (BuildResult buildstate _) -> Map.singleton (platform, buildstate) (Sum 1)) mapping)

     

       344
        
       

     

       345
        
       details :: Text -> [Text] -> [Text]

     

       346
        
       details summary content = ["<details><summary>" <> summary <> " </summary>", ""] <> content <> ["</details>", ""]

     

       347
        
       

     

       348
       -
       printBuildSummary :: Eval -> UTCTime -> StatusSummary -> Text

     

       349
        
       printBuildSummary

     

       350
        
          Eval{id, jobsetevalinputs = JobsetEvalInputs{nixpkgs = Nixpkgs{revision}}}

     

       351
        
          fetchTime

     

       352
       -
          summary =

     

       0
        
       
     

       353
        
             Text.unlines $

     

       354
        
                headline <> totals

     

       355
        
                   <> optionalList "#### Maintained packages with build failure" (maintainedList fails)

     
···

       358
        
                   <> optionalHideableList "#### Unmaintained packages with build failure" (unmaintainedList fails)

     

       359
        
                   <> optionalHideableList "#### Unmaintained packages with failed dependency" (unmaintainedList failedDeps)

     

       360
        
                   <> optionalHideableList "#### Unmaintained packages with unknown error" (unmaintainedList unknownErr)

     

       0
        
       
     

       0
        
       
     

       361
        
                   <> footer

     

       362
        
            where

     

       363
        
             footer = ["*Report generated with [maintainers/scripts/haskell/hydra-report.hs](https://github.com/NixOS/nixpkgs/blob/haskell-updates/maintainers/scripts/haskell/hydra-report.sh)*"]

     
···

       380
        
                   <> Text.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" fetchTime)

     

       381
        
                   <> "*"

     

       382
        
                ]

     

       383
       -
             jobsByState predicate = Map.filter (predicate . foldl' min Success . fmap state . fst) summary

     

       0
        
       
     

       384
        
             fails = jobsByState (== Failed)

     

       385
        
             failedDeps = jobsByState (== DependencyFailed)

     

       386
        
             unknownErr = jobsByState (\x -> x > DependencyFailed && x < TimedOut)

     

       387
       -
             withMaintainer = Map.mapMaybe (\(x, m) -> (x,) <$> nonEmpty (Set.toList m))

     

       388
       -
             withoutMaintainer = Map.mapMaybe (\(x, m) -> if Set.null m then Just x else Nothing)

     

       389
        
             optionalList heading list = if null list then mempty else [heading] <> list

     

       390
        
             optionalHideableList heading list = if null list then mempty else [heading] <> details (showT (length list) <> " job(s)") list

     

       391
        
             maintainedList = showMaintainedBuild <=< Map.toList . withMaintainer

     

       392
       -
             unmaintainedList = showBuild <=< Map.toList . withoutMaintainer

     

       393
       -
             showBuild (name, table) = printJob id name (table, "")

     

       394
        
             showMaintainedBuild (name, (table, maintainers)) = printJob id name (table, Text.intercalate " " (fmap ("@" <>) (toList maintainers)))

     

       395
        
       

     

       396
        
       printMaintainerPing :: IO ()

     

       397
        
       printMaintainerPing = do

     

       398
       -
          maintainerMap <- getMaintainerMap

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       399
        
          (eval, fetchTime, buildReport) <- readBuildReports

     

       400
       -
          putStrLn (Text.unpack (printBuildSummary eval fetchTime (buildSummary maintainerMap buildReport)))

     

       401
        
       

     

       402
        
       printMarkBrokenList :: IO ()

     

       403
        
       printMarkBrokenList = do

···

       26
        
       {-# LANGUAGE ScopedTypeVariables #-}

     

       27
        
       {-# LANGUAGE TupleSections #-}

     

       28
        
       {-# OPTIONS_GHC -Wall #-}

     

       29
       +
       {-# LANGUAGE ViewPatterns #-}

     

       30
       +
       {-# LANGUAGE TupleSections #-}

     

       31
        
       

     

       32
        
       import Control.Monad (forM_, (<=<))

     

       33
        
       import Control.Monad.Trans (MonadIO (liftIO))

     
···

       72
        
       import System.Environment (getArgs)

     

       73
        
       import System.Process (readProcess)

     

       74
        
       import Prelude hiding (id)

     

       75
       +
       import Data.List (sortOn)

     

       76
       +
       import Control.Concurrent.Async (concurrently)

     

       77
       +
       import Control.Exception (evaluate)

     

       78
       +
       import qualified Data.IntMap.Strict as IntMap

     

       79
       +
       import qualified Data.IntSet as IntSet

     

       80
       +
       import Data.Bifunctor (second)

     

       81
        
       

     

       82
        
       newtype JobsetEvals = JobsetEvals

     

       83
        
          { evals :: Seq Eval

     
···

       142
        
       hydraEvalParams :: [String]

     

       143
        
       hydraEvalParams = ["-I", ".", "pkgs/top-level/release-haskell.nix"]

     

       144
        
       

     

       145
       +
       nixExprCommand :: FilePath

     

       146
       +
       nixExprCommand = "nix-instantiate"

     

       147
        
       

     

       148
       +
       nixExprParams :: [String]

     

       149
       +
       nixExprParams = ["--eval", "--strict", "--json"]

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       150
        
       

     

       151
        
       -- | This newtype is used to parse a Hydra job output from @hydra-eval-jobs@.

     

       152
        
       -- The only field we are interested in is @maintainers@, which is why this

     

       153
        
       -- is just a newtype.

     

       154
        
       --

     

       155
       +
       -- Note that there are occasionally jobs that don't have a maintainers

     

       156
        
       -- field, which is why this has to be @Maybe Text@.

     

       157
        
       newtype Maintainers = Maintainers { maintainers :: Maybe Text }

     

       158
        
         deriving stock (Generic, Show)

     
···

       200
        
       -- @@

     

       201
        
       type MaintainerMap = Map Text (NonEmpty Text)

     

       202
        
       

     

       203
       +
       -- | Information about a package which lists its dependencies and whether the

     

       204
       +
       -- package is marked broken.

     

       205
       +
       data DepInfo = DepInfo {

     

       206
       +
          deps :: Set Text,

     

       207
       +
          broken :: Bool

     

       208
       +
       }

     

       209
       +
          deriving stock (Generic, Show)

     

       210
       +
          deriving anyclass (FromJSON, ToJSON)

     

       211
       +
       

     

       212
       +
       -- | Map from package names to their DepInfo. This is the data we get out of a

     

       213
       +
       -- nix call.

     

       214
       +
       type DependencyMap = Map Text DepInfo

     

       215
       +
       

     

       216
       +
       -- | Map from package names to its broken state, number of reverse dependencies (fst) and

     

       217
       +
       -- unbroken reverse dependencies (snd).

     

       218
       +
       type ReverseDependencyMap = Map Text (Int, Int)

     

       219
       +
       

     

       220
       +
       -- | Calculate the (unbroken) reverse dependencies of a package by transitively

     

       221
       +
       -- going through all packages if it’s a dependency of them.

     

       222
       +
       calculateReverseDependencies :: DependencyMap -> ReverseDependencyMap

     

       223
       +
       calculateReverseDependencies depMap = Map.fromDistinctAscList $ zip keys (zip (rdepMap False) (rdepMap True))

     

       224
       +
        where

     

       225
       +
           -- This code tries to efficiently invert the dependency map and calculate

     

       226
       +
           -- it’s transitive closure by internally identifying every pkg with it’s index

     

       227
       +
           -- in the package list and then using memoization.

     

       228
       +
           keys = Map.keys depMap

     

       229
       +
           pkgToIndexMap = Map.fromDistinctAscList (zip keys [0..])

     

       230
       +
           intDeps = zip [0..] $ (\DepInfo{broken,deps} -> (broken,mapMaybe (`Map.lookup` pkgToIndexMap) $ Set.toList deps)) <$> Map.elems depMap

     

       231
       +
           rdepMap onlyUnbroken = IntSet.size <$> resultList

     

       232
       +
            where

     

       233
       +
              resultList = go <$> [0..]

     

       234
       +
              oneStepMap = IntMap.fromListWith IntSet.union $ (\(key,(_,deps)) -> (,IntSet.singleton key) <$> deps) <=< filter (\(_, (broken,_)) -> not (broken && onlyUnbroken)) $ intDeps

     

       235
       +
              go pkg = IntSet.unions (oneStep:((resultList !!) <$> IntSet.toList oneStep))

     

       236
       +
               where oneStep = IntMap.findWithDefault mempty pkg oneStepMap

     

       237
       +
       

     

       238
       +
       -- | Generate a mapping of Hydra job names to maintainer GitHub handles. Calls

     

       239
       +
       -- hydra-eval-jobs and the nix script ./maintainer-handles.nix.

     

       240
        
       getMaintainerMap :: IO MaintainerMap

     

       241
        
       getMaintainerMap = do

     

       242
        
          hydraJobs :: HydraJobs <-

     

       243
       +
             readJSONProcess hydraEvalCommand hydraEvalParams "Failed to decode hydra-eval-jobs output: "

     

       244
        
          handlesMap :: EmailToGitHubHandles <-

     

       245
       +
             readJSONProcess nixExprCommand ("maintainers/scripts/haskell/maintainer-handles.nix":nixExprParams) "Failed to decode nix output for lookup of github handles: "

     

       246
        
          pure $ Map.mapMaybe (splitMaintainersToGitHubHandles handlesMap) hydraJobs

     

       247
        
          where

     

       248
        
          -- Split a comma-spearated string of Maintainers into a NonEmpty list of

     
···

       252
        
          splitMaintainersToGitHubHandles handlesMap (Maintainers maint) =

     

       253
        
             nonEmpty .  mapMaybe (`Map.lookup` handlesMap) .  Text.splitOn ", " $ fromMaybe "" maint

     

       254
        
       

     

       255
       +
       -- | Get the a map of all dependencies of every package by calling the nix

     

       256
       +
       -- script ./dependencies.nix.

     

       257
       +
       getDependencyMap :: IO DependencyMap

     

       258
       +
       getDependencyMap =

     

       259
       +
          readJSONProcess nixExprCommand ("maintainers/scripts/haskell/dependencies.nix":nixExprParams) "Failed to decode nix output for lookup of dependencies: "

     

       260
       +
       

     

       261
        
       -- | Run a process that produces JSON on stdout and and decode the JSON to a

     

       262
        
       -- data type.

     

       263
        
       --

     
···

       266
        
          :: FromJSON a

     

       267
        
          => FilePath -- ^ Filename of executable.

     

       268
        
          -> [String] -- ^ Arguments

     

       0
        
       
     

       269
        
          -> String -- ^ String to prefix to JSON-decode error.

     

       270
        
          -> IO a

     

       271
       +
       readJSONProcess exe args err = do

     

       272
       +
          output <- readProcess exe args ""

     

       273
        
          let eitherDecodedOutput = eitherDecodeStrict' . encodeUtf8 . Text.pack $ output

     

       274
        
          case eitherDecodedOutput of

     

       275
        
            Left decodeErr -> error $ err <> decodeErr <> "\nRaw: '" <> take 1000 output <> "'"

     
···

       310
        
       data BuildResult = BuildResult {state :: BuildState, id :: Int} deriving (Show, Eq, Ord)

     

       311
        
       newtype Platform = Platform {platform :: Text} deriving (Show, Eq, Ord)

     

       312
        
       newtype Table row col a = Table (Map (row, col) a)

     

       313
       +
       data SummaryEntry = SummaryEntry {

     

       314
       +
          summaryBuilds :: Table Text Platform BuildResult,

     

       315
       +
          summaryMaintainers :: Set Text,

     

       316
       +
          summaryReverseDeps :: Int,

     

       317
       +
          summaryUnbrokenReverseDeps :: Int

     

       318
       +
       }

     

       319
       +
       type StatusSummary = Map Text SummaryEntry

     

       320
        
       

     

       321
        
       instance (Ord row, Ord col, Semigroup a) => Semigroup (Table row col a) where

     

       322
        
          Table l <> Table r = Table (Map.unionWith (<>) l r)

     
···

       327
        
       instance Foldable (Table row col) where

     

       328
        
          foldMap f (Table a) = foldMap f a

     

       329
        
       

     

       330
       +
       buildSummary :: MaintainerMap -> ReverseDependencyMap -> Seq Build -> StatusSummary

     

       331
       +
       buildSummary maintainerMap reverseDependencyMap = foldl (Map.unionWith unionSummary) Map.empty . fmap toSummary

     

       332
        
         where

     

       333
       +
          unionSummary (SummaryEntry (Table lb) lm lr lu) (SummaryEntry (Table rb) rm rr ru) = SummaryEntry (Table $ Map.union lb rb) (lm <> rm) (max lr rr) (max lu ru)

     

       334
       +
          toSummary Build{finished, buildstatus, job, id, system} = Map.singleton name (SummaryEntry (Table (Map.singleton (set, Platform system) (BuildResult state id))) maintainers reverseDeps unbrokenReverseDeps)

     

       335
        
            where

     

       336
        
             state :: BuildState

     

       337
        
             state = case (finished, buildstatus) of

     
···

       349
        
             name = maybe packageName NonEmpty.last splitted

     

       350
        
             set = maybe "" (Text.intercalate "." . NonEmpty.init) splitted

     

       351
        
             maintainers = maybe mempty (Set.fromList . toList) (Map.lookup job maintainerMap)

     

       352
       +
             (reverseDeps, unbrokenReverseDeps) = Map.findWithDefault (0,0) name reverseDependencyMap

     

       353
        
       

     

       354
        
       readBuildReports :: IO (Eval, UTCTime, Seq Build)

     

       355
        
       readBuildReports = do

     
···

       392
        
       statusToNumSummary :: StatusSummary -> NumSummary

     

       393
        
       statusToNumSummary = fmap getSum . foldMap (fmap Sum . jobTotals)

     

       394
        
       

     

       395
       +
       jobTotals :: SummaryEntry -> Table Platform BuildState Int

     

       396
       +
       jobTotals (summaryBuilds -> Table mapping) = getSum <$> Table (Map.foldMapWithKey (\(_, platform) (BuildResult buildstate _) -> Map.singleton (platform, buildstate) (Sum 1)) mapping)

     

       397
        
       

     

       398
        
       details :: Text -> [Text] -> [Text]

     

       399
        
       details summary content = ["<details><summary>" <> summary <> " </summary>", ""] <> content <> ["</details>", ""]

     

       400
        
       

     

       401
       +
       printBuildSummary :: Eval -> UTCTime -> StatusSummary -> [(Text, Int)] -> Text

     

       402
        
       printBuildSummary

     

       403
        
          Eval{id, jobsetevalinputs = JobsetEvalInputs{nixpkgs = Nixpkgs{revision}}}

     

       404
        
          fetchTime

     

       405
       +
          summary

     

       406
       +
          topBrokenRdeps =

     

       407
        
             Text.unlines $

     

       408
        
                headline <> totals

     

       409
        
                   <> optionalList "#### Maintained packages with build failure" (maintainedList fails)

     
···

       412
        
                   <> optionalHideableList "#### Unmaintained packages with build failure" (unmaintainedList fails)

     

       413
        
                   <> optionalHideableList "#### Unmaintained packages with failed dependency" (unmaintainedList failedDeps)

     

       414
        
                   <> optionalHideableList "#### Unmaintained packages with unknown error" (unmaintainedList unknownErr)

     

       415
       +
                   <> optionalHideableList "#### Top 50 broken packages, sorted by number of reverse dependencies" (brokenLine <$> topBrokenRdeps)

     

       416
       +
                   <> ["","*:arrow_heading_up:: The number of packages that depend (directly or indirectly) on this package (if any). If two numbers are shown the first (lower) number considers only packages which currently have enabled hydra jobs, i.e. are not marked broken. The second (higher) number considers all packages.*",""]

     

       417
        
                   <> footer

     

       418
        
            where

     

       419
        
             footer = ["*Report generated with [maintainers/scripts/haskell/hydra-report.hs](https://github.com/NixOS/nixpkgs/blob/haskell-updates/maintainers/scripts/haskell/hydra-report.sh)*"]

     
···

       436
        
                   <> Text.pack (formatTime defaultTimeLocale "%Y-%m-%d %H:%M UTC" fetchTime)

     

       437
        
                   <> "*"

     

       438
        
                ]

     

       439
       +
             brokenLine (name, rdeps) = "[" <> name <> "](https://search.nixos.org/packages?channel=unstable&show=haskellPackages." <> name <> "&query=haskellPackages." <> name <> ") :arrow_heading_up: " <> Text.pack (show rdeps)

     

       440
       +
             jobsByState predicate = Map.filter (predicate . foldl' min Success . fmap state . summaryBuilds) summary

     

       441
        
             fails = jobsByState (== Failed)

     

       442
        
             failedDeps = jobsByState (== DependencyFailed)

     

       443
        
             unknownErr = jobsByState (\x -> x > DependencyFailed && x < TimedOut)

     

       444
       +
             withMaintainer = Map.mapMaybe (\e -> (summaryBuilds e,) <$> nonEmpty (Set.toList (summaryMaintainers e)))

     

       445
       +
             withoutMaintainer = Map.mapMaybe (\e -> if Set.null (summaryMaintainers e) then Just e else Nothing)

     

       446
        
             optionalList heading list = if null list then mempty else [heading] <> list

     

       447
        
             optionalHideableList heading list = if null list then mempty else [heading] <> details (showT (length list) <> " job(s)") list

     

       448
        
             maintainedList = showMaintainedBuild <=< Map.toList . withMaintainer

     

       449
       +
             unmaintainedList = showBuild <=< sortOn (\(snd -> x) -> (negate (summaryUnbrokenReverseDeps x), negate (summaryReverseDeps x))) . Map.toList . withoutMaintainer

     

       450
       +
             showBuild (name, entry) = printJob id name (summaryBuilds entry, Text.pack (if summaryReverseDeps entry > 0 then " :arrow_heading_up: " <> show (summaryUnbrokenReverseDeps entry) <>" | "<> show (summaryReverseDeps entry) else ""))

     

       451
        
             showMaintainedBuild (name, (table, maintainers)) = printJob id name (table, Text.intercalate " " (fmap ("@" <>) (toList maintainers)))

     

       452
        
       

     

       453
        
       printMaintainerPing :: IO ()

     

       454
        
       printMaintainerPing = do

     

       455
       +
          (maintainerMap, (reverseDependencyMap, topBrokenRdeps)) <- concurrently getMaintainerMap do

     

       456
       +
             depMap <- getDependencyMap

     

       457
       +
             rdepMap <- evaluate . calculateReverseDependencies $ depMap

     

       458
       +
             let tops = take 50 . sortOn (negate . snd) . fmap (second fst) . filter (\x -> maybe False broken $ Map.lookup (fst x) depMap) . Map.toList $ rdepMap

     

       459
       +
             pure (rdepMap, tops)

     

       460
        
          (eval, fetchTime, buildReport) <- readBuildReports

     

       461
       +
          putStrLn (Text.unpack (printBuildSummary eval fetchTime (buildSummary maintainerMap reverseDependencyMap buildReport) topBrokenRdeps))

     

       462
        
       

     

       463
        
       printMarkBrokenList :: IO ()

     

       464
        
       printMarkBrokenList = do

maintainers/scripts/haskell/maintainer-handles.nix

···

       1
       +
       # Nix script to lookup maintainer github handles from their email address. Used by ./hydra-report.hs.

     

       2
       +
       let

     

       3
       +
         pkgs = import ../../.. {};

     

       4
       +
         maintainers = import ../../maintainer-list.nix;

     

       5
       +
         inherit (pkgs) lib;

     

       6
       +
         mkMailGithubPair = _: maintainer: if maintainer ? github then { "${maintainer.email}" = maintainer.github; } else {};

     

       7
       +
       in lib.zipAttrsWith (_: builtins.head) (lib.mapAttrsToList mkMailGithubPair maintainers)