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
Distribution.Backpack.Configure
Distribution.Backpack.ComponentsGraph
Distribution.Backpack.ConfiguredComponent
Distribution.Backpack.DescribeUnitId
Distribution.Backpack.FullUnitId
Distribution.Backpack.LinkedComponent
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
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ForeignLib
import Distribution.Types.UnqualComponentName
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Package
import Distribution.Backpack
import Distribution.Backpack.DescribeUnitId
import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.JHC as JHC
......@@ -193,9 +195,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CLib lib) clbi distPref = do
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
extras <- preprocessExtras comp lbi
case libName lib of
Nothing -> info verbosity $ "Building library..."
Just n -> info verbosity $ "Building library " ++ display n ++ "..."
setupMessage' verbosity "Building" (packageId pkg_descr)
(componentLocalName clbi) (maybeComponentInstantiatedWith clbi)
let libbi = libBuildInfo lib
lib' = lib { libBuildInfo = addExtraCSources libbi extras }
buildLib verbosity numJobs pkg_descr lbi lib' clbi
......@@ -225,7 +226,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CFLib flib) clbi _distPref = do
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
return Nothing
......@@ -233,7 +235,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
comp@(CExe exe) clbi _ = do
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
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
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' clbi
......@@ -246,7 +249,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
let exe = testSuiteExeV10AsExe test
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
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
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' clbi
......@@ -267,7 +271,8 @@ buildComponent verbosity numJobs pkg_descr lbi0 suffixes
testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
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
-- NB: need to enable multiple instances here, because on 7.10+
-- the package name is the same as the library, and we still
......@@ -292,7 +297,8 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
let (exe, exeClbi) = benchmarkExeV10asExe bm clbi
preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes
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
exe' = exe { buildInfo = addExtraCSources ebi extras }
buildExe verbosity numJobs pkg_descr lbi exe' exeClbi
......
......@@ -98,6 +98,7 @@ import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Stack
import Distribution.Backpack.Configure
import Distribution.Backpack.DescribeUnitId
import Distribution.Backpack.PreExistingComponent
import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour)
import Distribution.Backpack.Id
......@@ -132,9 +133,8 @@ import System.IO
import Distribution.Text
( Text(disp), defaultStyle, display, simpleParse )
import Text.PrettyPrint
( Doc, (<+>), ($+$), ($$), char, comma, hsep, nest, hang, vcat
( Doc, (<+>), ($+$), char, comma, hsep, nest
, punctuate, quotes, render, renderStyle, sep, text )
import qualified Text.PrettyPrint as Disp
import Distribution.Compat.Environment ( lookupEnv )
import Distribution.Compat.Exception ( catchExit, catchIO )
......@@ -361,14 +361,8 @@ configure (pkg_descr0', pbi) cfg = do
let use_external_internal_deps = isJust mb_cname
case mb_cname of
Nothing -> setupMessage verbosity "Configuring" (packageId pkg_descr0)
Just cname -> noticeDoc verbosity $
text "Configuring component" <+> disp cname <+>
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 ])
Just cname -> setupMessage' verbosity "Configuring" (packageId pkg_descr0)
cname (Just (configInstantiateWith cfg))
-- configCID is only valid for per-component configure
when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $
......
......@@ -31,8 +31,10 @@ import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
-- local
import Distribution.Backpack.DescribeUnitId
import Distribution.Types.ForeignLib
import Distribution.Types.UnqualComponentName
import Distribution.Types.ComponentLocalBuildInfo
import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription as PD hiding (Flag)
......@@ -157,7 +159,6 @@ haddock pkg_descr lbi suffixes flags' = do
haddockTarget =
fromFlagOrDefault ForDevelopment (haddockForHackage flags')
setupMessage verbosity "Running Haddock for" (packageId pkg_descr)
(haddockProg, version, _) <-
requireProgramVersion verbosity haddockProgram
(orLaterVersion (mkVersion [2,0])) (withPrograms lbi)
......@@ -209,10 +210,17 @@ haddock pkg_descr lbi suffixes flags' = do
warn (fromFlag $ haddockVerbosity flags)
"Unsupported component, skipping..."
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
CLib lib -> do
withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $
\tmp -> do
smsg
libArgs <- fromLibrary verbosity tmp lbi clbi htmlTemplate
version lib
let libArgs' = commonArgs `mappend` libArgs
......@@ -220,13 +228,14 @@ haddock pkg_descr lbi suffixes flags' = do
CFLib flib -> when (flag haddockForeignLibs) $ do
withTempDirectoryEx verbosity tmpFileOpts (buildDir lbi) "tmp" $
\tmp -> do
smsg
flibArgs <- fromForeignLib verbosity tmp lbi clbi htmlTemplate
version flib
let libArgs' = commonArgs `mappend` flibArgs
runHaddock verbosity tmpFileOpts comp platform haddockProg libArgs'
CExe _ -> when (flag haddockExecutables) $ doExe component
CTest _ -> when (flag haddockTestSuites) $ doExe component
CBench _ -> when (flag haddockBenchmarks) $ doExe component
CExe _ -> when (flag haddockExecutables) $ smsg >> doExe component
CTest _ -> when (flag haddockTestSuites) $ smsg >> doExe component
CBench _ -> when (flag haddockBenchmarks) $ smsg >> doExe component
for_ (extraDocFiles pkg_descr) $ \ fpath -> do
files <- matchFileGlob fpath
......
......@@ -34,8 +34,10 @@ import Distribution.Compat.Prelude
import Distribution.Compat.Stack
import Distribution.Simple.PreProcess.Unlit
import Distribution.Backpack.DescribeUnitId
import Distribution.Package
import qualified Distribution.ModuleName as ModuleName
import Distribution.ModuleName (ModuleName)
import Distribution.PackageDescription as PD
import qualified Distribution.InstalledPackageInfo as Installed
import qualified Distribution.Simple.PackageIndex as PackageIndex
......@@ -149,36 +151,35 @@ preprocessComponent :: PackageDescription
-> Verbosity
-> [PPSuffixHandler]
-> 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
let dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi]
extra | componentIsPublic clbi = ""
| otherwise = " '" ++ display (componentUnitId clbi) ++ "' for"
setupMessage verbosity ("Preprocessing library" ++ extra) (packageId pd)
for_ (map ModuleName.toFilePath $ allLibModules lib clbi) $
pre dirs (componentBuildDir lbi clbi) (localHandlers bi)
(CFLib flib@ForeignLib { foreignLibBuildInfo = bi, foreignLibName = nm }) -> do
let nm' = unUnqualComponentName nm
flibDir = buildDir lbi </> nm' </> nm' ++ "-tmp"
let flibDir = buildDir lbi </> nm' </> nm' ++ "-tmp"
dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi]
setupMessage verbosity ("Preprocessing foreign library '" ++ nm' ++ "' for") (packageId pd)
for_ (map ModuleName.toFilePath $ foreignLibModules flib) $
pre dirs flibDir (localHandlers bi)
(CExe exe@Executable { buildInfo = bi, exeName = nm }) -> do
let nm' = unUnqualComponentName nm
exeDir = buildDir lbi </> nm' </> nm' ++ "-tmp"
let exeDir = buildDir lbi </> nm' </> nm' ++ "-tmp"
dirs = hsSourceDirs bi ++ [autogenComponentModulesDir lbi clbi
,autogenPackageModulesDir lbi]
setupMessage verbosity ("Preprocessing executable '" ++ nm' ++ "' for") (packageId pd)
for_ (map ModuleName.toFilePath $ otherModules bi) $
pre dirs exeDir (localHandlers bi)
pre (hsSourceDirs bi) exeDir (localHandlers bi) $
dropExtensions (modulePath exe)
CTest test@TestSuite{ testName = nm } -> do
let nm' = unUnqualComponentName nm
setupMessage verbosity ("Preprocessing test suite '" ++ nm' ++ "' for") (packageId pd)
case testInterface test of
TestSuiteExeV10 _ f ->
preProcessTest test f $ buildDir lbi </> nm' </> nm' ++ "-tmp"
......@@ -191,7 +192,6 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers = case comp of
++ "suite type " ++ display tt
CBench bm@Benchmark{ benchmarkName = nm } -> do
let nm' = unUnqualComponentName nm
setupMessage verbosity ("Preprocessing benchmark '" ++ nm' ++ "' for") (packageId pd)
case benchmarkInterface bm of
BenchmarkExeV10 _ f ->
preProcessBench bm f $ buildDir lbi </> nm' </> nm' ++ "-tmp"
......
......@@ -64,6 +64,7 @@ import qualified Distribution.Simple.UHC as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import qualified Distribution.Simple.PackageIndex as Index
import Distribution.Backpack.DescribeUnitId
import Distribution.Simple.Compiler
import Distribution.Simple.Program
import Distribution.Simple.Program.Script
......@@ -77,6 +78,7 @@ import Distribution.Simple.Utils
import Distribution.Utils.MapAccum
import Distribution.System
import Distribution.Text
import Distribution.Types.ComponentName
import Distribution.Verbosity as Verbosity
import Distribution.Version
import Distribution.Compat.Graph (IsNode(nodeKey))
......@@ -160,10 +162,12 @@ registerAll pkg lbi regFlags ipis
_ | modeGenerateRegFile -> writeRegistrationFileOrDirectory
| modeGenerateRegScript -> writeRegisterScript
| otherwise -> do
setupMessage verbosity "Registering" (packageId pkg)
for_ ipis $ \installedPkgInfo ->
for_ ipis $ \ipi -> do
setupMessage' verbosity "Registering" (packageId pkg)
(libraryComponentName (IPI.sourceLibName ipi))
(Just (IPI.instantiatedWith ipi))
registerPackage verbosity (compiler lbi) (withPrograms lbi)
HcPkg.NoMultiInstance packageDbs installedPkgInfo
HcPkg.NoMultiInstance packageDbs ipi
where
modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
......
......@@ -377,7 +377,7 @@ noticeDoc verbosity msg = withFrozenCallStack $ do
setupMessage :: Verbosity -> String -> PackageIdentifier -> IO ()
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.
--
......
......@@ -4,6 +4,7 @@
module Distribution.Types.ComponentLocalBuildInfo (
ComponentLocalBuildInfo(..),
componentIsIndefinite,
maybeComponentInstantiatedWith,
) where
import Prelude ()
......@@ -116,3 +117,8 @@ instance IsNode ComponentLocalBuildInfo where
componentIsIndefinite :: ComponentLocalBuildInfo -> Bool
componentIsIndefinite LibComponentLocalBuildInfo{ componentIsIndefinite_ = b } = b
componentIsIndefinite _ = False
maybeComponentInstantiatedWith :: ComponentLocalBuildInfo -> Maybe [(ModuleName, OpenModule)]
maybeComponentInstantiatedWith
LibComponentLocalBuildInfo { componentInstantiatedWith = insts } = Just insts
maybeComponentInstantiatedWith _ = Nothing
......@@ -4,6 +4,7 @@
module Distribution.Types.ComponentName (
ComponentName(..),
defaultLibName,
libraryComponentName,
showComponentName,
componentNameString,
) where
......@@ -71,3 +72,9 @@ componentNameString (CFLibName n) = Just n
componentNameString (CExeName n) = Just n
componentNameString (CTestName 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