diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 3cb68deb661..6225b79de7c 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -92,6 +92,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..5eb9eb52452 --- /dev/null +++ b/cabal-install/src/Distribution/Client/CmdPath.hs @@ -0,0 +1,404 @@ +{-# 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 + ( 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" + <> "This command always requires the flag '--output-format=" + <> intercalate "|" (map pathOutputFormatString [minBound .. maxBound]) + <> "'.\n" + <> "The output order of query keys is implementation defined and should not be relied on.\n" + , commandNotes = Just $ \pname -> + "Examples:\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 + = ConfigPathCacheDir + | ConfigPathLogsDir + | ConfigPathStoreDir + | ConfigPathConfigFile + | ConfigPathInstallDir + deriving (Eq, Ord, Show, Enum, Bounded) + +-- | The configuration name for this path. +pathName :: ConfigPath -> String +pathName ConfigPathCacheDir = "cache-dir" +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 (NoFlag == pathOutputFormat pathFlags) $ + dieWithException verbosity (CmdPathRequiresOutputFormat (map pathOutputFormatString [minBound .. maxBound])) + 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 JSON (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 baseCtx ConfigPathCacheDir = + 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-install-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/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index ada3eca5268..0c424148a05 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -184,6 +184,9 @@ data CabalInstallException | CorruptedIndexCache String | UnusableIndexState RemoteRepo Timestamp Timestamp | MissingPackageList RemoteRepo + | CmdPathAcceptsNoTargets + | CmdPathRequiresOutputFormat [String] -- Accepted values for the output format + | CmdPathCommandDoesn'tSupportDryRun deriving (Show, Typeable) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -334,6 +337,9 @@ exceptionCodeCabalInstall e = case e of CorruptedIndexCache{} -> 7158 UnusableIndexState{} -> 7159 MissingPackageList{} -> 7160 + CmdPathAcceptsNoTargets{} -> 7161 + CmdPathRequiresOutputFormat{} -> 7162 + CmdPathCommandDoesn'tSupportDryRun -> 7163 exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of @@ -849,6 +855,14 @@ 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." + CmdPathRequiresOutputFormat vals -> + "The 'path' command requires the flag '--output-format'. Allowed values are: " + ++ intercalate ", " vals + ++ "." + 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 dc196a66864..8cc9f3d37a6 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -33,8 +33,6 @@ import Distribution.Client.Setup , InitFlags (initHcPath, initVerbosity) , InstallFlags (..) , ListFlags (..) - , Path (..) - , PathFlags (..) , ReportFlags (..) , UploadFlags (..) , UserConfigFlags (..) @@ -62,8 +60,6 @@ import Distribution.Client.Setup , listCommand , listNeedsCompiler , manpageCommand - , pathCommand - , pathName , reconfigureCommand , registerCommand , replCommand @@ -101,11 +97,7 @@ import Prelude () import Distribution.Client.Config ( SavedConfig (..) , createDefaultConfigFile - , defaultCacheDir , defaultConfigFile - , defaultInstallPath - , defaultLogsDir - , defaultStoreDir , getConfigFilePath , loadConfig , userConfigDiff @@ -136,6 +128,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 @@ -151,7 +144,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) @@ -239,7 +231,6 @@ import Distribution.Simple.Utils , notice , topHandler , tryFindPackageDesc - , withOutputMarker ) import Distribution.Text ( display @@ -255,7 +246,6 @@ import Distribution.Version ) import Control.Exception (AssertionFailed, assert, try) -import Control.Monad (mapM_) import Data.Monoid (Any (..)) import Distribution.Client.Errors import Distribution.Compat.ResponseFile @@ -429,7 +419,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 hscolourVerbosity hscolourDistPref @@ -1382,32 +1372,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 e66117414a8..6eae587c36a 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -303,7 +303,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 a5d91aaf19b..23ab815ec75 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -85,10 +85,6 @@ module Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand - , Path (..) - , pathName - , PathFlags (..) - , pathCommand , liftOptions , yesNoOpt ) where @@ -348,7 +344,6 @@ globalCommand commands = ++ unlines ( [ startGroup "global" , addCmd "user-config" - , addCmd "path" , addCmd "help" , par , startGroup "package database" @@ -366,6 +361,7 @@ globalCommand commands = , addCmd "freeze" , addCmd "gen-bounds" , addCmd "outdated" + , addCmd "path" , par , startGroup "project building and installing" , addCmd "build" @@ -3329,73 +3325,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..d6a3fb98908 100644 --- a/cabal-testsuite/PackageTests/Path/All/cabal.out +++ b/cabal-testsuite/PackageTests/Path/All/cabal.out @@ -1,4 +1,8 @@ # cabal path +Resolving dependencies... +compiler-flavour: ghc +compiler-id: ghc- +compiler-path: /home/hugin/.ghcup/bin/ghc cache-dir: /cabal.dist/home/.cabal/packages logs-dir: /cabal.dist/home/.cabal/logs store-dir: /cabal.dist/home/.cabal/store diff --git a/cabal-testsuite/PackageTests/Path/All/cabal.test.hs b/cabal-testsuite/PackageTests/Path/All/cabal.test.hs index b8157a83ee8..0a39f875ed0 100644 --- a/cabal-testsuite/PackageTests/Path/All/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Path/All/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude -main = cabalTest . void $ cabal "path" [] +main = cabalTest . void $ cabal "path" ["-z", "--output-format=key-value"] diff --git a/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs b/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs index 8eac59024f3..2a27f349b38 100644 --- a/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Path/Single/cabal.test.hs @@ -1,3 +1,3 @@ import Test.Cabal.Prelude -main = cabalTest . void $ cabal "path" ["--installdir"] +main = cabalTest . void $ cabal "path" ["-z", "--output-format=key-value", "--installdir"]