From 4a8a7c5d2aae9ee7eaed0541457ff792fed26395 Mon Sep 17 00:00:00 2001 From: fendor Date: Sun, 14 Apr 2024 23:05:15 +0200 Subject: [PATCH] Redesign 'cabal path' command to account for projects (#9583) * Redesign 'cabal path' command to account for projects Previously, `cabal path` was only able to query from the global configuration file, e.g., `~/.cabal/config` or the XDG equivalent. Adding support for cabal project is a huge boost to usability. We take the foundations and turn them into `cabal v2-path` which takes project configuration, such as `cabal.project` into account. Note, the command is still named `cabal path`, but for the sake of disambiguation, we refer to this new iteration of the command as `cabal v2-path`. In addition, we add support for multiple output formats, such as key-value pairs and json. The key-value pair output prints a line for each queried key and its respective value: key1: value2 key2: value2 If only a single key is queried, we print only the value, for example: value1 The json output format is versioned by the cabal-install version which is part of the json object. Thus, all result objects contain at least the key "cabal-install-version". We expand the `cabal v2-path` to also produce information of the compiler that is going to be used in a `cabal build` or `cabal repl` invocation. To do that, we rebuild the install plan and query for the configured compiler program. This is helpful for downstream tools, such as HLS, to figure out the GHC version required to compile a project with. We also add an exhaustive test suite for 'cabal path' cmd We test that each query honours cabal.project files, cli parameters, and is composable with the other query flags. We extend the test output normalisers for ghc compiler location and cabal-install version, as the 'cabal path' command outputs the exact ghc and ghc-pkg location. In addition, the json output format is versioned on the cabal-install version. Currently, we query the cabal-install version on each test normalisation run. This might be unnecessary expensive, and could be avoided by introducing a 'cabalProgram' that specifies how the program version can be found. This way, we can cache the version query. Add '--cache-home' flag thats shows the cabal's cache root Rename '--cache-dir' to the more correct '--remote-repo-dir'. * Update 'cabal path' documentation * Add changelog.d entry --------- Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com> --- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/CmdPath.hs | 408 ++++++++++++++++++ .../src/Distribution/Client/Config.hs | 5 + .../src/Distribution/Client/Errors.hs | 8 + cabal-install/src/Distribution/Client/Main.hs | 43 +- .../src/Distribution/Client/ScriptUtils.hs | 8 + .../src/Distribution/Client/Setup.hs | 73 +--- .../PackageTests/Path/All/cabal.out | 94 +++- .../PackageTests/Path/All/cabal.test.hs | 28 +- .../PackageTests/Path/Compiler/cabal.out | 10 + .../PackageTests/Path/Compiler/cabal.test.hs | 7 + .../PackageTests/Path/Config/cabal.out | 150 +++++++ .../PackageTests/Path/Config/cabal.test.hs | 36 ++ .../PackageTests/Path/Config/config.cabal | 5 + .../Path/Config/fake-cabal.config | 11 + .../Path/Config/fake.cabal.project | 6 + .../PackageTests/Path/Single/cabal.out | 2 - .../PackageTests/Path/Single/cabal.test.hs | 3 - cabal-testsuite/src/Test/Cabal/Monad.hs | 25 +- .../src/Test/Cabal/OutputNormalizer.hs | 24 +- cabal-testsuite/src/Test/Cabal/Prelude.hs | 3 +- changelog.d/pr-9583 | 28 ++ doc/cabal-commands.rst | 50 ++- 23 files changed, 887 insertions(+), 141 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/CmdPath.hs create mode 100644 cabal-testsuite/PackageTests/Path/Compiler/cabal.out create mode 100644 cabal-testsuite/PackageTests/Path/Compiler/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Path/Config/cabal.out create mode 100644 cabal-testsuite/PackageTests/Path/Config/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/Path/Config/config.cabal create mode 100644 cabal-testsuite/PackageTests/Path/Config/fake-cabal.config create mode 100644 cabal-testsuite/PackageTests/Path/Config/fake.cabal.project delete mode 100644 cabal-testsuite/PackageTests/Path/Single/cabal.out delete mode 100644 cabal-testsuite/PackageTests/Path/Single/cabal.test.hs create mode 100644 changelog.d/pr-9583 diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index a5626d110b7..cee404429d5 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -100,6 +100,7 @@ library Distribution.Client.CmdInstall.ClientInstallTargetSelector Distribution.Client.CmdLegacy Distribution.Client.CmdListBin + Distribution.Client.CmdPath Distribution.Client.CmdOutdated Distribution.Client.CmdRepl Distribution.Client.CmdRun diff --git a/cabal-install/src/Distribution/Client/CmdPath.hs b/cabal-install/src/Distribution/Client/CmdPath.hs new file mode 100644 index 00000000000..8ca8d6181f1 --- /dev/null +++ b/cabal-install/src/Distribution/Client/CmdPath.hs @@ -0,0 +1,408 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +-- | +-- Module : Distribution.Client.CmdPath +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Implementation of the 'path' command. Query for project configuration +-- information. +module Distribution.Client.CmdPath + ( pathCommand + , pathAction + ) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Client.CmdInstall.ClientInstallFlags + ( cinstInstalldir + ) +import Distribution.Client.Config + ( defaultCacheHome + , defaultInstallPath + , defaultStoreDir + , getConfigFilePath + ) +import Distribution.Client.DistDirLayout (CabalDirLayout (..), distProjectRootDirectory) +import Distribution.Client.Errors +import Distribution.Client.GlobalFlags +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..) + , defaultNixStyleFlags + , nixStyleOptions + ) +import Distribution.Client.ProjectConfig.Types + ( ProjectConfig (..) + , ProjectConfigBuildOnly (..) + , ProjectConfigShared (..) + ) +import Distribution.Client.ProjectOrchestration +import Distribution.Client.ProjectPlanning +import Distribution.Client.RebuildMonad (runRebuild) +import Distribution.Client.ScriptUtils +import Distribution.Client.Setup + ( ConfigFlags (..) + , yesNoOpt + ) +import Distribution.Client.Utils.Json + ( (.=) + ) +import qualified Distribution.Client.Utils.Json as Json +import Distribution.Client.Version + ( cabalInstallVersion + ) +import Distribution.ReadE + ( ReadE (ReadE) + ) +import Distribution.Simple.Command + ( CommandUI (..) + , OptionField + , ShowOrParseArgs + , noArg + , option + , reqArg + ) +import Distribution.Simple.Compiler +import Distribution.Simple.Flag + ( Flag (..) + , flagToList + , fromFlagOrDefault + ) +import Distribution.Simple.Program +import Distribution.Simple.Utils + ( die' + , dieWithException + , withOutputMarker + , wrapText + ) +import Distribution.Verbosity + ( normal + ) + +------------------------------------------------------------------------------- +-- Command +------------------------------------------------------------------------------- + +pathCommand :: CommandUI (NixStyleFlags PathFlags) +pathCommand = + CommandUI + { commandName = "path" + , commandSynopsis = "Query for simple project information" + , commandDescription = Just $ \_ -> + wrapText $ + "Query for configuration and project information such as project GHC.\n" + <> "The output order of query keys is implementation defined and should not be relied on.\n" + , commandNotes = Just $ \pname -> + "Examples:\n" + <> " " + <> pname + <> " path --store-dir\n" + <> " Print the store-dir location of cabal.\n" + <> " " + <> pname + <> " path --output-format=json --compiler-info\n" + <> " Print compiler information in json format.\n" + <> " " + <> pname + <> " path --output-format=json --installdir --compiler-info\n" + <> " Print compiler information and installation directory in json format.\n" + <> " " + <> pname + <> " path --output-format=key-value --installdir\n" + <> " Print the installation directory, taking project information into account.\n" + <> " " + <> pname + <> " path -z --output-format=key-value --installdir\n" + <> " Print the installation directory, without taking project information into account.\n" + , commandUsage = \pname -> + "Usage: " <> pname <> " path [FLAGS]\n" + , commandDefaultFlags = defaultNixStyleFlags defaultPathFlags + , commandOptions = nixStyleOptions pathOptions + } + +------------------------------------------------------------------------------- +-- Flags +------------------------------------------------------------------------------- + +data PathOutputFormat + = JSON + | KeyValue + deriving (Eq, Ord, Show, Read, Enum, Bounded) + +data PathFlags = PathFlags + { pathCompiler :: Flag Bool + , pathOutputFormat :: Flag PathOutputFormat + , pathDirectories :: Flag [ConfigPath] + } + deriving (Eq, Show) + +defaultPathFlags :: PathFlags +defaultPathFlags = + PathFlags + { pathCompiler = mempty + , pathOutputFormat = mempty + , pathDirectories = mempty + } + +pathOutputFormatParser :: ReadE (Flag PathOutputFormat) +pathOutputFormatParser = ReadE $ \case + "json" -> Right $ Flag JSON + "key-value" -> Right $ Flag KeyValue + policy -> + Left $ + "Cannot parse the status output format '" + <> policy + <> "'" + +pathOutputFormatString :: PathOutputFormat -> String +pathOutputFormatString JSON = "json" +pathOutputFormatString KeyValue = "key-value" + +pathOutputFormatPrinter + :: Flag PathOutputFormat -> [String] +pathOutputFormatPrinter = \case + (Flag format) -> [pathOutputFormatString format] + NoFlag -> [] + +pathOptions :: ShowOrParseArgs -> [OptionField PathFlags] +pathOptions showOrParseArgs = + [ option + [] + ["output-format"] + "Output format of the requested path locations" + pathOutputFormat + (\v flags -> flags{pathOutputFormat = v}) + ( reqArg + (intercalate "|" $ map pathOutputFormatString [minBound .. maxBound]) + pathOutputFormatParser + pathOutputFormatPrinter + ) + , option + [] + ["compiler-info"] + "Print information of the project compiler" + pathCompiler + (\v flags -> flags{pathCompiler = v}) + (yesNoOpt showOrParseArgs) + ] + <> map pathOption [minBound .. maxBound] + where + pathOption s = + option + [] + [pathName s] + ("Print cabal's " <> pathName s) + pathDirectories + (\v flags -> flags{pathDirectories = Flag $ concat (flagToList (pathDirectories flags) <> flagToList v)}) + (noArg (Flag [s])) + +-- | A path that can be retrieved by the @cabal path@ command. +data ConfigPath + = ConfigPathCacheHome + | ConfigPathRemoteRepoCache + | ConfigPathLogsDir + | ConfigPathStoreDir + | ConfigPathConfigFile + | ConfigPathInstallDir + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | The configuration name for this path. +pathName :: ConfigPath -> String +pathName ConfigPathCacheHome = "cache-home" +pathName ConfigPathRemoteRepoCache = "remote-repo-cache" +pathName ConfigPathLogsDir = "logs-dir" +pathName ConfigPathStoreDir = "store-dir" +pathName ConfigPathConfigFile = "config-file" +pathName ConfigPathInstallDir = "installdir" + +------------------------------------------------------------------------------- +-- Action +------------------------------------------------------------------------------- + +-- | Entry point for the 'path' command. +pathAction :: NixStyleFlags PathFlags -> [String] -> GlobalFlags -> IO () +pathAction flags@NixStyleFlags{extraFlags = pathFlags', ..} cliTargetStrings globalFlags = withContextAndSelectors AcceptNoTargets Nothing flags [] globalFlags OtherCommand $ \_ baseCtx _ -> do + let pathFlags = + if pathCompiler pathFlags' == NoFlag && pathDirectories pathFlags' == NoFlag + then -- if not a single key to query is given, query everything! + + pathFlags' + { pathCompiler = Flag True + , pathDirectories = Flag [minBound .. maxBound] + } + else pathFlags' + when (not $ null cliTargetStrings) $ + dieWithException verbosity CmdPathAcceptsNoTargets + when (buildSettingDryRun (buildSettings baseCtx)) $ + dieWithException verbosity CmdPathCommandDoesn'tSupportDryRun + + compilerPathOutputs <- + if not $ fromFlagOrDefault False (pathCompiler pathFlags) + then pure Nothing + else do + (compiler, _, progDb) <- runRebuild (distProjectRootDirectory . distDirLayout $ baseCtx) $ configureCompiler verbosity (distDirLayout baseCtx) (projectConfig baseCtx) + compilerProg <- requireCompilerProg verbosity compiler + (configuredCompilerProg, _) <- requireProgram verbosity compilerProg progDb + pure $ Just $ mkCompilerInfo configuredCompilerProg compiler + + paths <- for (fromFlagOrDefault [] $ pathDirectories pathFlags) $ \p -> do + t <- getPathLocation baseCtx p + pure (pathName p, t) + + let pathOutputs = + PathOutputs + { pathOutputsCompilerInfo = compilerPathOutputs + , pathOutputsConfigPaths = paths + } + + let output = case fromFlagOrDefault KeyValue (pathOutputFormat pathFlags) of + JSON -> + Json.encodeToString (showAsJson pathOutputs) <> "\n" + KeyValue -> do + showAsKeyValuePair pathOutputs + + putStr $ withOutputMarker verbosity output + where + verbosity = fromFlagOrDefault normal (configVerbosity configFlags) + +-- | Find the FilePath location for common configuration paths. +-- +-- TODO: this should come from a common source of truth to avoid code path divergence +getPathLocation :: ProjectBaseContext -> ConfigPath -> IO FilePath +getPathLocation _ ConfigPathCacheHome = + defaultCacheHome +getPathLocation baseCtx ConfigPathRemoteRepoCache = + pure $ buildSettingCacheDir (buildSettings baseCtx) +getPathLocation baseCtx ConfigPathLogsDir = + pure $ cabalLogsDirectory (cabalDirLayout baseCtx) +getPathLocation baseCtx ConfigPathStoreDir = + fromFlagOrDefault + defaultStoreDir + (pure <$> projectConfigStoreDir (projectConfigShared (projectConfig baseCtx))) +getPathLocation baseCtx ConfigPathConfigFile = + getConfigFilePath (projectConfigConfigFile (projectConfigShared (projectConfig baseCtx))) +getPathLocation baseCtx ConfigPathInstallDir = + fromFlagOrDefault + defaultInstallPath + (pure <$> cinstInstalldir (projectConfigClientInstallFlags $ projectConfigBuildOnly (projectConfig baseCtx))) + +-- ---------------------------------------------------------------------------- +-- Helpers for determining compiler information +-- ---------------------------------------------------------------------------- + +requireCompilerProg :: Verbosity -> Compiler -> IO Program +requireCompilerProg verbosity compiler = + case compilerFlavor compiler of + GHC -> pure ghcProgram + GHCJS -> pure ghcjsProgram + flavour -> + die' verbosity $ + "path: Unsupported compiler flavour: " + <> prettyShow flavour + +-- ---------------------------------------------------------------------------- +-- Output +-- ---------------------------------------------------------------------------- + +data PathOutputs = PathOutputs + { pathOutputsCompilerInfo :: Maybe PathCompilerInfo + , pathOutputsConfigPaths :: [(String, FilePath)] + } + deriving (Show, Eq, Ord) + +data PathCompilerInfo = PathCompilerInfo + { pathCompilerInfoFlavour :: CompilerFlavor + , pathCompilerInfoId :: CompilerId + , pathCompilerInfoPath :: FilePath + } + deriving (Show, Eq, Ord) + +mkCompilerInfo :: ConfiguredProgram -> Compiler -> PathCompilerInfo +mkCompilerInfo compilerProgram compiler = + PathCompilerInfo + { pathCompilerInfoFlavour = compilerFlavor compiler + , pathCompilerInfoId = compilerId compiler + , pathCompilerInfoPath = programPath compilerProgram + } + +-- ---------------------------------------------------------------------------- +-- JSON +-- ---------------------------------------------------------------------------- + +showAsJson :: PathOutputs -> Json.Value +showAsJson pathOutputs = + let + cabalInstallJson = + Json.object + [ "cabal-version" .= jdisplay cabalInstallVersion + ] + + compilerInfoJson = case pathOutputsCompilerInfo pathOutputs of + Nothing -> Json.object [] + Just pci -> compilerInfoToJson pci + + pathsJson = Json.object $ map (\(k, v) -> k .= Json.String v) (pathOutputsConfigPaths pathOutputs) + in + mergeJsonObjects $ + [ cabalInstallJson + , compilerInfoJson + , pathsJson + ] + +jdisplay :: Pretty a => a -> Json.Value +jdisplay = Json.String . prettyShow + +mergeJsonObjects :: [Json.Value] -> Json.Value +mergeJsonObjects = Json.object . foldl' go [] + where + go acc (Json.Object objs) = + acc <> objs + go _ _ = + error "mergeJsonObjects: Only objects can be merged" + +compilerInfoToJson :: PathCompilerInfo -> Json.Value +compilerInfoToJson pci = + Json.object + [ "compiler" + .= Json.object + [ "flavour" .= jdisplay (pathCompilerInfoFlavour pci) + , "id" .= jdisplay (pathCompilerInfoId pci) + , "path" .= Json.String (pathCompilerInfoPath pci) + ] + ] + +-- ---------------------------------------------------------------------------- +-- Key Value Pair outputs +-- ---------------------------------------------------------------------------- + +showAsKeyValuePair :: PathOutputs -> String +showAsKeyValuePair pathOutputs = + let + cInfo = case pathOutputsCompilerInfo pathOutputs of + Nothing -> [] + Just pci -> compilerInfoToKeyValue pci + + paths = pathOutputsConfigPaths pathOutputs + + pairs = cInfo <> paths + + showPair (k, v) = k <> ": " <> v + in + case pairs of + [(_, v)] -> v + xs -> unlines $ map showPair xs + +compilerInfoToKeyValue :: PathCompilerInfo -> [(String, String)] +compilerInfoToKeyValue pci = + [ ("compiler-flavour", prettyShow $ pathCompilerInfoFlavour pci) + , ("compiler-id", prettyShow $ pathCompilerInfoId pci) + , ("compiler-path", pathCompilerInfoPath pci) + ] diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 2a2bc6754f0..fd9bd5af432 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -25,6 +25,7 @@ module Distribution.Client.Config , parseConfig , defaultConfigFile , defaultCacheDir + , defaultCacheHome , defaultScriptBuildsDir , defaultStoreDir , defaultCompiler @@ -804,6 +805,10 @@ defaultConfigFile :: IO FilePath defaultConfigFile = getDefaultDir XdgConfig "config" +defaultCacheHome :: IO FilePath +defaultCacheHome = + getDefaultDir XdgCache "" + defaultCacheDir :: IO FilePath defaultCacheDir = getDefaultDir XdgCache "packages" diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index ada3eca5268..d25c59af41e 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -184,6 +184,8 @@ data CabalInstallException | CorruptedIndexCache String | UnusableIndexState RemoteRepo Timestamp Timestamp | MissingPackageList RemoteRepo + | CmdPathAcceptsNoTargets + | CmdPathCommandDoesn'tSupportDryRun deriving (Show, Typeable) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -334,6 +336,8 @@ exceptionCodeCabalInstall e = case e of CorruptedIndexCache{} -> 7158 UnusableIndexState{} -> 7159 MissingPackageList{} -> 7160 + CmdPathAcceptsNoTargets{} -> 7161 + CmdPathCommandDoesn'tSupportDryRun -> 7163 exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of @@ -849,6 +853,10 @@ exceptionMessageCabalInstall e = case e of "The package list for '" ++ unRepoName (remoteRepoName repoRemote) ++ "' does not exist. Run 'cabal update' to download it." + CmdPathAcceptsNoTargets -> + "The 'path' command accepts no target arguments." + CmdPathCommandDoesn'tSupportDryRun -> + "The 'path' command doesn't support the flag '--dry-run'." instance Exception (VerboseException CabalInstallException) where displayException :: VerboseException CabalInstallException -> [Char] diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 4c9dcba5f03..2de2e48f3e4 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -36,8 +36,6 @@ import Distribution.Client.Setup , InitFlags (initHcPath, initVerbosity) , InstallFlags (..) , ListFlags (..) - , Path (..) - , PathFlags (..) , ReportFlags (..) , UploadFlags (..) , UserConfigFlags (..) @@ -66,8 +64,6 @@ import Distribution.Client.Setup , listCommand , listNeedsCompiler , manpageCommand - , pathCommand - , pathName , reconfigureCommand , registerCommand , replCommand @@ -104,11 +100,7 @@ import Prelude () import Distribution.Client.Config ( SavedConfig (..) , createDefaultConfigFile - , defaultCacheDir , defaultConfigFile - , defaultInstallPath - , defaultLogsDir - , defaultStoreDir , getConfigFilePath , loadConfig , userConfigDiff @@ -139,6 +131,7 @@ import qualified Distribution.Client.CmdInstall as CmdInstall import Distribution.Client.CmdLegacy import qualified Distribution.Client.CmdListBin as CmdListBin import qualified Distribution.Client.CmdOutdated as CmdOutdated +import qualified Distribution.Client.CmdPath as CmdPath import qualified Distribution.Client.CmdRepl as CmdRepl import qualified Distribution.Client.CmdRun as CmdRun import qualified Distribution.Client.CmdSdist as CmdSdist @@ -154,7 +147,6 @@ import Distribution.Client.Install (install) -- import Distribution.Client.Clean (clean) -import Distribution.Client.CmdInstall.ClientInstallFlags (ClientInstallFlags (cinstInstalldir)) import Distribution.Client.Get (get) import Distribution.Client.Init (initCmd) import Distribution.Client.Manpage (manpageCmd) @@ -244,7 +236,6 @@ import Distribution.Simple.Utils , notice , topHandler , tryFindPackageDesc - , withOutputMarker ) import Distribution.Text ( display @@ -264,7 +255,6 @@ import Distribution.Version ) import Control.Exception (AssertionFailed, assert, try) -import Control.Monad (mapM_) import Data.Monoid (Any (..)) import System.Directory ( doesFileExist @@ -439,7 +429,7 @@ mainWorker args = do , regularCmd reportCommand reportAction , regularCmd initCommand initAction , regularCmd userConfigCommand userConfigAction - , regularCmd pathCommand pathAction + , regularCmd CmdPath.pathCommand CmdPath.pathAction , regularCmd genBoundsCommand genBoundsAction , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction , wrapperCmd hscolourCommand hscolourCommonFlags @@ -1498,32 +1488,3 @@ manpageAction commands flags extraArgs _ = do then dropExtension pname else pname manpageCmd cabalCmd commands flags - -pathAction :: PathFlags -> [String] -> Action -pathAction pathflags extraArgs globalFlags = do - let verbosity = fromFlag (pathVerbosity pathflags) - unless (null extraArgs) $ - dieWithException verbosity $ - ManpageAction extraArgs - cfg <- loadConfig verbosity mempty - let getDir getDefault getGlobal = - maybe - getDefault - pure - (flagToMaybe $ getGlobal $ savedGlobalFlags cfg) - getSomeDir PathCacheDir = getDir defaultCacheDir globalCacheDir - getSomeDir PathLogsDir = getDir defaultLogsDir globalLogsDir - getSomeDir PathStoreDir = getDir defaultStoreDir globalStoreDir - getSomeDir PathConfigFile = getConfigFilePath (globalConfigFile globalFlags) - getSomeDir PathInstallDir = - fromFlagOrDefault defaultInstallPath (pure <$> cinstInstalldir (savedClientInstallFlags cfg)) - printPath p = putStrLn . withOutputMarker verbosity . ((pathName p ++ ": ") ++) =<< getSomeDir p - -- If no paths have been requested, print all paths with labels. - -- - -- If a single path has been requested, print that path without any label. - -- - -- If multiple paths have been requested, print each of them with labels. - case fromFlag $ pathDirs pathflags of - [] -> mapM_ printPath [minBound .. maxBound] - [d] -> putStrLn . withOutputMarker verbosity =<< getSomeDir d - ds -> mapM_ printPath ds diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index 494bb7a4de3..aeae4eaf459 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -313,7 +313,15 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings glo -- In the case where a selector is both a valid target and script, assume it is a target, -- because you can disambiguate the script with "./script" readTargetSelectors (localPackages ctx) kind targetStrings >>= \case + -- If there are no target selectors and no targets are fine, return + -- the context + Left (TargetSelectorNoTargetsInCwd{} : _) + | [] <- targetStrings + , AcceptNoTargets <- noTargets -> + return (tc, ctx, defaultTarget) Left err@(TargetSelectorNoTargetsInProject : _) + -- If there are no target selectors and no targets are fine, return + -- the context | [] <- targetStrings , AcceptNoTargets <- noTargets -> return (tc, ctx, defaultTarget) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 95ac8dbffff..c89f2a3524a 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -88,10 +88,6 @@ module Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand - , Path (..) - , pathName - , PathFlags (..) - , pathCommand , liftOptions , yesNoOpt ) where @@ -358,7 +354,6 @@ globalCommand commands = ++ unlines ( [ startGroup "global" , addCmd "user-config" - , addCmd "path" , addCmd "help" , par , startGroup "package database" @@ -376,6 +371,7 @@ globalCommand commands = , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" + , addCmd "path" , par , startGroup "project building and installing" , addCmd "build" @@ -3425,73 +3421,6 @@ userConfigCommand = -- ------------------------------------------------------------ --- * Dirs - --- ------------------------------------------------------------ - --- | A path that can be retrieved by the @cabal path@ command. -data Path - = PathCacheDir - | PathLogsDir - | PathStoreDir - | PathConfigFile - | PathInstallDir - deriving (Eq, Ord, Show, Enum, Bounded) - --- | The configuration name for this path. -pathName :: Path -> String -pathName PathCacheDir = "cache-dir" -pathName PathLogsDir = "logs-dir" -pathName PathStoreDir = "store-dir" -pathName PathConfigFile = "config-file" -pathName PathInstallDir = "installdir" - -data PathFlags = PathFlags - { pathVerbosity :: Flag Verbosity - , pathDirs :: Flag [Path] - } - deriving (Generic) - -instance Monoid PathFlags where - mempty = - PathFlags - { pathVerbosity = toFlag normal - , pathDirs = toFlag [] - } - mappend = (<>) - -instance Semigroup PathFlags where - (<>) = gmappend - -pathCommand :: CommandUI PathFlags -pathCommand = - CommandUI - { commandName = "path" - , commandSynopsis = "Display paths used by cabal." - , commandDescription = Just $ \_ -> - wrapText $ - "This command prints the directories that are used by cabal," - ++ " taking into account the contents of the configuration file and any" - ++ " environment variables." - , commandNotes = Nothing - , commandUsage = \pname -> "Usage: " ++ pname ++ " path\n" - , commandDefaultFlags = mempty - , commandOptions = \_ -> - map pathOption [minBound .. maxBound] - ++ [optionVerbosity pathVerbosity (\v flags -> flags{pathVerbosity = v})] - } - where - pathOption s = - option - [] - [pathName s] - ("Print " <> pathName s) - pathDirs - (\v flags -> flags{pathDirs = Flag $ concat (flagToList (pathDirs flags) ++ flagToList v)}) - (noArg (Flag [s])) - --- ------------------------------------------------------------ - -- * GetOpt Utils -- ------------------------------------------------------------ diff --git a/cabal-testsuite/PackageTests/Path/All/cabal.out b/cabal-testsuite/PackageTests/Path/All/cabal.out index 55d8b94bc3a..0f710cc0fb1 100644 --- a/cabal-testsuite/PackageTests/Path/All/cabal.out +++ b/cabal-testsuite/PackageTests/Path/All/cabal.out @@ -1,6 +1,98 @@ # cabal path -cache-dir: /cabal.dist/home/.cabal/packages +{"cabal-version":"","compiler":{"flavour":"ghc","id":"ghc-","path":""},"logs-dir":"/cabal.dist/home/.cabal/logs","installdir":"/cabal.dist/home/.cabal/bin"} +# cabal path +{"cabal-version":"","compiler":{"flavour":"ghc","id":"ghc-","path":""},"store-dir":"/cabal.dist/home/.cabal/store","config-file":"/cabal.dist/home/.cabal/config"} +# cabal path +{"cabal-version":"","compiler":{"flavour":"ghc","id":"ghc-","path":""},"remote-repo-cache":"/cabal.dist/home/.cabal/packages"} +# cabal path +{"cabal-version":"","compiler":{"flavour":"ghc","id":"ghc-","path":""},"cache-home":"/cabal.dist/home/.cabal","remote-repo-cache":"/cabal.dist/home/.cabal/packages","logs-dir":"/cabal.dist/home/.cabal/logs","store-dir":"/cabal.dist/home/.cabal/store","config-file":"/cabal.dist/home/.cabal/config","installdir":"/cabal.dist/home/.cabal/bin"} +# cabal path +{"cabal-version":"","cache-home":"/cabal.dist/home/.cabal"} +# cabal path +{"cabal-version":"","remote-repo-cache":"/cabal.dist/home/.cabal/packages"} +# cabal path +{"cabal-version":"","logs-dir":"/cabal.dist/home/.cabal/logs"} +# cabal path +{"cabal-version":"","store-dir":"/cabal.dist/home/.cabal/store"} +# cabal path +{"cabal-version":"","config-file":"/cabal.dist/home/.cabal/config"} +# cabal path +{"cabal-version":"","installdir":"/cabal.dist/home/.cabal/bin"} +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +logs-dir: /cabal.dist/home/.cabal/logs +installdir: /cabal.dist/home/.cabal/bin +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +store-dir: /cabal.dist/home/.cabal/store +config-file: /cabal.dist/home/.cabal/config +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +remote-repo-cache: /cabal.dist/home/.cabal/packages +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +cache-home: /cabal.dist/home/.cabal +remote-repo-cache: /cabal.dist/home/.cabal/packages logs-dir: /cabal.dist/home/.cabal/logs store-dir: /cabal.dist/home/.cabal/store config-file: /cabal.dist/home/.cabal/config installdir: /cabal.dist/home/.cabal/bin +# cabal path +/cabal.dist/home/.cabal +# cabal path +/cabal.dist/home/.cabal/packages +# cabal path +/cabal.dist/home/.cabal/logs +# cabal path +/cabal.dist/home/.cabal/store +# cabal path +/cabal.dist/home/.cabal/config +# cabal path +/cabal.dist/home/.cabal/bin +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +logs-dir: /cabal.dist/home/.cabal/logs +installdir: /cabal.dist/home/.cabal/bin +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +store-dir: /cabal.dist/home/.cabal/store +config-file: /cabal.dist/home/.cabal/config +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +remote-repo-cache: /cabal.dist/home/.cabal/packages +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +cache-home: /cabal.dist/home/.cabal +remote-repo-cache: /cabal.dist/home/.cabal/packages +logs-dir: /cabal.dist/home/.cabal/logs +store-dir: /cabal.dist/home/.cabal/store +config-file: /cabal.dist/home/.cabal/config +installdir: /cabal.dist/home/.cabal/bin +# cabal path +/cabal.dist/home/.cabal +# cabal path +/cabal.dist/home/.cabal/packages +# cabal path +/cabal.dist/home/.cabal/logs +# cabal path +/cabal.dist/home/.cabal/store +# cabal path +/cabal.dist/home/.cabal/config +# cabal path +/cabal.dist/home/.cabal/bin diff --git a/cabal-testsuite/PackageTests/Path/All/cabal.test.hs b/cabal-testsuite/PackageTests/Path/All/cabal.test.hs index b8157a83ee8..a1c0db98e8c 100644 --- a/cabal-testsuite/PackageTests/Path/All/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Path/All/cabal.test.hs @@ -1,3 +1,29 @@ import Test.Cabal.Prelude +import Data.List (subsequences) -main = cabalTest . void $ cabal "path" [] +allOutputFormats = + [ ["--output-format", "json"] + , ["--output-format", "key-value"] + , [] -- no specific output format + ] + +cabalPathPathFlags = + [ "--cache-home" + , "--remote-repo-cache" + , "--logs-dir" + , "--store-dir" + , "--config-file" + , "--installdir" + ] + +main = cabalTest $ do + forM_ allOutputFormats $ \outputFormat -> do + -- Mix and match with some flags + cabal "path" $ outputFormat <> ["--compiler-info", "--logs-dir", "--installdir"] + cabal "path" $ outputFormat <> ["--store-dir", "--compiler-info", "--config-file"] + cabal "path" $ outputFormat <> ["--remote-repo-cache", "--compiler-info"] + cabal "path" $ outputFormat <> [] + -- 'cabal path' works when the compiler is unknown but no compiler info is asked. + -- requires '-z' flag. + forM_ cabalPathPathFlags $ \pathFlag -> do + cabal "path" $ ["-w", "unknown-compiler", "-z"] <> outputFormat <> [pathFlag] diff --git a/cabal-testsuite/PackageTests/Path/Compiler/cabal.out b/cabal-testsuite/PackageTests/Path/Compiler/cabal.out new file mode 100644 index 00000000000..a640aa60948 --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Compiler/cabal.out @@ -0,0 +1,10 @@ +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: +# cabal path +{"cabal-version":"","compiler":{"flavour":"ghc","id":"ghc-","path":""}} +# cabal path +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: diff --git a/cabal-testsuite/PackageTests/Path/Compiler/cabal.test.hs b/cabal-testsuite/PackageTests/Path/Compiler/cabal.test.hs new file mode 100644 index 00000000000..b70251cf574 --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Compiler/cabal.test.hs @@ -0,0 +1,7 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + -- Basic output + void $ cabal "path" ["-z", "--output-format=key-value", "--compiler-info"] + void $ cabal "path" ["-z", "--output-format=json", "--compiler-info"] + void $ cabal "path" ["-z", "--compiler-info"] diff --git a/cabal-testsuite/PackageTests/Path/Config/cabal.out b/cabal-testsuite/PackageTests/Path/Config/cabal.out new file mode 100644 index 00000000000..2263588109f --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Config/cabal.out @@ -0,0 +1,150 @@ +# cabal path +/cabal.dist/home/.cabal +# cabal path +{"cabal-version":"","cache-home":"/cabal.dist/home/.cabal"} +# cabal path +/cabal.dist/home/.cabal +# cabal path +/cabal.dist/home/.cabal/packages +# cabal path +{"cabal-version":"","remote-repo-cache":"/cabal.dist/home/.cabal/packages"} +# cabal path +/cabal.dist/home/.cabal/packages +# cabal path +/cabal.dist/home/.cabal/logs +# cabal path +{"cabal-version":"","logs-dir":"/cabal.dist/home/.cabal/logs"} +# cabal path +/cabal.dist/home/.cabal/logs +# cabal path +/cabal.dist/home/.cabal/store +# cabal path +{"cabal-version":"","store-dir":"/cabal.dist/home/.cabal/store"} +# cabal path +/cabal.dist/home/.cabal/store +# cabal path +/cabal.dist/home/.cabal/config +# cabal path +{"cabal-version":"","config-file":"/cabal.dist/home/.cabal/config"} +# cabal path +/cabal.dist/home/.cabal/config +# cabal path +/cabal.dist/home/.cabal/bin +# cabal path +{"cabal-version":"","installdir":"/cabal.dist/home/.cabal/bin"} +# cabal path +/cabal.dist/home/.cabal/bin +# cabal path +test-dir +# cabal path +{"cabal-version":"","store-dir":"test-dir"} +# cabal path +test-dir +# cabal path +/cabal.dist/home/.cabal +# cabal path +{"cabal-version":"","cache-home":"/cabal.dist/home/.cabal"} +# cabal path +/cabal.dist/home/.cabal +# cabal path +/cabal.dist/home/.cabal +# cabal path +{"cabal-version":"","cache-home":"/cabal.dist/home/.cabal"} +# cabal path +/cabal.dist/home/.cabal +# cabal path +/cabal.dist/home/.cabal +# cabal path +{"cabal-version":"","cache-home":"/cabal.dist/home/.cabal"} +# cabal path +/cabal.dist/home/.cabal +# cabal path +my-cache-dir +# cabal path +{"cabal-version":"","remote-repo-cache":"my-cache-dir"} +# cabal path +my-cache-dir +# cabal path +/cabal.dist/home/.cabal/packages +# cabal path +{"cabal-version":"","remote-repo-cache":"/cabal.dist/home/.cabal/packages"} +# cabal path +/cabal.dist/home/.cabal/packages +# cabal path +my-cache-dir +# cabal path +{"cabal-version":"","remote-repo-cache":"my-cache-dir"} +# cabal path +my-cache-dir +# cabal path +my-logs-dir +# cabal path +{"cabal-version":"","logs-dir":"my-logs-dir"} +# cabal path +my-logs-dir +# cabal path +/cabal.dist/home/.cabal/logs +# cabal path +{"cabal-version":"","logs-dir":"/cabal.dist/home/.cabal/logs"} +# cabal path +/cabal.dist/home/.cabal/logs +# cabal path +my-logs-dir +# cabal path +{"cabal-version":"","logs-dir":"my-logs-dir"} +# cabal path +my-logs-dir +# cabal path +my-store-dir +# cabal path +{"cabal-version":"","store-dir":"my-store-dir"} +# cabal path +my-store-dir +# cabal path +/cabal.dist/home/.cabal/store +# cabal path +{"cabal-version":"","store-dir":"/cabal.dist/home/.cabal/store"} +# cabal path +/cabal.dist/home/.cabal/store +# cabal path +my-store-dir +# cabal path +{"cabal-version":"","store-dir":"my-store-dir"} +# cabal path +my-store-dir +# cabal path +fake-cabal.config +# cabal path +{"cabal-version":"","config-file":"fake-cabal.config"} +# cabal path +fake-cabal.config +# cabal path +/cabal.dist/home/.cabal/config +# cabal path +{"cabal-version":"","config-file":"/cabal.dist/home/.cabal/config"} +# cabal path +/cabal.dist/home/.cabal/config +# cabal path +fake-cabal.config +# cabal path +{"cabal-version":"","config-file":"fake-cabal.config"} +# cabal path +fake-cabal.config +# cabal path +my-installdir +# cabal path +{"cabal-version":"","installdir":"my-installdir"} +# cabal path +my-installdir +# cabal path +/cabal.dist/home/.cabal/bin +# cabal path +{"cabal-version":"","installdir":"/cabal.dist/home/.cabal/bin"} +# cabal path +/cabal.dist/home/.cabal/bin +# cabal path +my-installdir +# cabal path +{"cabal-version":"","installdir":"my-installdir"} +# cabal path +my-installdir diff --git a/cabal-testsuite/PackageTests/Path/Config/cabal.test.hs b/cabal-testsuite/PackageTests/Path/Config/cabal.test.hs new file mode 100644 index 00000000000..2397fbe4662 --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Config/cabal.test.hs @@ -0,0 +1,36 @@ +import Test.Cabal.Prelude + +cabalPathFlags = + [ "--cache-home" + , "--remote-repo-cache" + , "--logs-dir" + , "--store-dir" + , "--config-file" + , "--installdir" + ] + +main = cabalTest $ do + forM_ cabalPathFlags $ \flag -> do + -- Basic output + cabal "path" ["-z", "--output-format=key-value", flag] + -- Works for json, too + cabal "path" ["-z", "--output-format=json", flag] + -- defaults to key-value + cabal "path" ["-z", flag] + -- Honours cli overwrites + cabalG ["--store-dir=test-dir"] "path" ["-z", "--output-format=key-value", "--store-dir"] + cabalG ["--store-dir=test-dir"] "path" ["-z", "--output-format=json", "--store-dir"] + cabalG ["--store-dir=test-dir"] "path" ["-z", "--store-dir"] + forM_ cabalPathFlags $ \flag -> do + -- Honour config file overwrites: + cabalG ["--config-file=fake-cabal.config"] "path" ["-z", "--output-format=key-value", flag] + cabalG ["--config-file=fake-cabal.config"] "path" ["-z", "--output-format=json", flag] + cabalG ["--config-file=fake-cabal.config"] "path" ["-z", flag] + -- Honour cabal.project file + cabal "path" ["--output-format=key-value", flag] + cabal "path" ["--output-format=json", flag] + cabal "path" [flag] + -- Honour config file and project file overwrites: + cabalG ["--config-file=fake-cabal.config"] "path" ["--project-file=fake.cabal.project", "--output-format=key-value", flag] + cabalG ["--config-file=fake-cabal.config"] "path" ["--project-file=fake.cabal.project", "--output-format=json", flag] + cabalG ["--config-file=fake-cabal.config"] "path" ["--project-file=fake.cabal.project", flag] diff --git a/cabal-testsuite/PackageTests/Path/Config/config.cabal b/cabal-testsuite/PackageTests/Path/Config/config.cabal new file mode 100644 index 00000000000..f29aefce3f3 --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Config/config.cabal @@ -0,0 +1,5 @@ +cabal-version: 3.0 +name: config +version: 0.1 + +library diff --git a/cabal-testsuite/PackageTests/Path/Config/fake-cabal.config b/cabal-testsuite/PackageTests/Path/Config/fake-cabal.config new file mode 100644 index 00000000000..641b576fa39 --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Config/fake-cabal.config @@ -0,0 +1,11 @@ +-- this is a test file, dont use it +repository hackage.haskell.org + url: http://hackage.haskell.org/ + -- secure: True + -- root-keys: + -- key-threshold: 3 + +logs-dir: my-logs-dir +store-dir: my-store-dir +remote-repo-cache: my-cache-dir +installdir: my-installdir diff --git a/cabal-testsuite/PackageTests/Path/Config/fake.cabal.project b/cabal-testsuite/PackageTests/Path/Config/fake.cabal.project new file mode 100644 index 00000000000..34ebb745e8e --- /dev/null +++ b/cabal-testsuite/PackageTests/Path/Config/fake.cabal.project @@ -0,0 +1,6 @@ +packages: ./ + +logs-dir: my-logs-dir +store-dir: my-store-dir +remote-repo-cache: my-cache-dir +installdir: my-installdir diff --git a/cabal-testsuite/PackageTests/Path/Single/cabal.out b/cabal-testsuite/PackageTests/Path/Single/cabal.out deleted file mode 100644 index 1ae82037846..00000000000 --- a/cabal-testsuite/PackageTests/Path/Single/cabal.out +++ /dev/null @@ -1,2 +0,0 @@ -# cabal path -/cabal.dist/home/.cabal/bin diff --git a/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs b/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs deleted file mode 100644 index 8eac59024f3..00000000000 --- a/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs +++ /dev/null @@ -1,3 +0,0 @@ -import Test.Cabal.Prelude - -main = cabalTest . void $ cabal "path" ["--installdir"] diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index 90b69c7e7a6..6bf6dbabbeb 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -303,6 +303,8 @@ runTestM mode m = program_db1 verbosity + (configuredGhcProg, _) <- requireProgram verbosity ghcProgram program_db2 + program_db3 <- reconfigurePrograms verbosity ([("cabal", p) | p <- maybeToList (argCabalInstallPath cargs)] ++ @@ -324,6 +326,7 @@ runTestM mode m = testProgramDb = program_db, testPlatform = platform, testCompiler = comp, + testCompilerPath = programPath configuredGhcProg, testPackageDBStack = db_stack, testVerbosity = verbosity, testMtimeChangeDelay = Nothing, @@ -528,6 +531,16 @@ mkNormalizerEnv = do canonicalizedTestTmpDir <- liftIO $ canonicalizePath (testTmpDir env) + -- 'cabal' is configured in the package-db, but doesn't specify how to find the program version + -- Thus we find the program location, if it exists, and query for the program version for + -- output normalisation. + cabalVersionM <- do + cabalProgM <- needProgramM "cabal" + case cabalProgM of + Nothing -> pure Nothing + Just cabalProg -> do + liftIO (findProgramVersion "--numeric-version" id (testVerbosity env) (programPath cabalProg)) + return NormalizerEnv { normalizerRoot = addTrailingPathSeparator (testSourceDir env), @@ -539,12 +552,16 @@ mkNormalizerEnv = do = addTrailingPathSeparator tmpDir, normalizerGhcVersion = compilerVersion (testCompiler env), + normalizerGhcPath + = testCompilerPath env, normalizerKnownPackages = mapMaybe simpleParse (words list_out), normalizerPlatform = testPlatform env, normalizerCabalVersion - = cabalVersionLibrary + = cabalVersionLibrary, + normalizerCabalInstallVersion + = cabalVersionM } cabalVersionLibrary :: Version @@ -557,6 +574,11 @@ requireProgramM program = do requireProgram (testVerbosity env) program (testProgramDb env) return configured_program +needProgramM :: String -> TestM (Maybe ConfiguredProgram) +needProgramM program = do + env <- getTestEnv + return $ lookupProgramByName program (testProgramDb env) + programPathM :: Program -> TestM FilePath programPathM program = do fmap programPath (requireProgramM program) @@ -608,6 +630,7 @@ data TestEnv = TestEnv , testProgramDb :: ProgramDb -- | Compiler we are running tests for , testCompiler :: Compiler + , testCompilerPath :: FilePath -- | Platform we are running tests on , testPlatform :: Platform -- | Package database stack (actually this changes lol) diff --git a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs index e6afd93fcb0..42daa708885 100644 --- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs +++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs @@ -50,7 +50,6 @@ normalizeOutput nenv = "/incoming/new-" -- Normalize architecture . resub (posixRegexEscape (display (normalizerPlatform nenv))) "" - . normalizeBuildInfoJson -- 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, @@ -64,6 +63,8 @@ normalizeOutput nenv = ++ "(-[a-z0-9]+)?") "" else id) + . normalizeBuildInfoJson + . maybe id normalizePathCmdOutput (normalizerCabalInstallVersion nenv) -- hackage-security locks occur non-deterministically . resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" "" where @@ -72,16 +73,27 @@ normalizeOutput nenv = resub (posixRegexEscape (display pid) ++ "(-[A-Za-z0-9.-]+)?") (prettyShow (packageName pid) ++ "-") + normalizePathCmdOutput cabalInstallVersion = + -- clear the ghc path out of all supported output formats + resub ("compiler-path: " <> posixRegexEscape (normalizerGhcPath nenv)) + "compiler-path: " + -- ghc compiler path is already covered by 'normalizeBuildInfoJson' + . resub ("{\"cabal-version\":\"" ++ posixRegexEscape (display cabalInstallVersion) ++ "\"") + "{\"cabal-version\":\"\"" + -- Replace windows filepaths that contain `\\` in the json output. + -- since we need to escape each '\' ourselves, these 8 backslashes match on exactly 2 backslashes + -- in the test output. + -- As the json output is escaped, we need to re-escape the path. + . resub "\\\\\\\\" "\\" + -- 'build-info.json' contains a plethora of host system specific information. -- -- This must happen before the root-dir normalisation. normalizeBuildInfoJson = -- Remove ghc path from show-build-info output - resub ("\"path\":\"[^\"]*\"}") - "\"path\":\"\"}" + resub ("\"path\":\"" <> posixRegexEscape (normalizerGhcPath nenv) <> "\"") + "\"path\":\"\"" -- Remove cabal version output from show-build-info output - . resub ("{\"cabal-version\":\"" ++ posixRegexEscape (display (normalizerCabalVersion nenv)) ++ "\"") - "{\"cabal-version\":\"\"" . resub ("{\"cabal-lib-version\":\"" ++ posixRegexEscape (display (normalizerCabalVersion nenv)) ++ "\"") "{\"cabal-lib-version\":\"\"" -- Remove the package id for stuff such as: @@ -106,9 +118,11 @@ data NormalizerEnv = NormalizerEnv -- `/var` is a symlink for `/private/var`. , normalizerGblTmpDir :: FilePath , normalizerGhcVersion :: Version + , normalizerGhcPath :: FilePath , normalizerKnownPackages :: [PackageId] , normalizerPlatform :: Platform , normalizerCabalVersion :: Version + , normalizerCabalInstallVersion :: Maybe Version } posixSpecialChars :: [Char] diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 69e60078e78..4674585d5a9 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -305,12 +305,11 @@ cabalGArgs global_args cmd args input = do , "info" , "init" , "haddock-project" - , "path" ] = [ ] -- new-build commands are affected by testCabalProjectFile - | cmd == "v2-sdist" + | cmd `elem` ["v2-sdist", "path"] = [ "--project-file=" ++ fp | Just fp <- [testCabalProjectFile env] ] | cmd == "v2-clean" diff --git a/changelog.d/pr-9583 b/changelog.d/pr-9583 new file mode 100644 index 00000000000..1b9f1caaf33 --- /dev/null +++ b/changelog.d/pr-9583 @@ -0,0 +1,28 @@ +synopsis: Redesign 'cabal path' command to account for projects +packages: cabal-install +prs: #9673 + +description: { + +Previously, `cabal path` was only able to query from the global configuration file, e.g., `~/.cabal/config` or the XDG equivalent. +We take the foundations and enhance `cabal path` to take project configuration, such as `cabal.project`, into account. + +Additionally, we add support for multiple output formats, such as key-value pairs and json. + +The key-value pair output prints a line for each queried key and its respective value: + + key1: value2 + key2: value2 + +If only a single key is queried, we print only the value, for example: + + value1 + +The json output format is versioned by the cabal-install version, which is part of the json object. +Thus, all result objects contain at least the key "cabal-install-version". + +We expand the `cabal path` to also produce information of the compiler that is going to be used in a `cabal build` or `cabal repl` invocation. +To do that, we re-configure the compiler program, and outputs the location, version and compiler flavour. +This is helpful for downstream tools, such as HLS, to figure out the GHC version required to compile a project with, without dependency solving. + +} diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 35297d2937b..9655099129a 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -288,19 +288,43 @@ cabal preferences. It is very useful when you are e.g. first configuring cabal path ^^^^^^^^^^ -``cabal path`` prints the file system paths used by ``cabal`` for -cache, store, installed binaries, and so on. When run without any -options, it will show all paths, labeled with how they are namen in -the configuration file: +``cabal path`` allows to query for paths used by ``cabal``. +For example, it allows to query for the directories of the cache, store, +installed binaries, and so on. :: - $ cabal path - cache-dir: /home/haskell/.cache/cabal/packages - logs-dir: /home/haskell/.cache/cabal/logs - store-dir: /home/haskell/.local/state/cabal/store - config-file: /home/haskell/.config/cabal/config - installdir: /home/haskell/.local/bin - ... + + $ cabal path + cache-home: /home/haskell/.cache/cabal/ + remote-repo-cache: /home/haskell/.cache/cabal/packages + logs-dir: /home/haskell/.cache/cabal/logs + store-dir: /home/haskell/.local/state/cabal/store + config-file: /home/haskell/.config/cabal/config + installdir: /home/haskell/.local/bin + ... + +Or using the json output: + +:: + + $ cabal path --output-format=json + +.. code-block:: json + + { + "cabal-version": "3.11.0.0", + "compiler": { + "flavour": "ghc", + "id": "ghc-9.6.4", + "path": "/home/user/.ghcup/bin/ghc" + }, + "cache-home": "/home/user/.cabal", + "remote-repo-cache": "/home/user/.cabal/packages", + "logs-dir": "/home/user/.cabal/logs", + "store-dir": "/home/user/.cabal/store", + "config-file": "/home/user/.cabal/config", + "installdir": "/home/user/.cabal/bin" + } If ``cabal path`` is passed a single option naming a path, then that path will be printed *without* any label: @@ -310,8 +334,8 @@ path will be printed *without* any label: $ cabal path --installdir /home/haskell/.local/bin -This is a stable interface and is intended to be used for scripting. -For example: +While this interface is intended to be used for scripting, it is an experimental command. +Scripting example: :: $ ls $(cabal path --installdir)