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)