diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index 5543765a10d..156ce1180bf 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -108,6 +108,8 @@ 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. @@ -265,31 +267,34 @@ buildAction hooks flags args = do 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 +showBuildInfoAction hooks flags args = do + let buildFlags = buildInfoBuildFlags flags + distPref <- findDistPrefOrDefault (buildDistPref buildFlags) + let verbosity = fromFlag $ buildVerbosity buildFlags lbi <- getBuildConfig hooks verbosity distPref - let flags' = flags { buildDistPref = toFlag distPref - , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) - } + let buildFlags' = + buildFlags { buildDistPref = toFlag distPref + , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) + } progs <- reconfigurePrograms verbosity - (buildProgramPaths flags') - (buildProgramArgs flags') + (buildProgramPaths buildFlags') + (buildProgramArgs buildFlags') (withPrograms lbi) - pbi <- preBuild hooks args flags' + 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? - buildInfoString <- showBuildInfo pkg_descr lbi' flags - case fileOutput of - Nothing -> putStr buildInfoString - Just fp -> writeFile fp buildInfoString + buildInfoText <- showBuildInfo pkg_descr lbi' flags + + case buildInfoOutputFile flags of + Nothing -> T.putStr buildInfoText + Just fp -> T.writeFile fp buildInfoText - postBuild hooks args flags' pkg_descr lbi' + postBuild hooks args buildFlags' pkg_descr lbi' replAction :: UserHooks -> ReplFlags -> Args -> IO () replAction hooks flags args = do diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index 671ab8564cd..c38e47d8fea 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -89,6 +89,7 @@ import Control.Monad import qualified Data.Set as Set import System.FilePath ( (), (<.>), takeDirectory ) import System.Directory ( getCurrentDirectory ) +import qualified Data.Text as Text -- ----------------------------------------------------------------------------- -- |Build the libraries and executables in this package. @@ -133,15 +134,24 @@ 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 String + -> LocalBuildInfo -- ^ Configuration information + -> ShowBuildInfoFlags -- ^ Flags that the user passed to build + -> IO Text.Text showBuildInfo pkg_descr lbi flags = do - let verbosity = fromFlag (buildVerbosity flags) - targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags) + 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) - doc = mkBuildInfo pkg_descr lbi flags targetsToBuild - return $ renderJson doc "" + 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 repl :: PackageDescription -- ^ Mostly information from the .cabal file diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 4f1e06e0b73..a03c0cf0f35 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -2217,15 +2217,18 @@ optionNumJobs get set = -- ------------------------------------------------------------ data ShowBuildInfoFlags = ShowBuildInfoFlags - { buildInfoBuildFlags :: BuildFlags - , buildInfoOutputFile :: Maybe FilePath + { 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 + { buildInfoBuildFlags = defaultBuildFlags + , buildInfoOutputFile = Nothing + , buildInfoComponentsOnly = Flag False } showBuildInfoCommand :: ProgramDb -> CommandUI ShowBuildInfoFlags @@ -2262,8 +2265,12 @@ showBuildInfoCommand progDb = CommandUI ++ [ option [] ["buildinfo-json-output"] "Write the result to the given file instead of stdout" - buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) + 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 ] } diff --git a/Cabal/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs index b831d8c9172..f3d3a690617 100644 --- a/Cabal/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/Distribution/Simple/ShowBuildInfo.hs @@ -54,9 +54,13 @@ -- Note: At the moment this is only supported when using the GHC compiler. -- +{-# LANGUAGE OverloadedStrings #-} + module Distribution.Simple.ShowBuildInfo ( mkBuildInfo, mkBuildInfo', mkCompilerInfo, mkComponentInfo ) where +import qualified Data.Text as T + import Distribution.Compat.Prelude import Prelude () @@ -79,14 +83,15 @@ import Distribution.Pretty -- | Construct a JSON document describing the build information for a -- package. mkBuildInfo - :: PackageDescription -- ^ Mostly information from the .cabal file + :: FilePath -- ^ The source directory of the package + -> PackageDescription -- ^ Mostly information from the .cabal file -> LocalBuildInfo -- ^ Configuration information -> BuildFlags -- ^ Flags that the user passed to build -> [TargetInfo] -> Json -mkBuildInfo pkg_descr lbi _flags targetsToBuild = +mkBuildInfo wdir pkg_descr lbi _flags targetsToBuild = mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) - (map (mkComponentInfo pkg_descr lbi . targetCLBI) targetsToBuild) + (map (mkComponentInfo wdir pkg_descr lbi . targetCLBI) targetsToBuild) -- | A variant of 'mkBuildInfo' if you need to call 'mkCompilerInfo' and -- 'mkComponentInfo' yourself. @@ -96,19 +101,19 @@ mkBuildInfo' -> Json mkBuildInfo' cmplrInfo componentInfos = JsonObject - [ "cabal-version" .= JsonString (display cabalVersion) + [ "cabal-version" .= JsonString (T.pack (display cabalVersion)) , "compiler" .= cmplrInfo , "components" .= JsonArray componentInfos ] mkCompilerInfo :: ProgramDb -> Compiler -> Json mkCompilerInfo programDb cmplr = JsonObject - [ "flavour" .= JsonString (prettyShow $ compilerFlavor cmplr) - , "compiler-id" .= JsonString (showCompilerId cmplr) + [ "flavour" .= JsonString (T.pack (prettyShow $ compilerFlavor cmplr)) + , "compiler-id" .= JsonString (T.pack (showCompilerId cmplr)) , "path" .= path ] where - path = maybe JsonNull (JsonString . programPath) + path = maybe JsonNull (JsonString . T.pack . programPath) $ (flavorToProgram . compilerFlavor $ cmplr) >>= flip lookupProgram programDb @@ -119,16 +124,17 @@ mkCompilerInfo programDb cmplr = JsonObject flavorToProgram JHC = Just jhcProgram flavorToProgram _ = Nothing -mkComponentInfo :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json -mkComponentInfo pkg_descr lbi clbi = JsonObject +mkComponentInfo :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json +mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $ [ "type" .= JsonString compType - , "name" .= JsonString (prettyShow name) - , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) + , "name" .= JsonString (T.pack $ prettyShow name) + , "unit-id" .= JsonString (T.pack $ prettyShow $ componentUnitId clbi) , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) - , "modules" .= JsonArray (map (JsonString . display) modules) - , "src-files" .= JsonArray (map JsonString sourceFiles) - , "src-dirs" .= JsonArray (map JsonString $ hsSourceDirs bi) - ] + , "modules" .= JsonArray (map (JsonString . T.pack . display) modules) + , "src-files" .= JsonArray (map (JsonString . T.pack) sourceFiles) + , "hs-src-dirs" .= JsonArray (map (JsonString . T.pack) $ hsSourceDirs bi) + , "src-dir" .= JsonString (T.pack wdir) + ] <> cabalFile where name = componentLocalName clbi bi = componentBuildInfo comp @@ -147,6 +153,9 @@ mkComponentInfo pkg_descr lbi clbi = JsonObject CLib _ -> [] CExe exe -> [modulePath exe] _ -> [] + cabalFile + | Just fp <- pkgDescrFile lbi = [("cabal-file", JsonString (T.pack fp))] + | otherwise = [] -- | Get the command-line arguments that would be passed -- to the compiler to build the given component. @@ -154,7 +163,7 @@ getCompilerArgs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo - -> [String] + -> [T.Text] getCompilerArgs bi lbi clbi = case compilerFlavor $ compiler lbi of GHC -> ghc @@ -163,6 +172,7 @@ getCompilerArgs bi lbi clbi = "build arguments for compiler "++show c where -- This is absolutely awful - ghc = GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts + ghc = T.pack <$> + GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts where baseOpts = GHC.componentGhcOptions normal lbi bi clbi (buildDir lbi) diff --git a/Cabal/Distribution/Utils/Json.hs b/Cabal/Distribution/Utils/Json.hs index ba918b74880..15573c9c05a 100644 --- a/Cabal/Distribution/Utils/Json.hs +++ b/Cabal/Distribution/Utils/Json.hs @@ -1,50 +1,65 @@ --- | Extremely simple JSON helper. Don't do anything too fancy with this! +{-# LANGUAGE OverloadedStrings #-} +-- | Extremely simple JSON helper. Don't do anything too fancy with this! module Distribution.Utils.Json ( Json(..) , (.=) , renderJson ) where +import Data.Text (Text) +import qualified Data.Text as Text + data Json = JsonArray [Json] | JsonBool !Bool | JsonNull | JsonNumber !Int - | JsonObject [(String, Json)] - | JsonString !String + | JsonObject [(Text, Json)] + | JsonRaw !Text + | JsonString !Text -renderJson :: Json -> ShowS +-- | A type to mirror 'ShowS' +type ShowT = Text -> Text + +renderJson :: Json -> ShowT renderJson (JsonArray objs) = surround "[" "]" $ intercalate "," $ map renderJson objs -renderJson (JsonBool True) = showString "true" -renderJson (JsonBool False) = showString "false" -renderJson JsonNull = showString "null" -renderJson (JsonNumber n) = shows n +renderJson (JsonBool True) = showText "true" +renderJson (JsonBool False) = showText "false" +renderJson JsonNull = showText "null" +renderJson (JsonNumber n) = showText $ Text.pack (show 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 - -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 + render (k,v) = (surround "\"" "\"" $ showText' k) . showText ":" . renderJson v +renderJson (JsonString s) = surround "\"" "\"" $ showText' s +renderJson (JsonRaw s) = showText s + +surround :: Text -> Text -> ShowT -> ShowT +surround begin end middle = showText begin . middle . showText end + +showText :: Text -> ShowT +showText = (<>) + +showText' :: Text -> ShowT +showText' xs = showStringWorker xs + where + showStringWorker :: Text -> ShowT + showStringWorker t = + case Text.uncons t of + Just ('\r', as) -> showText "\\r" . showStringWorker as + Just ('\n', as) -> showText "\\n" . showStringWorker as + Just ('\"', as) -> showText "\\\"" . showStringWorker as + Just ('\\', as) -> showText "\\\\" . showStringWorker as + Just (x, as) -> showText (Text.singleton x) . showStringWorker as + Nothing -> showText "" + +intercalate :: Text -> [ShowT] -> ShowT intercalate sep = go where go [] = id go [x] = x - go (x:xs) = x . showString' sep . go xs + go (x:xs) = x . showText' sep . go xs -(.=) :: String -> Json -> (String, Json) +(.=) :: Text -> Json -> (Text, Json) k .= v = (k, v) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 52dd6e5d957..7c38cd17e15 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, OverloadedStrings #-} -- | cabal-install CLI command: show-build-info -- module Distribution.Client.CmdShowBuildInfo ( @@ -8,7 +8,7 @@ module Distribution.Client.CmdShowBuildInfo ( ) where import Distribution.Client.Compat.Prelude - ( when, find, fromMaybe ) + (catMaybes, fromMaybe ) import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.TargetProblem @@ -21,52 +21,30 @@ import Distribution.Simple.Setup import Distribution.Simple.Command ( CommandUI(..), option, reqArg', usageAlternatives ) import Distribution.Verbosity - ( Verbosity, silent ) + (Verbosity, silent ) import Distribution.Simple.Utils - ( wrapText, die' ) + (wrapText, die' ) import Distribution.Types.UnitId - ( UnitId, mkUnitId ) -import Distribution.Types.Version - ( mkVersion ) -import Distribution.Types.PackageDescription - ( buildType ) + ( mkUnitId ) import Distribution.Pretty ( prettyShow ) import qualified Data.Map as Map import qualified Distribution.Simple.Setup as Cabal -import Distribution.Client.SetupWrapper -import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Client.ProjectBuilding.Types import Distribution.Client.ProjectPlanning.Types -import Distribution.Client.ProjectPlanning - ( setupHsConfigureFlags, setupHsConfigureArgs, setupHsBuildFlags - , setupHsScriptOptions ) import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.DistDirLayout - ( distBuildDirectory ) -import Distribution.Client.Types - ( PackageLocation(..), GenericReadyPackage(..) ) -import Distribution.Client.JobControl - ( newLock, Lock ) -import Distribution.Simple.Configure - (getPersistBuildConfig, tryGetPersistBuildConfig ) + (distProjectRootDirectory ) import Distribution.Simple.ShowBuildInfo import Distribution.Utils.Json -import Distribution.Simple.BuildTarget - ( readTargetInfos ) -import Distribution.Types.LocalBuildInfo - ( neededTargetsInBuildOrder' ) -import Distribution.Compat.Graph - ( IsNode(nodeKey) ) -import Distribution.Simple.Setup - ( BuildFlags(..) ) -import Distribution.Types.TargetInfo - ( TargetInfo(..) ) -import Distribution.Simple.Build - ( componentInitialBuildSteps ) +import Control.Monad (forM_, unless) +import Data.Either +import qualified Data.Text as T +import qualified Data.Text.IO as T showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) showBuildInfoCommand = CommandUI { @@ -113,7 +91,7 @@ defaultShowBuildInfoFlags = ShowBuildInfoFlags -- configuration used to build it as JSON, that can be used by other tooling. -- See "Distribution.Simple.ShowBuildInfo" for more information. showBuildInfoAction :: NixStyleFlags ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () -showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileOutput unitIds), ..} +showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileOutput unitIdStrs), ..} targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand let baseCtx' = baseCtx @@ -127,7 +105,8 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do -- Interpret the targets on the command line as build targets -- (as opposed to say repl or haddock targets). - targets <- either (reportShowBuildInfoTargetProblems verbosity) return + + targets' <- either (reportShowBuildInfoTargetProblems verbosity) return $ resolveTargets selectPackageTargets selectComponentTarget @@ -135,114 +114,59 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO Nothing targetSelectors - let elaboratedPlan' = pruneInstallPlanToTargets - TargetActionBuild + let unitIds = map mkUnitId <$> unitIdStrs + + -- Check that all the unit ids exist + forM_ (fromMaybe [] unitIds) $ \ui -> + unless (Map.member ui targets') $ + die' verbosity ("No unit " ++ prettyShow ui) + + -- Filter out targets that aren't in the specified unit ids + let targets = Map.filterWithKey (\k _ -> maybe True (elem k) unitIds) targets' + elaboratedPlan' = pruneInstallPlanToTargets + TargetActionBuildInfo targets elaboratedPlan - -- This will be the build plan for building the dependencies required. - elaboratedPlan'' <- either (die' verbosity . renderCannotPruneDependencies) return - $ pruneInstallPlanToDependencies - (Map.keysSet targets) elaboratedPlan' - - return (elaboratedPlan'', targets) + return (elaboratedPlan', targets) buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes - scriptLock <- newLock - showTargets fileOutput unitIds verbosity baseCtx' buildCtx scriptLock - where - -- Default to silent verbosity otherwise it will pollute our json output - verbosity = fromFlagOrDefault silent (configVerbosity configFlags) - -- Also shut up haddock since it dumps warnings to stdout - flags' = flags { haddockFlags = haddockFlags { haddockVerbosity = Flag silent } } - cliConfig = commandLineFlagsToProjectConfig globalFlags flags' - mempty -- ClientInstallFlags, not needed here - -showTargets :: Maybe FilePath -> Maybe [String] -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () -showTargets fileOutput unitIds verbosity baseCtx buildCtx lock = do + -- We can ignore the errors here, since runProjectPostBuildPhase should + -- have already died and reported them if they exist + let (_errs, buildResults) = partitionEithers $ Map.elems buildOutcomes - -- TODO: can we use --disable-per-component so that we only get one package? - let configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] - targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds + let componentBuildInfos = + concatMap T.lines $ -- Component infos are returned each on a newline + catMaybes (buildResultBuildInfo <$> buildResults) - components <- concat <$> mapM (getComponentInfo verbosity baseCtx buildCtx - lock configured) targets + let compilerInfo = mkCompilerInfo + (pkgConfigCompilerProgs (elaboratedShared buildCtx)) + (pkgConfigCompiler (elaboratedShared buildCtx)) - let compilerInfo = mkCompilerInfo (pkgConfigCompilerProgs (elaboratedShared buildCtx)) - (pkgConfigCompiler (elaboratedShared buildCtx)) - - json = mkBuildInfo' compilerInfo components + components = map JsonRaw componentBuildInfos + JsonObject fields = mkBuildInfo' compilerInfo components + json = JsonObject $ fields <> + [ ("project-root", JsonString (T.pack (distProjectRootDirectory (distDirLayout baseCtx)))) + ] res = renderJson json "" case fileOutput of - Nothing -> putStrLn res - Just fp -> writeFile fp res - -getComponentInfo :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO [Json] -getComponentInfo verbosity baseCtx buildCtx lock pkgs targetUnitId = - case mbPkg of - Nothing -> die' verbosity $ "No unit " ++ prettyShow targetUnitId - Just pkg -> do - let shared = elaboratedShared buildCtx - install = elaboratedPlanOriginal buildCtx - dirLayout = distDirLayout baseCtx - buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) - buildType' = buildType (elabPkgDescription pkg) - flags = setupHsBuildFlags pkg shared verbosity buildDir - srcDir = case (elabPkgSourceLocation pkg) of - LocalUnpackedPackage fp -> fp - _ -> "" - scriptOptions = setupHsScriptOptions - (ReadyPackage pkg) - install - shared - dirLayout - srcDir - buildDir - False - lock - configureFlags = setupHsConfigureFlags (ReadyPackage pkg) shared verbosity buildDir - configureArgs = setupHsConfigureArgs pkg - - -- Check cabal version is correct - (cabalVersion, _, _) <- getSetupMethod verbosity scriptOptions - (elabPkgDescription pkg) buildType' - when (cabalVersion < mkVersion [3, 0, 0, 0]) - ( die' verbosity $ "Only a Cabal version >= 3.0.0.0 is supported for this command.\n" - ++ "Found version: " ++ prettyShow cabalVersion ++ "\n" - ++ "For component: " ++ prettyShow targetUnitId - ) - -- Configure the package if there's no existing config - lbi' <- tryGetPersistBuildConfig buildDir - case lbi' of - Left _ -> setupWrapper - verbosity - scriptOptions - (Just $ elabPkgDescription pkg) - (Cabal.configureCommand - (pkgConfigCompilerProgs (elaboratedShared buildCtx))) - (const configureFlags) - (const configureArgs) - Right _ -> pure () - - -- Do the bit the Cabal library would normally do here - lbi <- getPersistBuildConfig buildDir - let pkgDesc = elabPkgDescription pkg - targets <- readTargetInfos verbosity pkgDesc lbi (buildArgs flags) - let targetsToBuild = neededTargetsInBuildOrder' pkgDesc lbi (map nodeKey targets) - - -- generate autogen files which will be needed by tooling - flip mapM_ targetsToBuild $ \target -> - componentInitialBuildSteps (Cabal.fromFlag (buildDistPref flags)) - pkgDesc lbi (targetCLBI target) verbosity - - return $ map (mkComponentInfo pkgDesc lbi . targetCLBI) targetsToBuild + Nothing -> T.putStrLn res + Just fp -> T.writeFile fp res - where - mbPkg :: Maybe ElaboratedConfiguredPackage - mbPkg = find ((targetUnitId ==) . elabUnitId) pkgs + where + -- Default to silent verbosity otherwise it will pollute our json output + verbosity = fromFlagOrDefault silent (configVerbosity configFlags) + -- Also shut up haddock since it dumps warnings to stdout + flags' = flags { haddockFlags = haddockFlags { haddockVerbosity = Flag silent } + , configFlags = configFlags { Cabal.configTests = Flag True + , Cabal.configBenchmarks = Flag True + } + } + cliConfig = commandLineFlagsToProjectConfig globalFlags flags' + mempty -- ClientInstallFlags, not needed here -- | This defines what a 'TargetSelector' means for the @show-build-info@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 134e2249999..24b3299c134 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -97,6 +97,7 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text.IO as T import Control.Exception (Handler (..), SomeAsyncException, assert, catches, handle) import System.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removeFile, renameDirectory) @@ -456,9 +457,10 @@ checkPackageFileMonitorChanged PackageFileMonitor{..} (MonitorUnchanged buildResult _, MonitorUnchanged _ _) -> return $ Right BuildResult { - buildResultDocs = docsResult, - buildResultTests = testsResult, - buildResultLogFile = Nothing + buildResultDocs = docsResult, + buildResultTests = testsResult, + buildResultLogFile = Nothing, + buildResultBuildInfo = Nothing } where (docsResult, testsResult) = buildResult @@ -1052,9 +1054,10 @@ buildAndInstallUnpackedPackage verbosity noticeProgress ProgressCompleted return BuildResult { - buildResultDocs = docsResult, - buildResultTests = testsResult, - buildResultLogFile = mlogFile + buildResultDocs = docsResult, + buildResultTests = testsResult, + buildResultLogFile = mlogFile, + buildResultBuildInfo = Nothing } where @@ -1299,10 +1302,23 @@ buildInplaceUnpackedPackage verbosity Tar.createTarGzFile dest docDir name notice verbosity $ "Documentation tarball created: " ++ dest + -- Build info phase + buildInfo <- whenBuildInfo $ + -- Write the json to a temporary file to read it, since stdout can get + -- cluttered + withTempDirectory verbosity distTempDirectory "build-info" $ \dir -> do + let fp = dir "out" + setupInteractive + buildInfoCommand + (\v -> (buildInfoFlags v) { Cabal.buildInfoOutputFile = Just fp }) + buildInfoArgs + Just <$> T.readFile fp + return BuildResult { buildResultDocs = docsResult, buildResultTests = testsResult, - buildResultLogFile = Nothing + buildResultLogFile = Nothing, + buildResultBuildInfo = buildInfo } where @@ -1340,6 +1356,10 @@ buildInplaceUnpackedPackage verbosity | hasValidHaddockTargets pkg = action | otherwise = return () + whenBuildInfo action + | null (elabBuildInfoTargets pkg) = return Nothing + | otherwise = action + whenReRegister action = case buildStatus of -- We registered the package already @@ -1384,6 +1404,10 @@ buildInplaceUnpackedPackage verbosity haddockArgs v = flip filterHaddockArgs v $ setupHsHaddockArgs pkg + buildInfoCommand = Cabal.showBuildInfoCommand defaultProgramDb + buildInfoFlags _ = setupHsShowBuildInfoFlags pkg pkgshared verbosity builddir + buildInfoArgs _ = setupHsShowBuildInfoArgs pkg + scriptOptions = setupHsScriptOptions rpkg plan pkgshared distDirLayout srcdir builddir isParallelBuild cacheLock diff --git a/cabal-install/Distribution/Client/ProjectBuilding/Types.hs b/cabal-install/Distribution/Client/ProjectBuilding/Types.hs index f9ac571f3b6..65fc6149ba5 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding/Types.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding/Types.hs @@ -32,6 +32,8 @@ import Distribution.Package (UnitId, PackageId) import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Simple.LocalBuildInfo (ComponentName) +import Data.Text (Text) + ------------------------------------------------------------------------------ -- Pre-build status: result of the dry run @@ -173,9 +175,10 @@ type BuildOutcome = Either BuildFailure BuildResult -- | Information arising from successfully building a single package. -- data BuildResult = BuildResult { - buildResultDocs :: DocsResult, - buildResultTests :: TestsResult, - buildResultLogFile :: Maybe FilePath + buildResultDocs :: DocsResult, + buildResultTests :: TestsResult, + buildResultLogFile :: Maybe FilePath, + buildResultBuildInfo :: Maybe Text } deriving Show diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index f331b6eff18..351553f1cca 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -57,6 +57,8 @@ module Distribution.Client.ProjectPlanning ( setupHsRegisterFlags, setupHsHaddockFlags, setupHsHaddockArgs, + setupHsShowBuildInfoFlags, + setupHsShowBuildInfoArgs, packageHashInputs, @@ -1776,6 +1778,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabBenchTargets = [] elabReplTarget = Nothing elabHaddockTargets = [] + elabBuildInfoTargets = [] elabBuildHaddocks = perPkgOptionFlag pkgid False packageConfigDocumentation @@ -2565,6 +2568,7 @@ data TargetAction = TargetActionConfigure | TargetActionTest | TargetActionBench | TargetActionHaddock + | TargetActionBuildInfo -- | Given a set of per-package\/per-component targets, take the subset of the -- install plan needed to build those targets. Also, update the package config @@ -2642,6 +2646,7 @@ setRootTargets targetAction perPkgTargetsMap = (Just tgts, TargetActionHaddock) -> foldr setElabHaddockTargets (elab { elabHaddockTargets = tgts , elabBuildHaddocks = True }) tgts + (Just tgts, TargetActionBuildInfo) -> elab { elabBuildInfoTargets = tgts } (Just _, TargetActionRepl) -> error "pruneInstallPlanToTargets: multiple repl targets" @@ -2684,6 +2689,7 @@ pruneInstallPlanPass1 pkgs = , null (elabBenchTargets elab) , isNothing (elabReplTarget elab) , null (elabHaddockTargets elab) + , null (elabBuildInfoTargets elab) ] then Just (installedUnitId elab) else Nothing @@ -3594,6 +3600,22 @@ setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String] setupHsHaddockArgs elab = map (showComponentTarget (packageId elab)) (elabHaddockTargets elab) +setupHsShowBuildInfoFlags :: ElaboratedConfiguredPackage + -> ElaboratedSharedConfig + -> Verbosity + -> FilePath + -> Cabal.ShowBuildInfoFlags +setupHsShowBuildInfoFlags pkg config verbosity builddir = + Cabal.ShowBuildInfoFlags { + buildInfoBuildFlags = setupHsBuildFlags pkg config verbosity builddir, + buildInfoOutputFile = Nothing, + buildInfoComponentsOnly = toFlag True + } + +setupHsShowBuildInfoArgs :: ElaboratedConfiguredPackage -> [String] +setupHsShowBuildInfoArgs elab = + map (showComponentTarget (packageId elab)) (elabBuildInfoTargets elab) + {- setupHsTestFlags :: ElaboratedConfiguredPackage -> ElaboratedSharedConfig diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 1d0e1c5d0ab..bf379a42035 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -317,6 +317,7 @@ data ElaboratedConfiguredPackage elabBenchTargets :: [ComponentTarget], elabReplTarget :: Maybe ComponentTarget, elabHaddockTargets :: [ComponentTarget], + elabBuildInfoTargets :: [ComponentTarget], elabBuildHaddocks :: Bool, diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs index 0ff2aa1c45a..43e49419c3b 100644 --- a/cabal-install/Distribution/Client/Utils.hs +++ b/cabal-install/Distribution/Client/Utils.hs @@ -104,8 +104,8 @@ removeExistingFile path = do -- it will clean up the file afterwards, it's lenient if the file is -- moved\/deleted. -- -withTempFileName :: FilePath - -> String +withTempFileName :: FilePath -- ^ Directory to create file in + -> String -- ^ Template for the file name -> (FilePath -> IO a) -> IO a withTempFileName tmpDir template action = Exception.bracket diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs index b027fcc15f7..66c0d3bfd32 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs @@ -15,4 +15,4 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" [] (componentModules component) assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs index 8e40ea9bfad..1c710f65022 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs @@ -23,7 +23,7 @@ main = cabalTest $ withSourceCopy $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" [] (componentModules component) assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) assertLib :: ComponentInfo -> TestM () assertLib component = do @@ -33,4 +33,4 @@ main = cabalTest $ withSourceCopy $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs index 252f211d1d6..0816c11abd3 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs @@ -19,7 +19,7 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" [] (componentModules component) assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) assertLib :: ComponentInfo -> TestM () assertLib component = do @@ -29,4 +29,4 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs index 35f0fb18547..880fe8ac71b 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs @@ -19,7 +19,7 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" [] (componentModules component) assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) assertLib :: ComponentInfo -> TestM () assertLib component = do @@ -29,4 +29,4 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out index 5f6512b4dc9..72752bfec16 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out @@ -5,7 +5,6 @@ cabal: Internal error in target matching. It should always be possible to find a Resolving dependencies... cabal: No unit B-inplace-0.1.0.0 # cabal show-build-info -Configuring library for A-0.1.0.0.. cabal: No unit B-inplace-0.1.0.0 # cabal show-build-info cabal: Internal error in target matching. It should always be possible to find a syntax that's sufficiently qualified to give an unambiguous match. However when matching 'exe:B' we found exe:B (unknown-component) which does not have an unambiguous syntax. The possible syntax and the targets they match are as follows: diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs index ad7a0c07729..6b02eec8ec0 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs @@ -1,4 +1,4 @@ module A where foo :: Int -> Int -foo = id \ No newline at end of file +foo = id diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs index c9aa76a41ab..c836df828ca 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs @@ -15,4 +15,4 @@ main = cabalTest $ do assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) assertEqual "Component modules" ["A"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal new file mode 100644 index 00000000000..6fe31714e7a --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.4 +name: C +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: Lib + build-depends: base + default-language: Haskell2010 + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base, C + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs new file mode 100644 index 00000000000..12f5889322c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs @@ -0,0 +1,3 @@ +module Lib where + +f = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs new file mode 100644 index 00000000000..76a9bdb5d48 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs @@ -0,0 +1 @@ +main = pure () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs new file mode 100644 index 00000000000..db3e0adfd2b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["-v0"] + let comps = components buildInfo + assertEqual "Components, exactly three" 2 (length comps) + assertEqual "Test components, exactly one" 1 $ + length $ filter (\c -> "test" == componentType c) comps diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal index db2a4c566d8..b104678143d 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal @@ -8,7 +8,7 @@ library hs-source-dirs: src default-language: Haskell2010 exposed-modules: Lib - other-modules: Paths_complex + other-modules: Paths_Complex ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall @@ -17,32 +17,31 @@ executable Complex build-depends: base hs-source-dirs: src default-language: Haskell2010 - other-modules: Paths_complex + other-modules: Paths_Complex ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wredundant-constraints -with-rtsopts=-T test-suite unit-test type: exitcode-stdio-1.0 hs-source-dirs: test - build-depends: hspec + build-depends: base main-is: Main.hs test-suite func-test type: exitcode-stdio-1.0 hs-source-dirs: test - build-depends: hspec + build-depends: base main-is: Main.hs benchmark complex-benchmarks type: exitcode-stdio-1.0 main-is: Main.hs other-modules: - Paths_complex + Paths_Complex hs-source-dirs: benchmark ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N build-depends: base - , criterion , Complex default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs index 9d8cae95961..990bd65bcb2 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -29,6 +29,6 @@ main = cabalTest $ do [ "-Wall" ] ) - assertEqual "Component modules" ["Paths_complex"] (componentModules component) + assertEqual "Component modules" ["Paths_Complex"] (componentModules component) assertEqual "Component source files" ["Main.lhs"] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs index 0cae3329d62..51eaf075e6e 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -28,6 +28,6 @@ main = cabalTest $ do [ "-Wredundant-constraints" ] ) - assertEqual "Component modules" ["Lib", "Paths_complex"] (componentModules component) + assertEqual "Component modules" ["Lib", "Paths_Complex"] (componentModules component) assertEqual "Component source files" [] (componentSrcFiles component) - assertEqual "Component source directories" ["src"] (componentSrcDirs component) + assertEqual "Component source directories" ["src"] (componentHsSrcDirs component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal new file mode 100644 index 00000000000..0af36bee5bb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.4 +name: D +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: Lib + build-depends: base, D1 + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal new file mode 100644 index 00000000000..09118f6e84e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal @@ -0,0 +1,9 @@ +cabal-version: 2.4 +name: D1 +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: Lib1 + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs new file mode 100644 index 00000000000..50919006b5f --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs @@ -0,0 +1,3 @@ +module Lib1 where + +bar = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs new file mode 100644 index 00000000000..638711c17e5 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs @@ -0,0 +1,6 @@ +module Lib where + +-- Point of this is to make sure we can still get the build info even if one of +-- the components doesn't compile +foo :: String +foo = 42 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out new file mode 100644 index 00000000000..8a876417a2c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out @@ -0,0 +1,2 @@ +# cabal clean +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs new file mode 100644 index 00000000000..e3c0edb3651 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs @@ -0,0 +1,8 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + -- Make sure the vendored dependency D1 gets built + cabal' "clean" [] + r <- cabal' "show-build-info" ["-v1", "D", "D1"] + assertOutputContains "Building library for D1-0.1.0.0.." r + assertOutputDoesNotContain "Building library for D-0.1.0.0.." r diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project new file mode 100644 index 00000000000..e7083db0d01 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project @@ -0,0 +1,2 @@ +packages: . + ./D1 diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs index 35bbc5fb2a8..5b33be70a7d 100644 --- a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs +++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs @@ -42,8 +42,9 @@ data ComponentInfo = ComponentInfo , componentUnitId :: String , componentCompilerArgs :: [String] , componentModules :: [String] - , componentSrcFiles :: [String] - , componentSrcDirs :: [String] + , componentSrcFiles :: [FilePath] + , componentHsSrcDirs :: [FilePath] + , componentSrcDir :: FilePath } deriving (Generic, Show) instance ToJSON BuildInfo where