diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 1a46893c9b8..7ea4e1a0484 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -36,6 +36,7 @@ import Distribution.Client.Setup , ReportFlags (..) , UploadFlags (..) , UserConfigFlags (..) + , PathFlags (..) , actAsSetupCommand , benchmarkCommand , buildCommand @@ -69,6 +70,7 @@ import Distribution.Client.Setup , unpackCommand , uploadCommand , userConfigCommand + , pathCommand , withRepoContext ) import Distribution.Simple.Setup @@ -102,6 +104,9 @@ import Distribution.Client.Config , loadConfig , userConfigDiff , userConfigUpdate + , defaultCacheDir + , defaultLogsDir + , defaultStoreDir ) import qualified Distribution.Client.List as List ( info @@ -368,6 +373,7 @@ mainWorker args = do , regularCmd reportCommand reportAction , regularCmd initCommand initAction , regularCmd userConfigCommand userConfigAction + , regularCmd pathCommand pathAction , regularCmd genBoundsCommand genBoundsAction , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction , wrapperCmd hscolourCommand hscolourVerbosity hscolourDistPref @@ -1320,3 +1326,14 @@ 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) + cfg <- loadConfig verbosity mempty + putStrLn . ("cache-dir: "++) =<< maybe defaultCacheDir pure + (flagToMaybe $ globalCacheDir $ savedGlobalFlags cfg) + putStrLn . ("logs-dir: "++) =<< maybe defaultLogsDir pure + (flagToMaybe $ globalLogsDir $ savedGlobalFlags cfg) + putStrLn . ("store-dir: "++) =<< maybe defaultStoreDir pure + (flagToMaybe $ globalStoreDir $ savedGlobalFlags cfg) diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 6d04d401a8a..64a32a3760c 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -85,6 +85,8 @@ module Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand + , PathFlags (..) + , pathCommand , liftOptions , yesNoOpt ) where @@ -3322,6 +3324,42 @@ userConfigCommand = -- ------------------------------------------------------------ +-- * Dirs + +-- ------------------------------------------------------------ + +data PathFlags = PathFlags { + pathVerbosity :: Flag Verbosity + } deriving Generic + +instance Monoid PathFlags where + mempty = PathFlags { + pathVerbosity = toFlag normal + } + mappend = (<>) + +instance Semigroup PathFlags where + (<>) = gmappend + +pathCommand :: CommandUI PathFlags +pathCommand = CommandUI { + commandName = "path", + commandSynopsis = "Display the directories 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 = \ _ -> [ + optionVerbosity pathVerbosity (\v flags -> flags { pathVerbosity = v })] + } + + +-- ------------------------------------------------------------ + -- * GetOpt Utils -- ------------------------------------------------------------