diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 6d6d5a6de7e2c132440aa5487101256ea0ea4e3f..a1cec8618017582a438769610a905384e9327e22 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -99,6 +99,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 0000000000000000000000000000000000000000..8ca8d6181f186492d70e02a215da0c6c47898241
--- /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 1c2b4dabb279e22ac89b5d26a8f29fd78edfba54..e522289ea6f3c1f8a848b91a842d4c82f98f0fc8 100644
--- a/cabal-install/src/Distribution/Client/Config.hs
+++ b/cabal-install/src/Distribution/Client/Config.hs
@@ -24,6 +24,7 @@ module Distribution.Client.Config
   , parseConfig
   , defaultConfigFile
   , defaultCacheDir
+  , defaultCacheHome
   , defaultScriptBuildsDir
   , defaultStoreDir
   , defaultCompiler
@@ -795,6 +796,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 ada3eca5268ae06bbd8159cc8d3edbf12ea73c49..d25c59af41e7de244c47648b111a19bc24924790 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 6ef0a673717a0eeed7b6966916af070abdb32a6f..59597533026c9a8da88a2176af13cdffca68154e 100644
--- a/cabal-install/src/Distribution/Client/Main.hs
+++ b/cabal-install/src/Distribution/Client/Main.hs
@@ -34,8 +34,6 @@ import Distribution.Client.Setup
   , InitFlags (initHcPath, initVerbosity)
   , InstallFlags (..)
   , ListFlags (..)
-  , Path (..)
-  , PathFlags (..)
   , ReportFlags (..)
   , UploadFlags (..)
   , UserConfigFlags (..)
@@ -63,8 +61,6 @@ import Distribution.Client.Setup
   , listCommand
   , listNeedsCompiler
   , manpageCommand
-  , pathCommand
-  , pathName
   , reconfigureCommand
   , registerCommand
   , replCommand
@@ -102,11 +98,7 @@ import Prelude ()
 import Distribution.Client.Config
   ( SavedConfig (..)
   , createDefaultConfigFile
-  , defaultCacheDir
   , defaultConfigFile
-  , defaultInstallPath
-  , defaultLogsDir
-  , defaultStoreDir
   , getConfigFilePath
   , loadConfig
   , userConfigDiff
@@ -137,6 +129,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
@@ -152,7 +145,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)
@@ -240,7 +232,6 @@ import Distribution.Simple.Utils
   , notice
   , topHandler
   , tryFindPackageDesc
-  , withOutputMarker
   )
 import Distribution.Text
   ( display
@@ -256,7 +247,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
@@ -434,7 +424,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
@@ -1388,32 +1378,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 676486d343d66276953b38a3154ca14cb42a89a4..2b6ac797cfa792a21ae7160b411647af31bdf1ad 100644
--- a/cabal-install/src/Distribution/Client/ScriptUtils.hs
+++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs
@@ -308,7 +308,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 85cc76656476e012dd90f89cfe4370453b29213d..222b53b9967f628557c13a8f54b9dde3be87fefd 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -86,10 +86,6 @@ module Distribution.Client.Setup
   , cleanCommand
   , copyCommand
   , registerCommand
-  , Path (..)
-  , pathName
-  , PathFlags (..)
-  , pathCommand
   , liftOptions
   , yesNoOpt
   ) where
@@ -354,7 +350,6 @@ globalCommand commands =
             ++ unlines
               ( [ startGroup "global"
                 , addCmd "user-config"
-                , addCmd "path"
                 , addCmd "help"
                 , par
                 , startGroup "package database"
@@ -372,6 +367,7 @@ globalCommand commands =
                 , addCmd "freeze"
                 , addCmd "gen-bounds"
                 , addCmd "outdated"
+                , addCmd "path"
                 , par
                 , startGroup "project building and installing"
                 , addCmd "build"
@@ -3366,73 +3362,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 55d8b94bc3a3a0844dbb7aec53fceab6d2ffdbad..0f710cc0fb1b8db297012c7d41fb6bcd1a96b8c2 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: <ROOT>/cabal.dist/home/.cabal/packages
+{"cabal-version":"<CABAL_INSTALL_VER>","compiler":{"flavour":"ghc","id":"ghc-<GHCVER>","path":"<GHCPATH>"},"logs-dir":"<ROOT>/cabal.dist/home/.cabal/logs","installdir":"<ROOT>/cabal.dist/home/.cabal/bin"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","compiler":{"flavour":"ghc","id":"ghc-<GHCVER>","path":"<GHCPATH>"},"store-dir":"<ROOT>/cabal.dist/home/.cabal/store","config-file":"<ROOT>/cabal.dist/home/.cabal/config"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","compiler":{"flavour":"ghc","id":"ghc-<GHCVER>","path":"<GHCPATH>"},"remote-repo-cache":"<ROOT>/cabal.dist/home/.cabal/packages"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","compiler":{"flavour":"ghc","id":"ghc-<GHCVER>","path":"<GHCPATH>"},"cache-home":"<ROOT>/cabal.dist/home/.cabal","remote-repo-cache":"<ROOT>/cabal.dist/home/.cabal/packages","logs-dir":"<ROOT>/cabal.dist/home/.cabal/logs","store-dir":"<ROOT>/cabal.dist/home/.cabal/store","config-file":"<ROOT>/cabal.dist/home/.cabal/config","installdir":"<ROOT>/cabal.dist/home/.cabal/bin"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","cache-home":"<ROOT>/cabal.dist/home/.cabal"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","remote-repo-cache":"<ROOT>/cabal.dist/home/.cabal/packages"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","logs-dir":"<ROOT>/cabal.dist/home/.cabal/logs"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","store-dir":"<ROOT>/cabal.dist/home/.cabal/store"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","config-file":"<ROOT>/cabal.dist/home/.cabal/config"}
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","installdir":"<ROOT>/cabal.dist/home/.cabal/bin"}
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+logs-dir: <ROOT>/cabal.dist/home/.cabal/logs
+installdir: <ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+store-dir: <ROOT>/cabal.dist/home/.cabal/store
+config-file: <ROOT>/cabal.dist/home/.cabal/config
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+remote-repo-cache: <ROOT>/cabal.dist/home/.cabal/packages
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+cache-home: <ROOT>/cabal.dist/home/.cabal
+remote-repo-cache: <ROOT>/cabal.dist/home/.cabal/packages
 logs-dir: <ROOT>/cabal.dist/home/.cabal/logs
 store-dir: <ROOT>/cabal.dist/home/.cabal/store
 config-file: <ROOT>/cabal.dist/home/.cabal/config
 installdir: <ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/packages
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/logs
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/store
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/config
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+logs-dir: <ROOT>/cabal.dist/home/.cabal/logs
+installdir: <ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+store-dir: <ROOT>/cabal.dist/home/.cabal/store
+config-file: <ROOT>/cabal.dist/home/.cabal/config
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+remote-repo-cache: <ROOT>/cabal.dist/home/.cabal/packages
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+cache-home: <ROOT>/cabal.dist/home/.cabal
+remote-repo-cache: <ROOT>/cabal.dist/home/.cabal/packages
+logs-dir: <ROOT>/cabal.dist/home/.cabal/logs
+store-dir: <ROOT>/cabal.dist/home/.cabal/store
+config-file: <ROOT>/cabal.dist/home/.cabal/config
+installdir: <ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/packages
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/logs
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/store
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/config
+# cabal path
+<ROOT>/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 b8157a83ee8159dad361168523be9ed4da96ee50..a1c0db98e8c9cf892498306df1fca7cfe4903d49 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 0000000000000000000000000000000000000000..a640aa6094816abd412a8a653278009a27976439
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Path/Compiler/cabal.out
@@ -0,0 +1,10 @@
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","compiler":{"flavour":"ghc","id":"ghc-<GHCVER>","path":"<GHCPATH>"}}
+# cabal path
+compiler-flavour: ghc
+compiler-id: ghc-<GHCVER>
+compiler-path: <GHCPATH>
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 0000000000000000000000000000000000000000..b70251cf574690f367b2c870b62cd0f40efaccf9
--- /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 0000000000000000000000000000000000000000..2263588109ff3927bfeabe1eb8cb507156682eab
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Path/Config/cabal.out
@@ -0,0 +1,150 @@
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","cache-home":"<ROOT>/cabal.dist/home/.cabal"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/packages
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","remote-repo-cache":"<ROOT>/cabal.dist/home/.cabal/packages"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/packages
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/logs
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","logs-dir":"<ROOT>/cabal.dist/home/.cabal/logs"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/logs
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/store
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","store-dir":"<ROOT>/cabal.dist/home/.cabal/store"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/store
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/config
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","config-file":"<ROOT>/cabal.dist/home/.cabal/config"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/config
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","installdir":"<ROOT>/cabal.dist/home/.cabal/bin"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+test-dir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","store-dir":"test-dir"}
+# cabal path
+test-dir
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","cache-home":"<ROOT>/cabal.dist/home/.cabal"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","cache-home":"<ROOT>/cabal.dist/home/.cabal"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","cache-home":"<ROOT>/cabal.dist/home/.cabal"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal
+# cabal path
+my-cache-dir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","remote-repo-cache":"my-cache-dir"}
+# cabal path
+my-cache-dir
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/packages
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","remote-repo-cache":"<ROOT>/cabal.dist/home/.cabal/packages"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/packages
+# cabal path
+my-cache-dir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","remote-repo-cache":"my-cache-dir"}
+# cabal path
+my-cache-dir
+# cabal path
+my-logs-dir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","logs-dir":"my-logs-dir"}
+# cabal path
+my-logs-dir
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/logs
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","logs-dir":"<ROOT>/cabal.dist/home/.cabal/logs"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/logs
+# cabal path
+my-logs-dir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","logs-dir":"my-logs-dir"}
+# cabal path
+my-logs-dir
+# cabal path
+my-store-dir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","store-dir":"my-store-dir"}
+# cabal path
+my-store-dir
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/store
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","store-dir":"<ROOT>/cabal.dist/home/.cabal/store"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/store
+# cabal path
+my-store-dir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","store-dir":"my-store-dir"}
+# cabal path
+my-store-dir
+# cabal path
+fake-cabal.config
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","config-file":"fake-cabal.config"}
+# cabal path
+fake-cabal.config
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/config
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","config-file":"<ROOT>/cabal.dist/home/.cabal/config"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/config
+# cabal path
+fake-cabal.config
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","config-file":"fake-cabal.config"}
+# cabal path
+fake-cabal.config
+# cabal path
+my-installdir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","installdir":"my-installdir"}
+# cabal path
+my-installdir
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","installdir":"<ROOT>/cabal.dist/home/.cabal/bin"}
+# cabal path
+<ROOT>/cabal.dist/home/.cabal/bin
+# cabal path
+my-installdir
+# cabal path
+{"cabal-version":"<CABAL_INSTALL_VER>","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 0000000000000000000000000000000000000000..2397fbe46626f3087a51c7bc6fab4b8e1d9ab868
--- /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 0000000000000000000000000000000000000000..f29aefce3f3bcb187861a5c297f4c4a33146917f
--- /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 0000000000000000000000000000000000000000..641b576fa390bcb477dc1c9f8d423adbbc607de4
--- /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 0000000000000000000000000000000000000000..34ebb745e8e54ee959c79ae898bc246813285874
--- /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 1ae82037846c70899a30c84315a290313deffba4..0000000000000000000000000000000000000000
--- a/cabal-testsuite/PackageTests/Path/Single/cabal.out
+++ /dev/null
@@ -1,2 +0,0 @@
-# cabal path
-<ROOT>/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 8eac59024f32963fcf6c574bd9c30148a2ae5eb6..0000000000000000000000000000000000000000
--- 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 14e9313506432e1119c44aafd9bf992cdadbbd8b..a3c50ed70b980f5f9260be7957423b84e623e88a 100644
--- a/cabal-testsuite/src/Test/Cabal/Monad.hs
+++ b/cabal-testsuite/src/Test/Cabal/Monad.hs
@@ -295,6 +295,8 @@ runTestM mode m =
                 program_db1
                 verbosity
 
+    (configuredGhcProg, _) <- requireProgram verbosity ghcProgram program_db2
+
     program_db3 <-
         reconfigurePrograms verbosity
             ([("cabal", p)   | p <- maybeToList (argCabalInstallPath cargs)] ++
@@ -316,6 +318,7 @@ runTestM mode m =
                     testProgramDb = program_db,
                     testPlatform = platform,
                     testCompiler = comp,
+                    testCompilerPath = programPath configuredGhcProg,
                     testPackageDBStack = db_stack,
                     testVerbosity = verbosity,
                     testMtimeChangeDelay = Nothing,
@@ -521,6 +524,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),
@@ -532,12 +545,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
@@ -550,6 +567,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)
@@ -601,6 +623,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 a0b7d3ac669abfc08d2d995e2ac5c0ea3ba937c5..a4f38633965e31de994926a9b7cbce4f3a22b615 100644
--- a/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
+++ b/cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs
@@ -49,7 +49,6 @@ normalizeOutput nenv =
           "/incoming/new-<RAND>"
     -- Normalize architecture
   . resub (posixRegexEscape (display (normalizerPlatform nenv))) "<ARCH>"
-  . 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,
@@ -63,6 +62,8 @@ normalizeOutput nenv =
                         ++ "(-[a-z0-9]+)?")
                    "<GHCVER>"
         else id)
+  . normalizeBuildInfoJson
+  . maybe id normalizePathCmdOutput (normalizerCabalInstallVersion nenv)
   -- hackage-security locks occur non-deterministically
   . resub "(Released|Acquired|Waiting) .*hackage-security-lock\n" ""
   where
@@ -70,16 +71,27 @@ normalizeOutput nenv =
         resub (posixRegexEscape (display pid) ++ "(-[A-Za-z0-9.-]+)?")
               (prettyShow (packageName pid) ++ "-<VERSION>")
 
+    normalizePathCmdOutput cabalInstallVersion =
+      -- clear the ghc path out of all supported output formats
+      resub ("compiler-path: " <> posixRegexEscape (normalizerGhcPath nenv))
+          "compiler-path: <GHCPATH>"
+      -- ghc compiler path is already covered by 'normalizeBuildInfoJson'
+      . resub ("{\"cabal-version\":\"" ++ posixRegexEscape (display cabalInstallVersion) ++ "\"")
+          "{\"cabal-version\":\"<CABAL_INSTALL_VER>\""
+      -- 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\":\"<GHCPATH>\"}"
+        resub ("\"path\":\"" <> posixRegexEscape (normalizerGhcPath nenv) <> "\"")
+          "\"path\":\"<GHCPATH>\""
         -- Remove cabal version output from show-build-info output
-      . resub ("{\"cabal-version\":\"" ++ posixRegexEscape (display (normalizerCabalVersion nenv)) ++ "\"")
-              "{\"cabal-version\":\"<CABALVER>\""
       . resub ("{\"cabal-lib-version\":\"" ++ posixRegexEscape (display (normalizerCabalVersion nenv)) ++ "\"")
               "{\"cabal-lib-version\":\"<CABALVER>\""
         -- Remove the package id for stuff such as:
@@ -104,9 +116,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 22f109f16af67420eff22b7bf50bdd6338231ab1..d50f449f820db9cc2380d72ff549758e983999ba 100644
--- a/cabal-testsuite/src/Test/Cabal/Prelude.hs
+++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs
@@ -302,12 +302,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 0000000000000000000000000000000000000000..1b9f1caaf33ba274bcc61326dafee221acf59208
--- /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 229a5b7a616dab749257bcc5fbc3438e45060e45..e1d827f946bce2ded09d6ce3d8cb77bc1f9f7c6b 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)