Skip to content

Commit 39ed3a3

Browse files
bgamarifendor
bgamari
authored and
fendor
committed
Add show-build-info command
This allows users to get a JSON representation of various information about how Cabal would go about building a package. The output of this command is intended for external tools and therefore the format should remain stable.
1 parent 5be57c0 commit 39ed3a3

File tree

8 files changed

+287
-6
lines changed

8 files changed

+287
-6
lines changed

‎Cabal/Cabal.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -364,6 +364,7 @@ library
364364
Distribution.Simple.Program.Types
365365
Distribution.Simple.Register
366366
Distribution.Simple.Setup
367+
Distribution.Simple.ShowBuildInfo
367368
Distribution.Simple.SrcDist
368369
Distribution.Simple.Test
369370
Distribution.Simple.Test.ExeV10
@@ -521,6 +522,7 @@ library
521522
Distribution.Simple.GHC.EnvironmentParser
522523
Distribution.Simple.GHC.Internal
523524
Distribution.Simple.GHC.ImplInfo
525+
Distribution.Simple.Utils.Json
524526
Paths_Cabal
525527

526528
if flag(bundled-binary-generic)

‎Cabal/Distribution/Simple.hs

Lines changed: 24 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -73,8 +73,8 @@ import Distribution.Simple.PreProcess
7373
import Distribution.Simple.Setup
7474
import Distribution.Simple.Command
7575

76-
import Distribution.Simple.Build
77-
import Distribution.Simple.SrcDist
76+
import Distribution.Simple.Build ( build, showBuildInfo, repl )
77+
import Distribution.Simple.SrcDist ( sdist )
7878
import Distribution.Simple.Register
7979

8080
import Distribution.Simple.Configure
@@ -178,6 +178,7 @@ defaultMainHelper hooks args = topHandler $
178178
[configureCommand progs `commandAddAction`
179179
\fs as -> configureAction hooks fs as >> return ()
180180
,buildCommand progs `commandAddAction` buildAction hooks
181+
,showBuildInfoCommand progs `commandAddAction` showBuildInfoAction hooks
181182
,replCommand progs `commandAddAction` replAction hooks
182183
,installCommand `commandAddAction` installAction hooks
183184
,copyCommand `commandAddAction` copyAction hooks
@@ -263,6 +264,27 @@ buildAction hooks flags args = do
263264
(return lbi { withPrograms = progs })
264265
hooks flags' { buildArgs = args } args
265266

267+
showBuildInfoAction :: UserHooks -> BuildFlags -> Args -> IO ()
268+
showBuildInfoAction hooks flags args = do
269+
distPref <- findDistPrefOrDefault (buildDistPref flags)
270+
let verbosity = fromFlag $ buildVerbosity flags
271+
flags' = flags { buildDistPref = toFlag distPref }
272+
273+
lbi <- getBuildConfig hooks verbosity distPref
274+
progs <- reconfigurePrograms verbosity
275+
(buildProgramPaths flags')
276+
(buildProgramArgs flags')
277+
(withPrograms lbi)
278+
279+
pbi <- preBuild hooks args flags'
280+
let lbi' = lbi { withPrograms = progs }
281+
pkg_descr0 = localPkgDescr lbi'
282+
pkg_descr = updatePackageDescription pbi pkg_descr0
283+
-- TODO: Somehow don't ignore build hook?
284+
showBuildInfo pkg_descr lbi' flags
285+
286+
postBuild hooks args flags' pkg_descr lbi'
287+
266288
replAction :: UserHooks -> ReplFlags -> Args -> IO ()
267289
replAction hooks flags args = do
268290
distPref <- findDistPrefOrDefault (replDistPref flags)

‎Cabal/Distribution/Simple/Build.hs

Lines changed: 18 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@
1919
--
2020

2121
module Distribution.Simple.Build (
22-
build, repl,
22+
build, showBuildInfo, repl,
2323
startInterpreter,
2424

2525
initialBuildSteps,
@@ -69,11 +69,16 @@ import Distribution.Simple.PreProcess
6969
import Distribution.Simple.LocalBuildInfo
7070
import Distribution.Simple.Program.Types
7171
import Distribution.Simple.Program.Db
72+
import qualified Distribution.Simple.Program.HcPkg as HcPkg
73+
import Distribution.Simple.ShowBuildInfo
7274
import Distribution.Simple.BuildPaths
7375
import Distribution.Simple.Configure
7476
import Distribution.Simple.Register
7577
import Distribution.Simple.Test.LibV09
7678
import Distribution.Simple.Utils
79+
( createDirectoryIfMissingVerbose, rewriteFile, rewriteFileEx
80+
, die, die', info, debug, warn, setupMessage )
81+
import Distribution.Simple.Utils.Json
7782

7883
import Distribution.System
7984
import Distribution.Pretty
@@ -128,6 +133,18 @@ build pkg_descr lbi flags suffixes = do
128133
verbosity = fromFlag (buildVerbosity flags)
129134

130135

136+
showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file
137+
-> LocalBuildInfo -- ^ Configuration information
138+
-> BuildFlags -- ^ Flags that the user passed to build
139+
-> IO ()
140+
showBuildInfo pkg_descr lbi flags = do
141+
let verbosity = fromFlag (buildVerbosity flags)
142+
targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)
143+
let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
144+
doc = mkBuildInfo pkg_descr lbi flags targetsToBuild
145+
putStrLn $ renderJson doc ""
146+
147+
131148
repl :: PackageDescription -- ^ Mostly information from the .cabal file
132149
-> LocalBuildInfo -- ^ Configuration information
133150
-> ReplFlags -- ^ Flags that the user passed to build

‎Cabal/Distribution/Simple/Setup.hs

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ module Distribution.Simple.Setup (
4545
HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand,
4646
HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand,
4747
BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand,
48+
showBuildInfoCommand,
4849
buildVerbose,
4950
ReplFlags(..), defaultReplFlags, replCommand,
5051
CleanFlags(..), emptyCleanFlags, defaultCleanFlags, cleanCommand,
@@ -1622,6 +1623,49 @@ instance Monoid CleanFlags where
16221623
instance Semigroup CleanFlags where
16231624
(<>) = gmappend
16241625

1626+
-- ------------------------------------------------------------
1627+
-- * show-build-info flags
1628+
-- ------------------------------------------------------------
1629+
1630+
showBuildInfoCommand :: ProgramConfiguration -> CommandUI BuildFlags
1631+
showBuildInfoCommand progConf = CommandUI
1632+
{ commandName = "show-build-info"
1633+
, commandSynopsis = "Emit details about how a package would be built."
1634+
, commandDescription = Just $ \_ -> wrapText $
1635+
"Components encompass executables, tests, and benchmarks.\n"
1636+
++ "\n"
1637+
++ "Affected by configuration options, see `configure`.\n"
1638+
, commandNotes = Just $ \pname ->
1639+
"Examples:\n"
1640+
++ " " ++ pname ++ " show-build-info "
1641+
++ " All the components in the package\n"
1642+
++ " " ++ pname ++ " show-build-info foo "
1643+
++ " A component (i.e. lib, exe, test suite)\n\n"
1644+
++ programFlagsDescription progConf
1645+
--TODO: re-enable once we have support for module/file targets
1646+
-- ++ " " ++ pname ++ " show-build-info Foo.Bar "
1647+
-- ++ " A module\n"
1648+
-- ++ " " ++ pname ++ " show-build-info Foo/Bar.hs"
1649+
-- ++ " A file\n\n"
1650+
-- ++ "If a target is ambiguous it can be qualified with the component "
1651+
-- ++ "name, e.g.\n"
1652+
-- ++ " " ++ pname ++ " show-build-info foo:Foo.Bar\n"
1653+
-- ++ " " ++ pname ++ " show-build-info testsuite1:Foo/Bar.hs\n"
1654+
, commandUsage = usageAlternatives "show-build-info" $
1655+
[ "[FLAGS]"
1656+
, "COMPONENTS [FLAGS]"
1657+
]
1658+
, commandDefaultFlags = defaultBuildFlags
1659+
, commandOptions = \showOrParseArgs ->
1660+
[ optionVerbosity
1661+
buildVerbosity (\v flags -> flags { buildVerbosity = v })
1662+
1663+
, optionDistPref
1664+
buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs
1665+
]
1666+
++ buildOptions progConf showOrParseArgs
1667+
}
1668+
16251669
-- ------------------------------------------------------------
16261670
-- * Build flags
16271671
-- ------------------------------------------------------------

‎Cabal/Distribution/Simple/ShowBuildInfo.hs

Lines changed: 142 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,142 @@
1+
-- |
2+
-- This module defines a simple JSON-based format for exporting basic
3+
-- information about a Cabal package and the compiler configuration Cabal
4+
-- would use to build it. This can be produced with the @cabal show-build-info@
5+
-- command.
6+
--
7+
-- This format is intended for consumption by external tooling and should
8+
-- therefore be rather stable. Moreover, this allows tooling users to avoid
9+
-- linking against Cabal. This is an important advantage as direct API usage
10+
-- tends to be rather fragile in the presence of user-initiated upgrades of
11+
-- Cabal.
12+
--
13+
-- Below is an example of the output this module produces,
14+
--
15+
-- @
16+
-- { "cabal_version": "1.23.0.0",
17+
-- "compiler": {
18+
-- "flavor": "GHC",
19+
-- "compiler_id": "ghc-7.10.2",
20+
-- "path": "/usr/bin/ghc",
21+
-- },
22+
-- "components": [
23+
-- { "type": "library",
24+
-- "name": "CLibName",
25+
-- "compiler_args":
26+
-- ["-O", "-XHaskell98", "-Wall",
27+
-- "-package-id", "parallel-3.2.0.6-b79c38c5c25fff77f3ea7271851879eb"]
28+
-- "modules": ["Project.ModA", "Project.ModB", "Paths_project"],
29+
-- "source_files": [],
30+
-- "source_dirs": ["src"]
31+
-- }
32+
-- ]
33+
-- }
34+
-- @
35+
--
36+
-- The @cabal_version@ property provides the version of the Cabal library
37+
-- which generated the output. The @compiler@ property gives some basic
38+
-- information about the compiler Cabal would use to compile the package.
39+
--
40+
-- The @components@ property gives a list of the Cabal 'Component's defined by
41+
-- the package. Each has,
42+
--
43+
-- * @type@: the type of the component (one of @library@, @executable@,
44+
-- @test-suite@, or @benchmark@)
45+
-- * @name@: a string serving to uniquely identify the component within the
46+
-- package.
47+
-- * @compiler_args@: the command-line arguments Cabal would pass to the
48+
-- compiler to compile the component
49+
-- * @modules@: the modules belonging to the component
50+
-- * @source_dirs@: a list of directories where the modules might be found
51+
-- * @source_files@: any other Haskell sources needed by the component
52+
--
53+
-- Note: At the moment this is only supported when using the GHC compiler.
54+
--
55+
56+
module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where
57+
58+
import qualified Distribution.Simple.GHC as GHC
59+
import qualified Distribution.Simple.Program.GHC as GHC
60+
61+
import Distribution.PackageDescription
62+
import Distribution.Compiler
63+
import Distribution.Verbosity
64+
import Distribution.Simple.Compiler
65+
import Distribution.Simple.LocalBuildInfo
66+
import Distribution.Simple.Program
67+
import Distribution.Simple.Setup
68+
import Distribution.Simple.Utils (cabalVersion)
69+
import Distribution.Simple.Utils.Json
70+
import Distribution.Types.TargetInfo
71+
import Distribution.Text
72+
73+
-- | Construct a JSON document describing the build information for a package
74+
mkBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file
75+
-> LocalBuildInfo -- ^ Configuration information
76+
-> BuildFlags -- ^ Flags that the user passed to build
77+
-> [TargetInfo]
78+
-> Json
79+
mkBuildInfo pkg_descr lbi _flags targetsToBuild = info
80+
where
81+
componentsToBuild = map (\target -> (componentLocalName $ targetCLBI target,targetCLBI target)) targetsToBuild
82+
(.=) :: String -> Json -> (String, Json)
83+
k .= v = (k, v)
84+
85+
info = JsonObject
86+
[ "cabal_version" .= JsonString (display cabalVersion)
87+
, "compiler" .= mkCompilerInfo
88+
, "components" .= JsonArray (map mkComponentInfo componentsToBuild)
89+
]
90+
91+
mkCompilerInfo = JsonObject
92+
[ "flavour" .= JsonString (show $ compilerFlavor $ compiler lbi)
93+
, "compiler_id" .= JsonString (showCompilerId $ compiler lbi)
94+
, "path" .= path
95+
]
96+
where
97+
path = maybe JsonNull (JsonString . programPath)
98+
$ lookupProgram ghcProgram (withPrograms lbi)
99+
100+
mkComponentInfo (name, clbi) = JsonObject
101+
[ "type" .= JsonString compType
102+
, "name" .= JsonString (show name)
103+
, "compiler_args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi)
104+
, "modules" .= JsonArray (map (JsonString . display) modules)
105+
, "source_files" .= JsonArray (map JsonString source_files)
106+
, "source_dirs" .= JsonArray (map JsonString $ hsSourceDirs bi)
107+
]
108+
where
109+
bi = componentBuildInfo comp
110+
Just comp = lookupComponent pkg_descr name
111+
compType = case comp of
112+
CLib _ -> "library"
113+
CExe _ -> "executable"
114+
CTest _ -> "test-suite"
115+
CBench _ -> "benchmark"
116+
CFLib _ -> "foreign-library"
117+
modules = case comp of
118+
CLib lib -> explicitLibModules lib
119+
CExe exe -> exeModules exe
120+
_ -> []
121+
source_files = case comp of
122+
CLib _ -> []
123+
CExe exe -> [modulePath exe]
124+
_ -> []
125+
126+
-- | Get the command-line arguments that would be passed
127+
-- to the compiler to build the given component.
128+
getCompilerArgs :: BuildInfo
129+
-> LocalBuildInfo
130+
-> ComponentLocalBuildInfo
131+
-> [String]
132+
getCompilerArgs bi lbi clbi =
133+
case compilerFlavor $ compiler lbi of
134+
GHC -> ghc
135+
GHCJS -> ghc
136+
c -> error $ "ShowBuildInfo.getCompilerArgs: Don't know how to get "++
137+
"build arguments for compiler "++show c
138+
where
139+
-- This is absolutely awful
140+
ghc = GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts
141+
where
142+
baseOpts = GHC.componentGhcOptions normal lbi bi clbi (buildDir lbi)

‎Cabal/Distribution/Simple/UserHooks.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -71,7 +71,6 @@ data UserHooks = UserHooks {
7171

7272
-- |Hook to run before build command. Second arg indicates verbosity level.
7373
preBuild :: Args -> BuildFlags -> IO HookedBuildInfo,
74-
7574
-- |Over-ride this hook to get different behavior during build.
7675
buildHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO (),
7776
-- |Hook to run after build command. Second arg indicates verbosity level.

‎Cabal/Distribution/Simple/Utils/Json.hs

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,34 @@
1+
module Distribution.Simple.Utils.Json
2+
( Json(..)
3+
, renderJson
4+
) where
5+
6+
data Json = JsonArray [Json]
7+
| JsonBool !Bool
8+
| JsonNull
9+
| JsonNumber !Int
10+
| JsonObject [(String, Json)]
11+
| JsonString !String
12+
13+
renderJson :: Json -> ShowS
14+
renderJson (JsonArray objs) =
15+
surround "[" "]" $ intercalate "," $ map renderJson objs
16+
renderJson (JsonBool True) = showString "true"
17+
renderJson (JsonBool False) = showString "false"
18+
renderJson JsonNull = showString "null"
19+
renderJson (JsonNumber n) = shows n
20+
renderJson (JsonObject attrs) =
21+
surround "{" "}" $ intercalate "," $ map render attrs
22+
where
23+
render (k,v) = (surround "\"" "\"" $ showString k) . showString ":" . renderJson v
24+
renderJson (JsonString s) = surround "\"" "\"" $ showString s
25+
26+
surround :: String -> String -> ShowS -> ShowS
27+
surround begin end middle = showString begin . middle . showString end
28+
29+
intercalate :: String -> [ShowS] -> ShowS
30+
intercalate sep = go
31+
where
32+
go [] = id
33+
go [x] = x
34+
go (x:xs) = x . showString sep . go xs

0 commit comments

Comments
 (0)