From 84aa56054c09395416e0c5b37a7c2bce8842f3a4 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Tue, 7 Jul 2020 19:49:31 +0100 Subject: [PATCH] Rework show-build-info to use ProjectPlanning/Building infrastructure This fixes a lot of edge cases for example where the package db wasn't created at the time of configuring. Manually doing the setup.hs wrapper stuff was hairy. It also changes the internal representation of JSON to Text rather than String, and introduces the buildinfo-components-only flag in the Cabal part to make it easier to stitch back the JSON into an array in cabal-install. Turns out we do need to keep the show-build-info part inside Cabal as we rely on LocalBuildInfo which can change between versions, and we would need to do this anyway if we wanted to utilise the ProjectPlanning/Building infrastructure. --- Cabal/Distribution/Simple.hs | 33 ++-- Cabal/Distribution/Simple/Build.hs | 24 ++- Cabal/Distribution/Simple/Setup.hs | 17 +- Cabal/Distribution/Simple/ShowBuildInfo.hs | 50 +++-- Cabal/Distribution/Utils/Json.hs | 69 ++++--- .../Distribution/Client/CmdShowBuildInfo.hs | 182 +++++------------- .../Distribution/Client/ProjectBuilding.hs | 38 +++- .../Client/ProjectBuilding/Types.hs | 9 +- .../Distribution/Client/ProjectPlanning.hs | 22 +++ .../Client/ProjectPlanning/Types.hs | 1 + .../Distribution/Client/SetupWrapper.hs | 2 +- cabal-install/Distribution/Client/Utils.hs | 4 +- .../A/build-info-exe-exact.test.hs | 2 +- ...d-info-multiple-exact-unit-id-file.test.hs | 4 +- .../build-info-multiple-exact-unit-id.test.hs | 4 +- .../A/build-info-multiple-exact.test.hs | 4 +- .../ShowBuildInfo/A/build-info-unknown.out | 1 - .../PackageTests/ShowBuildInfo/A/src/A.hs | 2 +- .../B/build-info-lib-exact.test.hs | 2 +- .../PackageTests/ShowBuildInfo/C/C.cabal | 15 ++ .../PackageTests/ShowBuildInfo/C/Lib.hs | 3 + .../PackageTests/ShowBuildInfo/C/Test.hs | 1 + .../C/build-info-all-internal-deps.out | 1 + .../C/build-info-all-internal-deps.test.hs | 9 + .../ShowBuildInfo/C/cabal.project | 1 + .../ShowBuildInfo/Complex/Complex.cabal | 11 +- .../ShowBuildInfo/Complex/exe.test.hs | 4 +- .../ShowBuildInfo/Complex/lib.test.hs | 4 +- .../PackageTests/ShowBuildInfo/D/D.cabal | 9 + .../PackageTests/ShowBuildInfo/D/D1/D1.cabal | 9 + .../PackageTests/ShowBuildInfo/D/D1/Lib1.hs | 3 + .../PackageTests/ShowBuildInfo/D/Lib.hs | 6 + .../ShowBuildInfo/D/build-info-prune-deps.out | 2 + .../D/build-info-prune-deps.test.hs | 8 + .../ShowBuildInfo/D/cabal.project | 2 + .../src/Test/Cabal/DecodeShowBuildInfo.hs | 5 +- .../src/Test/Cabal/OutputNormalizer.hs | 4 +- 37 files changed, 328 insertions(+), 239 deletions(-) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/C.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/Lib.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/Test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/build-info-all-internal-deps.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/C/cabal.project create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/D1.cabal create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/D1/Lib1.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/Lib.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/build-info-prune-deps.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/D/cabal.project 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..d6e9c73102f 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,36 +83,37 @@ 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' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) - (map (mkComponentInfo pkg_descr lbi . targetCLBI) targetsToBuild) +mkBuildInfo wdir pkg_descr lbi _flags targetsToBuild = + JsonObject $ + mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) + (map (mkComponentInfo wdir pkg_descr lbi . targetCLBI) targetsToBuild) -- | A variant of 'mkBuildInfo' if you need to call 'mkCompilerInfo' and -- 'mkComponentInfo' yourself. mkBuildInfo' :: Json -- ^ The 'Json' from 'mkCompilerInfo' -> [Json] -- ^ The 'Json' from 'mkComponentInfo' - -> Json + -> [(T.Text, 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..489a3b7768b 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 + 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/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index 464452978fd..22ccf021128 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -18,7 +18,7 @@ -- runs it with the given arguments. module Distribution.Client.SetupWrapper ( - getSetup, runSetup, runSetupCommand, setupWrapper, getSetupMethod, + getSetup, runSetup, runSetupCommand, setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions, ) where 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 diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs index ce67115bd44..0fd04817508 100644 --- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs +++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs @@ -84,8 +84,8 @@ removeErrors s = unlines (go (lines s) False) where go [] _ = [] go (x:xs) True - | "cabal:" `isPrefixOf` x = x:(go xs False) - | otherwise = go xs True + | any (`isPrefixOf` x) ["cabal:", "cabal.exe:"] = x:(go xs False) + | otherwise = go xs True go (x:xs) False | "exited with an error" `isInfixOf` x = x:(go xs True) | otherwise = x:(go xs False)