Commit bc9d5ada authored by Edward Z. Yang's avatar Edward Z. Yang Committed by Edward Z. Yang
Browse files

Refactor setupMessage use in Cabal library.



I noticed that I was repeatedly writing the same code
to print out more elaborate information when we do builds,
so I refactored it all into one place.  In the process,
I think that I have made the build output more generally
useful.

The key changes:

    - There is a new function setupMessage' which takes in
      more information than the conventional setupMessage
      does, and prints a more informative message: whereas
      setupMessage will only tell you about the package
      it is being run in, setupMessage' will also tell
      you about the component and instantiation.

    - I applied this function to applicable sites, in some
      cases moving around messages to be closer to the place
      where an actual operation takes place.  For example,
      the 'Building' message previously only was triggered
      at the beginning of the build process; now it is
      emitted immediately before we call out to GHC.  This
      is a lot more informative, and avoids people thinking
      that we are slow because of preprocessing (we're not.)
      Something similar happened for Haddock as well.

Before:

Preprocessing library 'spider' for reflex-backpack-0.5.0..
[1 of 1] Compiling Reflex.Spider.Backpack ( src/Reflex/Spider/Backpack.hs, /srv/code/reflex-backpack/dist-newstyle/build/x86_64-linux/ghc-8.1.20170123/reflex-backpack-0.5.0/c/spider/build/spider/Reflex/Spider/Backpack.o )

After:

Preprocessing library 'host' for reflex-backpack-0.5.0..
Building library 'host' instantiated with
  Reflex.Host.Sig = reflex-backpack-0.5.0-inplace-spider:Reflex.Spider.Backpack
  Reflex.Sig = reflex-backpack-0.5.0-inplace-spider:Reflex.Spider.Backpack
for reflex-backpack-0.5.0..
[1 of 8] Compiling Reflex.Host.Sig[sig] ( host/Reflex/Host/Sig.hsig, /srv/code/reflex-backpack/dist-newstyle/build/x86_64-linux/ghc-8.1.20170123/reflex-backpack-0.5.0/c/host/reflex-backpack-0.5.0-inplace-host+FDoWUmUc0MMBtBRwItgjj9/build/reflex-backpack-0.5.0-inplace-host+FDoWUmUc0MMBtBRwItgjj9/Reflex/Host/Sig.o ) [Reflex.Basics changed]
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 988daa65
...@@ -120,6 +120,7 @@ library ...@@ -120,6 +120,7 @@ library
Distribution.Backpack.Configure Distribution.Backpack.Configure
Distribution.Backpack.ComponentsGraph Distribution.Backpack.ComponentsGraph
Distribution.Backpack.ConfiguredComponent Distribution.Backpack.ConfiguredComponent
Distribution.Backpack.DescribeUnitId
Distribution.Backpack.FullUnitId Distribution.Backpack.FullUnitId
Distribution.Backpack.LinkedComponent Distribution.Backpack.LinkedComponent
Distribution.Backpack.ModSubst Distribution.Backpack.ModSubst
......
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
module Distribution.Backpack.DescribeUnitId where
import Prelude ()
import Distribution.Compat.Prelude
import Distribution.Types.ComponentName
import Distribution.Compat.Stack
import Distribution.Verbosity
import Distribution.ModuleName
import Distribution.Package
import Distribution.Text
import Distribution.Simple.Utils
import Text.PrettyPrint
-- Unit identifiers have a well defined, machine-readable format,
-- but this format isn't very user-friendly for users. This
-- module defines some functions for solving common rendering
-- problems one has for displaying these.
--
-- There are three basic problems we tackle:
--
-- - Users don't want to see pkg-0.5-inplace-libname,
-- they want to see "library 'libname' from 'pkg-0.5'"
--
-- - Users don't want to see the raw component identifier, which
-- usually contains a wordy hash that doesn't matter.
--
-- - Users don't want to see a hash of the instantiation: they
-- want to see the actual instantiation, and they want it in
-- interpretable form.
--
-- | Print a Setup message stating (1) what operation we are doing,
-- for (2) which component (with enough details to uniquely identify
-- the build in question.)
--
setupMessage' :: Text a => Verbosity
-> String -- ^ Operation being done (capitalized), on:
-> PackageIdentifier -- ^ Package
-> ComponentName -- ^ Component name
-> Maybe [(ModuleName, a)] -- ^ Instantiation, if available.
-- Polymorphic to take
-- 'OpenModule' or 'Module'
-> IO ()
setupMessage' verbosity msg pkgid cname mb_insts = withFrozenCallStack $ do
noticeDoc verbosity $
case mb_insts of
Just insts | not (null insts) ->
hang (msg_doc <+> text "instantiated with") 2
(vcat [ disp k <+> text "=" <+> disp v
| (k,v) <- insts ]) $$
for_doc
_ ->
msg_doc <+> for_doc
where
msg_doc = text msg <+> text (showComponentName cname)
for_doc = text "for" <+> disp pkgid <<>> text ".."
...@@ -36,9 +36,11 @@ import Distribution.Types.TargetInfo ...@@ -36,9 +36,11 @@ import Distribution.Types.TargetInfo
import Distribution.Types.ComponentRequestedSpec import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ForeignLib import Distribution.Types.ForeignLib
import Distribution.Types.UnqualComponentName import Distribution.Types.UnqualComponentName
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Package import Distribution.Package
import Distribution.Backpack import Distribution.Backpack
import Distribution.Backpack.DescribeUnitId
import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.JHC as JHC import qualified Distribution.Simple.JHC as JHC
...@@ -193,9 +195,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes ...@@ -193,9 +195,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CLib lib) clbi distPref = do comp@(CLib lib) clbi distPref = do
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi extras <- preprocessExtras comp lbi
case libName lib of setupMessage' verbosity "Building" (packageId pkg_descr)
Nothing -> info verbosity $ "Building library..." (componentLocalName clbi) (maybeComponentInstantiatedWith clbi)
Just n -> info verbosity $ "Building library " ++ display n ++ "..."
let libbi = libBuildInfo lib let libbi = libBuildInfo lib
lib' = lib { libBuildInfo = addExtraCSources libbi extras } lib' = lib { libBuildInfo = addExtraCSources libbi extras }
buildLib verbosity numJobs pkg_descr lbi lib' clbi buildLib verbosity numJobs pkg_descr lbi lib' clbi
...@@ -225,7 +226,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes ...@@ -225,7 +226,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
buildComponent verbosity numJobs pkg_descr lbi suffixes buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CFLib flib) clbi _distPref = do comp@(CFLib flib) clbi _distPref = do
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
info verbosity $ "Building foreign library " ++ display (foreignLibName flib) ++ "..." setupMessage' verbosity "Building" (packageId pkg_descr)
(componentLocalName clbi) (maybeComponentInstantiatedWith clbi)
buildFLib verbosity numJobs pkg_descr lbi flib clbi buildFLib verbosity numJobs pkg_descr lbi flib clbi
return Nothing return Nothing
...@@ -233,7 +235,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes ...@@ -233,7 +235,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CExe exe) clbi _ = do comp@(CExe exe) clbi _ = do
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi extras <- preprocessExtras comp lbi
info verbosity $ "Building executable " ++ display (exeName exe) ++ "..." setupMessage' verbosity "Building" (packageId pkg_descr)
(componentLocalName clbi) (maybeComponentInstantiatedWith clbi)
let ebi = buildInfo exe let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras } exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' clbi buildExe verbosity numJobs pkg_descr lbi exe' clbi
...@@ -246,7 +249,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes ...@@ -246,7 +249,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
let exe = testSuiteExeV10AsExe test let exe = testSuiteExeV10AsExe test
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi extras <- preprocessExtras comp lbi
info verbosity $ "Building test suite " ++ display (testName test) ++ "..." setupMessage' verbosity "Building" (packageId pkg_descr)
(componentLocalName clbi) (maybeComponentInstantiatedWith clbi)
let ebi = buildInfo exe let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras } exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' clbi buildExe verbosity numJobs pkg_descr lbi exe' clbi
...@@ -267,7 +271,8 @@ buildComponent verbosity numJobs pkg_descr lbi0 suffixes ...@@ -267,7 +271,8 @@ buildComponent verbosity numJobs pkg_descr lbi0 suffixes
testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi extras <- preprocessExtras comp lbi
info verbosity $ "Building test suite " ++ display (testName test) ++ "..." setupMessage' verbosity "Building" (packageId pkg_descr)
(componentLocalName clbi) (maybeComponentInstantiatedWith clbi)
buildLib verbosity numJobs pkg lbi lib libClbi buildLib verbosity numJobs pkg lbi lib libClbi
-- NB: need to enable multiple instances here, because on 7.10+ -- NB: need to enable multiple instances here, because on 7.10+
-- the package name is the same as the library, and we still -- the package name is the same as the library, and we still
...@@ -292,7 +297,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes ...@@ -292,7 +297,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
let (exe, exeClbi) = benchmarkExeV10asExe bm clbi let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi extras <- preprocessExtras comp lbi
info verbosity $ "Building benchmark " ++ display (benchmarkName bm) ++ "..." setupMessage' verbosity "Building" (packageId pkg_descr)
(componentLocalName clbi) (maybeComponentInstantiatedWith clbi)
let ebi = buildInfo exe let ebi = buildInfo exe
exe' = exe { buildInfo = addExtraCSources ebi extras } exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' exeClbi buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
......
...@@ -98,6 +98,7 @@ import Distribution.Verbosity ...@@ -98,6 +98,7 @@ import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Stack import Distribution.Compat.Stack
import Distribution.Backpack.Configure import Distribution.Backpack.Configure
import Distribution.Backpack.DescribeUnitId
import Distribution.Backpack.PreExistingComponent import Distribution.Backpack.PreExistingComponent
import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour) import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour)
import Distribution.Backpack.Id import Distribution.Backpack.Id
...@@ -132,9 +133,8 @@ import System.IO ...@@ -132,9 +133,8 @@ import System.IO
import Distribution.Text import Distribution.Text
( Text(disp), defaultStyle, display, simpleParse ) ( Text(disp), defaultStyle, display, simpleParse )
import Text.PrettyPrint import Text.PrettyPrint
( Doc, (<+>), ($+$), ($$), char, comma, hsep, nest, hang, vcat ( Doc, (<+>), ($+$), char, comma, hsep, nest
, punctuate, quotes, render, renderStyle, sep, text ) , punctuate, quotes, render, renderStyle, sep, text )
import qualified Text.PrettyPrint as Disp
import Distribution.Compat.Environment ( lookupEnv ) import Distribution.Compat.Environment ( lookupEnv )
import Distribution.Compat.Exception ( catchExit, catchIO ) import Distribution.Compat.Exception ( catchExit, catchIO )
...@@ -361,14 +361,8 @@ configure (pkg_descr0', pbi) cfg = do ...@@ -361,14 +361,8 @@ configure (pkg_descr0', pbi) cfg = do
let use_external_internal_deps = isJust mb_cname let use_external_internal_deps = isJust mb_cname
case mb_cname of case mb_cname of
Nothing -> setupMessage verbosity "Configuring" (packageId pkg_descr0) Nothing -> setupMessage verbosity "Configuring" (packageId pkg_descr0)
Just cname -> noticeDoc verbosity $ Just cname -> setupMessage' verbosity "Configuring" (packageId pkg_descr0)
text "Configuring component" <+> disp cname <+> cname (Just (configInstantiateWith cfg))
text "from" <+> disp (packageId pkg_descr0) $$
if null (configInstantiateWith cfg)
then Disp.empty
else hang (text "Instantiated with:") 2
(vcat [ disp k <<>> "=" <<>> disp v
| (k,v) <- configInstantiateWith cfg ])
-- configCID is only valid for per-component configure -- configCID is only valid for per-component configure
when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $ when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $
......
...@@ -31,8 +31,10 @@ import qualified Distribution.Simple.GHC as GHC ...@@ -31,8 +31,10 @@ import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS import qualified Distribution.Simple.GHCJS as GHCJS
-- local -- local
import Distribution.Backpack.DescribeUnitId
import Distribution.Types.ForeignLib import Distribution.Types.ForeignLib
import Distribution.Types.UnqualComponentName import Distribution.Types.UnqualComponentName
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Package import Distribution.Package
import qualified Distribution.ModuleName as ModuleName import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD hiding (Flag) import Distribution.PackageDescription as PD hiding (Flag)
...@@ -157,7 +159,6 @@ haddock pkg_descr lbi suffixes flags' = do ...@@ -157,7 +159,6 @@ haddock pkg_descr lbi suffixes flags' = do
haddockTarget = haddockTarget =
fromFlagOrDefault ForDevelopment (haddockForHackage flags') fromFlagOrDefault ForDevelopment (haddockForHackage flags')
setupMessage verbosity "Running Haddock for" (packageId pkg_descr)
(haddockProg, version, _) <- (haddockProg, version, _) <-
requireProgramVersion verbosity haddockProgram requireProgramVersion verbosity haddockProgram
(orLaterVersion (mkVersion [2,0])) (withPrograms lbi) (orLaterVersion (mkVersion [2,0])) (withPrograms lbi)
...@@ -209,10 +210,17 @@ haddock pkg_descr lbi suffixes flags' = do ...@@ -209,10 +210,17 @@ haddock pkg_descr lbi suffixes flags' = do
warn (fromFlag $ haddockVerbosity flags) warn (fromFlag $ haddockVerbosity flags)
"Unsupported component, skipping..." "Unsupported component, skipping..."
return () return ()
-- We define 'smsg' once and then reuse it inside the case, so that
-- we don't say we are running Haddock when we actually aren't
-- (e.g., Haddock is not run on non-libraries)
smsg :: IO ()
smsg = setupMessage' verbosity "Running Haddock on" (packageId pkg_descr)
(componentLocalName clbi) (maybeComponentInstantiatedWith clbi)
case component of case component of
CLib lib -> do CLib lib -> do
withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $
\tmp -> do \tmp -> do
smsg
libArgs <- fromLibrary verbosity tmp lbi clbi htmlTemplate libArgs <- fromLibrary verbosity tmp lbi clbi htmlTemplate
version lib version lib
let libArgs' = commonArgs `mappend` libArgs let libArgs' = commonArgs `mappend` libArgs
...@@ -220,13 +228,14 @@ haddock pkg_descr lbi suffixes flags' = do ...@@ -220,13 +228,14 @@ haddock pkg_descr lbi suffixes flags' = do
CFLib flib -> when (flag haddockForeignLibs) $ do CFLib flib -> when (flag haddockForeignLibs) $ do
withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $ withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $
\tmp -> do \tmp -> do
smsg
flibArgs <- fromForeignLib verbosity tmp lbi clbi htmlTemplate flibArgs <- fromForeignLib verbosity tmp lbi clbi htmlTemplate
version flib version flib
let libArgs' = commonArgs `mappend` flibArgs let libArgs' = commonArgs `mappend` flibArgs
runHaddock verbosity tmpFileOpts comp platform haddockProg libArgs' runHaddock verbosity tmpFileOpts comp platform haddockProg libArgs'
CExe _ -> when (flag haddockExecutables) $ doExe component CExe _ -> when (flag haddockExecutables) $ smsg >> doExe component
CTest _ -> when (flag haddockTestSuites) $ doExe component CTest _ -> when (flag haddockTestSuites) $ smsg >> doExe component
CBench _ -> when (flag haddockBenchmarks) $ doExe component CBench _ -> when (flag haddockBenchmarks) $ smsg >> doExe component
for_ (extraDocFiles pkg_descr) $ \ fpath -> do for_ (extraDocFiles pkg_descr) $ \ fpath -> do
files <- matchFileGlob fpath files <- matchFileGlob fpath
......
...@@ -34,8 +34,10 @@ import Distribution.Compat.Prelude ...@@ -34,8 +34,10 @@ import Distribution.Compat.Prelude
import Distribution.Compat.Stack import Distribution.Compat.Stack
import Distribution.Simple.PreProcess.Unlit import Distribution.Simple.PreProcess.Unlit
import Distribution.Backpack.DescribeUnitId
import Distribution.Package import Distribution.Package
import qualified Distribution.ModuleName as ModuleName import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.PackageDescription as PD import Distribution.PackageDescription as PD
import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.Simple.PackageIndex as PackageIndex import qualified Distribution.Simple.PackageIndex as PackageIndex
...@@ -149,36 +151,35 @@ preprocessComponent :: PackageDescription ...@@ -149,36 +151,35 @@ preprocessComponent :: PackageDescription
-> Verbosity -> Verbosity
-> [PPSuffixHandler] -> [PPSuffixHandler]
-> IO () -> IO ()
preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers = case comp of preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers = do
-- NB: never report instantiation here; we'll report it properly when
-- building.
setupMessage' verbosity "Preprocessing" (packageId pd)
(componentLocalName clbi) (Nothing :: Maybe [(ModuleName, Module)])
case comp of
(CLib lib@Library{ libBuildInfo = bi }) -> do (CLib lib@Library{ libBuildInfo = bi }) -> do
let dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi let dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi] ,autogenPackageModulesDir lbi]
extra | componentIsPublic clbi = ""
| otherwise = " '" ++ display (componentUnitId clbi) ++ "' for"
setupMessage verbosity ("Preprocessing library" ++ extra) (packageId pd)
for_ (map ModuleName.toFilePath $ allLibModules lib clbi) $ for_ (map ModuleName.toFilePath $ allLibModules lib clbi) $
pre dirs (componentBuildDir lbi clbi) (localHandlers bi) pre dirs (componentBuildDir lbi clbi) (localHandlers bi)
(CFLib flib@ForeignLib { foreignLibBuildInfo = bi, foreignLibName = nm }) -> do (CFLib flib@ForeignLib { foreignLibBuildInfo = bi, foreignLibName = nm }) -> do
let nm' = unUnqualComponentName nm let nm' = unUnqualComponentName nm
flibDir = buildDir lbi </> nm' </> nm' ++ "-tmp" let flibDir = buildDir lbi </> nm' </> nm' ++ "-tmp"
dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi] ,autogenPackageModulesDir lbi]
setupMessage verbosity ("Preprocessing foreign library '" ++ nm' ++ "' for") (packageId pd)
for_ (map ModuleName.toFilePath $ foreignLibModules flib) $ for_ (map ModuleName.toFilePath $ foreignLibModules flib) $
pre dirs flibDir (localHandlers bi) pre dirs flibDir (localHandlers bi)
(CExe exe@Executable { buildInfo = bi, exeName = nm }) -> do (CExe exe@Executable { buildInfo = bi, exeName = nm }) -> do
let nm' = unUnqualComponentName nm let nm' = unUnqualComponentName nm
exeDir = buildDir lbi </> nm' </> nm' ++ "-tmp" let exeDir = buildDir lbi </> nm' </> nm' ++ "-tmp"
dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi] ,autogenPackageModulesDir lbi]
setupMessage verbosity ("Preprocessing executable '" ++ nm' ++ "' for") (packageId pd)
for_ (map ModuleName.toFilePath $ otherModules bi) $ for_ (map ModuleName.toFilePath $ otherModules bi) $
pre dirs exeDir (localHandlers bi) pre dirs exeDir (localHandlers bi)
pre (hsSourceDirs bi) exeDir (localHandlers bi) $ pre (hsSourceDirs bi) exeDir (localHandlers bi) $
dropExtensions (modulePath exe) dropExtensions (modulePath exe)
CTest test@TestSuite{ testName = nm } -> do CTest test@TestSuite{ testName = nm } -> do
let nm' = unUnqualComponentName nm let nm' = unUnqualComponentName nm
setupMessage verbosity ("Preprocessing test suite '" ++ nm' ++ "' for") (packageId pd)
case testInterface test of case testInterface test of
TestSuiteExeV10 _ f -> TestSuiteExeV10 _ f ->
preProcessTest test f $ buildDir lbi </> nm' </> nm' ++ "-tmp" preProcessTest test f $ buildDir lbi </> nm' </> nm' ++ "-tmp"
...@@ -191,7 +192,6 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers = case comp of ...@@ -191,7 +192,6 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers = case comp of
++ "suite type " ++ display tt ++ "suite type " ++ display tt
CBench bm@Benchmark{ benchmarkName = nm } -> do CBench bm@Benchmark{ benchmarkName = nm } -> do
let nm' = unUnqualComponentName nm let nm' = unUnqualComponentName nm
setupMessage verbosity ("Preprocessing benchmark '" ++ nm' ++ "' for") (packageId pd)
case benchmarkInterface bm of case benchmarkInterface bm of
BenchmarkExeV10 _ f -> BenchmarkExeV10 _ f ->
preProcessBench bm f $ buildDir lbi </> nm' </> nm' ++ "-tmp" preProcessBench bm f $ buildDir lbi </> nm' </> nm' ++ "-tmp"
......
...@@ -64,6 +64,7 @@ import qualified Distribution.Simple.UHC as UHC ...@@ -64,6 +64,7 @@ import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import qualified Distribution.Simple.PackageIndex as Index import qualified Distribution.Simple.PackageIndex as Index
import Distribution.Backpack.DescribeUnitId
import Distribution.Simple.Compiler import Distribution.Simple.Compiler
import Distribution.Simple.Program import Distribution.Simple.Program
import Distribution.Simple.Program.Script import Distribution.Simple.Program.Script
...@@ -77,6 +78,7 @@ import Distribution.Simple.Utils ...@@ -77,6 +78,7 @@ import Distribution.Simple.Utils
import Distribution.Utils.MapAccum import Distribution.Utils.MapAccum
import Distribution.System import Distribution.System
import Distribution.Text import Distribution.Text
import Distribution.Types.ComponentName
import Distribution.Verbosity as Verbosity import Distribution.Verbosity as Verbosity
import Distribution.Version import Distribution.Version
import Distribution.Compat.Graph (IsNode(nodeKey)) import Distribution.Compat.Graph (IsNode(nodeKey))
...@@ -160,10 +162,12 @@ registerAll pkg lbi regFlags ipis ...@@ -160,10 +162,12 @@ registerAll pkg lbi regFlags ipis
_ | modeGenerateRegFile -> writeRegistrationFileOrDirectory _ | modeGenerateRegFile -> writeRegistrationFileOrDirectory
| modeGenerateRegScript -> writeRegisterScript | modeGenerateRegScript -> writeRegisterScript
| otherwise -> do | otherwise -> do
setupMessage verbosity "Registering" (packageId pkg) for_ ipis $ \ipi -> do
for_ ipis $ \installedPkgInfo -> setupMessage' verbosity "Registering" (packageId pkg)
(libraryComponentName (IPI.sourceLibName ipi))
(Just (IPI.instantiatedWith ipi))
registerPackage verbosity (compiler lbi) (withPrograms lbi) registerPackage verbosity (compiler lbi) (withPrograms lbi)
HcPkg.NoMultiInstance packageDbs installedPkgInfo HcPkg.NoMultiInstance packageDbs ipi
where where
modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
......
...@@ -377,7 +377,7 @@ noticeDoc verbosity msg = withFrozenCallStack $ do ...@@ -377,7 +377,7 @@ noticeDoc verbosity msg = withFrozenCallStack $ do
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO () setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()
setupMessage verbosity msg pkgid = withFrozenCallStack $ do setupMessage verbosity msg pkgid = withFrozenCallStack $ do
notice verbosity (msg ++ ' ': display pkgid ++ "...") noticeNoWrap verbosity (msg ++ ' ': display pkgid ++ "...\n")
-- | More detail on the operation of some action. -- | More detail on the operation of some action.
-- --
......
...@@ -4,6 +4,7 @@ ...@@ -4,6 +4,7 @@
module Distribution.Types.ComponentLocalBuildInfo ( module Distribution.Types.ComponentLocalBuildInfo (
ComponentLocalBuildInfo(..), ComponentLocalBuildInfo(..),
componentIsIndefinite, componentIsIndefinite,
maybeComponentInstantiatedWith,
) where ) where
import Prelude () import Prelude ()
...@@ -116,3 +117,8 @@ instance IsNode ComponentLocalBuildInfo where ...@@ -116,3 +117,8 @@ instance IsNode ComponentLocalBuildInfo where
componentIsIndefinite :: ComponentLocalBuildInfo -> Bool componentIsIndefinite :: ComponentLocalBuildInfo -> Bool
componentIsIndefinite LibComponentLocalBuildInfo{ componentIsIndefinite_ = b } = b componentIsIndefinite LibComponentLocalBuildInfo{ componentIsIndefinite_ = b } = b
componentIsIndefinite _ = False componentIsIndefinite _ = False
maybeComponentInstantiatedWith :: ComponentLocalBuildInfo -> Maybe [(ModuleName, OpenModule)]
maybeComponentInstantiatedWith
LibComponentLocalBuildInfo { componentInstantiatedWith = insts } = Just insts
maybeComponentInstantiatedWith _ = Nothing
...@@ -4,6 +4,7 @@ ...@@ -4,6 +4,7 @@
module Distribution.Types.ComponentName ( module Distribution.Types.ComponentName (
ComponentName(..), ComponentName(..),
defaultLibName, defaultLibName,
libraryComponentName,
showComponentName, showComponentName,
componentNameString, componentNameString,
) where ) where
...@@ -71,3 +72,9 @@ componentNameString (CFLibName n) = Just n ...@@ -71,3 +72,9 @@ componentNameString (CFLibName n) = Just n
componentNameString (CExeName n) = Just n componentNameString (CExeName n) = Just n
componentNameString (CTestName n) = Just n componentNameString (CTestName n) = Just n
componentNameString (CBenchName n) = Just n componentNameString (CBenchName n) = Just n
-- | Convert the 'UnqualComponentName' of a library into a
-- 'ComponentName'.
libraryComponentName :: Maybe UnqualComponentName -> ComponentName
libraryComponentName Nothing = CLibName
libraryComponentName (Just n) = CSubLibName n
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment