diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 1adb417f008..f9d4f129ad5 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -257,6 +257,7 @@ library Distribution.Utils.NubList Distribution.Utils.ShortText Distribution.Utils.Progress + Distribution.Utils.Json Distribution.Verbosity Distribution.Verbosity.Internal Distribution.Version @@ -337,7 +338,6 @@ library Distribution.Simple.GHC.EnvironmentParser Distribution.Simple.GHC.Internal Distribution.Simple.GHC.ImplInfo - Distribution.Simple.Utils.Json Distribution.ZinzaPrelude Paths_Cabal diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index f58d79f0f23..7756afc7e0b 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -107,6 +107,8 @@ import Data.List (unionBy, (\\)) import Distribution.PackageDescription.Parsec +import qualified Data.Text.IO as T + -- | A simple implementation of @main@ for a Cabal setup script. -- It reads the package description file using IO, and performs the -- action specified on the command line. @@ -263,31 +265,34 @@ buildAction hooks flags args = do hooks flags' { buildArgs = args } args showBuildInfoAction :: UserHooks -> ShowBuildInfoFlags -> Args -> IO () -showBuildInfoAction hooks (ShowBuildInfoFlags flags fileOutput) args = do - distPref <- findDistPrefOrDefault (buildDistPref flags) - let verbosity = fromFlag $ buildVerbosity flags +showBuildInfoAction hooks flags args = do + let buildFlags = buildInfoBuildFlags flags + distPref <- findDistPrefOrDefault (buildDistPref buildFlags) + let verbosity = fromFlag $ buildVerbosity buildFlags lbi <- getBuildConfig hooks verbosity distPref - let flags' = flags { buildDistPref = toFlag distPref - , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) - } + let buildFlags' = + buildFlags { buildDistPref = toFlag distPref + , buildCabalFilePath = maybeToFlag (cabalFilePath lbi) + } progs <- reconfigurePrograms verbosity - (buildProgramPaths flags') - (buildProgramArgs flags') + (buildProgramPaths buildFlags') + (buildProgramArgs buildFlags') (withPrograms lbi) - pbi <- preBuild hooks args flags' + pbi <- preBuild hooks args buildFlags' let lbi' = lbi { withPrograms = progs } pkg_descr0 = localPkgDescr lbi' pkg_descr = updatePackageDescription pbi pkg_descr0 -- TODO: Somehow don't ignore build hook? - buildInfoString <- showBuildInfo pkg_descr lbi' flags - case fileOutput of - Nothing -> putStr buildInfoString - Just fp -> writeFile fp buildInfoString + buildInfoText <- showBuildInfo pkg_descr lbi' flags + + case buildInfoOutputFile flags of + Nothing -> T.putStr buildInfoText + Just fp -> T.writeFile fp buildInfoText - postBuild hooks args flags' pkg_descr lbi' + postBuild hooks args buildFlags' pkg_descr lbi' replAction :: UserHooks -> ReplFlags -> Args -> IO () replAction hooks flags args = do diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index c5963c733ab..2a9ab48b504 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -31,6 +31,7 @@ module Distribution.Simple.Build ( import Prelude () import Distribution.Compat.Prelude import Distribution.Utils.Generic +import Distribution.Utils.Json import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.ComponentRequestedSpec @@ -77,7 +78,6 @@ import Distribution.Simple.Configure import Distribution.Simple.Register import Distribution.Simple.Test.LibV09 import Distribution.Simple.Utils -import Distribution.Simple.Utils.Json import Distribution.System import Distribution.Pretty @@ -90,6 +90,7 @@ import Control.Monad import qualified Data.Set as Set import System.FilePath ( (), (<.>), takeDirectory ) import System.Directory ( getCurrentDirectory ) +import qualified Data.Text as Text -- ----------------------------------------------------------------------------- -- |Build the libraries and executables in this package. @@ -134,15 +135,24 @@ build pkg_descr lbi flags suffixes = do showBuildInfo :: PackageDescription -- ^ Mostly information from the .cabal file - -> LocalBuildInfo -- ^ Configuration information - -> BuildFlags -- ^ Flags that the user passed to build - -> IO String + -> LocalBuildInfo -- ^ Configuration information + -> ShowBuildInfoFlags -- ^ Flags that the user passed to build + -> IO Text.Text showBuildInfo pkg_descr lbi flags = do - let verbosity = fromFlag (buildVerbosity flags) - targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags) + let buildFlags = buildInfoBuildFlags flags + verbosity = fromFlag (buildVerbosity buildFlags) + targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs buildFlags) + pwd <- getCurrentDirectory let targetsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) - doc = mkBuildInfo pkg_descr lbi flags targetsToBuild - return $ renderJson doc "" + result + | fromFlag (buildInfoComponentsOnly flags) = + let components = map (mkComponentInfo pwd pkg_descr lbi . targetCLBI) + targetsToBuild + in Text.unlines $ map (flip renderJson mempty) components + | otherwise = + let json = mkBuildInfo pwd pkg_descr lbi buildFlags targetsToBuild + in renderJson json mempty + return result repl :: PackageDescription -- ^ Mostly information from the .cabal file diff --git a/Cabal/src/Distribution/Simple/BuildTarget.hs b/Cabal/src/Distribution/Simple/BuildTarget.hs index e2f930ff68c..4f49e7a6bb2 100644 --- a/Cabal/src/Distribution/Simple/BuildTarget.hs +++ b/Cabal/src/Distribution/Simple/BuildTarget.hs @@ -67,7 +67,7 @@ import System.Directory ( doesFileExist, doesDirectoryExist ) import qualified Data.Map as Map -- | Take a list of 'String' build targets, and parse and validate them --- into actual 'TargetInfo's to be built/registered/whatever. +-- into actual 'TargetInfo's to be built\/registered\/whatever. readTargetInfos :: Verbosity -> PackageDescription -> LocalBuildInfo -> [String] -> IO [TargetInfo] readTargetInfos verbosity pkg_descr lbi args = do build_targets <- readBuildTargets verbosity pkg_descr args diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index 92c4a842697..3a1863ee942 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/Cabal/src/Distribution/Simple/Setup.hs @@ -2153,15 +2153,18 @@ optionNumJobs get set = -- ------------------------------------------------------------ data ShowBuildInfoFlags = ShowBuildInfoFlags - { buildInfoBuildFlags :: BuildFlags - , buildInfoOutputFile :: Maybe FilePath + { buildInfoBuildFlags :: BuildFlags + , buildInfoOutputFile :: Maybe FilePath + , buildInfoComponentsOnly :: Flag Bool + -- ^ If 'True' then only print components, each separated by a newline } deriving (Show, Typeable) defaultShowBuildFlags :: ShowBuildInfoFlags defaultShowBuildFlags = ShowBuildInfoFlags - { buildInfoBuildFlags = defaultBuildFlags - , buildInfoOutputFile = Nothing + { buildInfoBuildFlags = defaultBuildFlags + , buildInfoOutputFile = Nothing + , buildInfoComponentsOnly = Flag False } showBuildInfoCommand :: ProgramDb -> CommandUI ShowBuildInfoFlags @@ -2198,8 +2201,12 @@ showBuildInfoCommand progDb = CommandUI ++ [ option [] ["buildinfo-json-output"] "Write the result to the given file instead of stdout" - buildInfoOutputFile (\pf flags -> flags { buildInfoOutputFile = pf }) + buildInfoOutputFile (\v flags -> flags { buildInfoOutputFile = v }) (reqArg' "FILE" Just (maybe [] pure)) + , option [] ["buildinfo-components-only"] + "Print out only the component info, each separated by a newline" + buildInfoComponentsOnly (\v flags -> flags { buildInfoComponentsOnly = v}) + trueArg ] } diff --git a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs index 631685b1d57..2b323d1da5a 100644 --- a/Cabal/src/Distribution/Simple/ShowBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/ShowBuildInfo.hs @@ -2,7 +2,7 @@ -- 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. +-- @cabal show-build-info@ command. -- -- -- This format is intended for consumption by external tooling and should @@ -54,7 +54,12 @@ -- Note: At the moment this is only supported when using the GHC compiler. -- -module Distribution.Simple.ShowBuildInfo (mkBuildInfo) where +{-# LANGUAGE OverloadedStrings #-} + +module Distribution.Simple.ShowBuildInfo + ( mkBuildInfo, mkBuildInfo', mkCompilerInfo, mkComponentInfo ) where + +import qualified Data.Text as T import Distribution.Compat.Prelude import Prelude () @@ -70,77 +75,104 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program import Distribution.Simple.Setup import Distribution.Simple.Utils (cabalVersion) -import Distribution.Simple.Utils.Json +import Distribution.Utils.Json import Distribution.Types.TargetInfo import Distribution.Text import Distribution.Pretty -import Distribution.Utils.Path + +import System.FilePath (addTrailingPathSeparator) -- | Construct a JSON document describing the build information for a -- package. mkBuildInfo - :: PackageDescription -- ^ Mostly information from the .cabal file + :: FilePath -- ^ The source directory of the package + -> PackageDescription -- ^ Mostly information from the .cabal file -> LocalBuildInfo -- ^ Configuration information -> BuildFlags -- ^ Flags that the user passed to build -> [TargetInfo] -> Json -mkBuildInfo pkg_descr lbi _flags targetsToBuild = info - where - targetToNameAndLBI target = - (componentLocalName $ targetCLBI target, targetCLBI target) - componentsToBuild = map targetToNameAndLBI targetsToBuild - (.=) :: String -> Json -> (String, Json) - k .= v = (k, v) +mkBuildInfo wdir pkg_descr lbi _flags targetsToBuild = + JsonObject $ + mkBuildInfo' (mkCompilerInfo (withPrograms lbi) (compiler lbi)) + (map (mkComponentInfo wdir pkg_descr lbi . targetCLBI) targetsToBuild) - info = JsonObject - [ "cabal-version" .= JsonString (display cabalVersion) - , "compiler" .= mkCompilerInfo - , "components" .= JsonArray (map mkComponentInfo componentsToBuild) - ] +-- | A variant of 'mkBuildInfo' if you need to call 'mkCompilerInfo' and +-- 'mkComponentInfo' yourself. +mkBuildInfo' + :: Json -- ^ The 'Json' from 'mkCompilerInfo' + -> [Json] -- ^ The 'Json' from 'mkComponentInfo' + -> [(T.Text, Json)] +mkBuildInfo' cmplrInfo componentInfos = + [ "cabal-version" .= JsonString (T.pack (display cabalVersion)) + , "compiler" .= cmplrInfo + , "components" .= JsonArray componentInfos + ] - mkCompilerInfo = JsonObject - [ "flavour" .= JsonString (prettyShow $ compilerFlavor $ compiler lbi) - , "compiler-id" .= JsonString (showCompilerId $ compiler lbi) - , "path" .= path - ] - where - path = maybe JsonNull (JsonString . programPath) - $ (flavorToProgram . compilerFlavor $ compiler lbi) - >>= flip lookupProgram (withPrograms lbi) +mkCompilerInfo :: ProgramDb -> Compiler -> Json +mkCompilerInfo programDb cmplr = JsonObject + [ "flavour" .= JsonString (T.pack (prettyShow $ compilerFlavor cmplr)) + , "compiler-id" .= JsonString (T.pack (showCompilerId cmplr)) + , "path" .= path + ] + where + path = maybe JsonNull (JsonString . T.pack . programPath) + $ (flavorToProgram . compilerFlavor $ cmplr) + >>= flip lookupProgram programDb - flavorToProgram :: CompilerFlavor -> Maybe Program - flavorToProgram GHC = Just ghcProgram - flavorToProgram GHCJS = Just ghcjsProgram - flavorToProgram UHC = Just uhcProgram - flavorToProgram JHC = Just jhcProgram - flavorToProgram _ = Nothing + flavorToProgram :: CompilerFlavor -> Maybe Program + flavorToProgram GHC = Just ghcProgram + flavorToProgram GHCJS = Just ghcjsProgram + flavorToProgram UHC = Just uhcProgram + flavorToProgram JHC = Just jhcProgram + flavorToProgram _ = Nothing - mkComponentInfo (name, clbi) = JsonObject - [ "type" .= JsonString compType - , "name" .= JsonString (prettyShow name) - , "unit-id" .= JsonString (prettyShow $ componentUnitId clbi) - , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) - , "modules" .= JsonArray (map (JsonString . display) modules) - , "src-files" .= JsonArray (map JsonString sourceFiles) - , "src-dirs" .= JsonArray (map JsonString $ map getSymbolicPath $ hsSourceDirs bi) - ] - where - bi = componentBuildInfo comp - comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name - compType = case comp of - CLib _ -> "lib" - CExe _ -> "exe" - CTest _ -> "test" - CBench _ -> "bench" - CFLib _ -> "flib" - modules = case comp of - CLib lib -> explicitLibModules lib - CExe exe -> exeModules exe - _ -> [] - sourceFiles = case comp of - CLib _ -> [] - CExe exe -> [modulePath exe] - _ -> [] +mkComponentInfo :: FilePath -> PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> Json +mkComponentInfo wdir pkg_descr lbi clbi = JsonObject $ + [ "type" .= JsonString compType + , "name" .= JsonString (T.pack $ prettyShow name) + , "unit-id" .= JsonString (T.pack $ prettyShow $ componentUnitId clbi) + , "compiler-args" .= JsonArray (map JsonString $ getCompilerArgs bi lbi clbi) + , "modules" .= JsonArray (map (JsonString . T.pack . display) modules) + , "src-files" .= JsonArray (map (JsonString . T.pack) sourceFiles) + , "hs-src-dirs" .= JsonArray (map (JsonString . T.pack . prettyShow) $ hsSourceDirs bi) + , "src-dir" .= JsonString (T.pack $ addTrailingPathSeparator wdir) + ] <> cabalFile + where + name = componentLocalName clbi + bi = componentBuildInfo comp + comp = fromMaybe (error $ "mkBuildInfo: no component " ++ prettyShow name) $ lookupComponent pkg_descr name + compType = case comp of + CLib _ -> "lib" + CExe _ -> "exe" + CTest _ -> "test" + CBench _ -> "bench" + CFLib _ -> "flib" + modules = case comp of + CLib lib -> explicitLibModules lib + CExe exe -> exeModules exe + CTest test -> + case testInterface test of + TestSuiteExeV10 _ _ -> [] + TestSuiteLibV09 _ modName -> [modName] + TestSuiteUnsupported _ -> [] + CBench bench -> benchmarkModules bench + CFLib flib -> foreignLibModules flib + sourceFiles = case comp of + CLib _ -> [] + CExe exe -> [modulePath exe] + CTest test -> + case testInterface test of + TestSuiteExeV10 _ fp -> [fp] + TestSuiteLibV09 _ _ -> [] + TestSuiteUnsupported _ -> [] + CBench bench -> case benchmarkInterface bench of + BenchmarkExeV10 _ fp -> [fp] + BenchmarkUnsupported _ -> [] + + CFLib _ -> [] + cabalFile + | Just fp <- pkgDescrFile lbi = [("cabal-file", JsonString (T.pack fp))] + | otherwise = [] -- | Get the command-line arguments that would be passed -- to the compiler to build the given component. @@ -148,7 +180,7 @@ getCompilerArgs :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo - -> [String] + -> [T.Text] getCompilerArgs bi lbi clbi = case compilerFlavor $ compiler lbi of GHC -> ghc @@ -157,6 +189,7 @@ getCompilerArgs bi lbi clbi = "build arguments for compiler "++show c where -- This is absolutely awful - ghc = GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts + ghc = T.pack <$> + GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) baseOpts where baseOpts = GHC.componentGhcOptions normal lbi bi clbi (buildDir lbi) diff --git a/Cabal/src/Distribution/Simple/Utils/Json.hs b/Cabal/src/Distribution/Simple/Utils/Json.hs deleted file mode 100644 index f90f2f38aa2..00000000000 --- a/Cabal/src/Distribution/Simple/Utils/Json.hs +++ /dev/null @@ -1,46 +0,0 @@ --- | 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/src/Distribution/Utils/Json.hs b/Cabal/src/Distribution/Utils/Json.hs new file mode 100644 index 00000000000..15573c9c05a --- /dev/null +++ b/Cabal/src/Distribution/Utils/Json.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | Extremely simple JSON helper. Don't do anything too fancy with this! +module Distribution.Utils.Json + ( Json(..) + , (.=) + , renderJson + ) where + +import Data.Text (Text) +import qualified Data.Text as Text + +data Json = JsonArray [Json] + | JsonBool !Bool + | JsonNull + | JsonNumber !Int + | JsonObject [(Text, Json)] + | JsonRaw !Text + | JsonString !Text + +-- | A type to mirror 'ShowS' +type ShowT = Text -> Text + +renderJson :: Json -> ShowT +renderJson (JsonArray objs) = + surround "[" "]" $ intercalate "," $ map renderJson objs +renderJson (JsonBool True) = showText "true" +renderJson (JsonBool False) = showText "false" +renderJson JsonNull = showText "null" +renderJson (JsonNumber n) = showText $ Text.pack (show n) +renderJson (JsonObject attrs) = + surround "{" "}" $ intercalate "," $ map render attrs + where + render (k,v) = (surround "\"" "\"" $ showText' k) . showText ":" . renderJson v +renderJson (JsonString s) = surround "\"" "\"" $ showText' s +renderJson (JsonRaw s) = showText s + +surround :: Text -> Text -> ShowT -> ShowT +surround begin end middle = showText begin . middle . showText end + +showText :: Text -> ShowT +showText = (<>) + +showText' :: Text -> ShowT +showText' xs = showStringWorker xs + where + showStringWorker :: Text -> ShowT + showStringWorker t = + case Text.uncons t of + Just ('\r', as) -> showText "\\r" . showStringWorker as + Just ('\n', as) -> showText "\\n" . showStringWorker as + Just ('\"', as) -> showText "\\\"" . showStringWorker as + Just ('\\', as) -> showText "\\\\" . showStringWorker as + Just (x, as) -> showText (Text.singleton x) . showStringWorker as + Nothing -> showText "" + +intercalate :: Text -> [ShowT] -> ShowT +intercalate sep = go + where + go [] = id + go [x] = x + go (x:xs) = x . showText' sep . go xs + +(.=) :: Text -> Json -> (Text, Json) +k .= v = (k, v) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index a6618def56e..aa7c41a54bc 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -88,6 +88,7 @@ library Distribution.Client.CmdOutdated Distribution.Client.CmdRepl Distribution.Client.CmdRun + Distribution.Client.CmdShowBuildInfo Distribution.Client.CmdSdist Distribution.Client.CmdTest Distribution.Client.CmdUpdate diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 51786f996c5..46f2521b392 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -75,6 +75,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 @@ -245,7 +246,9 @@ mainWorker args = do , hiddenCmd actAsSetupCommand actAsSetupAction , hiddenCmd manpageCommand (manpageAction commandSpecs) , regularCmd CmdListBin.listbinCommand CmdListBin.listbinAction - + -- ghc-mod supporting commands + , hiddenCmd CmdShowBuildInfo.showBuildInfoCommand + CmdShowBuildInfo.showBuildInfoAction ] ++ concat [ newCmd CmdConfigure.configureCommand CmdConfigure.configureAction , newCmd CmdUpdate.updateCommand CmdUpdate.updateAction diff --git a/cabal-install/src/Distribution/Client/CmdBench.hs b/cabal-install/src/Distribution/Client/CmdBench.hs index 7e65034e05a..a6d9aad58e3 100644 --- a/cabal-install/src/Distribution/Client/CmdBench.hs +++ b/cabal-install/src/Distribution/Client/CmdBench.hs @@ -118,7 +118,7 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - cliConfig = commandLineFlagsToProjectConfig globalFlags flags + cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here -- | This defines what a 'TargetSelector' means for the @bench@ command. diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index ea59acfff19..cb8c557fafb 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -8,7 +8,8 @@ module Distribution.Client.CmdBuild ( -- * Internals exposed for testing selectPackageTargets, - selectComponentTarget + selectComponentTarget, + reportTargetProblems ) where import Prelude () diff --git a/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs new file mode 100644 index 00000000000..7bf1f3b60e4 --- /dev/null +++ b/cabal-install/src/Distribution/Client/CmdShowBuildInfo.hs @@ -0,0 +1,192 @@ +{-# LANGUAGE RecordWildCards, OverloadedStrings #-} +-- | cabal-install CLI command: show-build-info +-- +module Distribution.Client.CmdShowBuildInfo ( + -- * The @show-build-info@ CLI and action + showBuildInfoCommand, + showBuildInfoAction + ) where + +import Distribution.Client.Compat.Prelude + ( for ) +import Distribution.Client.ProjectOrchestration +import Distribution.Client.CmdErrorMessages + +import Distribution.Client.Setup + ( GlobalFlags ) +import Distribution.Client.TargetProblem + ( TargetProblem', TargetProblem (TargetProblemNoneEnabled, TargetProblemNoTargets) ) +import Distribution.Simple.Setup + ( configVerbosity, fromFlagOrDefault ) +import Distribution.Simple.Command + ( CommandUI(..), option, reqArg', usageAlternatives ) +import Distribution.Verbosity + ( Verbosity, silent ) +import Distribution.Simple.Utils + ( wrapText, withOutputMarker ) + +import qualified Data.Map as Map +import Distribution.Client.ProjectPlanning.Types +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) +import Distribution.Client.DistDirLayout + ( distProjectRootDirectory, DistDirLayout (distProjectCacheDirectory) ) + +import Distribution.Simple.ShowBuildInfo +import Distribution.Utils.Json + +import qualified Data.Text as T +import qualified Data.Text.IO as T +import System.FilePath +import Distribution.Types.UnitId (unUnitId) + +showBuildInfoCommand :: CommandUI (NixStyleFlags ShowBuildInfoFlags) +showBuildInfoCommand = CommandUI { + commandName = "show-build-info", + commandSynopsis = "Show project build information", + commandUsage = usageAlternatives "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 ++ " show-build-info\n" + ++ " Shows build information about the current package\n" + ++ " " ++ pname ++ " show-build-info .\n" + ++ " Shows build information about the current package\n" + ++ " " ++ pname ++ " show-build-info ./pkgname \n" + ++ " Shows build information about the package located in './pkgname'\n", + commandOptions = nixStyleOptions $ \_ -> + [ 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)) + ], + commandDefaultFlags = defaultNixStyleFlags defaultShowBuildInfoFlags + } + +data ShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoOutputFile :: Maybe FilePath + } + +defaultShowBuildInfoFlags :: ShowBuildInfoFlags +defaultShowBuildInfoFlags = ShowBuildInfoFlags + { buildInfoOutputFile = Nothing + } + +-- | The @show-build-info@ exports information about a package and the compiler +-- configuration used to build it as JSON, that can be used by other tooling. +-- See "Distribution.Simple.ShowBuildInfo" for more information. +showBuildInfoAction :: NixStyleFlags ShowBuildInfoFlags -> [String] -> GlobalFlags -> IO () +showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileOutput), ..} + targetStrings globalFlags = do + baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand + + 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 (reportShowBuildInfoTargetProblems verbosity) return + $ resolveTargets + selectPackageTargets + selectComponentTarget + elaboratedPlan + Nothing + targetSelectors + + let elaboratedPlan' = pruneInstallPlanToTargets + TargetActionBuildInfo + targets + elaboratedPlan + + return (elaboratedPlan', targets) + + buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx + runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes + + let tm = targetsMap buildCtx + let units = Map.keys tm + let layout = distDirLayout baseCtx + let dir = distProjectCacheDirectory layout "buildinfo" + componentBuildInfos <- for units $ \unit -> do + let fp = dir (unUnitId unit) <.> "json" + T.strip <$> T.readFile fp + + let compilerInfo = mkCompilerInfo + (pkgConfigCompilerProgs (elaboratedShared buildCtx)) + (pkgConfigCompiler (elaboratedShared buildCtx)) + + components = map JsonRaw componentBuildInfos + fields = mkBuildInfo' compilerInfo components + json = JsonObject $ fields <> + [ ("project-root", JsonString (T.pack (addTrailingPathSeparator $ distProjectRootDirectory (distDirLayout baseCtx)))) + ] + res = renderJson json "" + + case fileOutput of + Nothing -> T.putStrLn $ T.pack $ withOutputMarker verbosity (T.unpack res) + Just fp -> T.writeFile fp res + + where + -- Default to silent verbosity otherwise it will pollute our json output + verbosity = fromFlagOrDefault silent (configVerbosity configFlags) + -- Also shut up haddock since it dumps warnings to stdout + -- flags' = flags { haddockFlags = haddockFlags { haddockVerbosity = Flag silent } + -- , configFlags = configFlags { Cabal.configTests = Flag True + -- , Cabal.configBenchmarks = Flag True + -- } + -- } + cliConfig = commandLineFlagsToProjectConfig globalFlags flags + mempty -- ClientInstallFlags, not needed here + +-- | This defines what a 'TargetSelector' means for the @show-build-info@ command. +-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, +-- or otherwise classifies the problem. +-- +-- For the @show-build-info@ command select all components except non-buildable and disabled +-- tests\/benchmarks, fail if there are no such components +-- +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 = selectComponentTargetBasic + + +reportShowBuildInfoTargetProblems :: Verbosity -> [TargetProblem'] -> IO a +reportShowBuildInfoTargetProblems verbosity problems = + reportTargetProblems verbosity "show-build-info" problems \ No newline at end of file diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding.hs b/cabal-install/src/Distribution/Client/ProjectBuilding.hs index fac7f863f2b..460d095988f 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding.hs @@ -378,12 +378,13 @@ packageFileMonitorKeyValues elab = -- elab_config = elab { - elabBuildTargets = [], - elabTestTargets = [], - elabBenchTargets = [], - elabReplTarget = Nothing, - elabHaddockTargets = [], - elabBuildHaddocks = False + elabBuildTargets = [], + elabBuildInfoTargets = [], + elabTestTargets = [], + elabBenchTargets = [], + elabReplTarget = Nothing, + elabHaddockTargets = [], + elabBuildHaddocks = False } -- The second part is the value used to guard the build step. So this is @@ -456,9 +457,10 @@ checkPackageFileMonitorChanged PackageFileMonitor{..} (MonitorUnchanged buildResult _, MonitorUnchanged _ _) -> return $ Right BuildResult { - buildResultDocs = docsResult, - buildResultTests = testsResult, - buildResultLogFile = Nothing + buildResultDocs = docsResult, + buildResultTests = testsResult, + buildResultLogFile = Nothing, + buildResultBuildInfo = Nothing } where (docsResult, testsResult) = buildResult @@ -666,7 +668,7 @@ rebuildTarget verbosity BuildStatusDownload -> void $ waitAsyncPackageDownload verbosity downloadMap pkg _ -> return () - return $ BuildResult DocsNotTried TestsNotTried Nothing + return $ BuildResult DocsNotTried TestsNotTried Nothing Nothing | otherwise = -- We rely on the 'BuildStatus' to decide which phase to start from: case pkgBuildStatus of @@ -1066,9 +1068,10 @@ buildAndInstallUnpackedPackage verbosity noticeProgress ProgressCompleted return BuildResult { - buildResultDocs = docsResult, - buildResultTests = testsResult, - buildResultLogFile = mlogFile + buildResultDocs = docsResult, + buildResultTests = testsResult, + buildResultLogFile = mlogFile, + buildResultBuildInfo = Nothing } where @@ -1190,6 +1193,7 @@ buildInplaceUnpackedPackage :: Verbosity buildInplaceUnpackedPackage verbosity distDirLayout@DistDirLayout { distTempDirectory, + distProjectCacheDirectory, distPackageCacheDirectory, distDirectory } @@ -1313,10 +1317,24 @@ buildInplaceUnpackedPackage verbosity Tar.createTarGzFile dest docDir name notice verbosity $ "Documentation tarball created: " ++ dest + -- Build info phase + {- buildInfo <- -} + whenBuildInfo $ do + -- Write the json to a temporary file to read it, since stdout can get + -- cluttered + let dir = distProjectCacheDirectory "buildinfo" + let fp = dir (unUnitId $ elabUnitId pkg) <.> "json" + createDirectoryIfMissing True dir + setupInteractive + buildInfoCommand + (\v -> (buildInfoFlags v) { Cabal.buildInfoOutputFile = Just fp }) + buildInfoArgs + return BuildResult { buildResultDocs = docsResult, buildResultTests = testsResult, - buildResultLogFile = Nothing + buildResultLogFile = Nothing, + buildResultBuildInfo = Nothing } where @@ -1354,6 +1372,10 @@ buildInplaceUnpackedPackage verbosity | hasValidHaddockTargets pkg = action | otherwise = return () + whenBuildInfo action + | null (elabBuildInfoTargets pkg) = return () + | otherwise = action + whenReRegister action = case buildStatus of -- We registered the package already @@ -1398,6 +1420,10 @@ buildInplaceUnpackedPackage verbosity haddockArgs v = flip filterHaddockArgs v $ setupHsHaddockArgs pkg + buildInfoCommand = Cabal.showBuildInfoCommand defaultProgramDb + buildInfoFlags _ = setupHsShowBuildInfoFlags pkg pkgshared verbosity builddir + buildInfoArgs _ = setupHsShowBuildInfoArgs pkg + scriptOptions = setupHsScriptOptions rpkg plan pkgshared distDirLayout srcdir builddir isParallelBuild cacheLock diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs index f9ac571f3b6..65fc6149ba5 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/Types.hs @@ -32,6 +32,8 @@ import Distribution.Package (UnitId, PackageId) import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Simple.LocalBuildInfo (ComponentName) +import Data.Text (Text) + ------------------------------------------------------------------------------ -- Pre-build status: result of the dry run @@ -173,9 +175,10 @@ type BuildOutcome = Either BuildFailure BuildResult -- | Information arising from successfully building a single package. -- data BuildResult = BuildResult { - buildResultDocs :: DocsResult, - buildResultTests :: TestsResult, - buildResultLogFile :: Maybe FilePath + buildResultDocs :: DocsResult, + buildResultTests :: TestsResult, + buildResultLogFile :: Maybe FilePath, + buildResultBuildInfo :: Maybe Text } deriving Show diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 077c6422be4..e9868a87cf9 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -57,6 +57,8 @@ module Distribution.Client.ProjectPlanning ( setupHsRegisterFlags, setupHsHaddockFlags, setupHsHaddockArgs, + setupHsShowBuildInfoFlags, + setupHsShowBuildInfoArgs, packageHashInputs, @@ -1780,6 +1782,7 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB elabBenchTargets = [] elabReplTarget = Nothing elabHaddockTargets = [] + elabBuildInfoTargets = [] elabBuildHaddocks = perPkgOptionFlag pkgid False packageConfigDocumentation @@ -2592,7 +2595,7 @@ nubComponentTargets = -> [(ComponentTarget, NonEmpty a)] wholeComponentOverrides ts = case [ ta | ta@(ComponentTarget _ WholeComponent, _) <- ts ] of - ((t, x):_) -> + ((t, x):_) -> let -- Delete tuple (t, x) from original list to avoid duplicates. -- Use 'deleteBy', to avoid additional Class constraint on 'nubComponentTargets'. @@ -2621,6 +2624,7 @@ pkgHasEphemeralBuildTargets elab = || (not . null) (elabTestTargets elab) || (not . null) (elabBenchTargets elab) || (not . null) (elabHaddockTargets elab) + || (not . null) (elabBuildInfoTargets elab) || (not . null) [ () | ComponentTarget _ subtarget <- elabBuildTargets elab , subtarget /= WholeComponent ] @@ -2649,6 +2653,7 @@ data TargetAction = TargetActionConfigure | TargetActionTest | TargetActionBench | TargetActionHaddock + | TargetActionBuildInfo -- | Given a set of per-package\/per-component targets, take the subset of the -- install plan needed to build those targets. Also, update the package config @@ -2726,6 +2731,7 @@ setRootTargets targetAction perPkgTargetsMap = (Just tgts, TargetActionHaddock) -> foldr setElabHaddockTargets (elab { elabHaddockTargets = tgts , elabBuildHaddocks = True }) tgts + (Just tgts, TargetActionBuildInfo) -> elab { elabBuildInfoTargets = tgts } (Just _, TargetActionRepl) -> error "pruneInstallPlanToTargets: multiple repl targets" @@ -2769,14 +2775,15 @@ pruneInstallPlanPass1 pkgs = , null (elabBenchTargets elab) , isNothing (elabReplTarget elab) , null (elabHaddockTargets elab) + , null (elabBuildInfoTargets elab) ] then Just (installedUnitId elab) else Nothing - find_root (InstallPlan.Configured pkg) = is_root pkg -- When using the extra-packages stanza we need to -- look at installed packages as well. find_root (InstallPlan.Installed pkg) = is_root pkg + find_root (InstallPlan.Configured pkg) = is_root pkg find_root _ = Nothing -- Note [Sticky enabled testsuites] @@ -3684,6 +3691,22 @@ setupHsHaddockArgs :: ElaboratedConfiguredPackage -> [String] setupHsHaddockArgs elab = map (showComponentTarget (packageId elab)) (elabHaddockTargets elab) +setupHsShowBuildInfoFlags :: ElaboratedConfiguredPackage + -> ElaboratedSharedConfig + -> Verbosity + -> FilePath + -> Cabal.ShowBuildInfoFlags +setupHsShowBuildInfoFlags pkg config verbosity builddir = + Cabal.ShowBuildInfoFlags { + buildInfoBuildFlags = setupHsBuildFlags pkg config verbosity builddir, + buildInfoOutputFile = Nothing, + buildInfoComponentsOnly = toFlag True + } + +setupHsShowBuildInfoArgs :: ElaboratedConfiguredPackage -> [String] +setupHsShowBuildInfoArgs elab = + map (showComponentTarget (packageId elab)) (elabBuildInfoTargets elab) + {- setupHsTestFlags :: ElaboratedConfiguredPackage -> ElaboratedSharedConfig diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs index 0388886ecde..36bda12417e 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning/Types.hs @@ -321,6 +321,7 @@ data ElaboratedConfiguredPackage elabBenchTargets :: [ComponentTarget], elabReplTarget :: Maybe ComponentTarget, elabHaddockTargets :: [ComponentTarget], + elabBuildInfoTargets :: [ComponentTarget], elabBuildHaddocks :: Bool, diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index c710b4a384e..d2953d0dff8 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -178,6 +178,7 @@ globalCommand commands = CommandUI { , "outdated" , "haddock" , "hscolour" + , "show-build-info" , "exec" , "new-build" , "new-configure" @@ -264,6 +265,7 @@ globalCommand commands = CommandUI { , addCmd "upload" , addCmd "report" , par + , addCmd "show-build-info" , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs index 0b5fde29c9e..968b503d28f 100644 --- a/cabal-install/src/Distribution/Client/Utils.hs +++ b/cabal-install/src/Distribution/Client/Utils.hs @@ -111,8 +111,8 @@ removeExistingFile path = do -- it will clean up the file afterwards, it's lenient if the file is -- moved\/deleted. -- -withTempFileName :: FilePath - -> String +withTempFileName :: FilePath -- ^ Directory to create file in + -> String -- ^ Template for the file name -> (FilePath -> IO a) -> IO a withTempFileName tmpDir template action = Exception.bracket diff --git a/cabal-testsuite/PackageTests/Configure/include/HsZlibConfig.h.in b/cabal-testsuite/PackageTests/Configure/include/HsZlibConfig.h.in index aa500c7d2ce..b276a09c56f 100644 --- a/cabal-testsuite/PackageTests/Configure/include/HsZlibConfig.h.in +++ b/cabal-testsuite/PackageTests/Configure/include/HsZlibConfig.h.in @@ -3,12 +3,12 @@ /* Define to 1 if you have the header file. */ #undef HAVE_INTTYPES_H -/* Define to 1 if you have the header file. */ -#undef HAVE_MEMORY_H - /* Define to 1 if you have the header file. */ #undef HAVE_STDINT_H +/* Define to 1 if you have the header file. */ +#undef HAVE_STDIO_H + /* Define to 1 if you have the header file. */ #undef HAVE_STDLIB_H @@ -45,5 +45,7 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION -/* Define to 1 if you have the ANSI C header files. */ +/* Define to 1 if all of the C90 standard headers exist (not just the ones + required in a freestanding environment). This macro is provided for + backward compatibility; new code need not use it. */ #undef STDC_HEADERS diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal new file mode 100644 index 00000000000..a1420d9676e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/A.cabal @@ -0,0 +1,23 @@ +cabal-version: 2.4 +name: A +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: A + build-depends: base >=4 + hs-source-dirs: src + default-language: Haskell2010 + +executable A + main-is: Main.hs + build-depends: base >=4 + hs-source-dirs: src + default-language: Haskell2010 + +test-suite A-tests + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base >=4, A + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/B.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/B.cabal new file mode 100644 index 00000000000..e81b9eb3a1d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/B.cabal @@ -0,0 +1,10 @@ +cabal-version: 2.4 +name: B +version: 0.1.0.0 +license: BSD-3-Clause + +library + exposed-modules: B + build-depends: base >=4.0.0.0, A + hs-source-dirs: lib + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/lib/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/lib/A.hs new file mode 100644 index 00000000000..8b74dfe6b43 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/B/lib/A.hs @@ -0,0 +1,4 @@ +module B where + +foo :: Int -> Int +foo = id diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.test.hs new file mode 100644 index 00000000000..f3ad330757e --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-lib.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["lib:B"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 1 (length $ components buildInfo) + let [libComp] = components buildInfo + assertLibComponent libComp "lib" ["B"] ["lib"] \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.test.hs new file mode 100644 index 00000000000..cbe6553cedb --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-B-outer-lib.test.hs @@ -0,0 +1,10 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["lib:B", "lib:A"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 2 (length $ components buildInfo) + let [libAComp, libBComp] = components buildInfo + assertLibComponent libAComp "lib" ["A"] ["src"] + assertLibComponent libBComp "lib" ["B"] ["lib"] diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs new file mode 100644 index 00000000000..ce34607f1b4 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-all.test.hs @@ -0,0 +1,12 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["all", "--enable-tests"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 4 (length $ components buildInfo) + let [libAComp, exeComp, testComp, libBComp] = components buildInfo + assertExeComponent exeComp "exe:A" ["Main.hs"] ["src"] + assertLibComponent libAComp "lib" ["A"] ["src"] + assertLibComponent libBComp "lib" ["B"] ["lib"] + assertTestComponent testComp "test:A-tests" ["Test.hs"] ["src"] diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.test.hs new file mode 100644 index 00000000000..213de15a7e4 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-exe.test.hs @@ -0,0 +1,13 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["exe:A"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 1 (length $ components buildInfo) + let [exeComp] = components buildInfo + assertExeComponent exeComp "exe:A" ["Main.hs"] ["src"] + + -- Must not have library as a dependency as "exe:A" does not depend on it. + assertBool "Does not contain library as dependency" + (all (/= "A-0.1.0.0-inplace") $ componentCompilerArgs exeComp) \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.out new file mode 100644 index 00000000000..3b4215e5719 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.out @@ -0,0 +1,4 @@ +# cabal show-build-info +Resolving dependencies... +Configuring library for A-0.1.0.0.. +Configuring executable 'A' for A-0.1.0.0.. diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.test.hs new file mode 100644 index 00000000000..f0160428fd7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets-file.test.hs @@ -0,0 +1,13 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ withSourceCopy $ do + cwd <- fmap testCurrentDir getTestEnv + let fp = cwd "unit.json" + _ <- cabal' "show-build-info" ["--buildinfo-json-output=" ++ fp, "exe:A", "lib:A"] + buildInfo <- decodeBuildInfoFile fp + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 2 (length $ components buildInfo) + let [libBuildInfo, exeBuildInfo] = components buildInfo + assertExeComponent exeBuildInfo "exe:A" ["Main.hs"] ["src"] + assertLibComponent libBuildInfo "lib" ["A"] ["src"] diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.test.hs new file mode 100644 index 00000000000..4ab4185b8be --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-multiple-targets.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["exe:A", "lib:A"] + assertCommonBuildInfo buildInfo + let [libBuildInfo, exeBuildInfo] = components buildInfo + assertExeComponent exeBuildInfo "exe:A" ["Main.hs"] ["src"] + assertLibComponent libBuildInfo "lib" ["A"] ["src"] \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.test.hs new file mode 100644 index 00000000000..6e11334d323 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-no-target.test.hs @@ -0,0 +1,12 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo [] + assertCommonBuildInfo buildInfo + let comps = components buildInfo + assertEqual "Number of Components" 2 (length comps) + assertBool "Contains main component executable" + (any (\c -> "exe:A" == componentName c) comps) + assertBool "Contains main component library" + (any (\c -> "lib" == componentName c) comps) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.out b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.out new file mode 100644 index 00000000000..6fbda9790b7 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.out @@ -0,0 +1 @@ +# cabal show-build-info diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.test.hs new file mode 100644 index 00000000000..1d1df200639 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-test.test.hs @@ -0,0 +1,13 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ do + buildInfo <- runShowBuildInfo ["test:A-tests"] + assertCommonBuildInfo buildInfo + assertEqual "Number of Components" 1 (length $ components buildInfo) + let [testComp] = components buildInfo + assertTestComponent testComp "test:A-tests" ["Test.hs"] ["src"] + + -- Must have library as a dependency as "test:A-tests" depends on it. + assertBool "Contains internal dependency" + (any (== "A-0.1.0.0-inplace") $ componentCompilerArgs testComp) 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..53db13639c8 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.out @@ -0,0 +1,4 @@ +# cabal show-build-info +# cabal show-build-info +# cabal show-build-info +# cabal show-build-info 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..20ef51ac600 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/build-info-unknown.test.hs @@ -0,0 +1,15 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + r <- fails $ cabal' "show-build-info" ["exe:B", "-v1"] + assertOutputContains "Internal error in target matching." r + + r <- fails $ cabal' "show-build-info" ["C", "-v1"] + assertOutputContains "Cannot show-build-info the package C, it is not in this project (either directly or indirectly)." r + + r <- fails $ cabal' "show-build-info" ["lib:C", "-v1"] + assertOutputContains "Internal error in target matching." r + + r <- fails $ cabal' "show-build-info" ["benchmarks", "-v1"] + assertOutputContains "Cannot show-build-info the benchmarks in the package A-0.1.0.0 because it does not contain any benchmarks." 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..9a091f69b3b --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/cabal.project @@ -0,0 +1 @@ +packages: . ./B/ 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..6b02eec8ec0 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/A.hs @@ -0,0 +1,4 @@ +module A where + +foo :: Int -> Int +foo = id 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/src/Test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs new file mode 100644 index 00000000000..b918ddac664 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/A/src/Test.hs @@ -0,0 +1 @@ +main = putStrLn "testing" diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal new file mode 100644 index 00000000000..d8ea0a46eca --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/Complex.cabal @@ -0,0 +1,72 @@ +cabal-version: 2.4 +name: Complex +version: 0.1.0.0 +license: MIT + +library + build-depends: base + hs-source-dirs: src doesnt-exist + default-language: Haskell2010 + exposed-modules: + A + B + + autogen-modules: Paths_Complex + other-modules: + C + D + Paths_Complex + + ghc-options: -Wall + +executable Complex + main-is: Main.lhs + build-depends: + , base + , Complex + + hs-source-dirs: app + autogen-modules: Paths_Complex + other-modules: + Other + Paths_Complex + + ghc-options: + -threaded -rtsopts "-with-rtsopts=-N -T" -Wredundant-constraints + + default-language: Haskell2010 + +test-suite unit-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: + , another-framework + , base + + main-is: UnitMain.hs + default-language: Haskell2010 + +test-suite func-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + build-depends: + , base + , Complex + , test-framework + + main-is: FuncMain.hs + default-language: Haskell2010 + +benchmark complex-benchmarks + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: Paths_Complex + autogen-modules: Paths_Complex + hs-source-dirs: benchmark + ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N + build-depends: + , base + , Complex + , criterion ^>=1.1.4 + + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Main.lhs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Main.lhs new file mode 100644 index 00000000000..c1ea21ba48c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Main.lhs @@ -0,0 +1,8 @@ +module Main where + +import A +import Other + +main = do + print foo + print bar diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Other.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Other.hs new file mode 100644 index 00000000000..5d0685b1815 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/app/Other.hs @@ -0,0 +1,3 @@ +module Other where + +bar = () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/benchmark/Main.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/benchmark/Main.hs new file mode 100644 index 00000000000..7753bcff18c --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/benchmark/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = pure () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project new file mode 100644 index 00000000000..b5bc61b1b15 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/cabal.project @@ -0,0 +1,4 @@ +packages: . + +tests: True +benchmarks: True \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/another-framework-0.8.1.1/another-framework.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/another-framework-0.8.1.1/another-framework.cabal new file mode 100644 index 00000000000..173443e1906 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/another-framework-0.8.1.1/another-framework.cabal @@ -0,0 +1,8 @@ +name: another-framework +version: 0.8.1.1 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: base + default-language: Haskell2010 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/test-framework-0.8.1.1/test-framework.cabal b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/test-framework-0.8.1.1/test-framework.cabal new file mode 100644 index 00000000000..2235e2eeb39 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/repo/test-framework-0.8.1.1/test-framework.cabal @@ -0,0 +1,8 @@ +name: test-framework +version: 0.8.1.1 +build-type: Simple +cabal-version: >= 1.10 + +library + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out new file mode 100644 index 00000000000..ae4c421e26d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.out @@ -0,0 +1,40 @@ +# cabal v2-update +Downloading the latest package list from test-local-repo +# cabal show-build-info +Resolving dependencies... +Configuring library for Complex-0.1.0.0.. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +Preprocessing library for Complex-0.1.0.0.. +Building library for Complex-0.1.0.0.. +Configuring executable 'Complex' for Complex-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"exe","name":"exe:Complex","unit-id":"Complex-0.1.0.0-inplace-Complex","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-iapp","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/x/Complex/build/Complex/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010","-threaded","-rtsopts","-with-rtsopts=-N -T","-Wredundant-constraints"],"modules":["Other","Paths_Complex"],"src-files":["Main.lhs"],"hs-src-dirs":["app"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} +# cabal show-build-info +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"lib","name":"lib","unit-id":"Complex-0.1.0.0-inplace","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-isrc","-idoesnt-exist","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/build/autogen/cabal_macros.h","-this-unit-id","Complex-0.1.0.0-inplace","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-XHaskell2010","-Wall"],"modules":["A","B","C","D","Paths_Complex"],"src-files":[],"hs-src-dirs":["src","doesnt-exist"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} +# cabal show-build-info +Configuring library for criterion-1.1.4.0.. +Preprocessing library for criterion-1.1.4.0.. +Building library for criterion-1.1.4.0.. +Installing library in +Configuring benchmark 'complex-benchmarks' for Complex-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"bench","name":"bench:complex-benchmarks","unit-id":"Complex-0.1.0.0-inplace-complex-benchmarks","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-ibenchmark","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/b/complex-benchmarks/build/complex-benchmarks/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010","-Wall","-rtsopts","-threaded","-with-rtsopts=-N"],"modules":["Paths_Complex"],"src-files":["Main.hs"],"hs-src-dirs":["benchmark"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} +# cabal show-build-info +Configuring library for test-framework-0.8.1.1.. +Preprocessing library for test-framework-0.8.1.1.. +Building library for test-framework-0.8.1.1.. +Installing library in +Configuring test suite 'func-test' for Complex-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0, Complex >=0 && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"test","name":"test:func-test","unit-id":"Complex-0.1.0.0-inplace-func-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/func-test/build/func-test/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["FuncMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} +# cabal show-build-info +Configuring library for another-framework-0.8.1.1.. +Preprocessing library for another-framework-0.8.1.1.. +Building library for another-framework-0.8.1.1.. +Installing library in +Configuring test suite 'unit-test' for Complex-0.1.0.0.. +Warning: 'hs-source-dirs: doesnt-exist' directory does not exist. +{"cabal-version":"","compiler":{"flavour":"ghc","compiler-id":"ghc-","path":""},"components":[{"type":"test","name":"test:unit-test","unit-id":"Complex-0.1.0.0-inplace-unit-test","compiler-args":["-fbuilding-cabal-package","-O","-outputdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-odir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-hidir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-stubdir","/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-i","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-itest","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-i/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/global-autogen","-I/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build","-optP-include","-optP/single.dist/work/./dist/build//ghc-/Complex-0.1.0.0/t/unit-test/build/unit-test/autogen/cabal_macros.h","-hide-all-packages","-Wmissing-home-modules","-no-user-package-db","-package-db","/single.dist/home/.cabal/store/ghc-/package.db","-package-db","/single.dist/work/./dist/packagedb/ghc-","-package-id","","-package-id","","-XHaskell2010"],"modules":[],"src-files":["UnitMain.hs"],"hs-src-dirs":["test"],"src-dir":"/","cabal-file":"./Complex.cabal"}],"project-root":"/"} diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs new file mode 100644 index 00000000000..f3d0622d0ff --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/single.test.hs @@ -0,0 +1,33 @@ +import Test.Cabal.Prelude +import Test.Cabal.DecodeShowBuildInfo + +main = cabalTest $ withRepo "repo" $ do + runShowBuildInfoWithMarker ["exe:Complex"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [exeComp] = components buildInfo + assertExeComponent' exeComp "exe:Complex" ["Other", "Paths_Complex"] ["Main.lhs"] ["app"]) + + runShowBuildInfoWithMarker ["lib:Complex"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [libComp] = components buildInfo + assertLibComponent libComp "lib" ["A", "B", "C", "D", "Paths_Complex"] ["src", "doesnt-exist"]) + + runShowBuildInfoWithMarker ["benchmark:complex-benchmarks"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [benchComp] = components buildInfo + assertBenchComponent' benchComp "bench:complex-benchmarks" ["Paths_Complex"] ["Main.hs"] ["benchmark"]) + + runShowBuildInfoWithMarker ["test:func-test"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [testComp] = components buildInfo + assertTestComponent testComp "test:func-test" ["FuncMain.hs"] ["test"]) + + runShowBuildInfoWithMarker ["test:unit-test"] >>= + (\buildInfo -> do + assertCommonBuildInfo buildInfo + let [testComp] = components buildInfo + assertTestComponent testComp "test:unit-test" ["UnitMain.hs"] ["test"]) diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/A.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/A.hs new file mode 100644 index 00000000000..18032f68988 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/A.hs @@ -0,0 +1,5 @@ +module A where + +import D + +foo = d diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/B.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/B.hs new file mode 100644 index 00000000000..93b0222a65d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/B.hs @@ -0,0 +1,3 @@ +module B where + +b = 1 diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/C.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/C.hs new file mode 100644 index 00000000000..419eb7eca64 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/C.hs @@ -0,0 +1,5 @@ +module C where + +import B + +c = b diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/D.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/D.hs new file mode 100644 index 00000000000..d9be40b5ba2 --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/src/D.hs @@ -0,0 +1,5 @@ +module D where + +import C + +d = c diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/FuncMain.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/FuncMain.hs new file mode 100644 index 00000000000..b3549c2fe3d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/FuncMain.hs @@ -0,0 +1 @@ +main = return () diff --git a/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/UnitMain.hs b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/UnitMain.hs new file mode 100644 index 00000000000..b3549c2fe3d --- /dev/null +++ b/cabal-testsuite/PackageTests/ShowBuildInfo/Complex/test/UnitMain.hs @@ -0,0 +1 @@ +main = return () diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 46f111e0c94..322175f9d75 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -39,6 +39,7 @@ library hs-source-dirs: src exposed-modules: Test.Cabal.CheckArMetadata + Test.Cabal.DecodeShowBuildInfo Test.Cabal.Monad Test.Cabal.OutputNormalizer Test.Cabal.Plan diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs new file mode 100644 index 00000000000..355559ff06c --- /dev/null +++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs @@ -0,0 +1,124 @@ +{-# LANGUAGE DeriveGeneric #-} +module Test.Cabal.DecodeShowBuildInfo where + +import Test.Cabal.Prelude +import Distribution.Text (display) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Data.Aeson +import GHC.Stack.Types +import GHC.Generics + +-- | Run 'show-build-info' silencing all output using '-v0'. +-- This is necessary to make sure no stray output from 'show-build-info' makes +-- parsing impossible. +runShowBuildInfo :: [String] -> TestM BuildInfo +runShowBuildInfo args = do + r <- cabal' "show-build-info" ("-v0":args) + decodeShowBuildInfo (resultOutput r) + +-- | Same as 'runShowBuildInfo' but does not require the verbosity '-v0'. +-- Uses "-vverbose +markoutput +nowrap" to extract the relevant json output. +runShowBuildInfoWithMarker :: [String] -> TestM BuildInfo +runShowBuildInfoWithMarker args = do + r <- cabal' "show-build-info" args + decodeShowBuildInfo (last . lines . getMarkedOutput $ resultOutput r) + +decodeShowBuildInfo :: String -> TestM BuildInfo +decodeShowBuildInfo s = case eitherDecodeStrict (T.encodeUtf8 $ T.pack s) of + Left err -> fail $ "Could not parse show-build-info command: " ++ err + Right buildInfos -> return buildInfos + +decodeBuildInfoFile :: FilePath -> TestM BuildInfo +decodeBuildInfoFile fp = do + shouldExist fp + res <- liftIO $ eitherDecodeFileStrict fp + case res of + Left err -> fail $ "Could not parse show-build-info file: " ++ err + Right buildInfos -> return buildInfos + +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 :: [FilePath] + , componentHsSrcDirs :: [FilePath] + , componentSrcDir :: FilePath + } 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 '-' } + +-- ----------------------------------------------------------- +-- Assertion Helpers to define succinct test cases +-- ----------------------------------------------------------- + +assertCommonBuildInfo :: (HasCallStack, MonadIO m) => BuildInfo -> m () +assertCommonBuildInfo buildInfo = do + assertEqual "Cabal Version" (display cabalVersionLibrary) (cabalVersion buildInfo) + assertEqual "Compiler flavour" "ghc" (flavour $ compiler buildInfo) + assertBool "Compiler id" (and $ zipWith (==) "ghc" (compilerId $ compiler buildInfo)) + assertBool "Compiler path non-empty" (not . null . path $ compiler buildInfo) + +assertExeComponent :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> m () +assertExeComponent = assertExecutableComp "exe" + +assertExeComponent' :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> [String] -> m () +assertExeComponent' component compName modules sourceFiles sourceDirs = + assertArbitraryComp "exe" compName (not . null) (not . null) modules sourceFiles sourceDirs component + +assertLibComponent :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> m () +assertLibComponent component compName modules sourceDirs = + assertArbitraryComp "lib" compName (not . null) (not . null) modules [] sourceDirs component + +assertTestComponent :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> m () +assertTestComponent = assertExecutableComp "test" + +assertBenchComponent :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> m () +assertBenchComponent = assertExecutableComp "bench" + +assertBenchComponent' :: (HasCallStack, MonadIO m) => ComponentInfo -> String -> [String] -> [String] -> [String] -> m () +assertBenchComponent' component compName modules sourceFiles sourceDirs = + assertArbitraryComp "bench" compName (not . null) (not . null) modules sourceFiles sourceDirs component + +assertExecutableComp :: (HasCallStack, MonadIO m) => String -> ComponentInfo -> String -> [String] -> [String] -> m () +assertExecutableComp compType component compName sourceFiles sourceDirs = + assertArbitraryComp compType compName (not . null) (not . null) [] sourceFiles sourceDirs component + +assertArbitraryComp :: (HasCallStack, MonadIO m) => String -> String -> + (String -> Bool) -> ([String] -> Bool) -> [String] -> [FilePath] -> + [FilePath] -> ComponentInfo -> m () +assertArbitraryComp compType compName unitIdPred compilerArgsPred modules sourceFiles sourceDirs component = do + assertEqual "Component type" compType (componentType component) + assertEqual "Component name" compName (componentName component) + assertBool "Component Unit Id" (unitIdPred $ componentUnitId component) + assertBool "Component compiler args" (compilerArgsPred $ componentCompilerArgs component) + assertEqual "Component modules" modules (componentModules component) + assertEqual "Component source files" sourceFiles (componentSrcFiles component) + assertEqual "Component source directories" sourceDirs (componentHsSrcDirs component) diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index c320282c301..4a216b4b602 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -47,6 +47,8 @@ module Test.Cabal.Monad ( CommonArgs(..), renderCommonArgs, commonArgParser, + -- * Version Constants + cabalVersionLibrary, ) where import Test.Cabal.Script @@ -62,9 +64,11 @@ import Distribution.Simple.Program.Db import Distribution.Simple.Program import Distribution.Simple.Configure ( configCompilerEx ) +import qualified Distribution.Simple.Utils as U (cabalVersion) import Distribution.Text import Distribution.Verbosity +import Distribution.Version import Data.Monoid ((<>), mempty) import qualified Control.Exception as E @@ -398,6 +402,7 @@ mkNormalizerEnv = do list_out <- liftIO $ readProcess (programPath ghc_pkg_program) ["list", "--global", "--simple-output"] "" tmpDir <- liftIO $ getTemporaryDirectory + return NormalizerEnv { normalizerRoot = addTrailingPathSeparator (testSourceDir env), @@ -410,8 +415,14 @@ mkNormalizerEnv = do normalizerKnownPackages = mapMaybe simpleParse (words list_out), normalizerPlatform - = testPlatform env + = testPlatform env, + normalizerCabalVersion + = cabalVersionLibrary } + where + +cabalVersionLibrary :: Version +cabalVersionLibrary = U.cabalVersion requireProgramM :: Program -> TestM ConfiguredProgram requireProgramM program = do diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs index 4e6aec19890..a1529cc47f9 100644 --- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs +++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs @@ -49,6 +49,25 @@ normalizeOutput nenv = "/incoming/new-" -- Normalize architecture . resub (posixRegexEscape (display (normalizerPlatform nenv))) "" + -- Remove ghc path from show-build-info output + . resub ("\"path\":\"[^\"]*\"}") + "\"path\":\"\"}" + -- Remove cabal version output from show-build-info output + . resub ("{\"cabal-version\":\"" ++ posixRegexEscape (display (normalizerCabalVersion nenv)) ++ "\"") + "{\"cabal-version\":\"\"" + -- Remove the package id for stuff such as: + -- > "-package-id","base-4.14.0.0-" + -- and replace it with: + -- > "-package-id","" + -- + -- Otherwise, output can not be properly normalized as on MacOs we remove + -- vowels from packages to make the names shorter. + -- E.g. "another-framework-0.8.1.1" -> "nthr-frmwrk-0.8.1.1" + -- + -- This makes it impossible to have a stable package id, thus remove it completely. + -- Check manually in your test-cases if the package-id needs to be verified. + . resub ("\"-package-id\",\"([^\"]*)\"") + "\"-package-id\",\"\"" -- Some GHC versions are chattier than others . resub "^ignoring \\(possibly broken\\) abi-depends field for packages" "" -- Normalize the current GHC version. Apply this BEFORE packageIdRegex, @@ -74,6 +93,7 @@ data NormalizerEnv = NormalizerEnv , normalizerGhcVersion :: Version , normalizerKnownPackages :: [PackageId] , normalizerPlatform :: Platform + , normalizerCabalVersion :: Version } posixSpecialChars :: [Char]