diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 889fa634390..de08063b7b5 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -43,6 +43,7 @@ import Distribution.Client.Setup , InitFlags(initVerbosity, initHcPath), initCommand , ActAsSetupFlags(..), actAsSetupCommand , UserConfigFlags(..), userConfigCommand + , DirsFlags(..), dirsCommand , reportCommand , manpageCommand , haddockCommand @@ -70,7 +71,8 @@ import Distribution.Client.SetupWrapper ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions ) import Distribution.Client.Config ( SavedConfig(..), loadConfig, defaultConfigFile, userConfigDiff - , userConfigUpdate, createDefaultConfigFile, getConfigFilePath ) + , userConfigUpdate, createDefaultConfigFile, getConfigFilePath + , defaultStoreDir, defaultCacheDir, defaultLogsDir ) import Distribution.Client.Targets ( readUserTargets ) import qualified Distribution.Client.List as List @@ -270,6 +272,7 @@ mainWorker args = do , regularCmd reportCommand reportAction , regularCmd initCommand initAction , regularCmd userConfigCommand userConfigAction + , regularCmd dirsCommand dirsAction , regularCmd genBoundsCommand genBoundsAction , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction , wrapperCmd hscolourCommand hscolourVerbosity hscolourDistPref @@ -1011,3 +1014,14 @@ manpageAction commands flags extraArgs _ = do then dropExtension pname else pname manpageCmd cabalCmd commands flags + +dirsAction :: DirsFlags -> [String] -> Action +dirsAction dirsflags _extraArgs _globalFlags = do + let verbosity = fromFlag (dirsVerbosity dirsflags) + 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 6db91d9cf98..4d3b5a85799 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -48,6 +48,7 @@ module Distribution.Client.Setup , cleanCommand , copyCommand , registerCommand + , DirsFlags(..), dirsCommand , liftOptions , yesNoOpt @@ -2415,6 +2416,40 @@ userConfigCommand = CommandUI { } +-- ------------------------------------------------------------ +-- * Dirs +-- ------------------------------------------------------------ + +data DirsFlags = DirsFlags { + dirsVerbosity :: Flag Verbosity + } deriving Generic + +instance Monoid DirsFlags where + mempty = DirsFlags { + dirsVerbosity = toFlag normal + } + mappend = (<>) + +instance Semigroup DirsFlags where + (<>) = gmappend + +dirsCommand :: CommandUI DirsFlags +dirsCommand = CommandUI { + commandName = "dirs", + 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 ++ " dirs\n", + commandDefaultFlags = mempty, + commandOptions = \ _ -> [ + optionVerbosity dirsVerbosity (\v flags -> flags { dirsVerbosity = v })] + } + + -- ------------------------------------------------------------ -- * GetOpt Utils -- ------------------------------------------------------------