diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 6175385cd65..9c66a4a9ce8 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -375,6 +375,7 @@ library Distribution.Simple.Program.Types Distribution.Simple.Register Distribution.Simple.Setup + Distribution.Simple.ShowBuildInfo Distribution.Simple.SrcDist Distribution.Simple.Test Distribution.Simple.Test.ExeV10 @@ -534,6 +535,7 @@ library Distribution.Simple.GHC.EnvironmentParser Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo + Distribution.Simple.Utils.Json Paths_Cabal if flag(bundled-binary-generic) diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index 16a5adff1a6..e632acc88e8 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -179,6 +179,7 @@ defaultMainHelper hooks args = topHandler $ do [configureCommand progs `commandAddAction` \fs as -> configureAction hooks fs as >> return () ,buildCommand progs `commandAddAction` buildAction hooks + ,showBuildInfoCommand progs `commandAddAction` showBuildInfoAction hooks ,replCommand progs `commandAddAction` replAction hooks ,installCommand `commandAddAction` installAction hooks ,copyCommand `commandAddAction` copyAction hooks @@ -264,6 +265,33 @@ buildAction hooks flags args = do (return lbi { withPrograms = progs }) 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 + lbi <- getBuildConfig hooks verbosity distPref + let flags' = flags { buildDistPref = toFlag distPref + , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) + } + + progs <- reconfigurePrograms verbosity + (buildProgramPaths flags') + (buildProgramArgs flags') + (withPrograms lbi) + + pbi <- preBuild hooks args flags' + 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 + + postBuild hooks args flags' pkg_descr lbi' + replAction :: UserHooks -> ReplFlags -> Args -> IO () replAction hooks flags args = do distPref <- findDistPrefOrDefault (replDistPref flags) diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index 95c576a5781..331c367d8de 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -19,7 +19,7 @@ -- module Distribution.Simple.Build ( - build, repl, + build, showBuildInfo, repl, startInterpreter, initialBuildSteps, @@ -69,11 +69,13 @@ import Distribution.Simple.PreProcess import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program.Types import Distribution.Simple.Program.Db +import Distribution.Simple.ShowBuildInfo import Distribution.Simple.BuildPaths 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 @@ -128,6 +130,18 @@ build pkg_descr lbi flags suffixes = do verbosity = fromFlag (buildVerbosity flags) +showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file + -> LocalBuildInfo -- ^ Configuration information + -> BuildFlags -- ^ Flags that the user passed to build + -> IO String +showBuildInfo pkg_descr lbi flags = do + let verbosity = fromFlag (buildVerbosity flags) + targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags) + let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) + doc = mkBuildInfo pkg_descr lbi flags targetsToBuild + return $ renderJson doc "" + + repl :: PackageDescription -- ^ Mostly information from the .cabal file -> LocalBuildInfo -- ^ Configuration information -> ReplFlags -- ^ Flags that the user passed to build diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index c778d407a61..4630f20e064 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -45,6 +45,7 @@ module Distribution.Simple.Setup ( HaddockFlags(..), emptyHaddockFlags, defaultHaddockFlags, haddockCommand, HscolourFlags(..), emptyHscolourFlags, defaultHscolourFlags, hscolourCommand, BuildFlags(..), emptyBuildFlags, defaultBuildFlags, buildCommand, + ShowBuildInfoFlags(..), defaultShowBuildFlags, showBuildInfoCommand, ReplFlags(..), defaultReplFlags, replCommand, CleanFlags(..), emptyCleanFlags, defaultCleanFlags, cleanCommand, RegisterFlags(..), emptyRegisterFlags, defaultRegisterFlags, registerCommand, @@ -2205,6 +2206,81 @@ optionNumJobs get set = | otherwise -> Right (Just n) _ -> Left "The jobs value should be a number or '$ncpus'" + +-- ------------------------------------------------------------ +-- * show-build-info command flags +-- ------------------------------------------------------------ + +data ShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoBuildFlags :: BuildFlags + , buildInfoOutputFile :: Maybe FilePath + } deriving Show + +defaultShowBuildFlags :: ShowBuildInfoFlags +defaultShowBuildFlags = + ShowBuildInfoFlags + { buildInfoBuildFlags = defaultBuildFlags + , buildInfoOutputFile = Nothing + } + +showBuildInfoCommand :: ProgramDb -> CommandUI ShowBuildInfoFlags +showBuildInfoCommand progDb = CommandUI + { commandName = "show-build-info" + , commandSynopsis = "Emit details about how a package would be built." + , commandDescription = Just $ \_ -> wrapText $ + "Components encompass executables, tests, and benchmarks.\n" + ++ "\n" + ++ "Affected by configuration options, see `configure`.\n" + , commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " show-build-info " + ++ " All the components in the package\n" + ++ " " ++ pname ++ " show-build-info foo " + ++ " A component (i.e. lib, exe, test suite)\n\n" + ++ programFlagsDescription progDb +--TODO: re-enable once we have support for module/file targets +-- ++ " " ++ pname ++ " show-build-info Foo.Bar " +-- ++ " A module\n" +-- ++ " " ++ pname ++ " show-build-info Foo/Bar.hs" +-- ++ " A file\n\n" +-- ++ "If a target is ambiguous it can be qualified with the component " +-- ++ "name, e.g.\n" +-- ++ " " ++ pname ++ " show-build-info foo:Foo.Bar\n" +-- ++ " " ++ pname ++ " show-build-info testsuite1:Foo/Bar.hs\n" + , commandUsage = usageAlternatives "show-build-info" $ + [ "[FLAGS]" + , "COMPONENTS [FLAGS]" + ] + , commandDefaultFlags = defaultShowBuildFlags + , commandOptions = \showOrParseArgs -> + parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb + ++ + [ option [] ["buildinfo-json-output"] + "Write the result to the given file instead of stdout" + buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) + (reqArg' "FILE" Just (maybe [] pure)) + ] + + } + +parseBuildFlagsForShowBuildInfoFlags :: ShowOrParseArgs -> ProgramDb -> [OptionField ShowBuildInfoFlags] +parseBuildFlagsForShowBuildInfoFlags showOrParseArgs progDb = + map + (liftOption + buildInfoBuildFlags + (\bf flags -> flags { buildInfoBuildFlags = bf } ) + ) + buildFlags + where + buildFlags = buildOptions progDb showOrParseArgs + ++ + [ optionVerbosity + buildVerbosity (\v flags -> flags { buildVerbosity = v }) + + , optionDistPref + buildDistPref (\d flags -> flags { buildDistPref = d }) showOrParseArgs + ] + -- ------------------------------------------------------------ -- * Other Utils -- ------------------------------------------------------------ diff --git a/Cabal/Distribution/Simple/ShowBuildInfo.hs b/Cabal/Distribution/Simple/ShowBuildInfo.hs new file mode 100644 index 00000000000..b13f95b78f0 --- /dev/null +++ b/Cabal/Distribution/Simple/ShowBuildInfo.hs @@ -0,0 +1,153 @@ +-- | +-- This module defines a simple JSON-based format for exporting basic +-- information about a Cabal package and the compiler configuration Cabal +-- would use to build it. This can be produced with the +-- @cabal new-show-build-info@ command. +-- +-- +-- This format is intended for consumption by external tooling and should +-- therefore be rather stable. Moreover, this allows tooling users to avoid +-- linking against Cabal. This is an important advantage as direct API usage +-- tends to be rather fragile in the presence of user-initiated upgrades of +-- Cabal. +-- +-- Below is an example of the output this module produces, +-- +-- @ +-- { "cabal-version": "1.23.0.0", +-- "compiler": { +-- "flavor": "GHC", +-- "compiler-id": "ghc-7.10.2", +-- "path": "/usr/bin/ghc", +-- }, +-- "components": [ +-- { "type": "lib", +-- "name": "lib:Cabal", +-- "compiler-args": +-- ["-O", "-XHaskell98", "-Wall", +-- "-package-id", "parallel-3.2.0.6-b79c38c5c25fff77f3ea7271851879eb"] +-- "modules": ["Project.ModA", "Project.ModB", "Paths_project"], +-- "src-files": [], +-- "src-dirs": ["src"] +-- } +-- ] +-- } +-- @ +-- +-- The @cabal-version@ property provides the version of the Cabal library +-- which generated the output. The @compiler@ property gives some basic +-- information about the compiler Cabal would use to compile the package. +-- +-- The @components@ property gives a list of the Cabal 'Component's defined by +-- the package. Each has, +-- +-- * @type@: the type of the component (one of @lib@, @exe@, +-- @test@, @bench@, or @flib@) +-- * @name@: a string serving to uniquely identify the component within the +-- package. +-- * @compiler-args@: the command-line arguments Cabal would pass to the +-- compiler to compile the component +-- * @modules@: the modules belonging to the component +-- * @src-dirs@: a list of directories where the modules might be found +-- * @src-files@: any other Haskell sources needed by the component +-- +-- Note: At the moment this is only supported when using the GHC compiler. +-- + +module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where + +import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.Program.GHC as GHC + +import Distribution.PackageDescription +import Distribution.Compiler +import Distribution.Verbosity +import Distribution.Simple.Compiler +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Program +import Distribution.Simple.Setup +import Distribution.Simple.Utils (cabalVersion) +import Distribution.Simple.Utils.Json +import Distribution.Types.TargetInfo +import Distribution.Text +import Distribution.Pretty + +-- | Construct a JSON document describing the build information for a package +mkBuildInfo :: 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 = info + where + componentsToBuild = map (\target -> (componentLocalName $ targetCLBI target,targetCLBI target)) targetsToBuild + (.=) :: String -> Json -> (String, Json) + k .= v = (k, v) + + info = JsonObject + [ "cabal-version" .= JsonString (display cabalVersion) + , "compiler" .= mkCompilerInfo + , "components" .= JsonArray (map mkComponentInfo componentsToBuild) + ] + + 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) + + 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 + Just comp = 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. +getCompilerArgs :: BuildInfo + -> LocalBuildInfo + -> ComponentLocalBuildInfo + -> [String] +getCompilerArgs bi lbi clbi = + case compilerFlavor $ compiler lbi of + GHC -> ghc + GHCJS -> ghc + c -> error $ "ShowBuildInfo.getCompilerArgs: Don't know how to get "++ + "build arguments for compiler "++show c + where + -- This is absolutely awful + ghc = GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts + where + baseOpts = GHC.componentGhcOptions normal lbi bi clbi (buildDir lbi) diff --git a/Cabal/Distribution/Simple/Utils/Json.hs b/Cabal/Distribution/Simple/Utils/Json.hs new file mode 100644 index 00000000000..f90f2f38aa2 --- /dev/null +++ b/Cabal/Distribution/Simple/Utils/Json.hs @@ -0,0 +1,46 @@ +-- | Utility json lib for Cabal +-- TODO: Remove it again. +module Distribution.Simple.Utils.Json + ( Json(..) + , renderJson + ) where + +data Json = JsonArray [Json] + | JsonBool !Bool + | JsonNull + | JsonNumber !Int + | JsonObject [(String, Json)] + | JsonString !String + +renderJson :: Json -> ShowS +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 (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 +intercalate sep = go + where + go [] = id + go [x] = x + go (x:xs) = x . showString' sep . go xs diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index cb1858837a4..5cb36f55529 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/Distribution/Client/CmdBuild.hs @@ -8,7 +8,8 @@ module Distribution.Client.CmdBuild ( -- * Internals exposed for testing TargetProblem(..), selectPackageTargets, - selectComponentTarget + selectComponentTarget, + reportTargetProblems ) where import Distribution.Client.ProjectOrchestration diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs new file mode 100644 index 00000000000..9eb23aafb67 --- /dev/null +++ b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs @@ -0,0 +1,327 @@ +-- | cabal-install CLI command: new-show-build-info +-- +module Distribution.Client.CmdShowBuildInfo where +-- ( +-- -- * The @show-build-info@ CLI and action +-- showBuildInfoCommand, +-- showBuildInfoAction +-- ) + +import Distribution.Client.Compat.Prelude + ( when, find, fromMaybe ) +import Distribution.Client.ProjectOrchestration +import Distribution.Client.CmdErrorMessages +import Distribution.Client.CmdInstall.ClientInstallFlags + +import Distribution.Client.Setup + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + ) +import qualified Distribution.Client.Setup as Client +import Distribution.Simple.Setup + ( HaddockFlags, TestFlags + , fromFlagOrDefault + ) +import Distribution.Simple.Command + ( CommandUI(..), option, reqArg', usageAlternatives + ) +import Distribution.Verbosity + ( Verbosity, silent ) +import Distribution.Simple.Utils + ( wrapText, die', withTempDirectory ) +import Distribution.Types.UnitId + ( UnitId, mkUnitId ) +import Distribution.Types.Version + ( mkVersion ) +import Distribution.Types.PackageDescription + ( buildType ) +import Distribution.Deprecated.Text + ( display ) + +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 + ) +import Distribution.Client.DistDirLayout (distBuildDirectory) +import Distribution.Client.Types ( PackageLocation(..), GenericReadyPackage(..) ) +import Distribution.Client.JobControl (newLock, Lock) +import Distribution.Simple.Configure (tryGetPersistBuildConfig) +import qualified Distribution.Client.CmdInstall as CmdInstall + +import System.Directory (getTemporaryDirectory) +import System.FilePath (()) + +showBuildInfoCommand :: CommandUI ShowBuildInfoFlags +showBuildInfoCommand = CmdInstall.installCommand { + commandName = "new-show-build-info", + commandSynopsis = "Show project build information", + commandUsage = usageAlternatives "new-show-build-info" [ "[TARGETS] [FLAGS]" ], + commandDescription = Just $ \_ -> wrapText $ + "Provides detailed json output for the given package.\n" + ++ "Contains information about the different build components and compiler flags.\n", + commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " new-show-build-info\n" + ++ " Shows build information about the current package\n" + ++ " " ++ pname ++ " new-show-build-info .\n" + ++ " Shows build information about the current package\n" + ++ " " ++ pname ++ " new-show-build-info ./pkgname \n" + ++ " Shows build information about the package located in './pkgname'\n" + ++ cmdCommonHelpTextNewBuildBeta, + commandOptions = \showOrParseArgs -> + Client.liftOptions buildInfoInstallCommandFlags (\pf flags -> flags { buildInfoInstallCommandFlags = pf }) (commandOptions CmdInstall.installCommand showOrParseArgs) + ++ + [ option [] ["buildinfo-json-output"] + "Write the result to the given file instead of stdout" + buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) + (reqArg' "FILE" Just (maybe [] pure)), + option [] ["unit-ids-json"] + "Show build-info only for selected unit-id's." + buildInfoUnitIds (\pf flags -> flags { buildInfoUnitIds = pf }) + (reqArg' "UNIT-ID" (Just . words) (fromMaybe [])) + ], + commandDefaultFlags = defaultShowBuildInfoFlags + + } + +data ShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoInstallCommandFlags :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, ClientInstallFlags) + , buildInfoOutputFile :: Maybe FilePath + , buildInfoUnitIds :: Maybe [String] + } + +defaultShowBuildInfoFlags :: ShowBuildInfoFlags +defaultShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoInstallCommandFlags = (mempty, mempty, mempty, mempty, mempty, mempty) + , buildInfoOutputFile = Nothing + , buildInfoUnitIds = Nothing + } + +-- | The @show-build-info@ command does a lot. It brings the install plan up to date, +-- selects that part of the plan needed by the given or implicit targets and +-- then executes the plan. +-- +-- For more details on how this works, see the module +-- "Distribution.Client.ProjectOrchestration" +-- +showBuildInfoAction :: ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () +showBuildInfoAction (ShowBuildInfoFlags (configFlags, configExFlags, installFlags, haddockFlags, testFlags, clientInstallFlags) fileOutput unitIds) + targetStrings globalFlags = do + baseCtx <- establishProjectBaseContext verbosity cliConfig + let baseCtx' = baseCtx + { buildSettings = (buildSettings baseCtx) { buildSettingDryRun = True } + } + + targetSelectors <- either (reportTargetSelectorProblems verbosity) return + =<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings + + buildCtx <- + 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 (reportTargetProblems verbosity) return + $ resolveTargets + selectPackageTargets + selectComponentTarget + TargetProblemCommon + elaboratedPlan + Nothing + targetSelectors + + -- Don't prune the plan though, as we want a list of all configured packages + return (elaboratedPlan, targets) + + 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) + cliConfig = commandLineFlagsToProjectConfig + globalFlags configFlags configExFlags + installFlags clientInstallFlags + haddockFlags + testFlags + +-- 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 + + 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 + + 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 "]" + + unitIdToFilePath :: UnitId -> FilePath + unitIdToFilePath unitId = "build-info-" ++ display unitId ++ ".json" + +showInfo :: FilePath -> Verbosity -> ProjectBaseContext -> ProjectBuildContext -> Lock -> [ElaboratedConfiguredPackage] -> UnitId -> IO () +showInfo fileOutput verbosity baseCtx buildCtx lock pkgs targetUnitId = + case mbPkg of + Nothing -> die' verbosity $ "No unit " ++ display 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 + args = setupHsBuildArgs pkg + 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 corrct + (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: " ++ display cabalVersion ++ "\n" + ++ "For component: " ++ display 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 defaultProgramDb) + (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) + where + mbPkg :: Maybe ElaboratedConfiguredPackage + mbPkg = find ((targetUnitId ==) . elabUnitId) pkgs + +-- | This defines what a 'TargetSelector' means for the @new-show-build-info@ command. +-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, +-- or otherwise classifies the problem. +-- +-- For the @new-show-build-info@ command select all components except non-buildable and disabled +-- tests\/benchmarks, fail if there are no such components +-- +selectPackageTargets :: TargetSelector + -> [AvailableTarget k] -> Either TargetProblem [k] +selectPackageTargets targetSelector targets + + -- If there are any buildable targets then we select those + | not (null targetsBuildable) + = Right targetsBuildable + + -- If there are targets but none are buildable then we report those + | not (null targets) + = Left (TargetProblemNoneEnabled targetSelector targets') + + -- If there are no targets at all then we report that + | otherwise + = 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 + +-- | For a 'TargetComponent' 'TargetSelector', check if the component can be +-- selected. +-- +-- For the @show-build-info@ command we just need the basic checks on being buildable etc. +-- +selectComponentTarget :: SubComponentTarget + -> AvailableTarget k -> Either TargetProblem k +selectComponentTarget subtarget = + either (Left . TargetProblemCommon) Right + . selectComponentTargetBasic subtarget + + +-- | The various error conditions that can occur when matching a +-- 'TargetSelector' against 'AvailableTarget's for the @show-build-info@ command. +-- +data TargetProblem = + TargetProblemCommon TargetProblemCommon + + -- | The 'TargetSelector' matches targets but none are buildable + | TargetProblemNoneEnabled TargetSelector [AvailableTarget ()] + + -- | There are no targets at all + | TargetProblemNoTargets TargetSelector + deriving (Eq, Show) + +reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a +reportTargetProblems verbosity = + die' verbosity . unlines . map renderTargetProblem + +renderTargetProblem :: TargetProblem -> String +renderTargetProblem (TargetProblemCommon problem) = + renderTargetProblemCommon "build" problem +renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = + renderTargetProblemNoneEnabled "build" targetSelector targets +renderTargetProblem(TargetProblemNoTargets targetSelector) = + renderTargetProblemNoTargets "build" targetSelector diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index eb5330d3d16..b47f22cf05d 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -23,7 +23,7 @@ module Distribution.Client.Setup , configureExCommand, ConfigExFlags(..), defaultConfigExFlags , buildCommand, BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..) , filterTestFlags - , replCommand, testCommand, benchmarkCommand, testOptions + , replCommand, testCommand, showBuildInfoCommand, benchmarkCommand, testOptions , configureExOptions, reconfigureCommand , installCommand, InstallFlags(..), installOptions, defaultInstallFlags , filterHaddockArgs, filterHaddockFlags, haddockOptions @@ -56,7 +56,7 @@ module Distribution.Client.Setup , doctestCommand , copyCommand , registerCommand - + --, showBuildInfoCommand , parsePackageArgs , liftOptions , yesNoOpt @@ -197,6 +197,7 @@ globalCommand commands = CommandUI { , "outdated" , "haddock" , "hscolour" + , "show-build-info" , "exec" , "new-build" , "new-configure" @@ -283,6 +284,7 @@ globalCommand commands = CommandUI { , addCmd "upload" , addCmd "report" , par + , addCmd "show-build-info" , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" @@ -2982,3 +2984,23 @@ relevantConfigValuesText :: [String] -> String relevantConfigValuesText vs = "Relevant global configuration keys:\n" ++ concat [" " ++ v ++ "\n" |v <- vs] + + +-- ------------------------------------------------------------ +-- * Commands to support show-build-info +-- ------------------------------------------------------------ + +showBuildInfoCommand :: CommandUI (Cabal.ShowBuildInfoFlags, BuildExFlags) +showBuildInfoCommand = parent { + commandDefaultFlags = (commandDefaultFlags parent, mempty), + commandOptions = + \showOrParseArgs -> liftOptions fst setFst + (commandOptions parent showOrParseArgs) + ++ + liftOptions snd setSnd (buildExOptions showOrParseArgs) + } + where + setFst a (_,b) = (a,b) + setSnd b (a,_) = (a,b) + + parent = Cabal.showBuildInfoCommand defaultProgramDb diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index d422a2fddfb..955ac3b0c11 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -17,7 +17,7 @@ -- runs it with the given arguments. module Distribution.Client.SetupWrapper ( - getSetup, runSetup, runSetupCommand, setupWrapper, + getSetup, runSetup, runSetupCommand, setupWrapper, getSetupMethod, SetupScriptOptions(..), defaultSetupScriptOptions, ) where diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 2310258bfb7..35c6912488f 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -171,6 +171,7 @@ executable cabal Distribution.Client.CmdInstall.ClientInstallFlags Distribution.Client.CmdRepl Distribution.Client.CmdRun + Distribution.Client.CmdShowBuildInfo Distribution.Client.CmdTest Distribution.Client.CmdLegacy Distribution.Client.CmdSdist diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index 860714fb2a9..c2c0fd44039 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -99,6 +99,7 @@ Distribution.Client.CmdInstall.ClientInstallFlags Distribution.Client.CmdRepl Distribution.Client.CmdRun + Distribution.Client.CmdShowBuildInfo Distribution.Client.CmdTest Distribution.Client.CmdLegacy Distribution.Client.CmdSdist diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 9c0cb8e3084..ef8f9dbf72a 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -83,6 +83,7 @@ import qualified Distribution.Client.List as List import qualified Distribution.Client.CmdConfigure as CmdConfigure import qualified Distribution.Client.CmdUpdate as CmdUpdate import qualified Distribution.Client.CmdBuild as CmdBuild +import qualified Distribution.Client.CmdShowBuildInfo as CmdShowBuildInfo import qualified Distribution.Client.CmdRepl as CmdRepl import qualified Distribution.Client.CmdFreeze as CmdFreeze import qualified Distribution.Client.CmdHaddock as CmdHaddock @@ -304,7 +305,8 @@ mainWorker args = do , hiddenCmd win32SelfUpgradeCommand win32SelfUpgradeAction , hiddenCmd actAsSetupCommand actAsSetupAction , hiddenCmd manpageCommand (manpageAction commandSpecs) - + , hiddenCmd CmdShowBuildInfo.showBuildInfoCommand + CmdShowBuildInfo.showBuildInfoAction ] ++ concat [ newCmd CmdConfigure.configureCommand CmdConfigure.configureAction , newCmd CmdUpdate.updateCommand CmdUpdate.updateAction @@ -319,7 +321,6 @@ mainWorker args = do , newCmd CmdExec.execCommand CmdExec.execAction , newCmd CmdClean.cleanCommand CmdClean.cleanAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction - , legacyCmd configureExCommand configureAction , legacyCmd updateCommand updateAction , legacyCmd buildCommand buildAction @@ -447,40 +448,67 @@ reconfigureAction flags@(configFlags, _) _ globalFlags = do checkFlags [] globalFlags config pure () -buildAction :: (BuildFlags, BuildExFlags) -> [String] -> Action -buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do - let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) - noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck - (buildOnly buildExFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags - distPref <- findSavedDistPref config (buildDistPref buildFlags) - -- Calls 'configureAction' to do the real work, so nothing special has to be - -- done to support sandboxes. - config' <- - reconfigure configureAction - verbosity distPref useSandbox noAddSource (buildNumJobs buildFlags) - mempty [] globalFlags config - nixShell verbosity distPref globalFlags config $ do - maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config' distPref buildFlags extraArgs +buildAction :: (BuildFlags, BuildExFlags) -> [String] -> Action +buildAction flags@(buildFlags, _) = buildActionForCommand + (Cabal.buildCommand defaultProgramDb) + verbosity + flags + where verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) + +-- showBuildInfoAction :: (Cabal.ShowBuildInfoFlags, BuildExFlags) -> [String] -> Action +-- showBuildInfoAction (showBuildInfoFlags, buildEx) = buildActionForCommand +-- (Cabal.showBuildInfoCommand defaultProgramDb) +-- showBuildInfoFlags +-- verbosity +-- (Cabal.buildInfoBuildFlags showBuildInfoFlags, buildEx) +-- -- Default silent verbosity so as not to pollute json output +-- where verbosity = fromFlagOrDefault silent (buildVerbosity (Cabal.buildInfoBuildFlags showBuildInfoFlags )) + +buildActionForCommand :: CommandUI BuildFlags + -> Verbosity + -> (BuildFlags, BuildExFlags) + -> [String] + -> Action +buildActionForCommand commandUI verbosity (buildFlags, buildExFlags) extraArgs globalFlags + = do + let noAddSource = + fromFlagOrDefault DontSkipAddSourceDepsCheck (buildOnly buildExFlags) + (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + distPref <- findSavedDistPref config (buildDistPref buildFlags) + -- Calls 'configureAction' to do the real work, so nothing special has to be + -- done to support sandboxes. + config' <- reconfigure + configureAction verbosity distPref useSandbox noAddSource + (buildNumJobs buildFlags) mempty [] globalFlags config + + nixShell verbosity distPref globalFlags config $ + maybeWithSandboxDirOnSearchPath useSandbox $ buildForCommand + commandUI verbosity config' distPref buildFlags extraArgs -- | Actually do the work of building the package. This is separate from -- 'buildAction' so that 'testAction' and 'benchmarkAction' do not invoke -- 'reconfigure' twice. build :: Verbosity -> SavedConfig -> FilePath -> BuildFlags -> [String] -> IO () -build verbosity config distPref buildFlags extraArgs = - setupWrapper verbosity setupOptions Nothing - (Cabal.buildCommand progDb) mkBuildFlags (const extraArgs) - where - progDb = defaultProgramDb - setupOptions = defaultSetupScriptOptions { useDistPref = distPref } +build = buildForCommand (Cabal.buildCommand defaultProgramDb) + +-- | Helper function +buildForCommand :: CommandUI BuildFlags + -> Verbosity + -> SavedConfig + -> FilePath + -> BuildFlags + -> [String] + -> IO () +buildForCommand command verbosity config distPref buildFlags extraArgs = + setupWrapper verbosity setupOptions Nothing command mkBuildFlags (const extraArgs) + where + setupOptions = defaultSetupScriptOptions { useDistPref = distPref } - mkBuildFlags version = filterBuildFlags version config buildFlags' - buildFlags' = buildFlags - { buildVerbosity = toFlag verbosity - , buildDistPref = toFlag distPref - } + mkBuildFlags version = filterBuildFlags version config buildFlags' + buildFlags' = buildFlags { buildVerbosity = toFlag verbosity + , buildDistPref = toFlag distPref + } -- | Make sure that we don't pass new flags to setup scripts compiled against -- old versions of Cabal. @@ -522,8 +550,8 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do -- be done to support sandboxes. _ <- reconfigure configureAction - verbosity distPref useSandbox noAddSource NoFlag - mempty [] globalFlags config + verbosity distPref useSandbox noAddSource NoFlag + mempty [] globalFlags config let progDb = defaultProgramDb setupOptions = defaultSetupScriptOptions { useCabalVersion = orLaterVersion $ mkVersion [1,18,0] diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal new file mode 100644 index 00000000000..2873a450394 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal @@ -0,0 +1,32 @@ +cabal-version: 2.4 +-- Initial package description 'A.cabal' generated by 'cabal init'. For +-- further documentation, see http://haskell.org/cabal/users-guide/ + +name: A +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +license: BSD-3-Clause +license-file: LICENSE +author: Foo Bar +maintainer: cabal-dev@haskell.org +-- copyright: +-- category: +extra-source-files: CHANGELOG.md + +library + exposed-modules: A + -- other-modules: + -- other-extensions: + build-depends: base >=4.0.0 + hs-source-dirs: src + default-language: Haskell2010 + +executable A + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.0.0.0 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md new file mode 100644 index 00000000000..cfa8b563c0e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for A + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE new file mode 100644 index 00000000000..671281e7a8b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Foo Bar + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Foo Bar nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out new file mode 100644 index 00000000000..bc3b3f767eb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.out @@ -0,0 +1 @@ +# cabal new-show-build-info 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 new file mode 100644 index 00000000000..240c39e7d40 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe-exact.test.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "new-show-build-info" ["exe:A", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.0.0.0" (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 + 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) + 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) + return () + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out new file mode 100644 index 00000000000..bc3b3f767eb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.out @@ -0,0 +1 @@ +# cabal new-show-build-info 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 new file mode 100644 index 00000000000..7d1f87fa62e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id-file.test.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ withSourceCopy $do + cwd <- fmap testCurrentDir getTestEnv + let fp = cwd "unit.json" + r <- cabal' "new-show-build-info" ["--buildinfo-json-output=" ++ fp, "--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] + shouldExist fp + buildInfoEither <- liftIO $ eitherDecodeFileStrict fp + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + return () + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" "3.0.0.0" (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 + 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) + 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) + + assertLib :: BuildInfo -> TestM () + assertLib buildInfo = do + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) + 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) + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out new file mode 100644 index 00000000000..bc3b3f767eb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.out @@ -0,0 +1 @@ +# cabal new-show-build-info 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 new file mode 100644 index 00000000000..3b82c94c393 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact-unit-id.test.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "new-show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace A-0.1.0.0-inplace-A", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + return () + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" "3.0.0.0" (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 + 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) + 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) + + assertLib :: BuildInfo -> TestM () + assertLib buildInfo = do + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) + 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) + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out new file mode 100644 index 00000000000..bc3b3f767eb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.out @@ -0,0 +1 @@ +# cabal new-show-build-info 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 new file mode 100644 index 00000000000..c410954fa27 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-exact.test.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "new-show-build-info" ["exe:A", "lib:A", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly two " 2 (length buildInfos) + let [libBuildInfo, exeBuildInfo] = buildInfos + assertExe exeBuildInfo + assertLib libBuildInfo + return () + where + assertExe :: BuildInfo -> TestM () + assertExe buildInfo = do + assertEqual "Cabal Version" "3.0.0.0" (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 + 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) + 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) + + assertLib :: BuildInfo -> TestM () + assertLib buildInfo = do + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "A-0.1.0.0-inplace" (componentUnitId component) + 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) + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out new file mode 100644 index 00000000000..ff049ec672f --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out @@ -0,0 +1,12 @@ +# cabal new-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: +'exe:B' which matches exe:B (unknown-component), :pkg:exe:lib:exe:module:B (unknown-module), :pkg:exe:lib:exe:file:B (unknown-file) +# cabal new-show-build-info +Resolving dependencies... +cabal: No unit B-inplace-0.1.0.0 +# cabal new-show-build-info +Configuring library for A-0.1.0.0.. +cabal: No unit B-inplace-0.1.0.0 +# cabal new-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: +'exe:B' which matches exe:B (unknown-component), :pkg:exe:lib:exe:module:B (unknown-module), :pkg:exe:lib:exe:file:B (unknown-file) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs new file mode 100644 index 00000000000..44ca75277cf --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs @@ -0,0 +1,14 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + r <- fails $ cabal' "new-show-build-info" ["exe:B"] + assertOutputContains "Internal error in target matching." r + + r <- fails $ cabal' "new-show-build-info" ["--unit-ids-json=B-inplace-0.1.0.0"] + assertOutputContains "No unit B-inplace-0.1.0.0" r + + r <- fails $ cabal' "new-show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace B-inplace-0.1.0.0"] + assertOutputContains "No unit B-inplace-0.1.0.0" r + + r <- fails $ cabal' "new-show-build-info" ["--unit-ids-json=A-0.1.0.0-inplace", "exe:B"] + assertOutputContains "Internal error in target matching." r diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project new file mode 100644 index 00000000000..5356e76f67c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project @@ -0,0 +1 @@ +packages: . \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs new file mode 100644 index 00000000000..ad7a0c07729 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs @@ -0,0 +1,4 @@ +module A where + +foo :: Int -> Int +foo = id \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Main.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Main.hs new file mode 100644 index 00000000000..65ae4a05d5d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/unit.json b/cabal-testsuite/PackageTests/ShowBuildInfo/A/unit.json new file mode 100644 index 00000000000..e69de29bb2d diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal new file mode 100644 index 00000000000..d8ed91d655b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/B.cabal @@ -0,0 +1,24 @@ +cabal-version: 2.4 +-- Initial package description 'B.cabal' generated by 'cabal init'. For +-- further documentation, see http://haskell.org/cabal/users-guide/ + +name: B +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +license: BSD-3-Clause +license-file: LICENSE +author: Foo Bar +maintainer: cabal-dev@haskell.org +-- copyright: +-- category: +extra-source-files: CHANGELOG.md + +library + exposed-modules: A + -- other-modules: + -- other-extensions: + build-depends: base >=4.0.0.0 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md new file mode 100644 index 00000000000..5cf6ac2adb2 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for B + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE new file mode 100644 index 00000000000..671281e7a8b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2019, Foo Bar + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Foo Bar nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out new file mode 100644 index 00000000000..bc3b3f767eb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.out @@ -0,0 +1 @@ +# cabal new-show-build-info 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 new file mode 100644 index 00000000000..31ef1fdc9f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/build-info-lib-exact.test.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "new-show-build-info" ["lib:B", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "B-0.1.0.0-inplace" (componentUnitId component) + 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) + return () + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs new file mode 100644 index 00000000000..ad7a0c07729 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/B/src/A.hs @@ -0,0 +1,4 @@ +module A where + +foo :: Int -> Int +foo = id \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md new file mode 100644 index 00000000000..624468cdfdb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for Complex + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal new file mode 100644 index 00000000000..9047830cd4f --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal @@ -0,0 +1,54 @@ +cabal-version: 2.4 +name: Complex +version: 0.1.0.0 +license: MIT +license-file: LICENSE +author: Bla Bla +maintainer: "" +category: Testing +extra-source-files: CHANGELOG.md + + +library + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + exposed-modules: Lib + other-modules: Paths_complex + + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + +executable Complex + main-is: Main.lhs + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + 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 + main-is: Main.hs + +test-suite func-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: hspec + main-is: Main.hs + +benchmark complex-benchmarks + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + 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/LICENSE b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE new file mode 100644 index 00000000000..a234fc7e8dd --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2019 Bla Bla + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/bench.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/bench.test.hs new file mode 100644 index 00000000000..e8c59683dfb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/bench.test.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ withRepo "repo" $ do + r <- cabal' "new-show-build-info" ["--enable-benchmarks", "bench:complex-benchmarks", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "benchmark" (componentType component) + assertEqual "Component name" "bench:complex-brenchmarks" (componentName component) + assertEqual "Component unit-id" "Complex-0.1.0.0-inplace-Complex" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertBool "Component ghc-options contains all specified in .cabal" + (all + (`elem` componentCompilerArgs component) + [ "-threaded" + , "-rtsopts" + , "-with-rtsopts=-N" + , "-with-rtsopts=-T" + , "-Wredundant-constraints" + ] + ) + assertBool "Component ghc-options does not contain -Wall" + (all + (`notElem` componentCompilerArgs component) + [ "-Wall" + ] + ) + assertEqual "Component modules" ["Paths_complex"] (componentModules component) + assertEqual "Component source files" ["Main.lhs"] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) + return () + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project new file mode 100644 index 00000000000..5356e76f67c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project @@ -0,0 +1 @@ +packages: . \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out new file mode 100644 index 00000000000..bc3b3f767eb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.out @@ -0,0 +1 @@ +# cabal new-show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs new file mode 100644 index 00000000000..43250743de8 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/exe.test.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "new-show-build-info" ["exe:Complex", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "exe" (componentType component) + assertEqual "Component name" "exe:Complex" (componentName component) + assertEqual "Component unit-id" "Complex-0.1.0.0-inplace-Complex" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertBool "Component ghc-options contains all specified in .cabal" + (all + (`elem` componentCompilerArgs component) + [ "-threaded" + , "-rtsopts" + , "-with-rtsopts=-N" + , "-with-rtsopts=-T" + , "-Wredundant-constraints" + ] + ) + assertBool "Component ghc-options does not contain -Wall" + (all + (`notElem` componentCompilerArgs component) + [ "-Wall" + ] + ) + assertEqual "Component modules" ["Paths_complex"] (componentModules component) + assertEqual "Component source files" ["Main.lhs"] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) + return () + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/func-test.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/func-test.test.hs new file mode 100644 index 00000000000..c0c4df28bd1 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/func-test.test.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ withRepo "repo" $ do + r <- cabal' "new-show-build-info" ["--enable-tests", "test:func-test", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "test" (componentType component) + assertEqual "Component name" "test:func" (componentName component) + assertEqual "Component unit-id" "Complex-0.1.0.0-inplace" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" ["Lib", "Paths_complex"] (componentModules component) + assertEqual "Component source files" [] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) + return () + + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out new file mode 100644 index 00000000000..bc3b3f767eb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.out @@ -0,0 +1 @@ +# cabal new-show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs new file mode 100644 index 00000000000..932c12a5955 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/lib.test.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ do + r <- cabal' "new-show-build-info" ["lib:Complex", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "lib" (componentType component) + assertEqual "Component name" "lib" (componentName component) + assertEqual "Component unit-id" "Complex-0.1.0.0-inplace" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertBool "Component ghc-options contains all specified in .cabal" + (all + (`elem` componentCompilerArgs component) + [ "-threaded" + , "-rtsopts" + , "-with-rtsopts=-N" + , "-Wall" + ] + ) + assertBool "Component ghc-options does not contain -Wredundant-constraints" + (all + (`notElem` componentCompilerArgs component) + [ "-Wredundant-constraints" + ] + ) + assertEqual "Component modules" ["Lib", "Paths_complex"] (componentModules component) + assertEqual "Component source files" [] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) + return () + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/criterion-1.1.4.0/criterion.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/criterion-1.1.4.0/criterion.cabal new file mode 100644 index 00000000000..e7cdc916530 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/criterion-1.1.4.0/criterion.cabal @@ -0,0 +1,8 @@ +name: criterion +version: 1.1.4.0 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: base, ghc-prim + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/hspec-2.7.1/hspec.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/hspec-2.7.1/hspec.cabal new file mode 100644 index 00000000000..d203fd4cd0e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/hspec-2.7.1/hspec.cabal @@ -0,0 +1,8 @@ +name: test-framework +version: 2.7.1 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs new file mode 100644 index 00000000000..5d35e3e9617 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Lib.hs @@ -0,0 +1,4 @@ +module Lib where + +foo :: Int -> Int +foo = (+1) \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs new file mode 100644 index 00000000000..a1b75006b8d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/Main.lhs @@ -0,0 +1,9 @@ +module Main where + +import Lib + +main :: IO () +main = do + let i = foo 5 + putStrLn "Hello, Haskell!" + print i diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs new file mode 100644 index 00000000000..3ef47688534 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/Main.hs @@ -0,0 +1 @@ +main = return () \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/unit-test.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/unit-test.test.hs new file mode 100644 index 00000000000..9eda7c27b8d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/unit-test.test.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DeriveGeneric #-} +import Test.Cabal.Prelude + +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Generics + +main = cabalTest $ withRepo "repo" $ do + r <- cabal' "new-show-build-info" ["--enable-tests", "test:unit-test", "-v0"] + let buildInfoEither = eitherDecodeStrict (T.encodeUtf8 . T.pack $ resultOutput r) :: Either String [BuildInfo] + case buildInfoEither of + Left err -> fail $ "Could not parse build-info command" ++ err + Right buildInfos -> do + assertEqual "Build Infos, exactly one" 1 (length buildInfos) + let [buildInfo] = buildInfos + assertEqual "Cabal Version" "3.0.0.0" (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 + assertEqual "Component type" "test" (componentType component) + assertEqual "Component name" "test:unit" (componentName component) + assertEqual "Component unit-id" "Complex-0.1.0.0-inplace" (componentUnitId component) + assertBool "Component compiler args are non-empty" (not . null $ componentCompilerArgs component) + assertEqual "Component modules" ["Lib", "Paths_complex"] (componentModules component) + assertEqual "Component source files" [] (componentSrcFiles component) + assertEqual "Component source directories" ["src"] (componentSrcDirs component) + return () + +data BuildInfo = BuildInfo + { cabalVersion :: String + , compiler :: CompilerInfo + , components :: [ComponentInfo] + } deriving (Generic, Show) + +data CompilerInfo = CompilerInfo + { flavour :: String + , compilerId :: String + , path :: String + } deriving (Generic, Show) + +data ComponentInfo = ComponentInfo + { componentType :: String + , componentName :: String + , componentUnitId :: String + , componentCompilerArgs :: [String] + , componentModules :: [String] + , componentSrcFiles :: [String] + , componentSrcDirs :: [String] + } deriving (Generic, Show) + +instance ToJSON BuildInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON BuildInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + + +instance ToJSON CompilerInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON CompilerInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '-' } + +instance ToJSON ComponentInfo where + toEncoding = genericToEncoding defaultOptions +instance FromJSON ComponentInfo where + parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 10 . camelTo2 '-' } \ No newline at end of file