{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
module Distribution.Simple.SrcDist (
sdist,
printPackageProblems,
prepareTree,
createArchive,
prepareSnapshotTree,
snapshotPackage,
snapshotVersion,
dateToSnapshotNumber,
listPackageSources,
listPackageSourcesWithDie,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.PackageDescription
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.Package
import Distribution.ModuleName
import qualified Distribution.ModuleName as ModuleName
import Distribution.Version
import Distribution.Simple.Configure (findDistPrefOrDefault)
import Distribution.Simple.Glob (matchDirFileGlobWithDie)
import Distribution.Simple.Utils
import Distribution.Simple.Setup
import Distribution.Simple.PreProcess
import Distribution.Simple.BuildPaths
import Distribution.Simple.Program
import Distribution.Pretty
import Distribution.Verbosity
import Distribution.Utils.Path
import qualified Data.Map as Map
import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
import System.Directory ( doesFileExist )
import System.IO (IOMode(WriteMode), hPutStrLn, withFile)
import System.FilePath ((</>), (<.>), dropExtension, isRelative)
sdist :: PackageDescription
-> SDistFlags
-> (FilePath -> FilePath)
-> [PPSuffixHandler]
-> IO ()
sdist :: PackageDescription
-> SDistFlags -> (String -> String) -> [PPSuffixHandler] -> IO ()
sdist PackageDescription
pkg SDistFlags
flags String -> String
mkTmpDir [PPSuffixHandler]
pps = do
String
distPref <- Flag String -> IO String
findDistPrefOrDefault forall a b. (a -> b) -> a -> b
$ SDistFlags -> Flag String
sDistDistPref SDistFlags
flags
let targetPref :: String
targetPref = String
distPref
tmpTargetDir :: String
tmpTargetDir = String -> String
mkTmpDir String
distPref
case SDistFlags -> Flag String
sDistListSources SDistFlags
flags of
Flag String
path -> forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
outHandle -> do
[String]
ordinary <- Verbosity
-> String -> PackageDescription -> [PPSuffixHandler] -> IO [String]
listPackageSources Verbosity
verbosity String
"." PackageDescription
pkg [PPSuffixHandler]
pps
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Handle -> String -> IO ()
hPutStrLn Handle
outHandle) [String]
ordinary
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"List of package sources written to file '" forall a. [a] -> [a] -> [a]
++ String
path forall a. [a] -> [a] -> [a]
++ String
"'"
Flag String
NoFlag -> do
Verbosity -> PackageDescription -> IO ()
printPackageProblems Verbosity
verbosity PackageDescription
pkg
UTCTime
date <- IO UTCTime
getCurrentTime
let pkg' :: PackageDescription
pkg' | Bool
snapshot = UTCTime -> PackageDescription -> PackageDescription
snapshotPackage UTCTime
date PackageDescription
pkg
| Bool
otherwise = PackageDescription
pkg
case forall a. Flag a -> Maybe a
flagToMaybe (SDistFlags -> Flag String
sDistDirectory SDistFlags
flags) of
Just String
targetDir -> do
String -> PackageDescription -> IO ()
generateSourceDir String
targetDir PackageDescription
pkg'
Verbosity -> String -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Source directory created: " forall a. [a] -> [a] -> [a]
++ String
targetDir
Maybe String
Nothing -> do
Verbosity -> Bool -> String -> IO ()
createDirectoryIfMissingVerbose Verbosity
verbosity Bool
True String
tmpTargetDir
forall a. Verbosity -> String -> String -> (String -> IO a) -> IO a
withTempDirectory Verbosity
verbosity String
tmpTargetDir String
"sdist." forall a b. (a -> b) -> a -> b
$ \String
tmpDir -> do
let targetDir :: String
targetDir = String
tmpDir String -> String -> String
</> PackageDescription -> String
tarBallName PackageDescription
pkg'
String -> PackageDescription -> IO ()
generateSourceDir String
targetDir PackageDescription
pkg'
String
targzFile <- Verbosity -> PackageDescription -> String -> String -> IO String
createArchive Verbosity
verbosity PackageDescription
pkg' String
tmpDir String
targetPref
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Source tarball created: " forall a. [a] -> [a] -> [a]
++ String
targzFile
where
generateSourceDir :: FilePath -> PackageDescription -> IO ()
generateSourceDir :: String -> PackageDescription -> IO ()
generateSourceDir String
targetDir PackageDescription
pkg' = do
Verbosity -> String -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbosity String
"Building source dist for" (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg')
Verbosity
-> PackageDescription -> String -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg' String
targetDir [PPSuffixHandler]
pps
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
snapshot forall a b. (a -> b) -> a -> b
$
Verbosity -> PackageDescription -> String -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg' String
targetDir
verbosity :: Verbosity
verbosity = forall a. WithCallStack (Flag a -> a)
fromFlag (SDistFlags -> Flag Verbosity
sDistVerbosity SDistFlags
flags)
snapshot :: Bool
snapshot = forall a. WithCallStack (Flag a -> a)
fromFlag (SDistFlags -> Flag Bool
sDistSnapshot SDistFlags
flags)
listPackageSources
:: Verbosity
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources :: Verbosity
-> String -> PackageDescription -> [PPSuffixHandler] -> IO [String]
listPackageSources Verbosity
verbosity String
cwd PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> PackageDescription
-> [PPSuffixHandler]
-> IO [String]
listPackageSources' Verbosity
verbosity forall a. Verbosity -> String -> IO a
die' String
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps
where
pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0
listPackageSourcesWithDie
:: Verbosity
-> (Verbosity -> String -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSourcesWithDie :: Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> PackageDescription
-> [PPSuffixHandler]
-> IO [String]
listPackageSourcesWithDie Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd PackageDescription
pkg_descr0 [PPSuffixHandler]
pps = do
Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> PackageDescription
-> [PPSuffixHandler]
-> IO [String]
listPackageSources' Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps
where
pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0
listPackageSources'
:: Verbosity
-> (Verbosity -> String -> IO [FilePath])
-> FilePath
-> PackageDescription
-> [PPSuffixHandler]
-> IO [FilePath]
listPackageSources' :: Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> PackageDescription
-> [PPSuffixHandler]
-> IO [String]
listPackageSources' Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd PackageDescription
pkg_descr [PPSuffixHandler]
pps =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$
[
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {b}.
Applicative f =>
(Library -> f b) -> f [b]
withAllLib forall a b. (a -> b) -> a -> b
$ \Library {
exposedModules :: Library -> [ModuleName]
exposedModules = [ModuleName]
modules,
signatures :: Library -> [ModuleName]
signatures = [ModuleName]
sigs,
libBuildInfo :: Library -> BuildInfo
libBuildInfo = BuildInfo
libBi
} ->
Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [String]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd BuildInfo
libBi [PPSuffixHandler]
pps ([ModuleName]
modules forall a. [a] -> [a] -> [a]
++ [ModuleName]
sigs)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {b}.
Applicative f =>
(Executable -> f b) -> f [b]
withAllExe forall a b. (a -> b) -> a -> b
$ \Executable { modulePath :: Executable -> String
modulePath = String
mainPath, buildInfo :: Executable -> BuildInfo
buildInfo = BuildInfo
exeBi } -> do
[String]
biSrcs <- Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [String]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd BuildInfo
exeBi [PPSuffixHandler]
pps []
String
mainSrc <- Verbosity
-> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
findMainExeFile Verbosity
verbosity String
cwd BuildInfo
exeBi [PPSuffixHandler]
pps String
mainPath
forall (m :: * -> *) a. Monad m => a -> m a
return (String
mainSrcforall a. a -> [a] -> [a]
:[String]
biSrcs)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {b}.
Applicative f =>
(ForeignLib -> f b) -> f [b]
withAllFLib forall a b. (a -> b) -> a -> b
$ \flib :: ForeignLib
flib@(ForeignLib { foreignLibBuildInfo :: ForeignLib -> BuildInfo
foreignLibBuildInfo = BuildInfo
flibBi }) -> do
[String]
biSrcs <- Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [String]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd BuildInfo
flibBi [PPSuffixHandler]
pps []
[String]
defFiles <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Verbosity
-> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
findModDefFile Verbosity
verbosity String
cwd BuildInfo
flibBi [PPSuffixHandler]
pps)
(ForeignLib -> [String]
foreignLibModDefFile ForeignLib
flib)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
defFiles forall a. [a] -> [a] -> [a]
++ [String]
biSrcs)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {b}.
Applicative f =>
(TestSuite -> f b) -> f [b]
withAllTest forall a b. (a -> b) -> a -> b
$ \TestSuite
t -> do
let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
t
case TestSuite -> TestSuiteInterface
testInterface TestSuite
t of
TestSuiteExeV10 Version
_ String
mainPath -> do
[String]
biSrcs <- Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [String]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd BuildInfo
bi [PPSuffixHandler]
pps []
String
srcMainFile <- Verbosity
-> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
findMainExeFile Verbosity
verbosity String
cwd BuildInfo
bi [PPSuffixHandler]
pps String
mainPath
forall (m :: * -> *) a. Monad m => a -> m a
return (String
srcMainFileforall a. a -> [a] -> [a]
:[String]
biSrcs)
TestSuiteLibV09 Version
_ ModuleName
m ->
Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [String]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd BuildInfo
bi [PPSuffixHandler]
pps [ModuleName
m]
TestSuiteUnsupported TestType
tp ->
Verbosity -> String -> IO [String]
rip Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Unsupported test suite type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TestType
tp
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {b}.
Applicative f =>
(Benchmark -> f b) -> f [b]
withAllBenchmark forall a b. (a -> b) -> a -> b
$ \Benchmark
bm -> do
let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm
case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bm of
BenchmarkExeV10 Version
_ String
mainPath -> do
[String]
biSrcs <- Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [String]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd BuildInfo
bi [PPSuffixHandler]
pps []
String
srcMainFile <- Verbosity
-> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
findMainExeFile Verbosity
verbosity String
cwd BuildInfo
bi [PPSuffixHandler]
pps String
mainPath
forall (m :: * -> *) a. Monad m => a -> m a
return (String
srcMainFileforall a. a -> [a] -> [a]
:[String]
biSrcs)
BenchmarkUnsupported BenchmarkType
tp ->
Verbosity -> String -> IO [String]
rip Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Unsupported benchmark type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show BenchmarkType
tp
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [String]
dataFiles PackageDescription
pkg_descr) forall a b. (a -> b) -> a -> b
$ \String
filename -> do
let srcDataDirRaw :: String
srcDataDirRaw = PackageDescription -> String
dataDir PackageDescription
pkg_descr
srcDataDir :: String
srcDataDir | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
srcDataDirRaw = String
"."
| Bool
otherwise = String
srcDataDirRaw
Verbosity
-> (Verbosity -> String -> IO [String])
-> CabalSpecVersion
-> String
-> String
-> IO [String]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> String -> IO [String]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) String
cwd (String
srcDataDir String -> String -> String
</> String
filename)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [String]
extraSrcFiles PackageDescription
pkg_descr) forall a b. (a -> b) -> a -> b
$ \String
fpath ->
Verbosity
-> (Verbosity -> String -> IO [String])
-> CabalSpecVersion
-> String
-> String
-> IO [String]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> String -> IO [String]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) String
cwd String
fpath
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (PackageDescription -> [String]
extraDocFiles PackageDescription
pkg_descr) forall a b. (a -> b) -> a -> b
$ \ String
filename ->
Verbosity
-> (Verbosity -> String -> IO [String])
-> CabalSpecVersion
-> String
-> String
-> IO [String]
matchDirFileGlobWithDie Verbosity
verbosity Verbosity -> String -> IO [String]
rip (PackageDescription -> CabalSpecVersion
specVersion PackageDescription
pkg_descr) String
cwd String
filename
, forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath forall a b. (a -> b) -> a -> b
$ PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkg_descr)
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *} {b}.
Applicative f =>
(Library -> f b) -> f [b]
withAllLib forall a b. (a -> b) -> a -> b
$ \ Library
l -> do
let lbi :: BuildInfo
lbi = Library -> BuildInfo
libBuildInfo Library
l
incls :: [String]
incls = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` BuildInfo -> [String]
autogenIncludes BuildInfo
lbi) (BuildInfo -> [String]
installIncludes BuildInfo
lbi)
relincdirs :: [String]
relincdirs = String
"." forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isRelative (BuildInfo -> [String]
includeDirs BuildInfo
lbi)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> String -> [String] -> String -> IO (String, String)
findIncludeFile Verbosity
verbosity String
cwd [String]
relincdirs) [String]
incls
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\String
f -> [String
f])) forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
findSetupFile String
cwd
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
d -> [String
d]) (Verbosity -> String -> String -> IO String
tryFindPackageDescCwd Verbosity
verbosity String
cwd String
".")
]
where
withAllLib :: (Library -> f b) -> f [b]
withAllLib Library -> f b
action = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Library -> f b
action (PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr)
withAllFLib :: (ForeignLib -> f b) -> f [b]
withAllFLib ForeignLib -> f b
action = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ForeignLib -> f b
action (PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg_descr)
withAllExe :: (Executable -> f b) -> f [b]
withAllExe Executable -> f b
action = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Executable -> f b
action (PackageDescription -> [Executable]
executables PackageDescription
pkg_descr)
withAllTest :: (TestSuite -> f b) -> f [b]
withAllTest TestSuite -> f b
action = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TestSuite -> f b
action (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr)
withAllBenchmark :: (Benchmark -> f b) -> f [b]
withAllBenchmark Benchmark -> f b
action = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Benchmark -> f b
action (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr)
prepareTree :: Verbosity
-> PackageDescription
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareTree :: Verbosity
-> PackageDescription -> String -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg_descr0 String
targetDir [PPSuffixHandler]
pps = do
[String]
ordinary <- Verbosity
-> String -> PackageDescription -> [PPSuffixHandler] -> IO [String]
listPackageSources Verbosity
verbosity String
"." PackageDescription
pkg_descr [PPSuffixHandler]
pps
Verbosity -> String -> [(String, String)] -> IO ()
installOrdinaryFiles Verbosity
verbosity String
targetDir (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. a -> [a]
repeat []) [String]
ordinary)
String -> IO ()
maybeCreateDefaultSetupScript String
targetDir
where
pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0
findSetupFile :: FilePath -> IO (Maybe FilePath)
findSetupFile :: String -> IO (Maybe String)
findSetupFile String
targetDir = do
Bool
hsExists <- String -> IO Bool
doesFileExist (String
targetDir String -> String -> String
</> String
setupHs)
Bool
lhsExists <- String -> IO Bool
doesFileExist (String
targetDir String -> String -> String
</> String
setupLhs)
if Bool
hsExists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
setupHs)
else if Bool
lhsExists
then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just String
setupLhs)
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
where
setupHs :: String
setupHs = String
"Setup.hs"
setupLhs :: String
setupLhs = String
"Setup.lhs"
maybeCreateDefaultSetupScript :: FilePath -> IO ()
maybeCreateDefaultSetupScript :: String -> IO ()
maybeCreateDefaultSetupScript String
targetDir = do
Maybe String
mSetupFile <- String -> IO (Maybe String)
findSetupFile String
targetDir
case Maybe String
mSetupFile of
Just String
_setupFile -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe String
Nothing -> do
String -> String -> IO ()
writeUTF8File (String
targetDir String -> String -> String
</> String
"Setup.hs") forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
String
"import Distribution.Simple",
String
"main = defaultMain"]
findMainExeFile
:: Verbosity
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> FilePath
-> IO FilePath
findMainExeFile :: Verbosity
-> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
findMainExeFile Verbosity
verbosity String
cwd BuildInfo
exeBi [PPSuffixHandler]
pps String
mainPath = do
Maybe String
ppFile <- String -> [String] -> [String] -> String -> IO (Maybe String)
findFileCwdWithExtension String
cwd ([PPSuffixHandler] -> [String]
ppSuffixes [PPSuffixHandler]
pps) (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
exeBi))
(String -> String
dropExtension String
mainPath)
case Maybe String
ppFile of
Maybe String
Nothing -> Verbosity -> String -> [String] -> String -> IO String
findFileCwd Verbosity
verbosity String
cwd (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
exeBi)) String
mainPath
Just String
pp -> forall (m :: * -> *) a. Monad m => a -> m a
return String
pp
findModDefFile
:: Verbosity -> FilePath -> BuildInfo -> [PPSuffixHandler] -> FilePath -> IO FilePath
findModDefFile :: Verbosity
-> String -> BuildInfo -> [PPSuffixHandler] -> String -> IO String
findModDefFile Verbosity
verbosity String
cwd BuildInfo
flibBi [PPSuffixHandler]
_pps String
modDefPath =
Verbosity -> String -> [String] -> String -> IO String
findFileCwd Verbosity
verbosity String
cwd (String
"." forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
flibBi)) String
modDefPath
findIncludeFile :: Verbosity -> FilePath -> [FilePath] -> String -> IO (String, FilePath)
findIncludeFile :: Verbosity -> String -> [String] -> String -> IO (String, String)
findIncludeFile Verbosity
verbosity String
_ [] String
f = forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String
"can't find include file " forall a. [a] -> [a] -> [a]
++ String
f)
findIncludeFile Verbosity
verbosity String
cwd (String
d:[String]
ds) String
f = do
let path :: String
path = (String
d String -> String -> String
</> String
f)
Bool
b <- String -> IO Bool
doesFileExist (String
cwd String -> String -> String
</> String
path)
if Bool
b then forall (m :: * -> *) a. Monad m => a -> m a
return (String
f,String
path) else Verbosity -> String -> [String] -> String -> IO (String, String)
findIncludeFile Verbosity
verbosity String
cwd [String]
ds String
f
filterAutogenModules :: PackageDescription -> PackageDescription
filterAutogenModules :: PackageDescription -> PackageDescription
filterAutogenModules PackageDescription
pkg_descr0 = (Library -> Library) -> PackageDescription -> PackageDescription
mapLib Library -> Library
filterAutogenModuleLib forall a b. (a -> b) -> a -> b
$
(BuildInfo -> BuildInfo)
-> PackageDescription -> PackageDescription
mapAllBuildInfo BuildInfo -> BuildInfo
filterAutogenModuleBI PackageDescription
pkg_descr0
where
mapLib :: (Library -> Library) -> PackageDescription -> PackageDescription
mapLib Library -> Library
f PackageDescription
pkg = PackageDescription
pkg { library :: Maybe Library
library = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Library
f (PackageDescription -> Maybe Library
library PackageDescription
pkg)
, subLibraries :: [Library]
subLibraries = forall a b. (a -> b) -> [a] -> [b]
map Library -> Library
f (PackageDescription -> [Library]
subLibraries PackageDescription
pkg) }
filterAutogenModuleLib :: Library -> Library
filterAutogenModuleLib Library
lib = Library
lib {
exposedModules :: [ModuleName]
exposedModules = forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> ModuleName -> Bool
filterFunction (Library -> BuildInfo
libBuildInfo Library
lib)) (Library -> [ModuleName]
exposedModules Library
lib)
}
filterAutogenModuleBI :: BuildInfo -> BuildInfo
filterAutogenModuleBI BuildInfo
bi = BuildInfo
bi {
otherModules :: [ModuleName]
otherModules = forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> ModuleName -> Bool
filterFunction BuildInfo
bi) (BuildInfo -> [ModuleName]
otherModules BuildInfo
bi)
}
pathsModule :: ModuleName
pathsModule = PackageDescription -> ModuleName
autogenPathsModuleName PackageDescription
pkg_descr0
filterFunction :: BuildInfo -> ModuleName -> Bool
filterFunction BuildInfo
bi = \ModuleName
mn ->
ModuleName
mn forall a. Eq a => a -> a -> Bool
/= ModuleName
pathsModule
Bool -> Bool -> Bool
&& Bool -> Bool
not (ModuleName
mn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` BuildInfo -> [ModuleName]
autogenModules BuildInfo
bi)
prepareSnapshotTree
:: Verbosity
-> PackageDescription
-> FilePath
-> [PPSuffixHandler]
-> IO ()
prepareSnapshotTree :: Verbosity
-> PackageDescription -> String -> [PPSuffixHandler] -> IO ()
prepareSnapshotTree Verbosity
verbosity PackageDescription
pkg String
targetDir [PPSuffixHandler]
pps = do
Verbosity
-> PackageDescription -> String -> [PPSuffixHandler] -> IO ()
prepareTree Verbosity
verbosity PackageDescription
pkg String
targetDir [PPSuffixHandler]
pps
Verbosity -> PackageDescription -> String -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg String
targetDir
overwriteSnapshotPackageDesc :: Verbosity
-> PackageDescription
-> FilePath
-> IO ()
overwriteSnapshotPackageDesc :: Verbosity -> PackageDescription -> String -> IO ()
overwriteSnapshotPackageDesc Verbosity
verbosity PackageDescription
pkg String
targetDir = do
String
descFile <- Verbosity -> IO String
defaultPackageDesc Verbosity
verbosity
forall a. String -> (String -> IO a) -> IO a
withUTF8FileContents String
descFile forall a b. (a -> b) -> a -> b
$
String -> String -> IO ()
writeUTF8File (String
targetDir String -> String -> String
</> String
descFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Version -> String -> String
replaceVersion (forall pkg. Package pkg => pkg -> Version
packageVersion PackageDescription
pkg)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
where
replaceVersion :: Version -> String -> String
replaceVersion :: Version -> String -> String
replaceVersion Version
version String
line
| String
"version:" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
line
= String
"version: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
version
| Bool
otherwise = String
line
snapshotPackage :: UTCTime -> PackageDescription -> PackageDescription
snapshotPackage :: UTCTime -> PackageDescription -> PackageDescription
snapshotPackage UTCTime
date PackageDescription
pkg =
PackageDescription
pkg {
package :: PackageIdentifier
package = PackageIdentifier
pkgid { pkgVersion :: Version
pkgVersion = UTCTime -> Version -> Version
snapshotVersion UTCTime
date (PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkgid) }
}
where pkgid :: PackageIdentifier
pkgid = forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg
snapshotVersion :: UTCTime -> Version -> Version
snapshotVersion :: UTCTime -> Version -> Version
snapshotVersion UTCTime
date = ([Int] -> [Int]) -> Version -> Version
alterVersion (forall a. [a] -> [a] -> [a]
++ [UTCTime -> Int
dateToSnapshotNumber UTCTime
date])
dateToSnapshotNumber :: UTCTime -> Int
dateToSnapshotNumber :: UTCTime -> Int
dateToSnapshotNumber UTCTime
date = case Day -> (Year, Int, Int)
toGregorian (UTCTime -> Day
utctDay UTCTime
date) of
(Year
year, Int
month, Int
day) ->
forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
year forall a. Num a => a -> a -> a
* Int
10000
forall a. Num a => a -> a -> a
+ Int
month forall a. Num a => a -> a -> a
* Int
100
forall a. Num a => a -> a -> a
+ Int
day
createArchive
:: Verbosity
-> PackageDescription
-> FilePath
-> FilePath
-> IO FilePath
createArchive :: Verbosity -> PackageDescription -> String -> String -> IO String
createArchive Verbosity
verbosity PackageDescription
pkg_descr String
tmpDir String
targetPref = do
let tarBallFilePath :: String
tarBallFilePath = String
targetPref String -> String -> String
</> PackageDescription -> String
tarBallName PackageDescription
pkg_descr String -> String -> String
<.> String
"tar.gz"
(ConfiguredProgram
tarProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
tarProgram ProgramDb
defaultProgramDb
let formatOptSupported :: Bool
formatOptSupported = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Eq a => a -> a -> Bool
== String
"YES") forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
"Supports --format"
(ConfiguredProgram -> Map String String
programProperties ConfiguredProgram
tarProg)
Verbosity -> ConfiguredProgram -> [String] -> IO ()
runProgram Verbosity
verbosity ConfiguredProgram
tarProg forall a b. (a -> b) -> a -> b
$
[String
"-czf", String
tarBallFilePath, String
"-C", String
tmpDir]
forall a. [a] -> [a] -> [a]
++ (if Bool
formatOptSupported then [String
"--format", String
"ustar"] else [])
forall a. [a] -> [a] -> [a]
++ [PackageDescription -> String
tarBallName PackageDescription
pkg_descr]
forall (m :: * -> *) a. Monad m => a -> m a
return String
tarBallFilePath
allSourcesBuildInfo
:: Verbosity
-> (Verbosity -> String -> IO [FilePath])
-> FilePath
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [FilePath]
allSourcesBuildInfo :: Verbosity
-> (Verbosity -> String -> IO [String])
-> String
-> BuildInfo
-> [PPSuffixHandler]
-> [ModuleName]
-> IO [String]
allSourcesBuildInfo Verbosity
verbosity Verbosity -> String -> IO [String]
rip String
cwd BuildInfo
bi [PPSuffixHandler]
pps [ModuleName]
modules = do
let searchDirs :: [String]
searchDirs = forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)
[String]
sources <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall a b. (a -> b) -> a -> b
$
[ let file :: String
file = ModuleName -> String
ModuleName.toFilePath ModuleName
module_
in String -> [String] -> [String] -> String -> IO [String]
findAllFilesCwdWithExtension String
cwd [String]
suffixes [String]
searchDirs String
file
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty' (ModuleName -> IO [String]
notFound ModuleName
module_) forall (m :: * -> *) a. Monad m => a -> m a
return
| ModuleName
module_ <- [ModuleName]
modules forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi ]
[Maybe String]
bootFiles <- forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
[ let file :: String
file = ModuleName -> String
ModuleName.toFilePath ModuleName
module_
fileExts :: [String]
fileExts = [String
"hs-boot", String
"lhs-boot"]
in String -> [String] -> [String] -> String -> IO (Maybe String)
findFileCwdWithExtension String
cwd [String]
fileExts (forall a b. (a -> b) -> [a] -> [b]
map forall from to. SymbolicPath from to -> String
getSymbolicPath (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
bi)) String
file
| ModuleName
module_ <- [ModuleName]
modules forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ModuleName]
otherModules BuildInfo
bi ]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String]
sources forall a. [a] -> [a] -> [a]
++ forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
bootFiles forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cSources BuildInfo
bi forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
cxxSources BuildInfo
bi forall a. [a] -> [a] -> [a]
++
BuildInfo -> [String]
cmmSources BuildInfo
bi forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
asmSources BuildInfo
bi forall a. [a] -> [a] -> [a]
++ BuildInfo -> [String]
jsSources BuildInfo
bi
where
nonEmpty' :: b -> ([a] -> b) -> [a] -> b
nonEmpty' :: forall b a. b -> ([a] -> b) -> [a] -> b
nonEmpty' b
x [a] -> b
_ [] = b
x
nonEmpty' b
_ [a] -> b
f [a]
xs = [a] -> b
f [a]
xs
suffixes :: [String]
suffixes = [PPSuffixHandler] -> [String]
ppSuffixes [PPSuffixHandler]
pps forall a. [a] -> [a] -> [a]
++ [String
"hs", String
"lhs", String
"hsig", String
"lhsig"]
notFound :: ModuleName -> IO [FilePath]
notFound :: ModuleName -> IO [String]
notFound ModuleName
m = Verbosity -> String -> IO [String]
rip Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Error: Could not find module: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow ModuleName
m
forall a. [a] -> [a] -> [a]
++ String
" with any suffix: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
suffixes forall a. [a] -> [a] -> [a]
++ String
". If the module "
forall a. [a] -> [a] -> [a]
++ String
"is autogenerated it should be added to 'autogen-modules'."
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems :: Verbosity -> PackageDescription -> IO ()
printPackageProblems Verbosity
verbosity PackageDescription
pkg_descr = do
[PackageCheck]
ioChecks <- Verbosity -> PackageDescription -> String -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg_descr String
"."
let pureChecks :: [PackageCheck]
pureChecks = PackageDescription -> [PackageCheck]
checkConfiguredPackage PackageDescription
pkg_descr
isDistError :: PackageCheck -> Bool
isDistError (PackageDistSuspicious String
_) = Bool
False
isDistError (PackageDistSuspiciousWarn String
_) = Bool
False
isDistError PackageCheck
_ = Bool
True
([PackageCheck]
errors, [PackageCheck]
warnings) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition PackageCheck -> Bool
isDistError ([PackageCheck]
pureChecks forall a. [a] -> [a] -> [a]
++ [PackageCheck]
ioChecks)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
errors) forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Distribution quality errors:\n"
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map PackageCheck -> String
explanation [PackageCheck]
errors)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
warnings) forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
notice Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ String
"Distribution quality warnings:\n"
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map PackageCheck -> String
explanation [PackageCheck]
warnings)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
errors) forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
notice Verbosity
verbosity
String
"Note: the public hackage server would reject this package."
tarBallName :: PackageDescription -> String
tarBallName :: PackageDescription -> String
tarBallName = forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageIdentifier
packageId
mapAllBuildInfo :: (BuildInfo -> BuildInfo)
-> (PackageDescription -> PackageDescription)
mapAllBuildInfo :: (BuildInfo -> BuildInfo)
-> PackageDescription -> PackageDescription
mapAllBuildInfo BuildInfo -> BuildInfo
f PackageDescription
pkg = PackageDescription
pkg {
library :: Maybe Library
library = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Library
mapLibBi (PackageDescription -> Maybe Library
library PackageDescription
pkg),
subLibraries :: [Library]
subLibraries = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Library -> Library
mapLibBi (PackageDescription -> [Library]
subLibraries PackageDescription
pkg),
foreignLibs :: [ForeignLib]
foreignLibs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ForeignLib -> ForeignLib
mapFLibBi (PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg),
executables :: [Executable]
executables = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Executable -> Executable
mapExeBi (PackageDescription -> [Executable]
executables PackageDescription
pkg),
testSuites :: [TestSuite]
testSuites = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestSuite -> TestSuite
mapTestBi (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg),
benchmarks :: [Benchmark]
benchmarks = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Benchmark -> Benchmark
mapBenchBi (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)
}
where
mapLibBi :: Library -> Library
mapLibBi Library
lib = Library
lib { libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo -> BuildInfo
f (Library -> BuildInfo
libBuildInfo Library
lib) }
mapFLibBi :: ForeignLib -> ForeignLib
mapFLibBi ForeignLib
flib = ForeignLib
flib { foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo = BuildInfo -> BuildInfo
f (ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib) }
mapExeBi :: Executable -> Executable
mapExeBi Executable
exe = Executable
exe { buildInfo :: BuildInfo
buildInfo = BuildInfo -> BuildInfo
f (Executable -> BuildInfo
buildInfo Executable
exe) }
mapTestBi :: TestSuite -> TestSuite
mapTestBi TestSuite
tst = TestSuite
tst { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo -> BuildInfo
f (TestSuite -> BuildInfo
testBuildInfo TestSuite
tst) }
mapBenchBi :: Benchmark -> Benchmark
mapBenchBi Benchmark
bm = Benchmark
bm { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo -> BuildInfo
f (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bm) }