Skip to content

Commit 8dc0c73

Browse files
fendorcfraz89
authored and
hvr
committed
Rebase and polish show-build-info implementation
This commit builds upon the work of cfraz89 and completes the lib:Cabal part of the show-build-info feature. Co-authored-by: Chris Fraser <[email protected]>
1 parent e027703 commit 8dc0c73

File tree

6 files changed

+148
-89
lines changed

6 files changed

+148
-89
lines changed

‎Cabal/Distribution/Simple.hs

Lines changed: 14 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -72,8 +72,8 @@ import Distribution.Simple.PreProcess
7272
import Distribution.Simple.Setup
7373
import Distribution.Simple.Command
7474

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

7979
import Distribution.Simple.Configure
@@ -265,13 +265,15 @@ buildAction hooks flags args = do
265265
(return lbi { withPrograms = progs })
266266
hooks flags' { buildArgs = args } args
267267

268-
showBuildInfoAction :: UserHooks -> BuildFlags -> Args -> IO ()
269-
showBuildInfoAction hooks flags args = do
268+
showBuildInfoAction :: UserHooks -> ShowBuildInfoFlags -> Args -> IO ()
269+
showBuildInfoAction hooks (ShowBuildInfoFlags flags fileOutput) args = do
270270
distPref <- findDistPrefOrDefault (buildDistPref flags)
271271
let verbosity = fromFlag $ buildVerbosity flags
272-
flags' = flags { buildDistPref = toFlag distPref }
273-
274272
lbi <- getBuildConfig hooks verbosity distPref
273+
let flags' = flags { buildDistPref = toFlag distPref
274+
, buildCabalFilePath = maybeToFlag (cabalFilePath lbi)
275+
}
276+
275277
progs <- reconfigurePrograms verbosity
276278
(buildProgramPaths flags')
277279
(buildProgramArgs flags')
@@ -281,8 +283,12 @@ showBuildInfoAction hooks flags args = do
281283
let lbi' = lbi { withPrograms = progs }
282284
pkg_descr0 = localPkgDescr lbi'
283285
pkg_descr = updatePackageDescription pbi pkg_descr0
284-
-- TODO: Somehow don't ignore build hook?
285-
showBuildInfo pkg_descr lbi' flags
286+
-- TODO: Somehow don't ignore build hook?
287+
buildInfoString <- showBuildInfo pkg_descr lbi' flags
288+
289+
case fileOutput of
290+
Nothing -> putStr buildInfoString
291+
Just fp -> writeFile fp buildInfoString
286292

287293
postBuild hooks args flags' pkg_descr lbi'
288294

‎Cabal/Distribution/Simple/Build.hs

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -69,15 +69,12 @@ 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
7372
import Distribution.Simple.ShowBuildInfo
7473
import Distribution.Simple.BuildPaths
7574
import Distribution.Simple.Configure
7675
import Distribution.Simple.Register
7776
import Distribution.Simple.Test.LibV09
7877
import Distribution.Simple.Utils
79-
( createDirectoryIfMissingVerbose, rewriteFile, rewriteFileEx
80-
, die, die', info, debug, warn, setupMessage )
8178
import Distribution.Simple.Utils.Json
8279

8380
import Distribution.System
@@ -136,13 +133,13 @@ build pkg_descr lbi flags suffixes = do
136133
showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file
137134
-> LocalBuildInfo -- ^ Configuration information
138135
-> BuildFlags -- ^ Flags that the user passed to build
139-
-> IO ()
136+
-> IO String
140137
showBuildInfo pkg_descr lbi flags = do
141138
let verbosity = fromFlag (buildVerbosity flags)
142139
targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)
143140
let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
144141
doc = mkBuildInfo pkg_descr lbi flags targetsToBuild
145-
putStrLn $ renderJson doc ""
142+
return $ renderJson doc ""
146143

147144

148145
repl :: PackageDescription -- ^ Mostly information from the .cabal file

‎Cabal/Distribution/Simple/Setup.hs

Lines changed: 76 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ module Distribution.Simple.Setup (
4545
HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand,
4646
HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand,
4747
BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand,
48-
showBuildInfoCommand,
48+
ShowBuildInfoFlags(..), defaultShowBuildFlags, showBuildInfoCommand,
4949
ReplFlags(..), defaultReplFlags, replCommand,
5050
CleanFlags(..), emptyCleanFlags, defaultCleanFlags, cleanCommand,
5151
RegisterFlags(..), emptyRegisterFlags, defaultRegisterFlags, registerCommand,
@@ -1622,49 +1622,6 @@ instance Monoid CleanFlags where
16221622
instance Semigroup CleanFlags where
16231623
(<>) = gmappend
16241624

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

2209+
2210+
-- ------------------------------------------------------------
2211+
-- * show-build-info command flags
2212+
-- ------------------------------------------------------------
2213+
2214+
data ShowBuildInfoFlags = ShowBuildInfoFlags
2215+
{ buildInfoBuildFlags :: BuildFlags
2216+
, buildInfoOutputFile :: Maybe FilePath
2217+
} deriving Show
2218+
2219+
defaultShowBuildFlags :: ShowBuildInfoFlags
2220+
defaultShowBuildFlags =
2221+
ShowBuildInfoFlags
2222+
{ buildInfoBuildFlags = defaultBuildFlags
2223+
, buildInfoOutputFile = Nothing
2224+
}
2225+
2226+
showBuildInfoCommand :: ProgramDb -> CommandUI ShowBuildInfoFlags
2227+
showBuildInfoCommand progDb = CommandUI
2228+
{ commandName = "show-build-info"
2229+
, commandSynopsis = "Emit details about how a package would be built."
2230+
, commandDescription = Just $ \_ -> wrapText $
2231+
"Components encompass executables, tests, and benchmarks.\n"
2232+
++ "\n"
2233+
++ "Affected by configuration options, see `configure`.\n"
2234+
, commandNotes = Just $ \pname ->
2235+
"Examples:\n"
2236+
++ " " ++ pname ++ " show-build-info "
2237+
++ " All the components in the package\n"
2238+
++ " " ++ pname ++ " show-build-info foo "
2239+
++ " A component (i.e. lib, exe, test suite)\n\n"
2240+
++ programFlagsDescription progDb
2241+
--TODO: re-enable once we have support for module/file targets
2242+
-- ++ " " ++ pname ++ " show-build-info Foo.Bar "
2243+
-- ++ " A module\n"
2244+
-- ++ " " ++ pname ++ " show-build-info Foo/Bar.hs"
2245+
-- ++ " A file\n\n"
2246+
-- ++ "If a target is ambiguous it can be qualified with the component "
2247+
-- ++ "name, e.g.\n"
2248+
-- ++ " " ++ pname ++ " show-build-info foo:Foo.Bar\n"
2249+
-- ++ " " ++ pname ++ " show-build-info testsuite1:Foo/Bar.hs\n"
2250+
, commandUsage = usageAlternatives "show-build-info" $
2251+
[ "[FLAGS]"
2252+
, "COMPONENTS [FLAGS]"
2253+
]
2254+
, commandDefaultFlags = defaultShowBuildFlags
2255+
, commandOptions = \showOrParseArgs ->
2256+
parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb
2257+
++
2258+
[ option [] ["buildinfo-json-output"]
2259+
"Write the result to the given file instead of stdout"
2260+
buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf })
2261+
(reqArg' "FILE" Just (maybe [] pure))
2262+
]
2263+
2264+
}
2265+
2266+
parseBuildFlagsForShowBuildInfoFlags :: ShowOrParseArgs -> ProgramDb -> [OptionField ShowBuildInfoFlags]
2267+
parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb =
2268+
map
2269+
(liftOption
2270+
buildInfoBuildFlags
2271+
(\bf flags -> flags { buildInfoBuildFlags = bf } )
2272+
)
2273+
buildFlags
2274+
where
2275+
buildFlags = buildOptions progDb showOrParseArgs
2276+
++
2277+
[ optionVerbosity
2278+
buildVerbosity (\v flags -> flags { buildVerbosity = v })
2279+
2280+
, optionDistPref
2281+
buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs
2282+
]
2283+
22522284
-- ------------------------------------------------------------
22532285
-- * Other Utils
22542286
-- ------------------------------------------------------------

‎Cabal/Distribution/Simple/ShowBuildInfo.hs

Lines changed: 40 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,9 @@
11
-- |
22
-- This module defines a simple JSON-based format for exporting basic
33
-- 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.
4+
-- would use to build it. This can be produced with the
5+
-- @cabal new-show-build-info@ command.
6+
--
67
--
78
-- This format is intended for consumption by external tooling and should
89
-- therefore be rather stable. Moreover, this allows tooling users to avoid
@@ -13,42 +14,42 @@
1314
-- Below is an example of the output this module produces,
1415
--
1516
-- @
16-
-- { "cabal_version": "1.23.0.0",
17+
-- { "cabal-version": "1.23.0.0",
1718
-- "compiler": {
1819
-- "flavor": "GHC",
19-
-- "compiler_id": "ghc-7.10.2",
20+
-- "compiler-id": "ghc-7.10.2",
2021
-- "path": "/usr/bin/ghc",
2122
-- },
2223
-- "components": [
23-
-- { "type": "library",
24-
-- "name": "CLibName",
25-
-- "compiler_args":
24+
-- { "type": "lib",
25+
-- "name": "lib:Cabal",
26+
-- "compiler-args":
2627
-- ["-O", "-XHaskell98", "-Wall",
2728
-- "-package-id", "parallel-3.2.0.6-b79c38c5c25fff77f3ea7271851879eb"]
2829
-- "modules": ["Project.ModA", "Project.ModB", "Paths_project"],
29-
-- "source_files": [],
30-
-- "source_dirs": ["src"]
30+
-- "src-files": [],
31+
-- "src-dirs": ["src"]
3132
-- }
3233
-- ]
3334
-- }
3435
-- @
3536
--
36-
-- The @cabal_version@ property provides the version of the Cabal library
37+
-- The @cabal-version@ property provides the version of the Cabal library
3738
-- which generated the output. The @compiler@ property gives some basic
3839
-- information about the compiler Cabal would use to compile the package.
3940
--
4041
-- The @components@ property gives a list of the Cabal 'Component's defined by
4142
-- the package. Each has,
4243
--
43-
-- * @type@: the type of the component (one of @library@, @executable@,
44-
-- @test-suite@, or @benchmark@)
44+
-- * @type@: the type of the component (one of @lib@, @exe@,
45+
-- @test@, @bench@, or @flib@)
4546
-- * @name@: a string serving to uniquely identify the component within the
4647
-- package.
47-
-- * @compiler_args@: the command-line arguments Cabal would pass to the
48+
-- * @compiler-args@: the command-line arguments Cabal would pass to the
4849
-- compiler to compile the component
4950
-- * @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
51+
-- * @src-dirs@: a list of directories where the modules might be found
52+
-- * @src-files@: any other Haskell sources needed by the component
5253
--
5354
-- Note: At the moment this is only supported when using the GHC compiler.
5455
--
@@ -69,6 +70,7 @@ import Distribution.Simple.Utils (cabalVersion)
6970
import Distribution.Simple.Utils.Json
7071
import Distribution.Types.TargetInfo
7172
import Distribution.Text
73+
import Distribution.Pretty
7274

7375
-- | Construct a JSON document describing the build information for a package
7476
mkBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file
@@ -83,42 +85,51 @@ mkBuildInfo pkg_descr lbi _flags targetsToBuild = info
8385
k .= v = (k, v)
8486

8587
info = JsonObject
86-
[ "cabal_version" .= JsonString (display cabalVersion)
88+
[ "cabal-version" .= JsonString (display cabalVersion)
8789
, "compiler" .= mkCompilerInfo
8890
, "components" .= JsonArray (map mkComponentInfo componentsToBuild)
8991
]
9092

9193
mkCompilerInfo = JsonObject
92-
[ "flavour" .= JsonString (show $ compilerFlavor $ compiler lbi)
93-
, "compiler_id" .= JsonString (showCompilerId $ compiler lbi)
94+
[ "flavour" .= JsonString (prettyShow $ compilerFlavor $ compiler lbi)
95+
, "compiler-id" .= JsonString (showCompilerId $ compiler lbi)
9496
, "path" .= path
9597
]
9698
where
9799
path = maybe JsonNull (JsonString . programPath)
98-
$ lookupProgram ghcProgram (withPrograms lbi)
100+
$ (flavorToProgram . compilerFlavor $ compiler lbi)
101+
>>= flip lookupProgram (withPrograms lbi)
102+
103+
flavorToProgram :: CompilerFlavor -> Maybe Program
104+
flavorToProgram GHC = Just ghcProgram
105+
flavorToProgram GHCJS = Just ghcjsProgram
106+
flavorToProgram UHC = Just uhcProgram
107+
flavorToProgram JHC = Just jhcProgram
108+
flavorToProgram _ = Nothing
99109

100110
mkComponentInfo (name, clbi) = JsonObject
101111
[ "type" .= JsonString compType
102-
, "name" .= JsonString (show name)
103-
, "compiler_args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi)
112+
, "name" .= JsonString (prettyShow name)
113+
, "unit-id" .= JsonString (prettyShow $ componentUnitId clbi)
114+
, "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi)
104115
, "modules" .= JsonArray (map (JsonString . display) modules)
105-
, "source_files" .= JsonArray (map JsonString source_files)
106-
, "source_dirs" .= JsonArray (map JsonString $ hsSourceDirs bi)
116+
, "src-files" .= JsonArray (map JsonString sourceFiles)
117+
, "src-dirs" .= JsonArray (map JsonString $ hsSourceDirs bi)
107118
]
108119
where
109120
bi = componentBuildInfo comp
110121
Just comp = lookupComponent pkg_descr name
111122
compType = case comp of
112-
CLib _ -> "library"
113-
CExe _ -> "executable"
114-
CTest _ -> "test-suite"
115-
CBench _ -> "benchmark"
116-
CFLib _ -> "foreign-library"
123+
CLib _ -> "lib"
124+
CExe _ -> "exe"
125+
CTest _ -> "test"
126+
CBench _ -> "bench"
127+
CFLib _ -> "flib"
117128
modules = case comp of
118129
CLib lib -> explicitLibModules lib
119130
CExe exe -> exeModules exe
120131
_ -> []
121-
source_files = case comp of
132+
sourceFiles = case comp of
122133
CLib _ -> []
123134
CExe exe -> [modulePath exe]
124135
_ -> []

‎Cabal/Distribution/Simple/UserHooks.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,7 @@ data UserHooks = UserHooks {
6969

7070
-- |Hook to run before build command. Second arg indicates verbosity level.
7171
preBuild :: Args -> BuildFlags -> IO HookedBuildInfo,
72+
7273
-- |Over-ride this hook to get different behavior during build.
7374
buildHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO (),
7475
-- |Hook to run after build command. Second arg indicates verbosity level.

0 commit comments

Comments
 (0)