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