Remove Show-build-info command and generate buildinfo on build

Removes 'show-build-info' command from 'lib:Cabal' and replaces it
by generating build-info whenever a build happens.

Add flag '--dump-buildinfo' to signal the build step to dump
build information for the package/component we are currently building.

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

@@ -107,8 +107,6 @@ import Data.List       (unionBy, (\\))
 
 import Distribution.PackageDescription.Parsec
 
-import qualified Data.Text.IO as T
-
 -- | A simple implementation of @main@ for a Cabal setup script.
 -- It reads the package description file using IO, and performs the
 -- action specified on the command line.
@@ -179,7 +177,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,36 +261,6 @@ buildAction hooks flags args = do
                (return lbi { withPrograms = progs })
                hooks flags' { buildArgs = args } args
 
-showBuildInfoAction :: UserHooks -> ShowBuildInfoFlags -> Args -> IO ()
-showBuildInfoAction hooks flags args = do
-  let buildFlags = buildInfoBuildFlags flags
-  distPref <- findDistPrefOrDefault (buildDistPref buildFlags)
-  let verbosity = fromFlag $ buildVerbosity buildFlags
-  lbi <- getBuildConfig hooks verbosity distPref
-  let buildFlags' =
-        buildFlags { buildDistPref = toFlag distPref
-                   , buildCabalFilePath = maybeToFlag (cabalFilePath lbi)
-                   }
-
-  progs <- reconfigurePrograms verbosity
-             (buildProgramPaths buildFlags')
-             (buildProgramArgs buildFlags')
-             (withPrograms lbi)
-
-  pbi <- preBuild hooks args buildFlags'
-  let lbi' = lbi { withPrograms = progs }
-      pkg_descr0 = localPkgDescr lbi'
-      pkg_descr = updatePackageDescription pbi pkg_descr0
-      -- TODO: Somehow don't ignore build hook?
-
-  buildInfoText <- showBuildInfo pkg_descr lbi' flags
-
-  case buildInfoOutputFile flags of
-    Nothing -> T.putStr buildInfoText
-    Just fp -> T.writeFile fp buildInfoText
-
-  postBuild hooks args buildFlags' 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,
@@ -89,8 +89,8 @@ import Distribution.Compat.Graph (IsNode(..))
 import Control.Monad
 import qualified Data.Set as Set
 import System.FilePath ( (</>), (<.>), takeDirectory )
-import System.Directory ( getCurrentDirectory )
-import qualified Data.Text as Text
+import System.Directory ( getCurrentDirectory, listDirectory, removeFile )
+import qualified Data.Text.IO as Text
 
 -- -----------------------------------------------------------------------------
 -- |Build the libraries and executables in this package.
@@ -128,32 +128,32 @@ 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)
+
+  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
+    let (warns, json) = mkBuildInfo pwd pkg_descr lbi flags activeTargets
+        buildInfoText = renderJson json mempty
+    unless (null warns) $
+      warn verbosity $ "Encountered warnings while dumping build-info:\n"
+                    ++ unlines warns
+    Text.writeFile (buildInfoPref distPref) buildInfoText
+
+  when (not shouldDumpBuildInfo) $ do
+    -- Remove existing build-info.json as it might be outdated now.
+    removeFile (buildInfoPref distPref)
+
   return ()
  where
   distPref  = fromFlag (buildDistPref flags)
   verbosity = fromFlag (buildVerbosity flags)
-
-
-showBuildInfo :: PackageDescription  -- ^ Mostly information from the .cabal file
-  -> LocalBuildInfo                  -- ^ Configuration information
-  -> ShowBuildInfoFlags              -- ^ Flags that the user passed to build
-  -> IO Text.Text
-showBuildInfo pkg_descr lbi flags = do
-  let buildFlags = buildInfoBuildFlags flags
-      verbosity = fromFlag (buildVerbosity buildFlags)
-  targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs buildFlags)
-  pwd <- getCurrentDirectory
-  let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
-      result
-        | fromFlag (buildInfoComponentsOnly flags) =
-            let components = map (mkComponentInfo pwd pkg_descr lbi . targetCLBI)
-                                 targetsToBuild
-              in Text.unlines $ map (flip renderJson mempty) components
-        | otherwise =
-            let json = mkBuildInfo pwd pkg_descr lbi buildFlags targetsToBuild
-              in renderJson json mempty
-  return result
-
+  shouldDumpBuildInfo = fromFlagOrDefault NoDumpBuildInfo (configDumpBuildInfo (configFlags lbi)) == DumpBuildInfo
 
 repl     :: PackageDescription  -- ^ Mostly information from the .cabal file
          -> LocalBuildInfo      -- ^ Configuration information

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,
   CleanFlags(..),    emptyCleanFlags,    defaultCleanFlags,    cleanCommand,
   RegisterFlags(..), emptyRegisterFlags, defaultRegisterFlags, registerCommand,
@@ -98,6 +98,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
@@ -270,6 +271,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?
+      -- After a successful build, tooling can parse these files and use them
+      -- to compile the source files themselves. Helpful for IDEs such as
+      -- Haskell Language Server
     configUseResponseFiles :: Flag Bool,
       -- ^ Whether to use response files at all. They're used for such tools
       -- as haddock, or ld.
@@ -338,6 +344,7 @@ instance Eq ConfigFlags where
     && equal configFlagError
     && equal configRelocatable
     && equal configDebugInfo
+    && equal configDumpBuildInfo
     && equal configUseResponseFiles
     where
       equal f = on (==) f a b
@@ -388,6 +395,7 @@ defaultConfigFlags progDb = emptyConfigFlags {
     configFlagError    = NoFlag,
     configRelocatable  = Flag False,
     configDebugInfo    = Flag NoDebugInfo,
+    configDumpBuildInfo = Flag NoDumpBuildInfo,
     configUseResponseFiles = NoFlag
   }
 
@@ -556,6 +564,17 @@ configureOptions showOrParseArgs =
                 "Don't emit debug info"
          ]
 
+      , multiOption "dump-buildinfo"
+         configDumpBuildInfo
+         (\v flags -> flags { configDumpBuildInfo = v })
+         [noArg (Flag DumpBuildInfo) []
+                ["enable-dump-buildinfo"]
+                "Enable dumping build information during building the project",
+          noArg (Flag NoDumpBuildInfo) []
+                ["disable-dump-buildinfo"]
+                "Disable dumping build information during building the project"
+         ]
+
       ,option "" ["library-for-ghci"]
          "compile library for use with GHCi"
          configGHCiLib (\v flags -> flags { configGHCiLib = v })
@@ -2147,88 +2166,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
-  , buildInfoComponentsOnly :: Flag Bool
-  -- ^ If 'True' then only print components, each separated by a newline
-  } deriving (Show, Typeable)
-
-defaultShowBuildFlags  :: ShowBuildInfoFlags
-defaultShowBuildFlags =
-    ShowBuildInfoFlags
-      { buildInfoBuildFlags     = defaultBuildFlags
-      , buildInfoOutputFile     = Nothing
-      , buildInfoComponentsOnly = Flag False
-      }
-
-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 (\v flags -> flags { buildInfoOutputFile = v })
-                (reqArg' "FILE" Just (maybe [] pure))
-      , option [] ["buildinfo-components-only"]
-                  "Print out only the component info, each separated by a newline"
-                  buildInfoComponentsOnly (\v flags -> flags { buildInfoComponentsOnly = v})
-                  trueArg
-      ]
-
-  }
-
-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
 -- ------------------------------------------------------------

Cabal/src/Distribution/Simple/ShowBuildInfo.hs

@@ -60,6 +60,7 @@ module Distribution.Simple.ShowBuildInfo
   ( mkBuildInfo, mkBuildInfo', mkCompilerInfo, mkComponentInfo ) where
 
 import qualified Data.Text as T
+import System.FilePath
 
 import Distribution.Compat.Prelude
 import Prelude ()
@@ -88,11 +89,16 @@ mkBuildInfo
   -> LocalBuildInfo      -- ^ Configuration information
   -> BuildFlags          -- ^ Flags that the user passed to build
   -> [TargetInfo]
-  -> Json
+  -> ([String], Json)    -- ^ Json representation of buildinfo alongside generated warnings
 mkBuildInfo wdir pkg_descr lbi _flags targetsToBuild =
-  JsonObject $
-    mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi))
-                 (map (mkComponentInfo wdir pkg_descr lbi . targetCLBI) targetsToBuild)
+  ( warnings
+  , JsonObject $ mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi))
+                              componentInfos
+  )
+    where
+      componentInfosWithWarnings = (map (mkComponentInfo wdir pkg_descr lbi . targetCLBI) targetsToBuild)
+      componentInfos = map snd componentInfosWithWarnings
+      warnings = concatMap fst componentInfosWithWarnings
 
 -- | A variant of 'mkBuildInfo' if you need to call 'mkCompilerInfo' and
 -- 'mkComponentInfo' yourself.
@@ -124,20 +130,22 @@ mkCompilerInfo programDb cmplr = JsonObject
     flavorToProgram JHC   = Just jhcProgram
     flavorToProgram _     = Nothing
 
-mkComponentInfo :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json
-mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $
+mkComponentInfo :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> ([String], Json)
+mkComponentInfo wdir pkg_descr lbi clbi = (warnings, JsonObject $
   [ "type"          .= JsonString compType
   , "name"          .= JsonString (T.pack $ prettyShow name)
   , "unit-id"       .= JsonString (T.pack $ prettyShow $ componentUnitId clbi)
-  , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi)
+  , "compiler-args" .= JsonArray (map JsonString compilerArgs)
   , "modules"       .= JsonArray (map (JsonString . T.pack . display) modules)
   , "src-files"     .= JsonArray (map (JsonString . T.pack) sourceFiles)
   , "hs-src-dirs"   .= JsonArray (map (JsonString . T.pack . prettyShow) $ hsSourceDirs bi)
-  , "src-dir"       .= JsonString (T.pack wdir)
-  ] <> cabalFile
+  , "src-dir"       .= JsonString (T.pack $ addTrailingPathSeparator wdir)
+  ] <> cabalFile)
   where
+    (warnings, compilerArgs) = getCompilerArgs bi lbi clbi
     name = componentLocalName clbi
     bi = componentBuildInfo comp
+    -- If this error happens, a cabal invariant has been violated
     comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name
     compType = case comp of
       CLib _   -> "lib"
@@ -178,13 +186,15 @@ getCompilerArgs
   :: BuildInfo
   -> LocalBuildInfo
   -> ComponentLocalBuildInfo
-  -> [T.Text]
+  -> ([String], [T.Text])
 getCompilerArgs bi lbi clbi =
   case compilerFlavor $ compiler lbi of
-      GHC   -> ghc
-      GHCJS -> ghc
-      c     -> error $ "ShowBuildInfo.getCompilerArgs: Don't know how to get "++
-                       "build arguments for compiler "++show c
+      GHC   -> ([], ghc)
+      GHCJS -> ([], ghc)
+      c     ->
+        ( ["ShowBuildInfo.getCompilerArgs: Don't know how to get build "
+          ++ " arguments for compiler " ++ show c]
+        , [])
   where
     -- This is absolutely awful
     ghc = T.pack <$>