Remove show-build-info command and generate build-info as a side-effect of 'build'

Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs

@@ -25,7 +25,7 @@ import Distribution.ModuleName
 import Distribution.Simple.Compiler                (DebugInfoLevel (..), OptimisationLevel (..), PackageDB (..), ProfDetailLevel (..), knownProfDetailLevels)
 import Distribution.Simple.Flag                    (Flag (..))
 import Distribution.Simple.InstallDirs
-import Distribution.Simple.Setup                   (HaddockTarget (..), TestShowDetails (..))
+import Distribution.Simple.Setup                   (HaddockTarget (..), TestShowDetails (..), DumpBuildInfo)
 import Distribution.SPDX
 import Distribution.System
 import Distribution.Types.Dependency
@@ -486,6 +486,12 @@ instance Arbitrary PackageDB where
                       , SpecificPackageDB <$> arbitraryShortToken
                       ]
 
+-------------------------------------------------------------------------------
+-- DumpBuildInfo
+-------------------------------------------------------------------------------
+
+instance Arbitrary DumpBuildInfo where
+    arbitrary = arbitraryBoundedEnum
 
 -------------------------------------------------------------------------------
 -- Helpers

Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs

@@ -29,7 +29,7 @@ tests = testGroup "Distribution.Utils.Structured"
     , testCase "GenericPackageDescription" $
       md5Check (Proxy :: Proxy GenericPackageDescription) 0xa164cbe5092a1cd31da1f15358d1537a
     , testCase "LocalBuildInfo" $
-      md5Check (Proxy :: Proxy LocalBuildInfo) 0xac70971ea59d30aab7e4b6dafc9113d4
+      md5Check (Proxy :: Proxy LocalBuildInfo) 0x9ce83e4aec3b2fa6d7f999dbc32c2a33
 #endif
     ]
 

Cabal-tree-diff/src/Data/TreeDiff/Instances/Cabal.hs

@@ -29,6 +29,7 @@ import Distribution.Simple.Setup                   (HaddockTarget, TestShowDetai
 import Distribution.System
 import Distribution.Types.AbiHash                  (AbiHash)
 import Distribution.Types.ComponentId              (ComponentId)
+import Distribution.Types.DumpBuildInfo            (DumpBuildInfo)
 import Distribution.Types.PackageVersionConstraint
 import Distribution.Types.UnitId                   (DefUnitId, UnitId)
 import Distribution.Utils.NubList                  (NubList)
@@ -74,6 +75,7 @@ instance ToExpr CompilerId
 instance ToExpr ComponentId
 instance ToExpr DebugInfoLevel
 instance ToExpr DefUnitId
+instance ToExpr DumpBuildInfo
 instance ToExpr ExeDependency
 instance ToExpr Executable
 instance ToExpr ExecutableScope

Cabal/Cabal.cabal

@@ -201,6 +201,7 @@ library
     Distribution.Types.ComponentInclude
     Distribution.Types.ConfVar
     Distribution.Types.Dependency
+    Distribution.Types.DumpBuildInfo
     Distribution.Types.ExeDependency
     Distribution.Types.LegacyExeDependency
     Distribution.Types.PkgconfigDependency

Cabal/src/Distribution/Simple.hs

@@ -104,7 +104,6 @@ import Distribution.Compat.Directory        (makeAbsolute)
 import Distribution.Compat.Environment      (getEnvironment)
 import Distribution.Compat.GetShortPathName (getShortPathName)
 
-import qualified Data.ByteString.Lazy as B
 import Data.List       (unionBy, (\\))
 
 import Distribution.PackageDescription.Parsec
@@ -179,7 +178,6 @@ defaultMainHelper hooks args = topHandler $ do
       [configureCommand progs `commandAddAction`
         \fs as -> configureAction hooks fs as >> return ()
       ,buildCommand     progs `commandAddAction` buildAction        hooks
-      ,showBuildInfoCommand progs `commandAddAction` showBuildInfoAction    hooks
       ,replCommand      progs `commandAddAction` replAction         hooks
       ,installCommand         `commandAddAction` installAction      hooks
       ,copyCommand            `commandAddAction` copyAction         hooks
@@ -264,33 +262,6 @@ buildAction hooks flags args = do
                (return lbi { withPrograms = progs })
                hooks flags' { buildArgs = args } args
 
-showBuildInfoAction :: UserHooks -> ShowBuildInfoFlags -> Args -> IO ()
-showBuildInfoAction hooks (ShowBuildInfoFlags flags fileOutput) args = do
-  distPref <- findDistPrefOrDefault (buildDistPref flags)
-  let verbosity = fromFlag $ buildVerbosity flags
-  lbi <- getBuildConfig hooks verbosity distPref
-  let flags' = flags { buildDistPref = toFlag distPref
-                     , buildCabalFilePath = maybeToFlag (cabalFilePath lbi)
-                     }
-
-  progs <- reconfigurePrograms verbosity
-             (buildProgramPaths flags')
-             (buildProgramArgs flags')
-             (withPrograms lbi)
-
-  pbi <- preBuild hooks args flags'
-  let lbi' = lbi { withPrograms = progs }
-      pkg_descr0 = localPkgDescr lbi'
-      pkg_descr = updatePackageDescription pbi pkg_descr0
-      -- TODO: Somehow don't ignore build hook?
-  buildInfoString <- showBuildInfo pkg_descr lbi' flags
-
-  case fileOutput of
-    Nothing -> B.putStr buildInfoString
-    Just fp -> B.writeFile fp buildInfoString
-
-  postBuild hooks args flags' pkg_descr lbi'
-
 replAction :: UserHooks -> ReplFlags -> Args -> IO ()
 replAction hooks flags args = do
   distPref <- findDistPrefOrDefault (replDistPref flags)

Cabal/src/Distribution/Simple/Build.hs

@@ -19,7 +19,7 @@
 --
 
 module Distribution.Simple.Build (
-    build, showBuildInfo, repl,
+    build, repl,
     startInterpreter,
 
     initialBuildSteps,
@@ -69,6 +69,7 @@ import Distribution.Simple.BuildTarget
 import Distribution.Simple.BuildToolDepends
 import Distribution.Simple.PreProcess
 import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Program.Builtin (ghcProgram, ghcjsProgram, uhcProgram, jhcProgram, haskellSuiteProgram)
 import Distribution.Simple.Program.Types
 import Distribution.Simple.Program.Db
 import Distribution.Simple.ShowBuildInfo
@@ -87,10 +88,10 @@ import Distribution.Version (thisVersion)
 import Distribution.Compat.Graph (IsNode(..))
 
 import Control.Monad
-import Data.ByteString.Lazy (ByteString)
 import qualified Data.Set as Set
+import qualified Data.ByteString.Lazy as LBS
 import System.FilePath ( (</>), (<.>), takeDirectory )
-import System.Directory ( getCurrentDirectory )
+import System.Directory ( getCurrentDirectory, removeFile, doesFileExist )
 
 -- -----------------------------------------------------------------------------
 -- |Build the libraries and executables in this package.
@@ -114,6 +115,12 @@ build pkg_descr lbi flags suffixes = do
 
   internalPackageDB <- createInternalPackageDB verbosity lbi distPref
 
+  -- Before the actual building, dump out build-information.
+  -- This way, if the actual compilation failed, the options have still been
+  -- dumped.
+  dumpBuildInfo verbosity distPref (configDumpBuildInfo (configFlags lbi)) pkg_descr lbi flags
+
+  -- Now do the actual building
   (\f -> foldM_ f (installedPkgs lbi) componentsToBuild) $ \index target -> do
     let comp = targetComponent target
         clbi = targetCLBI target
@@ -128,22 +135,65 @@ build pkg_descr lbi flags suffixes = do
     mb_ipi <- buildComponent verbosity (buildNumJobs flags) pkg_descr
                    lbi' suffixes comp clbi distPref
     return (maybe index (Index.insert `flip` index) mb_ipi)
+
   return ()
  where
   distPref  = fromFlag (buildDistPref flags)
   verbosity = fromFlag (buildVerbosity flags)
 
 
-showBuildInfo :: PackageDescription  -- ^ Mostly information from the .cabal file
-  -> LocalBuildInfo      -- ^ Configuration information
-  -> BuildFlags          -- ^ Flags that the user passed to build
-  -> IO ByteString
-showBuildInfo pkg_descr lbi flags = do
-  let verbosity = fromFlag (buildVerbosity flags)
-  targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)
-  let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
-      doc = mkBuildInfo pkg_descr lbi flags targetsToBuild
-  return $ renderJson doc
+-- | Write available build information for 'LocalBuildInfo' to disk.
+--
+-- Dumps detailed build information 'build-info.json' to the given directory.
+-- Build information contains basics such as compiler details, but also
+-- lists what modules a component contains and how to compile the component, assuming
+-- lib:Cabal made sure that dependencies are up-to-date.
+dumpBuildInfo :: Verbosity
+              -> FilePath           -- ^ To which directory should the build-info be dumped?
+              -> Flag DumpBuildInfo -- ^ Should we dump detailed build information for this component?
+              -> PackageDescription -- ^ Mostly information from the .cabal file
+              -> LocalBuildInfo     -- ^ Configuration information
+              -> BuildFlags         -- ^ Flags that the user passed to build
+              -> IO ()
+dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do
+  when shouldDumpBuildInfo $ do
+    -- Changing this line might break consumers of the dumped build info.
+    -- Announce changes on mailing lists!
+    let activeTargets = allTargetsInBuildOrder' pkg_descr lbi
+    info verbosity $ "Dump build information for: "
+                  ++ intercalate ", "
+                      (map (showComponentName . componentLocalName . targetCLBI)
+                          activeTargets)
+    pwd <- getCurrentDirectory
+
+    (compilerProg, _) <- case flavorToProgram (compilerFlavor (compiler lbi)) of
+      Nothing -> die' verbosity $ "dumpBuildInfo: Unknown compiler flavor: "
+                               ++ show (compilerFlavor (compiler lbi))
+      Just program -> requireProgram verbosity program (withPrograms lbi)
+
+    let (warns, json) = mkBuildInfo pwd pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets
+        buildInfoText = renderJson json
+    unless (null warns) $
+      warn verbosity $ "Encountered warnings while dumping build-info:\n"
+                    ++ unlines warns
+    LBS.writeFile (buildInfoPref distPref) buildInfoText
+
+  when (not shouldDumpBuildInfo) $ do
+    -- Remove existing build-info.json as it might be outdated now.
+    exists <- doesFileExist (buildInfoPref distPref)
+    when exists $ removeFile (buildInfoPref distPref)
+  where
+    shouldDumpBuildInfo = fromFlagOrDefault NoDumpBuildInfo dumpBuildInfoFlag == DumpBuildInfo
+
+    -- | Given the flavor of the compiler, try to find out
+    -- which program we need.
+    flavorToProgram :: CompilerFlavor -> Maybe Program
+    flavorToProgram GHC             = Just ghcProgram
+    flavorToProgram GHCJS           = Just ghcjsProgram
+    flavorToProgram UHC             = Just uhcProgram
+    flavorToProgram JHC             = Just jhcProgram
+    flavorToProgram HaskellSuite {} = Just haskellSuiteProgram
+    flavorToProgram _     = Nothing
 
 
 repl     :: PackageDescription  -- ^ Mostly information from the .cabal file

Cabal/src/Distribution/Simple/BuildPaths.hs

@@ -15,7 +15,7 @@
 
 module Distribution.Simple.BuildPaths (
     defaultDistPref, srcPref,
-    haddockDirName, hscolourPref, haddockPref,
+    buildInfoPref, haddockDirName, hscolourPref, haddockPref,
     autogenPackageModulesDir,
     autogenComponentModulesDir,
 
@@ -67,6 +67,10 @@ srcPref distPref = distPref </> "src"
 hscolourPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath
 hscolourPref = haddockPref
 
+-- | Build info json file, generated in every build
+buildInfoPref :: FilePath -> FilePath
+buildInfoPref distPref = distPref </> "build-info.json"
+
 -- | This is the name of the directory in which the generated haddocks
 -- should be stored. It does not include the @<dist>/doc/html@ prefix.
 haddockDirName :: HaddockTarget -> PackageDescription -> FilePath

Cabal/src/Distribution/Simple/Setup.hs

@@ -45,7 +45,7 @@ module Distribution.Simple.Setup (
   HaddockFlags(..),  emptyHaddockFlags,  defaultHaddockFlags,  haddockCommand,
   HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand,
   BuildFlags(..),    emptyBuildFlags,    defaultBuildFlags,    buildCommand,
-  ShowBuildInfoFlags(..),                defaultShowBuildFlags, showBuildInfoCommand,
+  DumpBuildInfo(..),
   ReplFlags(..),                         defaultReplFlags,     replCommand,
   ReplOptions(..),
   CleanFlags(..),    emptyCleanFlags,    defaultCleanFlags,    cleanCommand,
@@ -99,6 +99,7 @@ import Distribution.Simple.InstallDirs
 import Distribution.Verbosity
 import Distribution.Utils.NubList
 import Distribution.Types.ComponentId
+import Distribution.Types.DumpBuildInfo
 import Distribution.Types.GivenComponent
 import Distribution.Types.Module
 import Distribution.Types.PackageVersionConstraint
@@ -274,6 +275,11 @@ data ConfigFlags = ConfigFlags {
       -- ^Halt and show an error message indicating an error in flag assignment
     configRelocatable :: Flag Bool, -- ^ Enable relocatable package built
     configDebugInfo :: Flag DebugInfoLevel,  -- ^ Emit debug info.
+    configDumpBuildInfo :: Flag DumpBuildInfo,
+      -- ^ Should we dump available build information on build?
+      -- Dump build information to disk before attempting to build,
+      -- tooling can parse these files and use them to compile the
+      -- source files themselves.
     configUseResponseFiles :: Flag Bool,
       -- ^ Whether to use response files at all. They're used for such tools
       -- as haddock, or ld.
@@ -343,6 +349,7 @@ instance Eq ConfigFlags where
     && equal configFlagError
     && equal configRelocatable
     && equal configDebugInfo
+    && equal configDumpBuildInfo
     && equal configUseResponseFiles
     where
       equal f = on (==) f a b
@@ -393,6 +400,7 @@ defaultConfigFlags progDb = emptyConfigFlags {
     configFlagError    = NoFlag,
     configRelocatable  = Flag False,
     configDebugInfo    = Flag NoDebugInfo,
+    configDumpBuildInfo = NoFlag,
     configUseResponseFiles = NoFlag
   }
 
@@ -561,6 +569,17 @@ configureOptions showOrParseArgs =
                 "Don't emit debug info"
          ]
 
+      , multiOption "build-info"
+         configDumpBuildInfo
+         (\v flags -> flags { configDumpBuildInfo = v })
+         [noArg (Flag DumpBuildInfo) []
+                ["enable-build-info"]
+                "Enable build information generation during project building",
+          noArg (Flag NoDumpBuildInfo) []
+                ["disable-build-info"]
+                "Disable build information generation during project building"
+         ]
+
       ,option "" ["library-for-ghci"]
          "compile library for use with GHCi"
          configGHCiLib (\v flags -> flags { configGHCiLib = v })
@@ -2183,81 +2202,6 @@ optionNumJobs get set =
             | otherwise -> Right (Just n)
           _             -> Left "The jobs value should be a number or '$ncpus'"
 
-
--- ------------------------------------------------------------
--- * show-build-info command flags
--- ------------------------------------------------------------
-
-data ShowBuildInfoFlags = ShowBuildInfoFlags
-  { buildInfoBuildFlags :: BuildFlags
-  , buildInfoOutputFile :: Maybe FilePath
-  } deriving (Show, Typeable)
-
-defaultShowBuildFlags  :: ShowBuildInfoFlags
-defaultShowBuildFlags =
-    ShowBuildInfoFlags
-      { buildInfoBuildFlags = defaultBuildFlags
-      , buildInfoOutputFile = Nothing
-      }
-
-showBuildInfoCommand :: ProgramDb -> CommandUI ShowBuildInfoFlags
-showBuildInfoCommand progDb = CommandUI
-  { commandName         = "show-build-info"
-  , commandSynopsis     = "Emit details about how a package would be built."
-  , commandDescription  = Just $ \_ -> wrapText $
-         "Components encompass executables, tests, and benchmarks.\n"
-      ++ "\n"
-      ++ "Affected by configuration options, see `configure`.\n"
-  , commandNotes        = Just $ \pname ->
-       "Examples:\n"
-        ++ "  " ++ pname ++ " show-build-info      "
-        ++ "    All the components in the package\n"
-        ++ "  " ++ pname ++ " show-build-info foo       "
-        ++ "    A component (i.e. lib, exe, test suite)\n\n"
-        ++ programFlagsDescription progDb
---TODO: re-enable once we have support for module/file targets
---        ++ "  " ++ pname ++ " show-build-info Foo.Bar   "
---        ++ "    A module\n"
---        ++ "  " ++ pname ++ " show-build-info Foo/Bar.hs"
---        ++ "    A file\n\n"
---        ++ "If a target is ambiguous it can be qualified with the component "
---        ++ "name, e.g.\n"
---        ++ "  " ++ pname ++ " show-build-info foo:Foo.Bar\n"
---        ++ "  " ++ pname ++ " show-build-info testsuite1:Foo/Bar.hs\n"
-  , commandUsage        = usageAlternatives "show-build-info" $
-      [ "[FLAGS]"
-      , "COMPONENTS [FLAGS]"
-      ]
-  , commandDefaultFlags = defaultShowBuildFlags
-  , commandOptions      = \showOrParseArgs ->
-      parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb
-      ++
-      [ option [] ["buildinfo-json-output"]
-                "Write the result to the given file instead of stdout"
-                buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf })
-                (reqArg' "FILE" Just (maybe [] pure))
-      ]
-
-  }
-
-parseBuildFlagsForShowBuildInfoFlags :: ShowOrParseArgs -> ProgramDb -> [OptionField ShowBuildInfoFlags]
-parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb =
-  map
-      (liftOption
-        buildInfoBuildFlags
-          (\bf flags -> flags { buildInfoBuildFlags = bf } )
-      )
-      buildFlags
-  where
-    buildFlags = buildOptions progDb showOrParseArgs
-      ++
-      [ optionVerbosity
-        buildVerbosity (\v flags -> flags { buildVerbosity = v })
-
-      , optionDistPref
-        buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs
-      ]
-
 -- ------------------------------------------------------------
 -- * Other Utils
 -- ------------------------------------------------------------