diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs
index ae9b36a78435595e391fa846202de978ef139ed6..e632acc88e8a188726313f0bb79d521ccc9ec968 100644
--- a/Cabal/Distribution/Simple.hs
+++ b/Cabal/Distribution/Simple.hs
@@ -72,8 +72,8 @@ import Distribution.Simple.PreProcess
import Distribution.Simple.Setup
import Distribution.Simple.Command
-import Distribution.Simple.Build ( build, showBuildInfo, repl )
-import Distribution.Simple.SrcDist ( sdist )
+import Distribution.Simple.Build
+import Distribution.Simple.SrcDist
import Distribution.Simple.Register
import Distribution.Simple.Configure
@@ -265,13 +265,15 @@ buildAction hooks flags args = do
(return lbi { withPrograms = progs })
hooks flags' { buildArgs = args } args
-showBuildInfoAction :: UserHooks -> BuildFlags -> Args -> IO ()
-showBuildInfoAction hooks flags args = do
+showBuildInfoAction :: UserHooks -> ShowBuildInfoFlags -> Args -> IO ()
+showBuildInfoAction hooks (ShowBuildInfoFlags flags fileOutput) args = do
distPref <- findDistPrefOrDefault (buildDistPref flags)
let verbosity = fromFlag $ buildVerbosity flags
- flags' = flags { buildDistPref = toFlag distPref }
-
lbi <- getBuildConfig hooks verbosity distPref
+ let flags' = flags { buildDistPref = toFlag distPref
+ , buildCabalFilePath = maybeToFlag (cabalFilePath lbi)
+ }
+
progs <- reconfigurePrograms verbosity
(buildProgramPaths flags')
(buildProgramArgs flags')
@@ -281,8 +283,12 @@ showBuildInfoAction hooks flags args = do
let lbi' = lbi { withPrograms = progs }
pkg_descr0 = localPkgDescr lbi'
pkg_descr = updatePackageDescription pbi pkg_descr0
- -- TODO: Somehow don't ignore build hook?
- showBuildInfo pkg_descr lbi' flags
+ -- TODO: Somehow don't ignore build hook?
+ buildInfoString <- showBuildInfo pkg_descr lbi' flags
+
+ case fileOutput of
+ Nothing -> putStr buildInfoString
+ Just fp -> writeFile fp buildInfoString
postBuild hooks args flags' pkg_descr lbi'
diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs
index 3747d1f48fed8e3bc7a34deacb05d1c192f72829..331c367d8ded53d8726f7b675f63ef0677a1c85d 100644
--- a/Cabal/Distribution/Simple/Build.hs
+++ b/Cabal/Distribution/Simple/Build.hs
@@ -69,15 +69,12 @@ import Distribution.Simple.PreProcess
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Program.Types
import Distribution.Simple.Program.Db
-import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.Simple.ShowBuildInfo
import Distribution.Simple.BuildPaths
import Distribution.Simple.Configure
import Distribution.Simple.Register
import Distribution.Simple.Test.LibV09
import Distribution.Simple.Utils
- ( createDirectoryIfMissingVerbose, rewriteFile, rewriteFileEx
- , die, die', info, debug, warn, setupMessage )
import Distribution.Simple.Utils.Json
import Distribution.System
@@ -136,13 +133,13 @@ build pkg_descr lbi flags suffixes = do
showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file
-> LocalBuildInfo -- ^ Configuration information
-> BuildFlags -- ^ Flags that the user passed to build
- -> IO ()
+ -> IO String
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
- putStrLn $ renderJson doc ""
+ return $ renderJson doc ""
repl :: PackageDescription -- ^ Mostly information from the .cabal file
diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs
index cb3082801c350ad2aae646b66540eb5bd6e0def3..4630f20e0641c3ade67e4415685d023fb15ec51c 100644
--- a/Cabal/Distribution/Simple/Setup.hs
+++ b/Cabal/Distribution/Simple/Setup.hs
@@ -45,7 +45,7 @@ module Distribution.Simple.Setup (
HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand,
HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand,
BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand,
- showBuildInfoCommand,
+ ShowBuildInfoFlags(..), defaultShowBuildFlags, showBuildInfoCommand,
ReplFlags(..), defaultReplFlags, replCommand,
CleanFlags(..), emptyCleanFlags, defaultCleanFlags, cleanCommand,
RegisterFlags(..), emptyRegisterFlags, defaultRegisterFlags, registerCommand,
@@ -1622,49 +1622,6 @@ instance Monoid CleanFlags where
instance Semigroup CleanFlags where
(<>) = gmappend
--- ------------------------------------------------------------
--- * show-build-info flags
--- ------------------------------------------------------------
-
-showBuildInfoCommand :: ProgramConfiguration -> CommandUI BuildFlags
-showBuildInfoCommand progConf = 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 progConf
---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 = defaultBuildFlags
- , commandOptions = \showOrParseArgs ->
- [ optionVerbosity
- buildVerbosity (\v flags -> flags { buildVerbosity = v })
-
- , optionDistPref
- buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs
- ]
- ++ buildOptions progConf showOrParseArgs
- }
-
-- ------------------------------------------------------------
-- * Build flags
-- ------------------------------------------------------------
@@ -2249,6 +2206,81 @@ 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
+
+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
-- ------------------------------------------------------------
diff --git a/Cabal/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs
index 21bbb44c8769709da8da2fd49cfd3860802a4b62..b13f95b78f07f41bf0e7c8565b01497896184da1 100644
--- a/Cabal/Distribution/Simple/ShowBuildInfo.hs
+++ b/Cabal/Distribution/Simple/ShowBuildInfo.hs
@@ -1,8 +1,9 @@
-- |
-- This module defines a simple JSON-based format for exporting basic
-- information about a Cabal package and the compiler configuration Cabal
--- would use to build it. This can be produced with the @cabal show-build-info@
--- command.
+-- would use to build it. This can be produced with the
+-- @cabal new-show-build-info@ command.
+--
--
-- This format is intended for consumption by external tooling and should
-- therefore be rather stable. Moreover, this allows tooling users to avoid
@@ -13,42 +14,42 @@
-- Below is an example of the output this module produces,
--
-- @
--- { "cabal_version": "1.23.0.0",
+-- { "cabal-version": "1.23.0.0",
-- "compiler": {
-- "flavor": "GHC",
--- "compiler_id": "ghc-7.10.2",
+-- "compiler-id": "ghc-7.10.2",
-- "path": "/usr/bin/ghc",
-- },
-- "components": [
--- { "type": "library",
--- "name": "CLibName",
--- "compiler_args":
+-- { "type": "lib",
+-- "name": "lib:Cabal",
+-- "compiler-args":
-- ["-O", "-XHaskell98", "-Wall",
-- "-package-id", "parallel-3.2.0.6-b79c38c5c25fff77f3ea7271851879eb"]
-- "modules": ["Project.ModA", "Project.ModB", "Paths_project"],
--- "source_files": [],
--- "source_dirs": ["src"]
+-- "src-files": [],
+-- "src-dirs": ["src"]
-- }
-- ]
-- }
-- @
--
--- The @cabal_version@ property provides the version of the Cabal library
+-- The @cabal-version@ property provides the version of the Cabal library
-- which generated the output. The @compiler@ property gives some basic
-- information about the compiler Cabal would use to compile the package.
--
-- The @components@ property gives a list of the Cabal 'Component's defined by
-- the package. Each has,
--
--- * @type@: the type of the component (one of @library@, @executable@,
--- @test-suite@, or @benchmark@)
+-- * @type@: the type of the component (one of @lib@, @exe@,
+-- @test@, @bench@, or @flib@)
-- * @name@: a string serving to uniquely identify the component within the
-- package.
--- * @compiler_args@: the command-line arguments Cabal would pass to the
+-- * @compiler-args@: the command-line arguments Cabal would pass to the
-- compiler to compile the component
-- * @modules@: the modules belonging to the component
--- * @source_dirs@: a list of directories where the modules might be found
--- * @source_files@: any other Haskell sources needed by the component
+-- * @src-dirs@: a list of directories where the modules might be found
+-- * @src-files@: any other Haskell sources needed by the component
--
-- Note: At the moment this is only supported when using the GHC compiler.
--
@@ -69,6 +70,7 @@ import Distribution.Simple.Utils (cabalVersion)
import Distribution.Simple.Utils.Json
import Distribution.Types.TargetInfo
import Distribution.Text
+import Distribution.Pretty
-- | Construct a JSON document describing the build information for a package
mkBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file
@@ -83,42 +85,51 @@ mkBuildInfo pkg_descr lbi _flags targetsToBuild = info
k .= v = (k, v)
info = JsonObject
- [ "cabal_version" .= JsonString (display cabalVersion)
+ [ "cabal-version" .= JsonString (display cabalVersion)
, "compiler" .= mkCompilerInfo
, "components" .= JsonArray (map mkComponentInfo componentsToBuild)
]
mkCompilerInfo = JsonObject
- [ "flavour" .= JsonString (show $ compilerFlavor $ compiler lbi)
- , "compiler_id" .= JsonString (showCompilerId $ compiler lbi)
+ [ "flavour" .= JsonString (prettyShow $ compilerFlavor $ compiler lbi)
+ , "compiler-id" .= JsonString (showCompilerId $ compiler lbi)
, "path" .= path
]
where
path = maybe JsonNull (JsonString . programPath)
- $ lookupProgram ghcProgram (withPrograms lbi)
+ $ (flavorToProgram . compilerFlavor $ compiler lbi)
+ >>= flip lookupProgram (withPrograms lbi)
+
+ flavorToProgram :: CompilerFlavor -> Maybe Program
+ flavorToProgram GHC = Just ghcProgram
+ flavorToProgram GHCJS = Just ghcjsProgram
+ flavorToProgram UHC = Just uhcProgram
+ flavorToProgram JHC = Just jhcProgram
+ flavorToProgram _ = Nothing
mkComponentInfo (name, clbi) = JsonObject
[ "type" .= JsonString compType
- , "name" .= JsonString (show name)
- , "compiler_args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi)
+ , "name" .= JsonString (prettyShow name)
+ , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi)
+ , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi)
, "modules" .= JsonArray (map (JsonString . display) modules)
- , "source_files" .= JsonArray (map JsonString source_files)
- , "source_dirs" .= JsonArray (map JsonString $ hsSourceDirs bi)
+ , "src-files" .= JsonArray (map JsonString sourceFiles)
+ , "src-dirs" .= JsonArray (map JsonString $ hsSourceDirs bi)
]
where
bi = componentBuildInfo comp
Just comp = lookupComponent pkg_descr name
compType = case comp of
- CLib _ -> "library"
- CExe _ -> "executable"
- CTest _ -> "test-suite"
- CBench _ -> "benchmark"
- CFLib _ -> "foreign-library"
+ CLib _ -> "lib"
+ CExe _ -> "exe"
+ CTest _ -> "test"
+ CBench _ -> "bench"
+ CFLib _ -> "flib"
modules = case comp of
CLib lib -> explicitLibModules lib
CExe exe -> exeModules exe
_ -> []
- source_files = case comp of
+ sourceFiles = case comp of
CLib _ -> []
CExe exe -> [modulePath exe]
_ -> []
diff --git a/Cabal/Distribution/Simple/UserHooks.hs b/Cabal/Distribution/Simple/UserHooks.hs
index 97f22933c5625c507daa05d67f00d05cab463a48..306092186d1e7fcc9bcd94fc0906773c71f41303 100644
--- a/Cabal/Distribution/Simple/UserHooks.hs
+++ b/Cabal/Distribution/Simple/UserHooks.hs
@@ -69,6 +69,7 @@ data UserHooks = UserHooks {
-- |Hook to run before build command. Second arg indicates verbosity level.
preBuild :: Args -> BuildFlags -> IO HookedBuildInfo,
+
-- |Over-ride this hook to get different behavior during build.
buildHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO (),
-- |Hook to run after build command. Second arg indicates verbosity level.
diff --git a/Cabal/Distribution/Simple/Utils/Json.hs b/Cabal/Distribution/Simple/Utils/Json.hs
index b8447fc507559b2f3b67d74fe270d50df50efded..f90f2f38aa2c4b6cf569b832baf5f121b05d529c 100644
--- a/Cabal/Distribution/Simple/Utils/Json.hs
+++ b/Cabal/Distribution/Simple/Utils/Json.hs
@@ -1,3 +1,5 @@
+-- | Utility json lib for Cabal
+-- TODO: Remove it again.
module Distribution.Simple.Utils.Json
( Json(..)
, renderJson
@@ -20,15 +22,25 @@ renderJson (JsonNumber n) = shows n
renderJson (JsonObject attrs) =
surround "{" "}" $ intercalate "," $ map render attrs
where
- render (k,v) = (surround "\"" "\"" $ showString k) . showString ":" . renderJson v
-renderJson (JsonString s) = surround "\"" "\"" $ showString s
+ render (k,v) = (surround "\"" "\"" $ showString' k) . showString ":" . renderJson v
+renderJson (JsonString s) = surround "\"" "\"" $ showString' s
surround :: String -> String -> ShowS -> ShowS
surround begin end middle = showString begin . middle . showString end
+showString' :: String -> ShowS
+showString' xs = showStringWorker xs
+ where
+ showStringWorker :: String -> ShowS
+ showStringWorker ('\"':as) = showString "\\\"" . showStringWorker as
+ showStringWorker ('\\':as) = showString "\\\\" . showStringWorker as
+ showStringWorker ('\'':as) = showString "\\\'" . showStringWorker as
+ showStringWorker (x:as) = showString [x] . showStringWorker as
+ showStringWorker [] = showString ""
+
intercalate :: String -> [ShowS] -> ShowS
intercalate sep = go
where
go [] = id
go [x] = x
- go (x:xs) = x . showString sep . go xs
+ go (x:xs) = x . showString' sep . go xs