commit 4de9b2bfcbbefe4dd4b3aa25332b9561c3164a09 · pyrox.dev/nixpkgs

+10

maintainers/scripts/haskell/dependencies.nix

···

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

     

       2
       2
       +
       let

     

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

     

       4
       4
       +
         inherit (pkgs) lib;

     

       5
       5
       +
         getDeps = _: pkg: {

     

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

     

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

     

       8
       8
       +
         };

     

       9
       9
       +
       in

     

       10
       10
       +
         lib.mapAttrs getDeps pkgs.haskellPackages

+91 -30

maintainers/scripts/haskell/hydra-report.hs

···

       26
       26
        
       {-# LANGUAGE ScopedTypeVariables #-}

     

       27
       27
        
       {-# LANGUAGE TupleSections #-}

     

       28
       28
        
       {-# OPTIONS_GHC -Wall #-}

     

       29
       29
       +
       {-# LANGUAGE ViewPatterns #-}

     

       30
       30
       +
       {-# LANGUAGE TupleSections #-}

     

       29
       31
        
       

     

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

     

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

     
···

       70
       72
        
       import System.Environment (getArgs)

     

       71
       73
        
       import System.Process (readProcess)

     

       72
       74
        
       import Prelude hiding (id)

     

       75
       75
       +
       import Data.List (sortOn)

     

       76
       76
       +
       import Control.Concurrent.Async (concurrently)

     

       77
       77
       +
       import Control.Exception (evaluate)

     

       78
       78
       +
       import qualified Data.IntMap.Strict as IntMap

     

       79
       79
       +
       import qualified Data.IntSet as IntSet

     

       80
       80
       +
       import Data.Bifunctor (second)

     

       73
       81
        
       

     

       74
       82
        
       newtype JobsetEvals = JobsetEvals

     

       75
       83
        
          { evals :: Seq Eval

     
···

       134
       142
        
       hydraEvalParams :: [String]

     

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

     

       136
       144
        
       

     

       137
       137
       -
       handlesCommand :: FilePath

     

       138
       138
       -
       handlesCommand = "nix-instantiate"

     

       145
       145
       +
       nixExprCommand :: FilePath

     

       146
       146
       +
       nixExprCommand = "nix-instantiate"

     

       139
       147
        
       

     

       140
       140
       -
       handlesParams :: [String]

     

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

     

       142
       142
       -
       

     

       143
       143
       -
       handlesExpression :: String

     

       144
       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))"

     

       148
       148
       +
       nixExprParams :: [String]

     

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

     

       145
       150
        
       

     

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

     

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

     

       148
       153
        
       -- is just a newtype.

     

       149
       154
        
       --

     

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

     

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

     

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

     

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

     

       153
       158
        
         deriving stock (Generic, Show)

     
···

       195
       200
        
       -- @@

     

       196
       201
        
       type MaintainerMap = Map Text (NonEmpty Text)

     

       197
       202
        
       

     

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

     

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

     

       204
       204
       +
       -- package is marked broken.

     

       205
       205
       +
       data DepInfo = DepInfo {

     

       206
       206
       +
          deps :: Set Text,

     

       207
       207
       +
          broken :: Bool

     

       208
       208
       +
       }

     

       209
       209
       +
          deriving stock (Generic, Show)

     

       210
       210
       +
          deriving anyclass (FromJSON, ToJSON)

     

       211
       211
       +
       

     

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

     

       213
       213
       +
       -- nix call.

     

       214
       214
       +
       type DependencyMap = Map Text DepInfo

     

       215
       215
       +
       

     

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

     

       217
       217
       +
       -- unbroken reverse dependencies (snd).

     

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

     

       219
       219
       +
       

     

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

     

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

     

       222
       222
       +
       calculateReverseDependencies :: DependencyMap -> ReverseDependencyMap

     

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

     

       224
       224
       +
        where

     

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

     

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

     

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

     

       228
       228
       +
           keys = Map.keys depMap

     

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

     

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

     

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

     

       232
       232
       +
            where

     

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

     

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

     

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

     

       236
       236
       +
               where oneStep = IntMap.findWithDefault mempty pkg oneStepMap

     

       237
       237
       +
       

     

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

     

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

     

       199
       240
        
       getMaintainerMap :: IO MaintainerMap

     

       200
       241
        
       getMaintainerMap = do

     

       201
       242
        
          hydraJobs :: HydraJobs <-

     

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

     

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

     

       203
       244
        
          handlesMap :: EmailToGitHubHandles <-

     

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

     

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

     

       205
       246
        
          pure $ Map.mapMaybe (splitMaintainersToGitHubHandles handlesMap) hydraJobs

     

       206
       247
        
          where

     

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

     
···

       211
       252
        
          splitMaintainersToGitHubHandles handlesMap (Maintainers maint) =

     

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

     

       213
       254
        
       

     

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

     

       256
       256
       +
       -- script ./dependencies.nix.

     

       257
       257
       +
       getDependencyMap :: IO DependencyMap

     

       258
       258
       +
       getDependencyMap =

     

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

     

       260
       260
       +
       

     

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

     

       215
       262
        
       -- data type.

     

       216
       263
        
       --

     
···

       219
       266
        
          :: FromJSON a

     

       220
       267
        
          => FilePath -- ^ Filename of executable.

     

       221
       268
        
          -> [String] -- ^ Arguments

     

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

     

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

     

       224
       270
        
          -> IO a

     

       225
       225
       -
       readJSONProcess exe args input err = do

     

       226
       226
       -
          output <- readProcess exe args input

     

       271
       271
       +
       readJSONProcess exe args err = do

     

       272
       272
       +
          output <- readProcess exe args ""

     

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

     

       228
       274
        
          case eitherDecodedOutput of

     

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

     
···

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

     

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

     

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

     

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

     

       313
       313
       +
       data SummaryEntry = SummaryEntry {

     

       314
       314
       +
          summaryBuilds :: Table Text Platform BuildResult,

     

       315
       315
       +
          summaryMaintainers :: Set Text,

     

       316
       316
       +
          summaryReverseDeps :: Int,

     

       317
       317
       +
          summaryUnbrokenReverseDeps :: Int

     

       318
       318
       +
       }

     

       319
       319
       +
       type StatusSummary = Map Text SummaryEntry

     

       268
       320
        
       

     

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

     

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

     
···

       275
       327
        
       instance Foldable (Table row col) where

     

       276
       328
        
          foldMap f (Table a) = foldMap f a

     

       277
       329
        
       

     

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

     

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

     

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

     

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

     

       280
       332
        
         where

     

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

     

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

     

       333
       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
       334
       +
          toSummary Build{finished, buildstatus, job, id, system} = Map.singleton name (SummaryEntry (Table (Map.singleton (set, Platform system) (BuildResult state id))) maintainers reverseDeps unbrokenReverseDeps)

     

       283
       335
        
            where

     

       284
       336
        
             state :: BuildState

     

       285
       337
        
             state = case (finished, buildstatus) of

     
···

       297
       349
        
             name = maybe packageName NonEmpty.last splitted

     

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

     

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

     

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

     

       300
       353
        
       

     

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

     

       302
       355
        
       readBuildReports = do

     
···

       339
       392
        
       statusToNumSummary :: StatusSummary -> NumSummary

     

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

     

       341
       394
        
       

     

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

     

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

     

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

     

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

     

       344
       397
        
       

     

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

     

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

     

       347
       400
        
       

     

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

     

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

     

       349
       402
        
       printBuildSummary

     

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

     

       351
       404
        
          fetchTime

     

       352
       352
       -
          summary =

     

       405
       405
       +
          summary

     

       406
       406
       +
          topBrokenRdeps =

     

       353
       407
        
             Text.unlines $

     

       354
       408
        
                headline <> totals

     

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

     
···

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

     

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

     

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

     

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

     

       416
       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.*",""]

     

       361
       417
        
                   <> footer

     

       362
       418
        
            where

     

       363
       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)*"]

     
···

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

     

       381
       437
        
                   <> "*"

     

       382
       438
        
                ]

     

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

     

       439
       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
       440
       +
             jobsByState predicate = Map.filter (predicate . foldl' min Success . fmap state . summaryBuilds) summary

     

       384
       441
        
             fails = jobsByState (== Failed)

     

       385
       442
        
             failedDeps = jobsByState (== DependencyFailed)

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

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

     

       450
       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 ""))

     

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

     

       395
       452
        
       

     

       396
       453
        
       printMaintainerPing :: IO ()

     

       397
       454
        
       printMaintainerPing = do

     

       398
       398
       -
          maintainerMap <- getMaintainerMap

     

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

     

       456
       456
       +
             depMap <- getDependencyMap

     

       457
       457
       +
             rdepMap <- evaluate . calculateReverseDependencies $ depMap

     

       458
       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
       459
       +
             pure (rdepMap, tops)

     

       399
       460
        
          (eval, fetchTime, buildReport) <- readBuildReports

     

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

     

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

     

       401
       462
        
       

     

       402
       463
        
       printMarkBrokenList :: IO ()

     

       403
       464
        
       printMarkBrokenList = do

maintainers/scripts/haskell/maintainer-handles.nix

···

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

     

       2
       2
       +
       let

     

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

     

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

     

       5
       5
       +
         inherit (pkgs) lib;

     

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

     

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