{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

module Outpaths
  ( currentOutpathSet,
    ResultLine,
    dummyOutpathSetBefore,
    dummyOutpathSetAfter,
    numPackageRebuilds,
    outpathReport,
  )
where

import Data.List (sort)
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Vector as V
import OurPrelude
import Text.Parsec (parse)
import Text.Parser.Char
import Text.Parser.Combinators

outPathsExpr :: Text
outPathsExpr :: Text
outPathsExpr =
  [interpolate|
{ checkMeta
, path ? ./.
}:
let
  lib = import (path + "/lib");
  hydraJobs = import (path + "/pkgs/top-level/release.nix")
    # Compromise: accuracy vs. resources needed for evaluation.
    {
      supportedSystems = [
        "aarch64-linux"
        "i686-linux"
        "x86_64-linux"
        "x86_64-darwin"
      ];

      nixpkgsArgs = {
        config = {
          allowBroken = true;
          allowUnfree = true;
          allowInsecurePredicate = x: true;
          checkMeta = checkMeta;

          handleEvalIssue = reason: errormsg:
            let
              fatalErrors = [
                "unknown-meta" "broken-outputs"
              ];
            in if builtins.elem reason fatalErrors
              then abort errormsg
              else true;

          inHydra = true;
        };
      };
    };
  recurseIntoAttrs = attrs: attrs // { recurseForDerivations = true; };

  # hydraJobs leaves recurseForDerivations as empty attrmaps;
  # that would break nix-env and we also need to recurse everywhere.
  tweak = lib.mapAttrs
    (name: val:
      if name == "recurseForDerivations" then true
      else if lib.isAttrs val && val.type or null != "derivation"
              then recurseIntoAttrs (tweak val)
      else val
    );

  # Some of these contain explicit references to platform(s) we want to avoid;
  # some even (transitively) depend on ~/.nixpkgs/config.nix (!)
  blacklist = [
    "tarball" "metrics" "manual"
    "darwin-tested" "unstable" "stdenvBootstrapTools"
    "moduleSystem" "lib-tests" # these just confuse the output
  ];

in
  tweak (builtins.removeAttrs hydraJobs blacklist)
|]

outPath :: MonadIO m => ExceptT Text m Text
outPath :: ExceptT Text m Text
outPath = do
  IO () -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text m ()) -> IO () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Writing outpaths.nix..."
  IO () -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text m ()) -> IO () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
T.writeFile String
"./outpaths.nix" Text
outPathsExpr
  IO () -> ExceptT Text m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text m ()) -> IO () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Evaluating outpaths..."
  ProcessConfig () () () -> ExceptT Text m Text
forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored
-> ExceptT Text m Text
ourReadProcessInterleaved_
    ProcessConfig () () ()
"nix-env -f ./outpaths.nix -qaP --no-name --out-path --arg checkMeta true --show-trace"

data Outpath = Outpath
  { Outpath -> Maybe Text
mayName :: Maybe Text,
    Outpath -> Text
storePath :: Text
  }
  deriving (Outpath -> Outpath -> Bool
(Outpath -> Outpath -> Bool)
-> (Outpath -> Outpath -> Bool) -> Eq Outpath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Outpath -> Outpath -> Bool
$c/= :: Outpath -> Outpath -> Bool
== :: Outpath -> Outpath -> Bool
$c== :: Outpath -> Outpath -> Bool
Eq, Eq Outpath
Eq Outpath
-> (Outpath -> Outpath -> Ordering)
-> (Outpath -> Outpath -> Bool)
-> (Outpath -> Outpath -> Bool)
-> (Outpath -> Outpath -> Bool)
-> (Outpath -> Outpath -> Bool)
-> (Outpath -> Outpath -> Outpath)
-> (Outpath -> Outpath -> Outpath)
-> Ord Outpath
Outpath -> Outpath -> Bool
Outpath -> Outpath -> Ordering
Outpath -> Outpath -> Outpath
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Outpath -> Outpath -> Outpath
$cmin :: Outpath -> Outpath -> Outpath
max :: Outpath -> Outpath -> Outpath
$cmax :: Outpath -> Outpath -> Outpath
>= :: Outpath -> Outpath -> Bool
$c>= :: Outpath -> Outpath -> Bool
> :: Outpath -> Outpath -> Bool
$c> :: Outpath -> Outpath -> Bool
<= :: Outpath -> Outpath -> Bool
$c<= :: Outpath -> Outpath -> Bool
< :: Outpath -> Outpath -> Bool
$c< :: Outpath -> Outpath -> Bool
compare :: Outpath -> Outpath -> Ordering
$ccompare :: Outpath -> Outpath -> Ordering
$cp1Ord :: Eq Outpath
Ord, Int -> Outpath -> ShowS
[Outpath] -> ShowS
Outpath -> String
(Int -> Outpath -> ShowS)
-> (Outpath -> String) -> ([Outpath] -> ShowS) -> Show Outpath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Outpath] -> ShowS
$cshowList :: [Outpath] -> ShowS
show :: Outpath -> String
$cshow :: Outpath -> String
showsPrec :: Int -> Outpath -> ShowS
$cshowsPrec :: Int -> Outpath -> ShowS
Show)

data ResultLine = ResultLine
  { ResultLine -> Text
package :: Text,
    ResultLine -> Text
architecture :: Text,
    ResultLine -> Vector Outpath
outpaths :: Vector Outpath
  }
  deriving (ResultLine -> ResultLine -> Bool
(ResultLine -> ResultLine -> Bool)
-> (ResultLine -> ResultLine -> Bool) -> Eq ResultLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultLine -> ResultLine -> Bool
$c/= :: ResultLine -> ResultLine -> Bool
== :: ResultLine -> ResultLine -> Bool
$c== :: ResultLine -> ResultLine -> Bool
Eq, Eq ResultLine
Eq ResultLine
-> (ResultLine -> ResultLine -> Ordering)
-> (ResultLine -> ResultLine -> Bool)
-> (ResultLine -> ResultLine -> Bool)
-> (ResultLine -> ResultLine -> Bool)
-> (ResultLine -> ResultLine -> Bool)
-> (ResultLine -> ResultLine -> ResultLine)
-> (ResultLine -> ResultLine -> ResultLine)
-> Ord ResultLine
ResultLine -> ResultLine -> Bool
ResultLine -> ResultLine -> Ordering
ResultLine -> ResultLine -> ResultLine
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ResultLine -> ResultLine -> ResultLine
$cmin :: ResultLine -> ResultLine -> ResultLine
max :: ResultLine -> ResultLine -> ResultLine
$cmax :: ResultLine -> ResultLine -> ResultLine
>= :: ResultLine -> ResultLine -> Bool
$c>= :: ResultLine -> ResultLine -> Bool
> :: ResultLine -> ResultLine -> Bool
$c> :: ResultLine -> ResultLine -> Bool
<= :: ResultLine -> ResultLine -> Bool
$c<= :: ResultLine -> ResultLine -> Bool
< :: ResultLine -> ResultLine -> Bool
$c< :: ResultLine -> ResultLine -> Bool
compare :: ResultLine -> ResultLine -> Ordering
$ccompare :: ResultLine -> ResultLine -> Ordering
$cp1Ord :: Eq ResultLine
Ord, Int -> ResultLine -> ShowS
[ResultLine] -> ShowS
ResultLine -> String
(Int -> ResultLine -> ShowS)
-> (ResultLine -> String)
-> ([ResultLine] -> ShowS)
-> Show ResultLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultLine] -> ShowS
$cshowList :: [ResultLine] -> ShowS
show :: ResultLine -> String
$cshow :: ResultLine -> String
showsPrec :: Int -> ResultLine -> ShowS
$cshowsPrec :: Int -> ResultLine -> ShowS
Show)

-- Example query result line:
-- testInput :: Text
-- testInput =
--   "haskellPackages.amazonka-dynamodb-streams.x86_64-linux                        doc=/nix/store/m4rpsc9nx0qcflh9ni6qdlg6hbkwpicc-amazonka-dynamodb-streams-1.6.0-doc;/nix/store/rvd4zydr22a7j5kgnmg5x6695c7bgqbk-amazonka-dynamodb-streams-1.6.0\nhaskellPackages.agum.x86_64-darwin                                            doc=/nix/store/n526rc0pa5h0krdzsdni5agcpvcd3cb9-agum-2.7-doc;/nix/store/s59r75svbjm724q5iaprq4mln5k6wcr9-agum-2.7"
currentOutpathSet :: MonadIO m => ExceptT Text m (Set ResultLine)
currentOutpathSet :: ExceptT Text m (Set ResultLine)
currentOutpathSet = do
  Text
op <- ExceptT Text m Text
forall (m :: * -> *). MonadIO m => ExceptT Text m Text
outPath
  Parsec Text () (Set ResultLine)
-> String -> Text -> Either ParseError (Set ResultLine)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () (Set ResultLine)
forall (m :: * -> *). CharParsing m => m (Set ResultLine)
parseResults String
"outpath" Text
op Either ParseError (Set ResultLine)
-> (Either ParseError (Set ResultLine)
    -> Either Text (Set ResultLine))
-> Either Text (Set ResultLine)
forall a b. a -> (a -> b) -> b
& (ParseError -> Text)
-> Either ParseError (Set ResultLine)
-> Either Text (Set ResultLine)
forall a b r. (a -> b) -> Either a r -> Either b r
fmapL ParseError -> Text
forall a. Show a => a -> Text
tshow Either Text (Set ResultLine)
-> (Either Text (Set ResultLine)
    -> ExceptT Text m (Set ResultLine))
-> ExceptT Text m (Set ResultLine)
forall a b. a -> (a -> b) -> b
& Either Text (Set ResultLine) -> ExceptT Text m (Set ResultLine)
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
hoistEither

dummyOutpathSetBefore :: Text -> Set ResultLine
dummyOutpathSetBefore :: Text -> Set ResultLine
dummyOutpathSetBefore Text
attrPath = ResultLine -> Set ResultLine
forall a. a -> Set a
S.singleton (Text -> Text -> Vector Outpath -> ResultLine
ResultLine Text
attrPath Text
"x86-64" (Outpath -> Vector Outpath
forall a. a -> Vector a
V.singleton (Maybe Text -> Text -> Outpath
Outpath (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"attrPath") Text
"fakepath")))

dummyOutpathSetAfter :: Text -> Set ResultLine
dummyOutpathSetAfter :: Text -> Set ResultLine
dummyOutpathSetAfter Text
attrPath = ResultLine -> Set ResultLine
forall a. a -> Set a
S.singleton (Text -> Text -> Vector Outpath -> ResultLine
ResultLine Text
attrPath Text
"x86-64" (Outpath -> Vector Outpath
forall a. a -> Vector a
V.singleton (Maybe Text -> Text -> Outpath
Outpath (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"attrPath") Text
"fakepath-edited")))

parseResults :: CharParsing m => m (Set ResultLine)
parseResults :: m (Set ResultLine)
parseResults = [ResultLine] -> Set ResultLine
forall a. Ord a => [a] -> Set a
S.fromList ([ResultLine] -> Set ResultLine)
-> m [ResultLine] -> m (Set ResultLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m ResultLine
forall (m :: * -> *). CharParsing m => m ResultLine
parseResultLine m ResultLine -> m Char -> m [ResultLine]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepEndBy` m Char
forall (m :: * -> *). CharParsing m => m Char
newline

parseResultLine :: CharParsing m => m ResultLine
parseResultLine :: m ResultLine
parseResultLine =
  Text -> Text -> Vector Outpath -> ResultLine
ResultLine (Text -> Text -> Vector Outpath -> ResultLine)
-> m Text -> m (Text -> Vector Outpath -> ResultLine)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Char -> Bool) -> Text -> Text
T.dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
forall (m :: * -> *). CharParsing m => m Text
parseAttrpath)
    m (Text -> Vector Outpath -> ResultLine)
-> m Text -> m (Vector Outpath -> ResultLine)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Text
forall (m :: * -> *). CharParsing m => m Text
parseArchitecture
    m (Vector Outpath -> ResultLine)
-> m () -> m (Vector Outpath -> ResultLine)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
spaces
    m (Vector Outpath -> ResultLine)
-> m (Vector Outpath) -> m ResultLine
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m (Vector Outpath)
forall (m :: * -> *). CharParsing m => m (Vector Outpath)
parseOutpaths

parseAttrpath :: CharParsing m => m Text
parseAttrpath :: m Text
parseAttrpath = [Text] -> Text
T.concat ([Text] -> Text) -> m [Text] -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text -> m [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m Text -> m Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try m Text
forall (m :: * -> *). CharParsing m => m Text
parseAttrpathPart)

parseAttrpathPart :: CharParsing m => m Text
parseAttrpathPart :: m Text
parseAttrpathPart = Text -> Char -> Text
T.snoc (Text -> Char -> Text) -> m Text -> m (Char -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
noneOf String
". ")) m (Char -> Text) -> m Char -> m Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'.'

parseArchitecture :: CharParsing m => m Text
parseArchitecture :: m Text
parseArchitecture = String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
noneOf String
" ")

parseOutpaths :: CharParsing m => m (Vector Outpath)
parseOutpaths :: m (Vector Outpath)
parseOutpaths = [Outpath] -> Vector Outpath
forall a. [a] -> Vector a
V.fromList ([Outpath] -> Vector Outpath) -> m [Outpath] -> m (Vector Outpath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m Outpath
forall (m :: * -> *). CharParsing m => m Outpath
parseOutpath m Outpath -> m Char -> m [Outpath]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy1` Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
';')

parseOutpath :: CharParsing m => m Outpath
parseOutpath :: m Outpath
parseOutpath =
  Maybe Text -> Text -> Outpath
Outpath (Maybe Text -> Text -> Outpath)
-> m (Maybe Text) -> m (Text -> Outpath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m Text
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
noneOf String
"=\n") m String -> m Char -> m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'=')))
    m (Text -> Outpath) -> m Text -> m Outpath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (String -> Text
T.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (String -> m Char
forall (m :: * -> *). CharParsing m => String -> m Char
noneOf String
";\n"))

packageRebuilds :: Set ResultLine -> Vector Text
packageRebuilds :: Set ResultLine -> Vector Text
packageRebuilds = Set ResultLine -> [ResultLine]
forall a. Set a -> [a]
S.toList (Set ResultLine -> [ResultLine])
-> ([ResultLine] -> Vector Text) -> Set ResultLine -> Vector Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ResultLine -> Text) -> [ResultLine] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultLine -> Text
package ([ResultLine] -> [Text])
-> ([Text] -> Vector Text) -> [ResultLine] -> Vector Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Text] -> [Text]
forall a. Ord a => [a] -> [a]
sort ([Text] -> [Text])
-> ([Text] -> Vector Text) -> [Text] -> Vector Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Text] -> Vector Text
forall a. [a] -> Vector a
V.fromList ([Text] -> Vector Text)
-> (Vector Text -> Vector Text) -> [Text] -> Vector Text
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Vector Text -> Vector Text
forall a. Eq a => Vector a -> Vector a
V.uniq

numPackageRebuilds :: Set ResultLine -> Int
numPackageRebuilds :: Set ResultLine -> Int
numPackageRebuilds Set ResultLine
diff = Vector Text -> Int
forall a. Vector a -> Int
V.length (Vector Text -> Int) -> Vector Text -> Int
forall a b. (a -> b) -> a -> b
$ Set ResultLine -> Vector Text
packageRebuilds Set ResultLine
diff

archRebuilds :: Text -> Set ResultLine -> Int
archRebuilds :: Text -> Set ResultLine -> Int
archRebuilds Text
arch =
  Set ResultLine -> [ResultLine]
forall a. Set a -> [a]
S.toList (Set ResultLine -> [ResultLine])
-> ([ResultLine] -> Int) -> Set ResultLine -> Int
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (ResultLine -> Text) -> [ResultLine] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultLine -> Text
architecture ([ResultLine] -> [Text]) -> ([Text] -> Int) -> [ResultLine] -> Int
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
arch) ([Text] -> [Text]) -> ([Text] -> Int) -> [Text] -> Int
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

darwinRebuilds :: Set ResultLine -> Int
darwinRebuilds :: Set ResultLine -> Int
darwinRebuilds = Text -> Set ResultLine -> Int
archRebuilds Text
"x86_64-darwin"

linuxRebuilds :: Set ResultLine -> Int
linuxRebuilds :: Set ResultLine -> Int
linuxRebuilds = Text -> Set ResultLine -> Int
archRebuilds Text
"x86_64-linux"

linux32bRebuilds :: Set ResultLine -> Int
linux32bRebuilds :: Set ResultLine -> Int
linux32bRebuilds = Text -> Set ResultLine -> Int
archRebuilds Text
"i686-linux"

armRebuilds :: Set ResultLine -> Int
armRebuilds :: Set ResultLine -> Int
armRebuilds = Text -> Set ResultLine -> Int
archRebuilds Text
"aarch64-linux"

outpathReport :: Set ResultLine -> Text
outpathReport :: Set ResultLine -> Text
outpathReport Set ResultLine
diff =
  let pkg :: Text
pkg = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Vector Text -> Int
forall a. Vector a -> Int
V.length (Vector Text -> Int) -> Vector Text -> Int
forall a b. (a -> b) -> a -> b
$ Set ResultLine -> Vector Text
packageRebuilds Set ResultLine
diff
      firstFifty :: Text
firstFifty = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Vector Text -> [Text]
forall a. Vector a -> [a]
V.toList (Vector Text -> [Text]) -> Vector Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> Vector Text -> Vector Text
forall a. Int -> Vector a -> Vector a
V.take Int
50 (Vector Text -> Vector Text) -> Vector Text -> Vector Text
forall a b. (a -> b) -> a -> b
$ Set ResultLine -> Vector Text
packageRebuilds Set ResultLine
diff
      darwin :: Text
darwin = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Set ResultLine -> Int
darwinRebuilds Set ResultLine
diff
      linux :: Text
linux = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Set ResultLine -> Int
linuxRebuilds Set ResultLine
diff
      linux32b :: Text
linux32b = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Set ResultLine -> Int
linux32bRebuilds Set ResultLine
diff
      arm :: Text
arm = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Set ResultLine -> Int
armRebuilds Set ResultLine
diff
      numPaths :: Text
numPaths = Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Set ResultLine -> Int
forall a. Set a -> Int
S.size Set ResultLine
diff
   in [interpolate|
        $numPaths total rebuild path(s)

        $pkg package rebuild(s)

        $linux x86_64-linux rebuild(s)
        $linux32b i686-linux rebuild(s)
        $darwin x86_64-darwin rebuild(s)
        $arm aarch64-linux rebuild(s)


        First fifty rebuilds by attrpath
        $firstFifty
      |]