From de2a4d6f62cbf09ab9f6bda142599817ab6c7469 Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Wed, 3 Jun 2020 15:54:49 +0100 Subject: [PATCH] Rework show-build-info command to avoid wrapper This means that cabal-install now extracts the LocalBuildInfo etc. itself for each component, and now assembles the JSON without the need for writing to temporary files. It also means that one build info JSON object can be returned instead of an array. It works by configuring each component separately as before, and instead of making its own build info object, it just collects the component information. This one build info object now reports the compiler used with the ElaboratedSharedConfig, which is shared across all components. --- Cabal/Cabal.cabal | 4 +- Cabal/Distribution/Simple/Build.hs | 2 +- Cabal/Distribution/Simple/ShowBuildInfo.hs | 117 ++++++++++-------- Cabal/Distribution/{Simple => }/Utils/Json.hs | 10 +- .../Distribution/Client/CmdShowBuildInfo.hs | 117 ++++++------------ .../PackageTests/ShowBuildInfo/A/A.cabal | 11 +- .../ShowBuildInfo/A/build-info-all.out | 1 + .../ShowBuildInfo/A/build-info-all.test.hs | 9 ++ .../A/build-info-exe-exact.test.hs | 4 +- ...d-info-multiple-exact-unit-id-file.test.hs | 30 ++--- .../build-info-multiple-exact-unit-id.test.hs | 29 ++--- .../A/build-info-multiple-exact.test.hs | 29 ++--- .../PackageTests/ShowBuildInfo/A/src/Test.hs | 1 + .../B/build-info-lib-exact.test.hs | 4 +- .../ShowBuildInfo/Complex/exe.test.hs | 4 +- .../ShowBuildInfo/Complex/lib.test.hs | 4 +- .../src/Test/Cabal/DecodeShowBuildInfo.hs | 4 +- 17 files changed, 169 insertions(+), 211 deletions(-) rename Cabal/Distribution/{Simple => }/Utils/Json.hs (89%) create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs create mode 100644 cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 590c6e177ad..951cafbf26a 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -506,6 +506,7 @@ library Distribution.Utils.NubList Distribution.Utils.ShortText Distribution.Utils.Progress + Distribution.Utils.Json Distribution.Verbosity Distribution.Verbosity.Internal Distribution.Version @@ -585,7 +586,6 @@ library Distribution.Simple.GHC.EnvironmentParser Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo - Distribution.Simple.Utils.Json Distribution.ZinzaPrelude Paths_Cabal @@ -665,7 +665,7 @@ test-suite unit-tests Distribution.Described Distribution.Utils.CharSet Distribution.Utils.GrammarRegex - + main-is: UnitTests.hs build-depends: array, diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index c7e5ebfdb92..671ab8564cd 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -31,6 +31,7 @@ module Distribution.Simple.Build ( import Prelude () import Distribution.Compat.Prelude import Distribution.Utils.Generic +import Distribution.Utils.Json import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ComponentRequestedSpec @@ -76,7 +77,6 @@ import Distribution.Simple.Configure import Distribution.Simple.Register import Distribution.Simple.Test.LibV09 import Distribution.Simple.Utils -import Distribution.Simple.Utils.Json import Distribution.System import Distribution.Pretty diff --git a/Cabal/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs index b0bb0e16093..b831d8c9172 100644 --- a/Cabal/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/Distribution/Simple/ShowBuildInfo.hs @@ -54,7 +54,8 @@ -- Note: At the moment this is only supported when using the GHC compiler. -- -module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where +module Distribution.Simple.ShowBuildInfo + ( mkBuildInfo, mkBuildInfo', mkCompilerInfo, mkComponentInfo ) where import Distribution.Compat.Prelude import Prelude () @@ -70,7 +71,7 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program import Distribution.Simple.Setup import Distribution.Simple.Utils (cabalVersion) -import Distribution.Simple.Utils.Json +import Distribution.Utils.Json import Distribution.Types.TargetInfo import Distribution.Text import Distribution.Pretty @@ -83,63 +84,69 @@ mkBuildInfo -> BuildFlags -- ^ Flags that the user passed to build -> [TargetInfo] -> Json -mkBuildInfo pkg_descr lbi _flags targetsToBuild = info - where - targetToNameAndLBI target = - (componentLocalName $ targetCLBI target, targetCLBI target) - componentsToBuild = map targetToNameAndLBI targetsToBuild - (.=) :: String -> Json -> (String, Json) - k .= v = (k, v) +mkBuildInfo pkg_descr lbi _flags targetsToBuild = + mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) + (map (mkComponentInfo pkg_descr lbi . targetCLBI) targetsToBuild) - info = JsonObject - [ "cabal-version" .= JsonString (display cabalVersion) - , "compiler" .= mkCompilerInfo - , "components" .= JsonArray (map mkComponentInfo componentsToBuild) - ] +-- | 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 +mkBuildInfo' cmplrInfo componentInfos = + JsonObject + [ "cabal-version" .= JsonString (display cabalVersion) + , "compiler" .= cmplrInfo + , "components" .= JsonArray componentInfos + ] - mkCompilerInfo = JsonObject - [ "flavour" .= JsonString (prettyShow $ compilerFlavor $ compiler lbi) - , "compiler-id" .= JsonString (showCompilerId $ compiler lbi) - , "path" .= path - ] - where - path = maybe JsonNull (JsonString . programPath) - $ (flavorToProgram . compilerFlavor $ compiler lbi) - >>= flip lookupProgram (withPrograms lbi) +mkCompilerInfo :: ProgramDb -> Compiler -> Json +mkCompilerInfo programDb cmplr = JsonObject + [ "flavour" .= JsonString (prettyShow $ compilerFlavor cmplr) + , "compiler-id" .= JsonString (showCompilerId cmplr) + , "path" .= path + ] + where + path = maybe JsonNull (JsonString . programPath) + $ (flavorToProgram . compilerFlavor $ cmplr) + >>= flip lookupProgram programDb - flavorToProgram :: CompilerFlavor -> Maybe Program - flavorToProgram GHC = Just ghcProgram - flavorToProgram GHCJS = Just ghcjsProgram - flavorToProgram UHC = Just uhcProgram - flavorToProgram JHC = Just jhcProgram - flavorToProgram _ = Nothing + flavorToProgram :: CompilerFlavor -> Maybe Program + flavorToProgram GHC = Just ghcProgram + flavorToProgram GHCJS = Just ghcjsProgram + flavorToProgram UHC = Just uhcProgram + flavorToProgram JHC = Just jhcProgram + flavorToProgram _ = Nothing - mkComponentInfo (name, clbi) = JsonObject - [ "type" .= JsonString compType - , "name" .= JsonString (prettyShow name) - , "unit-id" .= JsonString (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) - ] - where - bi = componentBuildInfo comp - comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name - compType = case comp of - CLib _ -> "lib" - CExe _ -> "exe" - CTest _ -> "test" - CBench _ -> "bench" - CFLib _ -> "flib" - modules = case comp of - CLib lib -> explicitLibModules lib - CExe exe -> exeModules exe - _ -> [] - sourceFiles = case comp of - CLib _ -> [] - CExe exe -> [modulePath exe] - _ -> [] +mkComponentInfo :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json +mkComponentInfo pkg_descr lbi clbi = JsonObject + [ "type" .= JsonString compType + , "name" .= JsonString (prettyShow name) + , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) + , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) + , "modules" .= JsonArray (map (JsonString . display) modules) + , "src-files" .= JsonArray (map JsonString sourceFiles) + , "src-dirs" .= JsonArray (map JsonString $ hsSourceDirs bi) + ] + where + name = componentLocalName clbi + bi = componentBuildInfo comp + comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name + compType = case comp of + CLib _ -> "lib" + CExe _ -> "exe" + CTest _ -> "test" + CBench _ -> "bench" + CFLib _ -> "flib" + modules = case comp of + CLib lib -> explicitLibModules lib + CExe exe -> exeModules exe + _ -> [] + sourceFiles = case comp of + CLib _ -> [] + CExe exe -> [modulePath exe] + _ -> [] -- | Get the command-line arguments that would be passed -- to the compiler to build the given component. diff --git a/Cabal/Distribution/Simple/Utils/Json.hs b/Cabal/Distribution/Utils/Json.hs similarity index 89% rename from Cabal/Distribution/Simple/Utils/Json.hs rename to Cabal/Distribution/Utils/Json.hs index f90f2f38aa2..ba918b74880 100644 --- a/Cabal/Distribution/Simple/Utils/Json.hs +++ b/Cabal/Distribution/Utils/Json.hs @@ -1,7 +1,8 @@ --- | Utility json lib for Cabal --- TODO: Remove it again. -module Distribution.Simple.Utils.Json +-- | Extremely simple JSON helper. Don't do anything too fancy with this! + +module Distribution.Utils.Json ( Json(..) + , (.=) , renderJson ) where @@ -44,3 +45,6 @@ intercalate sep = go go [] = id go [x] = x go (x:xs) = x . showString' sep . go xs + +(.=) :: String -> Json -> (String, Json) +k .= v = (k, v) diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index 170f3bcf841..47175da7b1f 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -23,7 +23,7 @@ import Distribution.Simple.Command import Distribution.Verbosity ( Verbosity, silent ) import Distribution.Simple.Utils - ( wrapText, die', withTempDirectory ) + ( wrapText, die' ) import Distribution.Types.UnitId ( UnitId, mkUnitId ) import Distribution.Types.Version @@ -36,13 +36,11 @@ import Distribution.Pretty import qualified Data.Map as Map import qualified Distribution.Simple.Setup as Cabal import Distribution.Client.SetupWrapper -import Distribution.Simple.Program - ( defaultProgramDb ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ProjectPlanning ( setupHsConfigureFlags, setupHsConfigureArgs, setupHsBuildFlags - , setupHsBuildArgs, setupHsScriptOptions ) + , setupHsScriptOptions ) import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.DistDirLayout @@ -52,12 +50,16 @@ import Distribution.Client.Types import Distribution.Client.JobControl ( newLock, Lock ) import Distribution.Simple.Configure - ( tryGetPersistBuildConfig ) + (getPersistBuildConfig, tryGetPersistBuildConfig ) -import System.Directory - ( getTemporaryDirectory ) -import System.FilePath - ( () ) +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(buildArgs)) +import Distribution.Types.TargetInfo (TargetInfo(targetCLBI)) showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) showBuildInfoCommand = CommandUI { @@ -137,51 +139,26 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here --- Pretty nasty piecemeal out of json, but I can't see a way to retrieve output of the setupWrapper'd tasks showTargets :: Maybe FilePath -> Maybe [String] -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> IO () showTargets fileOutput unitIds verbosity baseCtx buildCtx lock = do - tempDir <- getTemporaryDirectory - withTempDirectory verbosity tempDir "show-build-info" $ \dir -> do - mapM_ (doShowInfo dir) targets - case fileOutput of - Nothing -> outputResult dir putStr targets - Just fp -> do - writeFile fp "" - outputResult dir (appendFile fp) targets + let configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] + targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds + + components <- concat <$> mapM (getComponentInfo verbosity baseCtx buildCtx + lock configured) targets - where configured = [p | InstallPlan.Configured p <- InstallPlan.toList (elaboratedPlanOriginal buildCtx)] - targets = maybe (fst <$> (Map.toList . targetsMap $ buildCtx)) (map mkUnitId) unitIds - doShowInfo :: FilePath -> UnitId -> IO () - doShowInfo dir unitId = - showInfo - (dir unitIdToFilePath unitId) - verbosity - baseCtx - buildCtx - lock - configured - unitId + let compilerInfo = mkCompilerInfo (pkgConfigCompilerProgs (elaboratedShared buildCtx)) + (pkgConfigCompiler (elaboratedShared buildCtx)) - outputResult :: FilePath -> (String -> IO ()) -> [UnitId] -> IO () - outputResult dir printer units = do - let unroll [] = return () - unroll [x] = do - content <- readFile (dir unitIdToFilePath x) - printer content - unroll (x:xs) = do - content <- readFile (dir unitIdToFilePath x) - printer content - printer "," - unroll xs - printer "[" - unroll units - printer "]" + json = mkBuildInfo' compilerInfo components + res = renderJson json "" - unitIdToFilePath :: UnitId -> FilePath - unitIdToFilePath unitId = "build-info-" ++ prettyShow unitId ++ ".json" + case fileOutput of + Nothing -> putStrLn res + Just fp -> writeFile fp res -showInfo :: FilePath -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO () -showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = +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 @@ -191,7 +168,6 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = buildDir = distBuildDirectory dirLayout (elabDistDirParams shared pkg) buildType' = buildType (elabPkgDescription pkg) flags = setupHsBuildFlags pkg shared verbosity buildDir - args = setupHsBuildArgs pkg srcDir = case (elabPkgSourceLocation pkg) of LocalUnpackedPackage fp -> fp _ -> "" @@ -216,29 +192,25 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = ++ "For component: " ++ prettyShow targetUnitId ) -- Configure the package if there's no existing config - lbi <- tryGetPersistBuildConfig buildDir - case lbi of + lbi' <- tryGetPersistBuildConfig buildDir + case lbi' of Left _ -> setupWrapper verbosity scriptOptions (Just $ elabPkgDescription pkg) - (Cabal.configureCommand defaultProgramDb) + (Cabal.configureCommand + (pkgConfigCompilerProgs (elaboratedShared buildCtx))) (const configureFlags) (const configureArgs) Right _ -> pure () - setupWrapper - verbosity - scriptOptions - (Just $ elabPkgDescription pkg) - (Cabal.showBuildInfoCommand defaultProgramDb) - (const (Cabal.ShowBuildInfoFlags - { Cabal.buildInfoBuildFlags = flags - , Cabal.buildInfoOutputFile = Just fileOutput - } - ) - ) - (const args) + -- 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) + return $ map (mkComponentInfo pkgDesc lbi . targetCLBI) targetsToBuild + where mbPkg :: Maybe ElaboratedConfiguredPackage mbPkg = find ((targetUnitId ==) . elabUnitId) pkgs @@ -247,9 +219,9 @@ showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, -- or otherwise classifies the problem. -- --- For the @show-build-info@ command select all components except non-buildable and disabled --- tests\/benchmarks, fail if there are no such components --- +-- For the @show-build-info@ command select all components. Unlike the @build@ +-- command, we want to show info for tests and benchmarks even without the +-- @--enable-tests@\/@--enable-benchmarks@ flag set. selectPackageTargets :: TargetSelector -> [AvailableTarget k] -> Either TargetProblem' [k] selectPackageTargets targetSelector targets @@ -267,16 +239,7 @@ selectPackageTargets targetSelector targets = Left (TargetProblemNoTargets targetSelector) where targets' = forgetTargetsDetail targets - targetsBuildable = selectBuildableTargetsWith - (buildable targetSelector) - targets - - -- When there's a target filter like "pkg:tests" then we do select tests, - -- but if it's just a target like "pkg" then we don't build tests unless - -- they are requested by default (i.e. by using --enable-tests) - buildable (TargetPackage _ _ Nothing) TargetNotRequestedByDefault = False - buildable (TargetAllPackages Nothing) TargetNotRequestedByDefault = False - buildable _ _ = True + targetsBuildable = selectBuildableTargets targets -- | For a 'TargetComponent' 'TargetSelector', check if the component can be -- selected. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal index 40f0a570d5a..5a1e2977b66 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal @@ -5,12 +5,19 @@ license: BSD-3-Clause library exposed-modules: A - build-depends: base >=4.0.0 + build-depends: base >=4 hs-source-dirs: src default-language: Haskell2010 executable A main-is: Main.hs - build-depends: base >=4.0.0.0 + build-depends: base >=4 + hs-source-dirs: src + default-language: Haskell2010 + +test-suite A-tests + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base >=4 hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs new file mode 100644 index 00000000000..aa2d0142358 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["-v0"] -- hide verbose output so we can parse + let comps = components buildInfo + assertEqual "Components, exactly three" 3 (length comps) + assertEqual "Test components, exactly one" 1 $ + length $ filter (\c -> "test" == componentType c) comps 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 962cacaf416..b027fcc15f7 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 @@ -2,9 +2,7 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["exe:A", "-v0"] - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["exe:A", "-v0"] assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) 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 6c3109019e7..8e40ea9bfad 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 @@ -5,20 +5,18 @@ main = cabalTest $ withSourceCopy $ do cwd <- fmap testCurrentDir getTestEnv let fp = cwd "unit.json" _ <- cabal' "show-build-info" ["--buildinfo-json-output=" ++ fp, "--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] - buildInfos <- decodeBuildInfoFile fp - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos + buildInfo <- decodeBuildInfoFile fp + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + assertEqual "Components, exactly two" 2 (length $ components buildInfo) + let [libBuildInfo, exeBuildInfo] = components buildInfo assertExe exeBuildInfo assertLib libBuildInfo where - assertExe :: BuildInfo -> TestM () - assertExe buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertExe :: ComponentInfo -> TestM () + assertExe component = do assertEqual "Component type" "exe" (componentType component) assertEqual "Component name" "exe:A" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) @@ -27,14 +25,8 @@ main = cabalTest $ withSourceCopy $ do assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - assertLib :: BuildInfo -> TestM () - assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertLib :: ComponentInfo -> TestM () + assertLib component = do assertEqual "Component type" "lib" (componentType component) assertEqual "Component name" "lib" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId 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 e17f1113720..252f211d1d6 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 @@ -2,20 +2,17 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + let [libBuildInfo, exeBuildInfo] = components buildInfo assertExe exeBuildInfo assertLib libBuildInfo where - assertExe :: BuildInfo -> TestM () - assertExe buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertExe :: ComponentInfo -> TestM () + assertExe component = do assertEqual "Component type" "exe" (componentType component) assertEqual "Component name" "exe:A" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) @@ -24,14 +21,8 @@ main = cabalTest $ do assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - assertLib :: BuildInfo -> TestM () - assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertLib :: ComponentInfo -> TestM () + assertLib component = do assertEqual "Component type" "lib" (componentType component) assertEqual "Component name" "lib" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId 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 9ec29f3c90f..35f0fb18547 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 @@ -2,20 +2,17 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["exe:A", "lib:A", "-v0"] - assertEqual "Build Infos, exactly two " 2 (length buildInfos) - let [libBuildInfo, exeBuildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["exe:A", "lib:A", "-v0"] + assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + let [libBuildInfo, exeBuildInfo] = components buildInfo assertExe exeBuildInfo assertLib libBuildInfo where - assertExe :: BuildInfo -> TestM () - assertExe buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertExe :: ComponentInfo -> TestM () + assertExe component = do assertEqual "Component type" "exe" (componentType component) assertEqual "Component name" "exe:A" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace-A" (componentUnitId component) @@ -24,14 +21,8 @@ main = cabalTest $ do assertEqual "Component source files" ["Main.hs"] (componentSrcFiles component) assertEqual "Component source directories" ["src"] (componentSrcDirs component) - assertLib :: BuildInfo -> TestM () - assertLib buildInfo = do - assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) - assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) - assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) - assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) - assertEqual "Components, exactly one" 1 (length $ components buildInfo) - let [component] = components buildInfo + assertLib :: ComponentInfo -> TestM () + assertLib component = do assertEqual "Component type" "lib" (componentType component) assertEqual "Component name" "lib" (componentName component) assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs new file mode 100644 index 00000000000..b918ddac664 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs @@ -0,0 +1 @@ +main = putStrLn "testing" 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 3c32164830f..c9aa76a41ab 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 @@ -2,9 +2,7 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["lib:B", "-v0"] - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["lib:B", "-v0"] assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs index 7d0560321a4..9d8cae95961 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -2,9 +2,7 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["exe:Complex", "-v0"] - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["exe:Complex", "-v0"] assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs index 76dbc720543..0cae3329d62 100644 --- a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -2,9 +2,7 @@ import Test.Cabal.Prelude import Test.Cabal.DecodeShowBuildInfo main = cabalTest $ do - buildInfos <- runShowBuildInfo ["lib:Complex", "-v0"] - assertEqual "Build Infos, exactly one" 1 (length buildInfos) - let [buildInfo] = buildInfos + buildInfo <- runShowBuildInfo ["lib:Complex", "-v0"] assertEqual "Cabal Version" cabalVersionLibrary (cabalVersion buildInfo) assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs index daa552fa754..35bbc5fb2a8 100644 --- a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs +++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs @@ -9,14 +9,14 @@ import qualified Data.Text.Encoding as T import Data.Aeson import GHC.Generics -runShowBuildInfo :: [String] -> TestM [BuildInfo] +runShowBuildInfo :: [String] -> TestM BuildInfo runShowBuildInfo args = do r <- cabal' "show-build-info" args case eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) of Left err -> fail $ "Could not parse show-build-info command: " ++ err Right buildInfos -> return buildInfos -decodeBuildInfoFile :: FilePath -> TestM [BuildInfo] +decodeBuildInfoFile :: FilePath -> TestM BuildInfo decodeBuildInfoFile fp = do shouldExist fp res <- liftIO $ eitherDecodeFileStrict fp