From de17699d5538b071e7f7dfab31ee1b11c399b6d3 Mon Sep 17 00:00:00 2001
From: Fendor <power.walross@gmail.com>
Date: Sun, 1 Aug 2021 16:21:17 +0200
Subject: [PATCH 1/5] Add 'status' command to cabal

Lightweight command that can query for very basic information
in a cabal project.
In particular, information about the compiler for the project and the
location of the so-called `build-info` field.
Other flags are bound to follow.
---
 cabal-install/cabal-install.cabal             |   1 +
 cabal-install/main/Main.hs                    |   2 +
 .../src/Distribution/Client/CmdStatus.hs      | 366 ++++++++++++++++++
 .../src/Distribution/Client/Setup.hs          |   1 +
 .../src/Distribution/Client/TargetSelector.hs |   5 +
 5 files changed, 375 insertions(+)
 create mode 100644 cabal-install/src/Distribution/Client/CmdStatus.hs

diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 747d353276b..f7aece47a91 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -94,6 +94,7 @@ library
         Distribution.Client.CmdRepl
         Distribution.Client.CmdRun
         Distribution.Client.CmdSdist
+        Distribution.Client.CmdStatus
         Distribution.Client.CmdTest
         Distribution.Client.CmdUpdate
         Distribution.Client.Compat.Directory
diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs
index 324fd88d8ad..9bf723a94fd 100644
--- a/cabal-install/main/Main.hs
+++ b/cabal-install/main/Main.hs
@@ -83,6 +83,7 @@ import qualified Distribution.Client.CmdHaddock   as CmdHaddock
 import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject
 import qualified Distribution.Client.CmdInstall   as CmdInstall
 import qualified Distribution.Client.CmdRun       as CmdRun
+import qualified Distribution.Client.CmdStatus    as CmdStatus
 import qualified Distribution.Client.CmdTest      as CmdTest
 import qualified Distribution.Client.CmdBench     as CmdBench
 import qualified Distribution.Client.CmdExec      as CmdExec
@@ -274,6 +275,7 @@ mainWorker args = do
       , hiddenCmd  actAsSetupCommand actAsSetupAction
       , hiddenCmd  manpageCommand (manpageAction commandSpecs)
       , regularCmd CmdListBin.listbinCommand     CmdListBin.listbinAction
+      , regularCmd CmdStatus.statusCommand       CmdStatus.statusAction
 
       ] ++ concat
       [ newCmd  CmdConfigure.configureCommand CmdConfigure.configureAction
diff --git a/cabal-install/src/Distribution/Client/CmdStatus.hs b/cabal-install/src/Distribution/Client/CmdStatus.hs
new file mode 100644
index 00000000000..c9d6c7a00dc
--- /dev/null
+++ b/cabal-install/src/Distribution/Client/CmdStatus.hs
@@ -0,0 +1,366 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Distribution.Client.CmdStatus
+-- Maintainer  :  cabal-devel@haskell.org
+-- Portability :  portable
+--
+-- Implementation of the 'status' command. Query for project information
+-- such as targets in the project or which ghc version is going to be used
+-- to build the project.
+-----------------------------------------------------------------------------
+
+module Distribution.Client.CmdStatus (
+  statusCommand, statusAction,
+  ) where
+
+import qualified Data.Map as Map
+
+import Prelude ()
+import Distribution.Client.Compat.Prelude
+
+import Distribution.Client.DistDirLayout
+import Distribution.Client.TargetProblem
+import Distribution.Client.CmdErrorMessages
+import qualified Distribution.Client.InstallPlan as InstallPlan
+import Distribution.Client.NixStyleOptions
+         ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
+import Distribution.Client.ProjectOrchestration
+import Distribution.Client.ProjectPlanning
+import Distribution.Client.ProjectPlanning.Types
+import Distribution.Client.Setup
+         ( GlobalFlags, ConfigFlags(..), yesNoOpt )
+import Distribution.Client.Utils.Json
+         ( (.=) )
+import qualified Distribution.Client.Utils.Json as Json
+import Distribution.Client.Version
+         ( cabalInstallVersion )
+import Distribution.InstalledPackageInfo
+         ( InstalledPackageInfo )
+import Distribution.Parsec (parsecCommaList, parsecToken)
+import Distribution.ReadE
+         ( ReadE(ReadE), parsecToReadE )
+import Distribution.Simple.BuildPaths (buildInfoPref)
+import Distribution.Simple.Command
+         ( CommandUI(..), option, reqArg, ShowOrParseArgs, OptionField )
+import Distribution.Simple.Compiler
+import Distribution.Simple.Program
+import Distribution.Simple.Flag
+         ( Flag(..), fromFlagOrDefault )
+import Distribution.Simple.Utils
+         ( wrapText, die', withOutputMarker, ordNub )
+import Distribution.Verbosity
+         ( normal )
+import Distribution.Version
+
+-------------------------------------------------------------------------------
+-- Command
+-------------------------------------------------------------------------------
+
+statusCommand :: CommandUI (NixStyleFlags StatusFlags)
+statusCommand = CommandUI
+  { commandName = "status"
+  , commandSynopsis = "Query for simple project information"
+  , commandDescription  = Just $ \_ -> wrapText $
+      "Query for available targets and project information such as project GHC."
+  , commandNotes = Just $ \pname ->
+        "Examples:\n"
+     ++ "  " ++ pname ++ " status --output-format=json --compiler-info\n"
+     ++ "    Print the compiler that is used for this project in the json format.\n"
+     ++ "  " ++ pname ++ " status --output-format=json --build-info=./src/Foo.hs\n"
+     ++ "    Print the location of the component \"src/Foo.hs\" belongs to.\n"
+     ++ "  " ++ pname ++ " status --output-format=json --build-info=./src/Foo.hs\n"
+     ++ "    Print both, compiler information and build-info location for the given target.\n"
+     ++ "  " ++ pname ++ " status --output-format=json --build-info=./src/Foo.hs --build-info=./test/Bar.hs\n"
+     ++ "    Print build-info location for multiple targets.\n"
+  , commandUsage = \pname ->
+      "Usage: " ++ pname ++ " status [FLAGS]\n"
+  , commandDefaultFlags = defaultNixStyleFlags defaultStatusFlags
+  , commandOptions      = nixStyleOptions statusOptions
+
+  }
+
+-------------------------------------------------------------------------------
+-- Flags
+-------------------------------------------------------------------------------
+
+data StatusOutputFormat
+  = JSON
+  deriving (Eq, Ord, Show, Read)
+
+data StatusFlags = StatusFlags
+  { statusBuildInfo :: [String]
+  , statusCompiler :: Flag Bool
+  , statusOutputFormat :: Flag StatusOutputFormat
+  } deriving (Eq, Show, Read)
+
+defaultStatusFlags :: StatusFlags
+defaultStatusFlags = StatusFlags
+  { statusBuildInfo = mempty
+  , statusCompiler = mempty
+  , statusOutputFormat = mempty
+  }
+
+statusOutputFormatParser :: ReadE (Flag StatusOutputFormat)
+statusOutputFormatParser = ReadE $ \case
+  "json" -> Right $ Flag JSON
+  policy -> Left  $ "Cannot parse the status output format '"
+            <> policy <> "'"
+
+statusOutputFormatPrinter
+  :: Flag StatusOutputFormat -> [String]
+statusOutputFormatPrinter = \case
+  (Flag JSON) -> ["json"]
+  NoFlag      -> []
+
+statusOptions :: ShowOrParseArgs -> [OptionField StatusFlags]
+statusOptions showOrParseArgs =
+  [ option [] ["output-format"]
+    "Output Format for the information"
+    statusOutputFormat (\v flags -> flags { statusOutputFormat = v })
+    (reqArg "json"
+      statusOutputFormatParser
+      statusOutputFormatPrinter
+    )
+  , option [] ["build-info"]
+    "List all available targets in the project"
+    statusBuildInfo (\v flags -> flags { statusBuildInfo = v ++ statusBuildInfo flags})
+    (reqArg "TARGET" buildInfoTargetReadE (fmap show))
+  , option [] ["compiler-info"]
+    "Print information of the project compiler"
+    statusCompiler (\v flags -> flags { statusCompiler = v })
+    (yesNoOpt showOrParseArgs)
+  ]
+  where
+    buildInfoTargetReadE :: ReadE [String]
+    buildInfoTargetReadE =
+      parsecToReadE
+        -- This error should never be shown
+        ("couldn't parse targets: " ++)
+        -- TODO: wrong parser, kills filepaths with spaces
+        (parsecCommaList parsecToken)
+
+-------------------------------------------------------------------------------
+-- Action
+-------------------------------------------------------------------------------
+
+-- | Entry point for the 'status' command.
+statusAction :: NixStyleFlags StatusFlags -> [String] -> GlobalFlags -> IO ()
+statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetStrings globalFlags = do
+  when (NoFlag == statusOutputFormat statusFlags) $ do
+    die' verbosity "The status command requires the flag '--output-format'."
+  when (not $ null cliTargetStrings) $
+    die' verbosity "The status command takes not target arguments directly. Use appropriate flags to pass in target information."
+
+  baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
+  (_, elaboratedPlan, elabSharedConfig, _, _) <-
+    rebuildInstallPlan verbosity
+                        (distDirLayout baseCtx)
+                        (cabalDirLayout baseCtx)
+                        (projectConfig baseCtx)
+                        (localPackages baseCtx)
+
+  let initialJson = Json.object
+        [ "cabal-version" .= jdisplay cabalInstallVersion
+        ]
+
+  compilerJson <- if not $ fromFlagOrDefault False (statusCompiler statusFlags)
+    then pure $ Json.object [] -- Neutral element
+    else do
+      let compiler = pkgConfigCompiler elabSharedConfig
+      compilerProg <- requireCompilerProg verbosity compiler
+      let progDb = pkgConfigCompilerProgs elabSharedConfig
+      (configuredCompilerProg, _) <- requireProgram verbosity compilerProg progDb
+      pure $ mkCompilerInfo configuredCompilerProg compiler
+
+  buildInfoJson <- if null (statusBuildInfo statusFlags)
+    then pure $ Json.object [] -- Neutral element
+    else do
+      let targetStrings = statusBuildInfo statusFlags
+      targetSelectors <- readTargetSelectors (localPackages baseCtx) Nothing targetStrings >>= \case
+        Left err   -> reportTargetSelectorProblems verbosity err
+        Right sels -> pure sels
+
+      -- Interpret the targets on the command line as build targets
+      -- (as opposed to say repl or haddock targets).
+      -- TODO: don't throw on targets that are invalid.
+      targets <- either (reportBuildTargetProblems verbosity) return
+                $ resolveTargets
+                    selectPackageTargets
+                    selectComponentTarget
+                    elaboratedPlan
+                    Nothing
+                    targetSelectors
+
+      pure $ mkBuildInfoJson (distDirLayout baseCtx) elabSharedConfig
+              elaboratedPlan targets targetSelectors targetStrings
+
+  let statusJson = mergeJsonObjects [initialJson, compilerJson, buildInfoJson]
+
+  -- Final output
+  putStrLn $ withOutputMarker verbosity $ Json.encodeToString statusJson
+  where
+    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
+    cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty
+
+-- ----------------------------------------------------------------------------
+-- Helpers for determining and serialising compiler information
+-- ----------------------------------------------------------------------------
+
+requireCompilerProg :: Verbosity -> Compiler -> IO Program
+requireCompilerProg verbosity compiler =
+  case compilerFlavor compiler of
+    GHC -> pure ghcProgram
+    GHCJS -> pure ghcjsProgram
+    flavour -> die' verbosity $
+      "status: Unsupported compiler flavour: "
+      <> prettyShow flavour
+
+mkCompilerInfo :: ConfiguredProgram -> Compiler -> Json.Value
+mkCompilerInfo compilerProgram compiler =
+  Json.object
+    [ "compiler" .= Json.object
+        [ "flavour"     .= Json.String (prettyShow $ compilerFlavor compiler)
+        , "compiler-id" .= Json.String (showCompilerId compiler)
+        , "path"        .= Json.String (programPath compilerProgram)
+        ]
+    ]
+
+-- ----------------------------------------------------------------------------
+-- Helpers for determining and serialising build info
+-- ----------------------------------------------------------------------------
+
+mkBuildInfoJson :: DistDirLayout -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> TargetsMap -> [TargetSelector] -> [String] -> Json.Value
+mkBuildInfoJson distDirLayout elaboratedSharedConfig elaboratedPlan targetsMap targetSelectors targetStrings = Json.object
+  [ "build-info" .= Json.Array allTargetsJsons
+  ]
+  where
+    allTargetsJsons =
+      [ planPackageToJ elab ts
+      | (uid, elab) <- Map.assocs subsetInstallPlan
+      , (_, tss) <- targetsMap Map.! uid
+      , ts <- ordNub $ toList tss
+      ]
+
+    subsetInstallPlan = Map.restrictKeys (InstallPlan.toMap elaboratedPlan) (Map.keysSet targetsMap)
+
+    targetsTable = Map.fromList $ zip targetSelectors targetStrings
+
+    tsToOriginalTarget ts = targetsTable Map.! ts
+
+    planPackageToJ :: ElaboratedPlanPackage -> TargetSelector -> Json.Value
+    planPackageToJ pkg ts =
+      case pkg of
+        InstallPlan.PreExisting ipi -> installedPackageInfoToJ ipi
+        InstallPlan.Configured elab -> elaboratedPackageToJ elab ts
+        InstallPlan.Installed  elab -> elaboratedPackageToJ elab ts
+        -- Note that the --build-info currently only uses the elaborated plan,
+        -- not the improved plan. So we will not get the Installed state for
+        -- that case, but the code supports it in case we want to use this
+        -- later in some use case where we want the status of the build.
+
+    -- TODO: what should we do if we run in this case?
+    -- Happens on `--build-info=containers` while we are not in the containers project.
+    installedPackageInfoToJ :: InstalledPackageInfo -> Json.Value
+    installedPackageInfoToJ _ipi =
+      -- Pre-existing packages lack configuration information such as their flag
+      -- settings or non-lib components. We only get pre-existing packages for
+      -- the global/core packages however, so this isn't generally a problem.
+      -- So these packages are never local to the project.
+      --
+      Json.object []
+
+    elaboratedPackageToJ :: ElaboratedConfiguredPackage -> TargetSelector -> Json.Value
+    elaboratedPackageToJ elab ts = Json.object
+      [ "target" .= Json.String (tsToOriginalTarget ts)
+      , "path" .= maybe Json.Null Json.String buildInfoFileLocation
+      ]
+      where
+      dist_dir :: FilePath
+      dist_dir = distBuildDirectory distDirLayout
+                    (elabDistDirParams elaboratedSharedConfig elab)
+
+      -- | Only add build-info file location if the Setup.hs CLI
+      -- is recent enough to be able to generate build info files.
+      -- Otherwise, write 'null'.
+      --
+      -- Consumers of `status` can use the nullability of this file location
+      -- to indicate that the given component uses `build-type: Custom`
+      -- with an old lib:Cabal version.
+      buildInfoFileLocation :: Maybe FilePath
+      buildInfoFileLocation
+        | elabSetupScriptCliVersion elab < mkVersion [3, 7, 0, 0]
+        = Nothing
+        | otherwise
+        = Just (buildInfoPref dist_dir)
+
+-- ----------------------------------------------------------------------------
+-- Target selectors and helpers
+-- ----------------------------------------------------------------------------
+
+-- | This defines what a 'TargetSelector' means for the @status@ command.
+-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
+-- or otherwise classifies the problem.
+--
+-- For the @status@ command select all components except non-buildable
+-- and disabled tests\/benchmarks, fail if there are no such
+-- components
+--
+selectPackageTargets :: TargetSelector
+                     -> [AvailableTarget k] -> Either TargetProblem' [k]
+selectPackageTargets targetSelector targets
+
+    -- If there are any buildable targets then we select those
+  | not (null targetsBuildable)
+  = Right targetsBuildable
+
+    -- If there are targets but none are buildable then we report those
+  | not (null targets)
+  = Left (TargetProblemNoneEnabled targetSelector targets')
+
+    -- If there are no targets at all then we report that
+  | otherwise
+  = Left (TargetProblemNoTargets targetSelector)
+  where
+    targets'         = forgetTargetsDetail targets
+    targetsBuildable = selectBuildableTargetsWith
+                         (buildable targetSelector)
+                         targets
+
+    -- When there's a target filter like "pkg:tests" then we do select tests,
+    -- but if it's just a target like "pkg" then we don't build tests unless
+    -- they are requested by default (i.e. by using --enable-tests)
+    buildable (TargetPackage _ _  Nothing) TargetNotRequestedByDefault = False
+    buildable (TargetAllPackages  Nothing) TargetNotRequestedByDefault = False
+    buildable _ _ = True
+
+-- | For a 'TargetComponent' 'TargetSelector', check if the component can be
+-- selected.
+--
+-- For the @build@ command we just need the basic checks on being buildable etc.
+--
+selectComponentTarget :: SubComponentTarget
+                      -> AvailableTarget k -> Either TargetProblem' k
+selectComponentTarget = selectComponentTargetBasic
+
+reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
+reportBuildTargetProblems verbosity problems =
+  reportTargetProblems verbosity "status" problems
+
+-- ----------------------------------------------------------------------------
+-- JSON serialisation helpers
+-- ----------------------------------------------------------------------------
+
+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"
diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs
index 6db91d9cf98..316e60b18c1 100644
--- a/cabal-install/src/Distribution/Client/Setup.hs
+++ b/cabal-install/src/Distribution/Client/Setup.hs
@@ -283,6 +283,7 @@ globalCommand commands = CommandUI {
         , startGroup "deprecated"
         , addCmd "unpack"
         , addCmd "hscolour"
+        , addCmd "status"
         , par
         , startGroup "new-style projects (forwards-compatible aliases)"
         , addCmd "v2-build"
diff --git a/cabal-install/src/Distribution/Client/TargetSelector.hs b/cabal-install/src/Distribution/Client/TargetSelector.hs
index 498d53a7e0d..6499888e090 100644
--- a/cabal-install/src/Distribution/Client/TargetSelector.hs
+++ b/cabal-install/src/Distribution/Client/TargetSelector.hs
@@ -25,6 +25,11 @@ module Distribution.Client.TargetSelector (
     SubComponentTarget(..),
     QualLevel(..),
     componentKind,
+    -- * Known Targets
+    KnownTargets(..),
+    KnownComponent(..),
+    KnownPackage(..),
+    getKnownTargets,
 
     -- * Reading target selectors
     readTargetSelectors,

From b8f77ef9b9d6b14bb859e5bc7e0fe9225e0d3549 Mon Sep 17 00:00:00 2001
From: Fendor <power.walross@gmail.com>
Date: Sun, 20 Feb 2022 16:57:25 +0100
Subject: [PATCH 2/5] Resolve targets to unit-ids instead of build-info

This is more flexible than giving the user the build-info file directly,
since this information is redundant as it is located in plan.json.

There we can even express some more conditions. If the target is not a
local dependency, the user can check that. If the user needs the
build-info, then they can look it up in plan.json.
---
 .../src/Distribution/Client/CmdStatus.hs      | 251 ++++++++++--------
 1 file changed, 133 insertions(+), 118 deletions(-)

diff --git a/cabal-install/src/Distribution/Client/CmdStatus.hs b/cabal-install/src/Distribution/Client/CmdStatus.hs
index c9d6c7a00dc..50d6011a014 100644
--- a/cabal-install/src/Distribution/Client/CmdStatus.hs
+++ b/cabal-install/src/Distribution/Client/CmdStatus.hs
@@ -17,12 +17,13 @@ module Distribution.Client.CmdStatus (
   statusCommand, statusAction,
   ) where
 
+import Control.Monad
+         ( mapM )
 import qualified Data.Map as Map
 
 import Prelude ()
 import Distribution.Client.Compat.Prelude
 
-import Distribution.Client.DistDirLayout
 import Distribution.Client.TargetProblem
 import Distribution.Client.CmdErrorMessages
 import qualified Distribution.Client.InstallPlan as InstallPlan
@@ -30,20 +31,21 @@ import Distribution.Client.NixStyleOptions
          ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
 import Distribution.Client.ProjectOrchestration
 import Distribution.Client.ProjectPlanning
-import Distribution.Client.ProjectPlanning.Types
 import Distribution.Client.Setup
          ( GlobalFlags, ConfigFlags(..), yesNoOpt )
+import Distribution.Client.Types
+         ( PackageSpecifier, PackageLocation )
+import Distribution.Client.TargetSelector
+         ( TargetSelectorProblem )
 import Distribution.Client.Utils.Json
          ( (.=) )
 import qualified Distribution.Client.Utils.Json as Json
 import Distribution.Client.Version
          ( cabalInstallVersion )
-import Distribution.InstalledPackageInfo
-         ( InstalledPackageInfo )
-import Distribution.Parsec (parsecCommaList, parsecToken)
+
+import qualified Distribution.Compat.CharParsing as P
 import Distribution.ReadE
          ( ReadE(ReadE), parsecToReadE )
-import Distribution.Simple.BuildPaths (buildInfoPref)
 import Distribution.Simple.Command
          ( CommandUI(..), option, reqArg, ShowOrParseArgs, OptionField )
 import Distribution.Simple.Compiler
@@ -52,6 +54,8 @@ import Distribution.Simple.Flag
          ( Flag(..), fromFlagOrDefault )
 import Distribution.Simple.Utils
          ( wrapText, die', withOutputMarker, ordNub )
+import Distribution.Solver.Types.SourcePackage
+import Distribution.Types.UnitId
 import Distribution.Verbosity
          ( normal )
 import Distribution.Version
@@ -68,14 +72,14 @@ statusCommand = CommandUI
       "Query for available targets and project information such as project GHC."
   , commandNotes = Just $ \pname ->
         "Examples:\n"
-     ++ "  " ++ pname ++ " status --output-format=json --compiler-info\n"
+     ++ "  " ++ pname ++ " status --output-format=json --compiler\n"
      ++ "    Print the compiler that is used for this project in the json format.\n"
-     ++ "  " ++ pname ++ " status --output-format=json --build-info=./src/Foo.hs\n"
-     ++ "    Print the location of the component \"src/Foo.hs\" belongs to.\n"
-     ++ "  " ++ pname ++ " status --output-format=json --build-info=./src/Foo.hs\n"
-     ++ "    Print both, compiler information and build-info location for the given target.\n"
-     ++ "  " ++ pname ++ " status --output-format=json --build-info=./src/Foo.hs --build-info=./test/Bar.hs\n"
-     ++ "    Print build-info location for multiple targets.\n"
+     ++ "  " ++ pname ++ " status --output-format=json --target=./src/Foo.hs\n"
+     ++ "    Print the unit-id of the component \"src/Foo.hs\" belongs to.\n"
+     ++ "  " ++ pname ++ " status --output-format=json --target=./src/Foo.hs\n"
+     ++ "    Print both, compiler information and unit-id for the given target.\n"
+     ++ "  " ++ pname ++ " status --output-format=json --target=./src/Foo.hs --target=./test/Bar.hs\n"
+     ++ "    Print unit-id location for multiple targets.\n"
   , commandUsage = \pname ->
       "Usage: " ++ pname ++ " status [FLAGS]\n"
   , commandDefaultFlags = defaultNixStyleFlags defaultStatusFlags
@@ -92,14 +96,14 @@ data StatusOutputFormat
   deriving (Eq, Ord, Show, Read)
 
 data StatusFlags = StatusFlags
-  { statusBuildInfo :: [String]
+  { statusTargets :: [String]
   , statusCompiler :: Flag Bool
   , statusOutputFormat :: Flag StatusOutputFormat
   } deriving (Eq, Show, Read)
 
 defaultStatusFlags :: StatusFlags
 defaultStatusFlags = StatusFlags
-  { statusBuildInfo = mempty
+  { statusTargets = mempty
   , statusCompiler = mempty
   , statusOutputFormat = mempty
   }
@@ -125,11 +129,11 @@ statusOptions showOrParseArgs =
       statusOutputFormatParser
       statusOutputFormatPrinter
     )
-  , option [] ["build-info"]
-    "List all available targets in the project"
-    statusBuildInfo (\v flags -> flags { statusBuildInfo = v ++ statusBuildInfo flags})
-    (reqArg "TARGET" buildInfoTargetReadE (fmap show))
-  , option [] ["compiler-info"]
+  , option [] ["target"]
+    "Given a target, obtain the unit-id in the build-plan"
+    statusTargets (\v flags -> flags { statusTargets = v ++ statusTargets flags})
+    (reqArg "TARGET" buildInfoTargetReadE id)
+  , option [] ["compiler"]
     "Print information of the project compiler"
     statusCompiler (\v flags -> flags { statusCompiler = v })
     (yesNoOpt showOrParseArgs)
@@ -137,11 +141,10 @@ statusOptions showOrParseArgs =
   where
     buildInfoTargetReadE :: ReadE [String]
     buildInfoTargetReadE =
-      parsecToReadE
+      fmap pure $ parsecToReadE
         -- This error should never be shown
         ("couldn't parse targets: " ++)
-        -- TODO: wrong parser, kills filepaths with spaces
-        (parsecCommaList parsecToken)
+        (P.munch1 (const True))
 
 -------------------------------------------------------------------------------
 -- Action
@@ -163,49 +166,112 @@ statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetString
                         (projectConfig baseCtx)
                         (localPackages baseCtx)
 
-  let initialJson = Json.object
-        [ "cabal-version" .= jdisplay cabalInstallVersion
-        ]
-
-  compilerJson <- if not $ fromFlagOrDefault False (statusCompiler statusFlags)
-    then pure $ Json.object [] -- Neutral element
+  compilerInformation <- if not $ fromFlagOrDefault False (statusCompiler statusFlags)
+    then pure Nothing
     else do
       let compiler = pkgConfigCompiler elabSharedConfig
       compilerProg <- requireCompilerProg verbosity compiler
       let progDb = pkgConfigCompilerProgs elabSharedConfig
       (configuredCompilerProg, _) <- requireProgram verbosity compilerProg progDb
-      pure $ mkCompilerInfo configuredCompilerProg compiler
+      pure $ Just $ mkCompilerInfo configuredCompilerProg compiler
 
-  buildInfoJson <- if null (statusBuildInfo statusFlags)
-    then pure $ Json.object [] -- Neutral element
+  resolvedTargets <- if null (statusTargets statusFlags)
+    then pure Nothing
     else do
-      let targetStrings = statusBuildInfo statusFlags
-      targetSelectors <- readTargetSelectors (localPackages baseCtx) Nothing targetStrings >>= \case
-        Left err   -> reportTargetSelectorProblems verbosity err
-        Right sels -> pure sels
-
+      let targetStrings = statusTargets statusFlags
+      mtargetSelectors <- mapM (readTargetSelector (localPackages baseCtx) Nothing) targetStrings
+      let (unresolvable, targetSelectors) = partitionEithers
+                    $ map (\(mts, str) -> case mts of
+                        Left _ -> Left str
+                        Right ts -> Right (ts, str)
+                    )
+                    $ zip mtargetSelectors targetStrings
       -- Interpret the targets on the command line as build targets
       -- (as opposed to say repl or haddock targets).
       -- TODO: don't throw on targets that are invalid.
+      -- TODO: why might this still fail? should we try to avoid that?
       targets <- either (reportBuildTargetProblems verbosity) return
                 $ resolveTargets
                     selectPackageTargets
                     selectComponentTarget
                     elaboratedPlan
                     Nothing
-                    targetSelectors
+                    (map fst targetSelectors)
 
-      pure $ mkBuildInfoJson (distDirLayout baseCtx) elabSharedConfig
-              elaboratedPlan targets targetSelectors targetStrings
+      pure $ Just $ mkBuildInfoJson elaboratedPlan targets (Map.fromList targetSelectors) unresolvable
 
-  let statusJson = mergeJsonObjects [initialJson, compilerJson, buildInfoJson]
+  let si = StatusInformation
+        { siCabalVersion = cabalInstallVersion
+        , siCompiler = compilerInformation
+        , siTargetResolving = resolvedTargets
+        }
+
+  serialisedStatusInformation <- serialise verbosity (statusOutputFormat statusFlags) si
 
   -- Final output
-  putStrLn $ withOutputMarker verbosity $ Json.encodeToString statusJson
+  putStrLn $ withOutputMarker verbosity serialisedStatusInformation
   where
     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
     cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty
 
+-- ----------------------------------------------------------------------------
+-- Big Datatype that can be serialised to different formats
+-- ----------------------------------------------------------------------------
+
+data StatusInformation = StatusInformation
+  { siCabalVersion :: Version
+  , siCompiler :: Maybe CompilerInformation
+  , siTargetResolving :: Maybe [ResolvedTarget]
+  }
+  deriving (Show, Read, Eq, Ord)
+
+data CompilerInformation = CompilerInformation
+  { ciFlavour :: CompilerFlavor
+  , ciCompilerId :: CompilerId
+  , ciPath :: FilePath
+  }
+  deriving (Show, Read, Eq, Ord)
+
+data ResolvedTarget = ResolvedTarget
+  { rtOriginalTarget :: String
+  -- | UnitId of the resolved target.
+  -- If 'Nothing', then the given target can not be resolved
+  -- to a target in this project.
+  , rtUnitId :: Maybe UnitId
+  }
+  deriving (Show, Read, Eq, Ord)
+
+serialise :: Verbosity -> Flag StatusOutputFormat -> StatusInformation -> IO String
+serialise verbosity NoFlag      _  =
+  die' verbosity $ "Could not serialise Status information. "
+                ++ "The flag '--output-format' is required."
+
+serialise _         (Flag JSON) si = pure $ Json.encodeToString $ Json.object $
+  [ "cabal-version" .= jdisplay (siCabalVersion si)
+  ]
+  ++ prettyCompilerInfo (siCompiler si)
+  ++ prettyTargetResolving (siTargetResolving si)
+  where
+    prettyCompilerInfo Nothing = []
+    prettyCompilerInfo (Just ci) =
+      [ "compiler" .= Json.object
+        [ "flavour"     .= jdisplay (ciFlavour ci)
+        , "compiler-id" .= jdisplay (ciCompilerId ci)
+        , "path"        .= Json.String (ciPath ci)
+        ]
+      ]
+
+    prettyTargetResolving Nothing = []
+    prettyTargetResolving (Just rts) =
+      [ "targets" .= Json.Array (fmap prettyResolvedTarget rts)
+      ]
+      where
+        prettyResolvedTarget rt = Json.object
+          [ "target" .= Json.String (rtOriginalTarget rt)
+          , "unit-id" .= maybe Json.Null jdisplay (rtUnitId rt)
+          ]
+
+
 -- ----------------------------------------------------------------------------
 -- Helpers for determining and serialising compiler information
 -- ----------------------------------------------------------------------------
@@ -219,83 +285,29 @@ requireCompilerProg verbosity compiler =
       "status: Unsupported compiler flavour: "
       <> prettyShow flavour
 
-mkCompilerInfo :: ConfiguredProgram -> Compiler -> Json.Value
+mkCompilerInfo :: ConfiguredProgram -> Compiler -> CompilerInformation
 mkCompilerInfo compilerProgram compiler =
-  Json.object
-    [ "compiler" .= Json.object
-        [ "flavour"     .= Json.String (prettyShow $ compilerFlavor compiler)
-        , "compiler-id" .= Json.String (showCompilerId compiler)
-        , "path"        .= Json.String (programPath compilerProgram)
-        ]
-    ]
+  CompilerInformation (compilerFlavor compiler) (compilerId compiler) (programPath compilerProgram)
 
 -- ----------------------------------------------------------------------------
--- Helpers for determining and serialising build info
+-- Helpers for determining and serialising the unit-id
 -- ----------------------------------------------------------------------------
 
-mkBuildInfoJson :: DistDirLayout -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> TargetsMap -> [TargetSelector] -> [String] -> Json.Value
-mkBuildInfoJson distDirLayout elaboratedSharedConfig elaboratedPlan targetsMap targetSelectors targetStrings = Json.object
-  [ "build-info" .= Json.Array allTargetsJsons
+mkBuildInfoJson :: ElaboratedInstallPlan -> TargetsMap -> Map TargetSelector String -> [String] -> [ResolvedTarget]
+mkBuildInfoJson elaboratedPlan targetsMap tsMap unresolvableTargetStrings =
+  [ ResolvedTarget str (Just uid)
+  | uid <- Map.keys subsetInstallPlan
+  , (_, tss) <- targetsMap Map.! uid
+  , str <- ordNub $ map tsToOriginalTarget $ toList tss
   ]
+  ++ map mkUnresolvedTarget unresolvableTargetStrings
   where
-    allTargetsJsons =
-      [ planPackageToJ elab ts
-      | (uid, elab) <- Map.assocs subsetInstallPlan
-      , (_, tss) <- targetsMap Map.! uid
-      , ts <- ordNub $ toList tss
-      ]
-
     subsetInstallPlan = Map.restrictKeys (InstallPlan.toMap elaboratedPlan) (Map.keysSet targetsMap)
 
-    targetsTable = Map.fromList $ zip targetSelectors targetStrings
-
-    tsToOriginalTarget ts = targetsTable Map.! ts
-
-    planPackageToJ :: ElaboratedPlanPackage -> TargetSelector -> Json.Value
-    planPackageToJ pkg ts =
-      case pkg of
-        InstallPlan.PreExisting ipi -> installedPackageInfoToJ ipi
-        InstallPlan.Configured elab -> elaboratedPackageToJ elab ts
-        InstallPlan.Installed  elab -> elaboratedPackageToJ elab ts
-        -- Note that the --build-info currently only uses the elaborated plan,
-        -- not the improved plan. So we will not get the Installed state for
-        -- that case, but the code supports it in case we want to use this
-        -- later in some use case where we want the status of the build.
-
-    -- TODO: what should we do if we run in this case?
-    -- Happens on `--build-info=containers` while we are not in the containers project.
-    installedPackageInfoToJ :: InstalledPackageInfo -> Json.Value
-    installedPackageInfoToJ _ipi =
-      -- Pre-existing packages lack configuration information such as their flag
-      -- settings or non-lib components. We only get pre-existing packages for
-      -- the global/core packages however, so this isn't generally a problem.
-      -- So these packages are never local to the project.
-      --
-      Json.object []
-
-    elaboratedPackageToJ :: ElaboratedConfiguredPackage -> TargetSelector -> Json.Value
-    elaboratedPackageToJ elab ts = Json.object
-      [ "target" .= Json.String (tsToOriginalTarget ts)
-      , "path" .= maybe Json.Null Json.String buildInfoFileLocation
-      ]
-      where
-      dist_dir :: FilePath
-      dist_dir = distBuildDirectory distDirLayout
-                    (elabDistDirParams elaboratedSharedConfig elab)
-
-      -- | Only add build-info file location if the Setup.hs CLI
-      -- is recent enough to be able to generate build info files.
-      -- Otherwise, write 'null'.
-      --
-      -- Consumers of `status` can use the nullability of this file location
-      -- to indicate that the given component uses `build-type: Custom`
-      -- with an old lib:Cabal version.
-      buildInfoFileLocation :: Maybe FilePath
-      buildInfoFileLocation
-        | elabSetupScriptCliVersion elab < mkVersion [3, 7, 0, 0]
-        = Nothing
-        | otherwise
-        = Just (buildInfoPref dist_dir)
+    tsToOriginalTarget ts = tsMap Map.! ts
+
+    mkUnresolvedTarget :: String -> ResolvedTarget
+    mkUnresolvedTarget s = ResolvedTarget s Nothing
 
 -- ----------------------------------------------------------------------------
 -- Target selectors and helpers
@@ -350,17 +362,20 @@ reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a
 reportBuildTargetProblems verbosity problems =
   reportTargetProblems verbosity "status" problems
 
+readTargetSelector :: [PackageSpecifier (SourcePackage (PackageLocation a))]
+                    -> Maybe ComponentKindFilter
+                    -> String
+                    -> IO (Either TargetSelectorProblem TargetSelector)
+readTargetSelector pkgs mfilter targetStr =
+  readTargetSelectors pkgs mfilter [targetStr] >>= \case
+    Left [problem] -> pure $ Left problem
+    Right [ts] -> pure $ Right ts
+    _ -> error $ "CmdStatus.readTargetSelector: invariant broken, more than "
+              ++ "one target passed *somehow*."
+
 -- ----------------------------------------------------------------------------
 -- JSON serialisation helpers
 -- ----------------------------------------------------------------------------
 
 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"

From 97af56bec9b6b85bff1258e094b15c44b2155ef8 Mon Sep 17 00:00:00 2001
From: Fendor <power.walross@gmail.com>
Date: Sat, 5 Mar 2022 17:27:07 +0100
Subject: [PATCH 3/5] Work in feedback regarding error handling

---
 .../src/Distribution/Client/CmdStatus.hs      | 47 ++++++++++++-------
 1 file changed, 31 insertions(+), 16 deletions(-)

diff --git a/cabal-install/src/Distribution/Client/CmdStatus.hs b/cabal-install/src/Distribution/Client/CmdStatus.hs
index 50d6011a014..e53b8bb8c08 100644
--- a/cabal-install/src/Distribution/Client/CmdStatus.hs
+++ b/cabal-install/src/Distribution/Client/CmdStatus.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE FlexibleContexts #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Distribution.Client.CmdStatus
@@ -17,8 +18,7 @@ module Distribution.Client.CmdStatus (
   statusCommand, statusAction,
   ) where
 
-import Control.Monad
-         ( mapM )
+import Control.Monad.Except hiding (mfilter)
 import qualified Data.Map as Map
 
 import Prelude ()
@@ -91,8 +91,12 @@ statusCommand = CommandUI
 -- Flags
 -------------------------------------------------------------------------------
 
+-- | Output format of project metadata.
 data StatusOutputFormat
   = JSON
+  -- ^ Output of project metadata shall be in JSON.
+  --
+  -- @since 3.7.0.0
   deriving (Eq, Ord, Show, Read)
 
 data StatusFlags = StatusFlags
@@ -156,7 +160,7 @@ statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetString
   when (NoFlag == statusOutputFormat statusFlags) $ do
     die' verbosity "The status command requires the flag '--output-format'."
   when (not $ null cliTargetStrings) $
-    die' verbosity "The status command takes not target arguments directly. Use appropriate flags to pass in target information."
+    die' verbosity "The status command doesn't take target arguments directly. Use appropriate flags to pass in target information."
 
   baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
   (_, elaboratedPlan, elabSharedConfig, _, _) <-
@@ -170,7 +174,10 @@ statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetString
     then pure Nothing
     else do
       let compiler = pkgConfigCompiler elabSharedConfig
-      compilerProg <- requireCompilerProg verbosity compiler
+      compilerProg <- runExceptT (requireCompilerProg compiler)
+        >>= \case
+          Right c -> pure c
+          Left errMsg -> die' verbosity errMsg
       let progDb = pkgConfigCompilerProgs elabSharedConfig
       (configuredCompilerProg, _) <- requireProgram verbosity compilerProg progDb
       pure $ Just $ mkCompilerInfo configuredCompilerProg compiler
@@ -206,7 +213,10 @@ statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetString
         , siTargetResolving = resolvedTargets
         }
 
-  serialisedStatusInformation <- serialise verbosity (statusOutputFormat statusFlags) si
+  serialisedStatusInformation <- runExceptT (serialise (statusOutputFormat statusFlags) si)
+    >>= \case
+      Right s -> pure s
+      Left errMsg -> die' verbosity errMsg
 
   -- Final output
   putStrLn $ withOutputMarker verbosity serialisedStatusInformation
@@ -241,12 +251,12 @@ data ResolvedTarget = ResolvedTarget
   }
   deriving (Show, Read, Eq, Ord)
 
-serialise :: Verbosity -> Flag StatusOutputFormat -> StatusInformation -> IO String
-serialise verbosity NoFlag      _  =
-  die' verbosity $ "Could not serialise Status information. "
-                ++ "The flag '--output-format' is required."
+serialise :: MonadError String m => Flag StatusOutputFormat -> StatusInformation -> m String
+serialise NoFlag      _  =
+  throwError $ "Could not serialise Status information. "
+            ++ "The flag '--output-format' is required."
 
-serialise _         (Flag JSON) si = pure $ Json.encodeToString $ Json.object $
+serialise (Flag JSON) si = pure $ Json.encodeToString $ Json.object $
   [ "cabal-version" .= jdisplay (siCabalVersion si)
   ]
   ++ prettyCompilerInfo (siCompiler si)
@@ -271,17 +281,16 @@ serialise _         (Flag JSON) si = pure $ Json.encodeToString $ Json.object $
           , "unit-id" .= maybe Json.Null jdisplay (rtUnitId rt)
           ]
 
-
 -- ----------------------------------------------------------------------------
 -- Helpers for determining and serialising compiler information
 -- ----------------------------------------------------------------------------
 
-requireCompilerProg :: Verbosity -> Compiler -> IO Program
-requireCompilerProg verbosity compiler =
+requireCompilerProg ::  MonadError String m => Compiler -> m Program
+requireCompilerProg compiler =
   case compilerFlavor compiler of
     GHC -> pure ghcProgram
     GHCJS -> pure ghcjsProgram
-    flavour -> die' verbosity $
+    flavour -> throwError $
       "status: Unsupported compiler flavour: "
       <> prettyShow flavour
 
@@ -297,13 +306,19 @@ mkBuildInfoJson :: ElaboratedInstallPlan -> TargetsMap -> Map TargetSelector Str
 mkBuildInfoJson elaboratedPlan targetsMap tsMap unresolvableTargetStrings =
   [ ResolvedTarget str (Just uid)
   | uid <- Map.keys subsetInstallPlan
+  -- for all unit-ids that have been requested, look at all their TargetSelector's
   , (_, tss) <- targetsMap Map.! uid
+  -- Now, for each TargetSelector, lookup the original target string users have given.
+  -- We have to remove duplicates, because certain target strings are represented as
+  -- multiple TargetSelector's.
   , str <- ordNub $ map tsToOriginalTarget $ toList tss
   ]
   ++ map mkUnresolvedTarget unresolvableTargetStrings
   where
+    -- Only look at unit-ids we care about because the user has requested them
     subsetInstallPlan = Map.restrictKeys (InstallPlan.toMap elaboratedPlan) (Map.keysSet targetsMap)
 
+    -- Easier lookup for the reverse table
     tsToOriginalTarget ts = tsMap Map.! ts
 
     mkUnresolvedTarget :: String -> ResolvedTarget
@@ -370,8 +385,8 @@ readTargetSelector pkgs mfilter targetStr =
   readTargetSelectors pkgs mfilter [targetStr] >>= \case
     Left [problem] -> pure $ Left problem
     Right [ts] -> pure $ Right ts
-    _ -> error $ "CmdStatus.readTargetSelector: invariant broken, more than "
-              ++ "one target passed *somehow*."
+    _ -> fail $ "CmdStatus.readTargetSelector: invariant broken, more than "
+             ++ "one target passed *somehow*."
 
 -- ----------------------------------------------------------------------------
 -- JSON serialisation helpers

From 0b89579e68418f84f691e65bdc3284c38abf37d0 Mon Sep 17 00:00:00 2001
From: Fendor <power.walross@gmail.com>
Date: Tue, 20 Sep 2022 23:04:40 +0200
Subject: [PATCH 4/5] Add tests for cabal status

---
 .../Status/Invalid/InvalidDep.cabal           | 10 +++
 .../PackageTests/Status/Invalid/cabal.project |  1 +
 .../another-framework.cabal                   |  8 ++
 .../PackageTests/Status/Invalid/src/Main.hs   |  4 +
 .../Status/Invalid/unbuildabledep.out         | 20 +++++
 .../Status/Invalid/unbuildabledep.test.hs     | 11 +++
 .../PackageTests/Status/Simple/Simple.cabal   | 72 ++++++++++++++++
 .../PackageTests/Status/Simple/bench/Bench.hs |  3 +
 .../PackageTests/Status/Simple/cabal.project  |  4 +
 .../PackageTests/Status/Simple/compiler.out   |  4 +
 .../Status/Simple/compiler.test.hs            |  8 ++
 .../Status/Simple/csrc/MyForeignLibWrapper.c  | 24 ++++++
 .../PackageTests/Status/Simple/exe/Main.hs    |  4 +
 .../PackageTests/Status/Simple/exe/Main2.hs   |  4 +
 .../Simple/flibsrc/MyForeignLib/AnotherVal.hs |  3 +
 .../Simple/flibsrc/MyForeignLib/Hello.hs      | 13 +++
 .../flibsrc/MyForeignLib/SomeBindings.hsc     | 10 +++
 .../PackageTests/Status/Simple/plan.out       |  4 +
 .../PackageTests/Status/Simple/plan.test.hs   |  7 ++
 .../PackageTests/Status/Simple/simple.out     | 41 +++++++++
 .../PackageTests/Status/Simple/simple.test.hs | 78 +++++++++++++++++
 .../PackageTests/Status/Simple/src/Fails.hs   |  4 +
 .../PackageTests/Status/Simple/src/MyLib.hs   |  4 +
 .../PackageTests/Status/Simple/src/MyLib2.hs  |  4 +
 .../Status/Simple/src/Unbuildable.hs          |  4 +
 .../PackageTests/Status/Simple/test/Main.hs   |  3 +
 .../src/Test/Cabal/DecodeShowBuildInfo.hs     | 86 +++++++++++++++++++
 cabal-testsuite/src/Test/Cabal/Prelude.hs     |  8 ++
 28 files changed, 446 insertions(+)
 create mode 100644 cabal-testsuite/PackageTests/Status/Invalid/InvalidDep.cabal
 create mode 100644 cabal-testsuite/PackageTests/Status/Invalid/cabal.project
 create mode 100644 cabal-testsuite/PackageTests/Status/Invalid/repo/another-framework-0.8.1.1/another-framework.cabal
 create mode 100644 cabal-testsuite/PackageTests/Status/Invalid/src/Main.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.out
 create mode 100644 cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.test.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/Simple.cabal
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/bench/Bench.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/cabal.project
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/compiler.out
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/compiler.test.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/csrc/MyForeignLibWrapper.c
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/exe/Main.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/exe/Main2.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/AnotherVal.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/Hello.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/SomeBindings.hsc
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/plan.out
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/plan.test.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/simple.out
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/simple.test.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/src/Fails.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/src/MyLib.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/src/MyLib2.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/src/Unbuildable.hs
 create mode 100644 cabal-testsuite/PackageTests/Status/Simple/test/Main.hs

diff --git a/cabal-testsuite/PackageTests/Status/Invalid/InvalidDep.cabal b/cabal-testsuite/PackageTests/Status/Invalid/InvalidDep.cabal
new file mode 100644
index 00000000000..9f3b1a4ed27
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Invalid/InvalidDep.cabal
@@ -0,0 +1,10 @@
+cabal-version:      2.4
+name:               InvalidDep
+version:            0.1.0.0
+
+executable Inv
+    main-is:          Main.hs
+    hs-source-dirs:   src
+    build-depends:    another-framework
+    default-language: Haskell2010
+
diff --git a/cabal-testsuite/PackageTests/Status/Invalid/cabal.project b/cabal-testsuite/PackageTests/Status/Invalid/cabal.project
new file mode 100644
index 00000000000..6f920794c80
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Invalid/cabal.project
@@ -0,0 +1 @@
+packages: ./
diff --git a/cabal-testsuite/PackageTests/Status/Invalid/repo/another-framework-0.8.1.1/another-framework.cabal b/cabal-testsuite/PackageTests/Status/Invalid/repo/another-framework-0.8.1.1/another-framework.cabal
new file mode 100644
index 00000000000..87eb0492c91
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Invalid/repo/another-framework-0.8.1.1/another-framework.cabal
@@ -0,0 +1,8 @@
+name: another-framework
+version: 0.8.1.1
+build-type: Simple
+cabal-version: >= 1.10
+
+library
+    build-depends: base <3 && >=3
+    default-language: Haskell2010
diff --git a/cabal-testsuite/PackageTests/Status/Invalid/src/Main.hs b/cabal-testsuite/PackageTests/Status/Invalid/src/Main.hs
new file mode 100644
index 00000000000..eef02a80080
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Invalid/src/Main.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStr "Test"
diff --git a/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.out b/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.out
new file mode 100644
index 00000000000..c78a13ef3dd
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.out
@@ -0,0 +1,20 @@
+# cabal v2-update
+Downloading the latest package list from test-local-repo
+# cabal status
+Resolving dependencies...
+Error: cabal: Could not resolve dependencies:
+[__0] trying: InvalidDep-0.1.0.0 (user goal)
+[__1] trying: another-framework-0.8.1.1 (dependency of InvalidDep)
+[__2] next goal: base (dependency of another-framework)
+[__2] rejecting: base-<VERSION>/installed-<HASH> (conflict: another-framework => base<3 && >=3)
+[__2] fail (backjumping, conflict set: another-framework, base)
+After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: another-framework (3), InvalidDep (2), base (2)
+# cabal status
+Resolving dependencies...
+Error: cabal: Could not resolve dependencies:
+[__0] trying: InvalidDep-0.1.0.0 (user goal)
+[__1] trying: another-framework-0.8.1.1 (dependency of InvalidDep)
+[__2] next goal: base (dependency of another-framework)
+[__2] rejecting: base-<VERSION>/installed-<HASH> (conflict: another-framework => base<3 && >=3)
+[__2] fail (backjumping, conflict set: another-framework, base)
+After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: another-framework (3), InvalidDep (2), base (2)
diff --git a/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.test.hs b/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.test.hs
new file mode 100644
index 00000000000..1055d0b608f
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Invalid/unbuildabledep.test.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+import           Test.Cabal.Prelude
+import           Test.Cabal.DecodeShowBuildInfo
+
+main = cabalTest $ withRepo "repo" $ do
+  -- no build plan available
+  r <- fails $ cabal' "status" ["--output-format=json", "--target", "src/Main.hs"]
+  assertOutputContains "Could not resolve dependencies" r
+  -- TODO: should this actually work?
+  r <- fails $ cabal' "status" ["--output-format=json", "--compiler"]
+  assertOutputContains "Could not resolve dependencies" r
diff --git a/cabal-testsuite/PackageTests/Status/Simple/Simple.cabal b/cabal-testsuite/PackageTests/Status/Simple/Simple.cabal
new file mode 100644
index 00000000000..334589b6664
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/Simple.cabal
@@ -0,0 +1,72 @@
+cabal-version: 2.4
+name:          Simple
+version:       0.1.0.0
+
+library
+  exposed-modules:
+    MyLib
+    MyLib2
+
+  build-depends:    base
+  hs-source-dirs:   src
+  default-language: Haskell2010
+
+library unbuildable
+  exposed-modules:  Unbuildable
+  hs-source-dirs:   src
+  build-depends:    base
+  default-language: Haskell2010
+  buildable:        False
+
+library compilefail
+  exposed-modules:  Fails
+  hs-source-dirs:   src
+  build-depends:    base
+  default-language: Haskell2010
+
+executable Simple
+  main-is:          Main.hs
+
+  -- Module that belongs to multiple components
+  other-modules:    MyLib
+  hs-source-dirs:   src, exe
+  build-depends:    base
+  default-language: Haskell2010
+
+-- Just some simple config to test 'exes' meta command
+executable Simple2
+  main-is:          Main2.hs
+
+  -- Module that belongs to multiple components
+  other-modules:    MyLib
+  hs-source-dirs:   src, exe
+  build-depends:    base
+  default-language: Haskell2010
+
+test-suite Tests
+  type:           exitcode-stdio-1.0
+  main-is:        Main.hs
+  hs-source-dirs: test
+  build-depends:  base
+
+benchmark Benchs
+  type:           exitcode-stdio-1.0
+  main-is:        Bench.hs
+  hs-source-dirs: test
+  build-depends:  base
+
+foreign-library myforeignlib
+  type:             native-shared
+
+  if os(windows)
+    options: standalone
+
+  other-modules:
+    MyForeignLib.AnotherVal
+    MyForeignLib.Hello
+    MyForeignLib.SomeBindings
+
+  build-depends:    base
+  hs-source-dirs:   flibsrc
+  c-sources:        csrc/MyForeignLibWrapper.c
+  default-language: Haskell2010
diff --git a/cabal-testsuite/PackageTests/Status/Simple/bench/Bench.hs b/cabal-testsuite/PackageTests/Status/Simple/bench/Bench.hs
new file mode 100644
index 00000000000..d1eb41ede58
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/bench/Bench.hs
@@ -0,0 +1,3 @@
+module Bench where
+
+main = putStr "Benchmarks!"
diff --git a/cabal-testsuite/PackageTests/Status/Simple/cabal.project b/cabal-testsuite/PackageTests/Status/Simple/cabal.project
new file mode 100644
index 00000000000..d1b37452122
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/cabal.project
@@ -0,0 +1,4 @@
+packages: ./
+
+tests: True
+executables: True
diff --git a/cabal-testsuite/PackageTests/Status/Simple/compiler.out b/cabal-testsuite/PackageTests/Status/Simple/compiler.out
new file mode 100644
index 00000000000..a5c5ed34bfc
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/compiler.out
@@ -0,0 +1,4 @@
+# cabal status
+Warning: <ROOT>/cabal.project: Unrecognized field 'executables' on line 4
+Resolving dependencies...
+{"cabal-version":"3.9","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"}}
diff --git a/cabal-testsuite/PackageTests/Status/Simple/compiler.test.hs b/cabal-testsuite/PackageTests/Status/Simple/compiler.test.hs
new file mode 100644
index 00000000000..127033544cf
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/compiler.test.hs
@@ -0,0 +1,8 @@
+import           Test.Cabal.Prelude
+import           Test.Cabal.DecodeShowBuildInfo
+import           Data.Maybe
+
+main = cabalTest $ do
+  r <- cabal' "status" ["--output-format=json", "--compiler"]
+  statusInfo <- withJsonOutput r
+  assertBool "Must contain compiler information" (isJust $ siCompiler statusInfo)
diff --git a/cabal-testsuite/PackageTests/Status/Simple/csrc/MyForeignLibWrapper.c b/cabal-testsuite/PackageTests/Status/Simple/csrc/MyForeignLibWrapper.c
new file mode 100644
index 00000000000..3347c970e7d
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/csrc/MyForeignLibWrapper.c
@@ -0,0 +1,24 @@
+#include <stdlib.h>
+#include <stdbool.h>
+#include "HsFFI.h"
+
+bool myForeignLibInit(void){
+  int argc = 2;
+  char *argv[] = { "+RTS", "-A32m", NULL };
+  char **pargv = argv;
+
+  // Initialize Haskell runtime
+  hs_init(&argc, &pargv);
+
+  // do any other initialization here and
+  // return false if there was a problem
+  return true;
+}
+
+void myForeignLibExit(void){
+  hs_exit();
+}
+
+int cFoo2() {
+   return 1234;
+}
diff --git a/cabal-testsuite/PackageTests/Status/Simple/exe/Main.hs b/cabal-testsuite/PackageTests/Status/Simple/exe/Main.hs
new file mode 100644
index 00000000000..2bba7565907
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/exe/Main.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "Test"
diff --git a/cabal-testsuite/PackageTests/Status/Simple/exe/Main2.hs b/cabal-testsuite/PackageTests/Status/Simple/exe/Main2.hs
new file mode 100644
index 00000000000..2bba7565907
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/exe/Main2.hs
@@ -0,0 +1,4 @@
+module Main where
+
+main :: IO ()
+main = putStrLn "Test"
diff --git a/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/AnotherVal.hs b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/AnotherVal.hs
new file mode 100644
index 00000000000..60fd694a14c
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/AnotherVal.hs
@@ -0,0 +1,3 @@
+module MyForeignLib.AnotherVal where
+
+anotherVal = 189
diff --git a/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/Hello.hs b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/Hello.hs
new file mode 100644
index 00000000000..a9e54986dc6
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/Hello.hs
@@ -0,0 +1,13 @@
+-- | Module with single foreign export
+module MyForeignLib.Hello (sayHi) where
+
+import MyForeignLib.SomeBindings
+import MyForeignLib.AnotherVal
+
+foreign export ccall sayHi :: IO ()
+
+-- | Say hi!
+sayHi :: IO ()
+sayHi = putStrLn $
+     "Hi from a foreign library! Foo has value " ++ show valueOfFoo
+  ++ " and anotherVal has value " ++ show anotherVal
diff --git a/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/SomeBindings.hsc b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/SomeBindings.hsc
new file mode 100644
index 00000000000..beea7f8c49c
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/flibsrc/MyForeignLib/SomeBindings.hsc
@@ -0,0 +1,10 @@
+-- | Module that needs the hsc2hs preprocessor
+module MyForeignLib.SomeBindings where
+
+#define FOO 1
+
+#ifdef FOO
+-- | Value guarded by a CPP flag
+valueOfFoo :: Int
+valueOfFoo = 5678
+#endif
diff --git a/cabal-testsuite/PackageTests/Status/Simple/plan.out b/cabal-testsuite/PackageTests/Status/Simple/plan.out
new file mode 100644
index 00000000000..07429e70c09
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/plan.out
@@ -0,0 +1,4 @@
+# cabal status
+Warning: <ROOT>/cabal.project: Unrecognized field 'executables' on line 4
+Resolving dependencies...
+{"cabal-version":"3.9","targets":[{"target":"src/Main.hs","unit-id":null}]}
diff --git a/cabal-testsuite/PackageTests/Status/Simple/plan.test.hs b/cabal-testsuite/PackageTests/Status/Simple/plan.test.hs
new file mode 100644
index 00000000000..30136bca921
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/plan.test.hs
@@ -0,0 +1,7 @@
+import           Test.Cabal.Prelude
+
+main = cabalTest $ do
+    -- Make sure plan.json is generated, even if no target is resolved
+    cabal "status" ["--output-format=json", "--target", "src/Main.hs"]
+    withPlan $ do
+        pure ()
diff --git a/cabal-testsuite/PackageTests/Status/Simple/simple.out b/cabal-testsuite/PackageTests/Status/Simple/simple.out
new file mode 100644
index 00000000000..d1740c09bba
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/simple.out
@@ -0,0 +1,41 @@
+# cabal status
+Error: cabal: The status command requires the flag '--output-format'.
+# cabal status
+Resolving dependencies...
+{"cabal-version":"3.9","targets":[{"target":"exe/Main.hs","unit-id":"Simple-0.1.0.0-inplace-Simple"}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"exe/Main.hs","unit-id":"Simple-0.1.0.0-inplace-Simple"},{"target":"exe/Main2.hs","unit-id":"Simple-0.1.0.0-inplace-Simple2"}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"src/MyLib.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"src/MyLib2.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"bench/Bench.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"test/Main.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"flibsrc/MyForeignLib/AnotherVal.hs","unit-id":"Simple-0.1.0.0-inplace-myforeignlib"},{"target":"flibsrc/MyForeignLib/Hello.hs","unit-id":"Simple-0.1.0.0-inplace-myforeignlib"},{"target":"flibsrc/MyForeignLib/SomeBindings.hsc","unit-id":"Simple-0.1.0.0-inplace-myforeignlib"},{"target":"csrc/MyForeignLibWrapper.c","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"Benchs","unit-id":"Simple-0.1.0.0-inplace-Benchs"}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"all","unit-id":"Simple-0.1.0.0-inplace"},{"target":"all","unit-id":"Simple-0.1.0.0-inplace-Simple"},{"target":"all","unit-id":"Simple-0.1.0.0-inplace-Simple2"},{"target":"all","unit-id":"Simple-0.1.0.0-inplace-myforeignlib"}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"exes","unit-id":"Simple-0.1.0.0-inplace-Simple"},{"target":"exes","unit-id":"Simple-0.1.0.0-inplace-Simple2"}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"tests","unit-id":"Simple-0.1.0.0-inplace-Tests"}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"benchmarks","unit-id":"Simple-0.1.0.0-inplace-Benchs"}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"executables","unit-id":"Simple-0.1.0.0-inplace-Simple"},{"target":"executables","unit-id":"Simple-0.1.0.0-inplace-Simple2"}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"Main2.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"Main3.hs","unit-id":null},{"target":"src/MyLib2.hs","unit-id":null},{"target":"Main3.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"Lib.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"targets":[{"target":"Lib.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","targets":[{"target":"Lib2.hs","unit-id":null}]}
+# cabal status
+{"cabal-version":"3.9","compiler":{"flavour":"ghc","compiler-id":"ghc-<GHCVER>","path":"<GHCPATH>"},"targets":[{"target":"Lib.hs","unit-id":null}]}
diff --git a/cabal-testsuite/PackageTests/Status/Simple/simple.test.hs b/cabal-testsuite/PackageTests/Status/Simple/simple.test.hs
new file mode 100644
index 00000000000..6c8a9201295
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/simple.test.hs
@@ -0,0 +1,78 @@
+import           Test.Cabal.Prelude
+import           Test.Cabal.DecodeShowBuildInfo
+import           Data.Maybe (isJust)
+import           Data.List (sort, nub)
+
+main = cabalTest $ do
+  -- output-format flag is missing but required, must fail
+  r <- fails $ cabal' "status" ["--target", "Main.hs"]
+  assertOutputContains "The status command requires the flag '--output-format'." r
+
+  -- Simple file target tests
+  runStatusWithTargets ["exe/Main.hs"]$ \si -> do
+    resolveOnce "exe/Main.hs" si
+  runStatusWithTargets ["exe/Main.hs", "exe/Main2.hs"] $ \si -> do
+    resolveOnce "exe/Main.hs" si
+    resolveOnce "exe/Main2.hs" si
+  runStatusWithTargets ["src/MyLib.hs"] $ \si -> do
+    rts <- resolve "src/MyLib.hs" si
+    assertEqual "Ambiguous component" 3 (length rts)
+  runStatusWithTargets ["src/MyLib2.hs"] $ \si -> do
+    resolveOnce "src/MyLib2.hs" si
+  runStatusWithTargets ["bench/Bench.hs"] $ \si -> do
+    resolveOnce "bench/Bench.hs" si
+  runStatusWithTargets ["test/Main.hs"]$ \si -> do
+    resolveOnce "test/Main.hs" si
+  runStatusWithTargets ["flibsrc/MyForeignLib/AnotherVal.hs",
+                        "flibsrc/MyForeignLib/Hello.hs",
+                        "flibsrc/MyForeignLib/SomeBindings.hsc",
+                        "csrc/MyForeignLibWrapper.c"
+                        ]$ \si -> do
+    resolveOnce "flibsrc/MyForeignLib/AnotherVal.hs" si
+    resolveOnce "flibsrc/MyForeignLib/Hello.hs" si
+    resolveOnce "flibsrc/MyForeignLib/SomeBindings.hsc" si
+    unresolvable "csrc/MyForeignLibWrapper.c" si
+  runStatusWithTargets ["lib:Simple", "exe:Simple", "Simple:exe:Simple"] $ \si -> do
+    resolveOnce "lib:Simple" si
+    resolveOnce "exe:Simple" si
+    resolveOnce "Simple:exe:Simple" si
+  -- pkgs syntax tests
+  runStatusWithTargets ["Benchs"] $ \si -> do
+    resolveOnce "Benchs" si
+  -- meta targets
+  runStatusWithTargets ["all"] $ \si -> do
+    rts <- resolve "all" si
+    assertEqual "Seven components" 7 (length rts)
+  runStatusWithTargets ["exes"] $ \si -> do
+    rts <- resolve "exes" si
+    assertEqual "Two executables" 2 (length rts)
+  runStatusWithTargets ["tests"] $ \si -> do
+    resolveOnce "tests" si
+  runStatusWithTargets ["benchmarks"] $ \si -> do
+    resolveOnce "benchmarks" si
+
+  -- unknown target selectors
+  runStatusWithTargets ["executables"] $ \si ->
+    unresolvable "executables" si
+  runStatusWithTargets ["Main2.hs"] $ \si ->
+    unresolvable "Main2.hs" si
+
+  -- partially works, Main3.hs isn't known while `src/MyLib2.hs` is.
+  runStatusWithTargets ["Main3.hs", "src/MyLib2.hs"] $ \si -> do
+    unresolvable "Main3.hs" si
+    resolveOnce "src/MyLib2.hs" si
+
+  -- component fails to compile, still works
+  runStatusWithTargets ["src/Fails.hs"] $ \si -> do
+    resolveOnce "src/Fails.hs" si
+  cabal "status" ["--output-format=json", "--compiler", "--target", "Fails.hs"]
+  -- unbuildable target, resolves to 'null'
+  runStatusWithTargets ["src/Unbuildable.hs"] $ \si -> do
+    unresolvable "src/Unbuildable.hs" si
+  cabal "status" ["--output-format=json", "--compiler", "--target", "src/Unbuildable"]
+  where
+    runStatusWithTargets :: [String] -> (StatusInformation -> TestM a) -> TestM  a
+    runStatusWithTargets targets act = do
+      r <- cabal' "status" $ ["--output-format=json"] ++ concatMap (\t -> ["--target", t]) targets
+      statusInfo <- withJsonOutput r
+      act statusInfo
diff --git a/cabal-testsuite/PackageTests/Status/Simple/src/Fails.hs b/cabal-testsuite/PackageTests/Status/Simple/src/Fails.hs
new file mode 100644
index 00000000000..ba479e8f17b
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/src/Fails.hs
@@ -0,0 +1,4 @@
+module Fails where
+
+-- fails to compile intentionally
+foo =
diff --git a/cabal-testsuite/PackageTests/Status/Simple/src/MyLib.hs b/cabal-testsuite/PackageTests/Status/Simple/src/MyLib.hs
new file mode 100644
index 00000000000..e657c4403f6
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/src/MyLib.hs
@@ -0,0 +1,4 @@
+module MyLib (someFunc) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
diff --git a/cabal-testsuite/PackageTests/Status/Simple/src/MyLib2.hs b/cabal-testsuite/PackageTests/Status/Simple/src/MyLib2.hs
new file mode 100644
index 00000000000..c9b80390bbb
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/src/MyLib2.hs
@@ -0,0 +1,4 @@
+module MyLib2 (someFunc) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
diff --git a/cabal-testsuite/PackageTests/Status/Simple/src/Unbuildable.hs b/cabal-testsuite/PackageTests/Status/Simple/src/Unbuildable.hs
new file mode 100644
index 00000000000..0509e53c342
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/src/Unbuildable.hs
@@ -0,0 +1,4 @@
+module Unbuildable (someFunc) where
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
diff --git a/cabal-testsuite/PackageTests/Status/Simple/test/Main.hs b/cabal-testsuite/PackageTests/Status/Simple/test/Main.hs
new file mode 100644
index 00000000000..d3c7f187c8f
--- /dev/null
+++ b/cabal-testsuite/PackageTests/Status/Simple/test/Main.hs
@@ -0,0 +1,3 @@
+module Bench where
+
+main = putStr "Tests!"
diff --git a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs
index 02c1cb7e733..42aac5b0f08 100644
--- a/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs
+++ b/cabal-testsuite/src/Test/Cabal/DecodeShowBuildInfo.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Test.Cabal.DecodeShowBuildInfo where
 
 import           Test.Cabal.Prelude
@@ -14,6 +16,8 @@ import           Distribution.Package
 import           Distribution.Pretty (prettyShow)
 import           Control.Monad.Trans.Reader
 import           Data.Aeson
+import           Data.List (sort, nub)
+import           Data.Maybe (maybeToList, isJust)
 import           GHC.Generics
 import           System.Exit
 
@@ -186,3 +190,85 @@ bench = CBenchName . mkUnqualComponentName
 -- | Helper function to create a main library component name.
 mainLib :: ComponentName
 mainLib = CLibName LMainLibName
+
+-- -----------------------------------------------------------
+-- Cabal Status json decoder
+-- -----------------------------------------------------------
+
+-- Copied from 'CmdStatus' at the moment, but maybe the datatypes diverge at some point
+-- in the future. Thus, we copy them here.
+
+data StatusInformation = StatusInformation
+  { siCabalVersion :: String
+  , siCompiler :: Maybe CompilerInformation
+  , siTargetResolving :: Maybe [ResolvedTarget]
+  }
+  deriving (Generic, Show, Read, Eq, Ord)
+
+data CompilerInformation = CompilerInformation
+  { ciFlavour :: String
+  , ciCompilerId :: String
+  , ciPath :: FilePath
+  }
+  deriving (Generic, Show, Read, Eq, Ord)
+
+data ResolvedTarget = ResolvedTarget
+  { rtOriginalTarget :: String
+  -- | UnitId of the resolved target.
+  -- If 'Nothing', then the given target can not be resolved
+  -- to a target in this project.
+  , rtUnitId :: Maybe String
+  }
+  deriving (Generic, Show, Read, Eq, Ord)
+
+instance FromJSON StatusInformation where
+  parseJSON = withObject "StatusInformation" $ \v -> do
+    StatusInformation
+      <$> v .: "cabal-version"
+      <*> v .:? "compiler"
+      <*> v .:? "targets"
+
+instance FromJSON CompilerInformation where
+  parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = drop 3 . camelTo2 '-' }
+
+instance FromJSON ResolvedTarget where
+  parseJSON = withObject "ResolvedTarget" $ \v -> do
+    ResolvedTarget
+      <$> v .: "target"
+      <*> v .: "unit-id"
+
+-- -----------------------------------------------------------
+-- Assertion Helpers to define succinct test cases
+-- -----------------------------------------------------------
+
+allUniqueTargets :: StatusInformation -> [TargetString]
+allUniqueTargets si = nub . sort . map rtOriginalTarget . concat $ maybeToList $ siTargetResolving si
+
+type TargetString = String
+
+resolve :: TargetString -> StatusInformation -> TestM [ResolvedTarget]
+resolve target si = do
+  rts <- resolveAll target si
+  pure $ filter (not . (==Nothing) . rtUnitId) rts
+
+resolveOnce :: TargetString -> StatusInformation -> TestM ()
+resolveOnce target si = do
+  resolveAll target si >>= \case
+    [rt] -> assertBool "Has associated unit-id" (isJust $ rtUnitId rt)
+    _ -> fail "Failed to resolve exactly once"
+
+resolveAll :: TargetString -> StatusInformation -> TestM [ResolvedTarget]
+resolveAll target si = do
+  case fmap (filter ((== target) . rtOriginalTarget)) (siTargetResolving si) of
+    Nothing -> fail $ "Failed to find \"" ++ target ++ "\". Available: " ++ show (allUniqueTargets si)
+    Just rts -> pure rts
+
+unresolvable :: TargetString -> StatusInformation -> TestM ()
+unresolvable target si =
+  resolveAll target si >>= \case
+    [t] -> assertEqual "No associated unit-id" Nothing (rtUnitId t)
+    ts
+      -- assumes that the target was given to `cabal status --target <target>` only once
+      | all ((==Nothing) . rtUnitId) ts -> fail "Target resolves to Nothing multiple times. Internal inconsistency."
+      | otherwise -> fail $ "Target unexpectedly resolves to the following units: " ++ show (map rtUnitId ts)
+
diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs
index 4ad7b68d116..da9aa115c90 100644
--- a/cabal-testsuite/src/Test/Cabal/Prelude.hs
+++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs
@@ -332,6 +332,14 @@ withProjectFile :: FilePath -> TestM a -> TestM a
 withProjectFile fp m =
     withReaderT (\env -> env { testCabalProjectFile = fp }) m
 
+-- | Decode a json object from the *last* line of the result output.
+withJsonOutput :: JSON.FromJSON a => WithCallStack (Result -> TestM a)
+withJsonOutput r = do
+    let jsonLine = last . lines . getMarkedOutput $ resultOutput r
+    case JSON.eitherDecode' (BSL.fromStrict $ C.pack jsonLine) of
+        Left err -> fail $ "Failed to decode JSON object:" ++ err
+        Right o -> pure o
+
 -- | Assuming we've successfully configured a new-build project,
 -- read out the plan metadata so that we can use it to do other
 -- operations.

From c780f34a91742b1efa419615edeadd016c490f02 Mon Sep 17 00:00:00 2001
From: Fendor <power.walross@gmail.com>
Date: Thu, 27 Oct 2022 09:49:37 +0200
Subject: [PATCH 5/5] WIP

---
 cabal-install/src/Distribution/Client/CmdStatus.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/cabal-install/src/Distribution/Client/CmdStatus.hs b/cabal-install/src/Distribution/Client/CmdStatus.hs
index e53b8bb8c08..0ebbb6de0a3 100644
--- a/cabal-install/src/Distribution/Client/CmdStatus.hs
+++ b/cabal-install/src/Distribution/Client/CmdStatus.hs
@@ -59,6 +59,7 @@ import Distribution.Types.UnitId
 import Distribution.Verbosity
          ( normal )
 import Distribution.Version
+import Debug.Trace
 
 -------------------------------------------------------------------------------
 -- Command
@@ -158,7 +159,7 @@ statusOptions showOrParseArgs =
 statusAction :: NixStyleFlags StatusFlags -> [String] -> GlobalFlags -> IO ()
 statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetStrings globalFlags = do
   when (NoFlag == statusOutputFormat statusFlags) $ do
-    die' verbosity "The status command requires the flag '--output-format'."
+    die' verbosity "The status command requires the flag '--output-format'. Try '--output-format=json'."
   when (not $ null cliTargetStrings) $
     die' verbosity "The status command doesn't take target arguments directly. Use appropriate flags to pass in target information."
 
@@ -169,6 +170,7 @@ statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetString
                         (cabalDirLayout baseCtx)
                         (projectConfig baseCtx)
                         (localPackages baseCtx)
+                        (installedPackages baseCtx)
 
   compilerInformation <- if not $ fromFlagOrDefault False (statusCompiler statusFlags)
     then pure Nothing
@@ -186,6 +188,7 @@ statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetString
     then pure Nothing
     else do
       let targetStrings = statusTargets statusFlags
+      traceShowM targetStrings
       mtargetSelectors <- mapM (readTargetSelector (localPackages baseCtx) Nothing) targetStrings
       let (unresolvable, targetSelectors) = partitionEithers
                     $ map (\(mts, str) -> case mts of
@@ -193,6 +196,7 @@ statusAction flags@NixStyleFlags { extraFlags = statusFlags, ..} cliTargetString
                         Right ts -> Right (ts, str)
                     )
                     $ zip mtargetSelectors targetStrings
+      traceShowM mtargetSelectors
       -- Interpret the targets on the command line as build targets
       -- (as opposed to say repl or haddock targets).
       -- TODO: don't throw on targets that are invalid.