Allow filtering out -tests -specs -bench modules

CHANGELOG.md

@@ -65,3 +65,4 @@
 ## 0.1.0.8 -- 2026-05-01
 * fix for empty file.source_location.
 * Add `inspect-deprecated --fail-on none|direct|any`.
+* Add `inspect-locals` to list locally defined stanza.

README.md

@@ -9,8 +9,8 @@ Extract a dependency graph for GitHub dependency submission snapshots.
 1. Find deprecated Hackage dependencies and explain why they are present.
 
 ```sh
-cabal-plan-submit inspect-deprecated dist-newstyle/cache/plan.json deprecated.yaml
-cabal-plan-submit why dist-newstyle/cache/plan.json cryptonite
+cabal run cabal-plan-submit -- why dist-newstyle/cache/plan.json cryptonite
+cabal run cabal-plan-submit -- why $PROJECT_PATH/dist-newstyle/cache/plan.json process
 ```
 2. Submit Cabal dependency graphs to GitHub Dependency Graph.
 ```sh
@@ -104,6 +104,8 @@ jobs:
 After successful build data should apperar in `Insights` -> `Dependency graph` in `ecosystem:other`
 e.g. as [in here](https://github.com/dancewithheart/agda2scala/network/dependencies?q=ecosystem%3Aother)
 
+You can export SBOM (Software Bill of Materials) file on `Dependency graph` tab.
+
 Fail CI on deprecated dependencies:
 
 ```sh

app/Main.hs

@@ -11,14 +11,18 @@ import Data.Time.Clock (getCurrentTime)
 import Data.Version (showVersion)
 import Hgs.Deprecated
   ( FailOnDeprecated(..)
-  , findDeprecatedPackages
+  , findDeprecatedPackagesFrom
   , readDeprecationIndex
   , renderDeprecatedPackages
   , shouldFailOnDeprecated
   )
 import Hgs.Domain (RawPlan)
 import Hgs.Extract (extractPlanGraph, summarisePlanGraph)
 import Hgs.Input.PlanJson (readRawPlan, summariseRawPlan)
+import Hgs.Locals
+  ( inspectLocals
+  , renderLocals
+  )
 import Hgs.Snapshot
   ( SnapshotInput(..)
   , encodeSnapshot
@@ -30,7 +34,10 @@ import Hgs.Validate
   , validateSnapshotFile
   )
 import Hgs.Domain (PackageName(..))
-import Hgs.Why (renderWhy)
+import Hgs.Why (renderWhyFrom)
+import Hgs.LocalUnitFilter
+  ( LocalUnitFilter(..)
+  )
 import Paths_cabal_plan_submit qualified as Paths
 import System.Directory (doesFileExist, listDirectory)
 import System.Environment (getArgs)
@@ -56,15 +63,27 @@ main = do
     ["validate-snapshot", path] ->
       validateSnapshot path
     ["inspect-deprecated", planPath, deprecatedPath] ->
-      inspectDeprecated FailOnNone planPath deprecatedPath
+      inspectDeprecated AllLocalUnits FailOnNone planPath deprecatedPath
     ["inspect-deprecated", "--fail-on", failOn, planPath, deprecatedPath] ->
       case parseFailOnDeprecated failOn of
         Nothing ->
           die ("unknown --fail-on value: " <> failOn <> "\nExpected one of: none, direct, any")
         Just policy ->
-          inspectDeprecated policy planPath deprecatedPath
+          inspectDeprecated AllLocalUnits policy planPath deprecatedPath
+    ["inspect-deprecated", "--production-only", planPath, deprecatedPath] ->
+      inspectDeprecated ProductionLocalUnits FailOnNone planPath deprecatedPath
+    ["inspect-deprecated", "--production-only", "--fail-on", failOn, planPath, deprecatedPath] ->
+      case parseFailOnDeprecated failOn of
+        Nothing ->
+          die ("unknown --fail-on value: " <> failOn <> "\nExpected one of: none, direct, any")
+        Just policy ->
+          inspectDeprecated ProductionLocalUnits policy planPath deprecatedPath
+    ["why", "--production-only", path, packageName] ->
+      whyPackage ProductionLocalUnits path packageName
     ["why", path, packageName] ->
-      whyPackage path packageName
+      whyPackage AllLocalUnits path packageName
+    ["inspect-locals", path] ->
+      inspectLocalPackages path
     _ ->
       die usage
 
@@ -152,14 +171,14 @@ missingPlanMessage path =
     , "  cabal-plan-submit inspect-plan dist-newstyle/cache/plan.json"
     ]
 
-inspectDeprecated :: FailOnDeprecated -> FilePath -> FilePath -> IO ()
-inspectDeprecated failOn planPath deprecatedPath = do
+inspectDeprecated :: LocalUnitFilter -> FailOnDeprecated -> FilePath -> FilePath -> IO ()
+inspectDeprecated localFilter failOn planPath deprecatedPath = do
   plan <- readPlanOrDie planPath
   eIndex <- readDeprecationIndex deprecatedPath
   case eIndex of
     Left err -> die ("failed to parse deprecated metadata: " <> err)
     Right index -> do
-      let deprecated = findDeprecatedPackages index (extractPlanGraph plan)
+      let deprecated = findDeprecatedPackagesFrom localFilter index (extractPlanGraph plan)
       putStr (renderDeprecatedPackages deprecated)
       when (shouldFailOnDeprecated failOn deprecated) $ do
         hPutStrLn stderr (failOnMessage failOn)
@@ -178,14 +197,22 @@ failOnMessage = \case
   FailOnDirect -> "deprecated direct dependencies found"
   FailOnAny    -> "deprecated dependencies found"
 
-whyPackage :: FilePath -> String -> IO ()
-whyPackage path packageName = do
+whyPackage :: LocalUnitFilter -> FilePath -> String -> IO ()
+whyPackage localFilter path packageName = do
   plan <- readPlanOrDie path
   putStr $
-    renderWhy
+    renderWhyFrom
+      localFilter
       (PackageName (Text.pack packageName))
       (extractPlanGraph plan)
 
+inspectLocalPackages :: FilePath -> IO ()
+inspectLocalPackages path = do
+  plan <- readPlanOrDie path
+  putStr $
+    renderLocals
+      (inspectLocals (extractPlanGraph plan))
+
 usage :: String
 usage =
   unlines
@@ -194,9 +221,13 @@ usage =
     , "  cabal-plan-submit --version"
     , "  cabal-plan-submit inspect-plan PATH_TO_PLAN_JSON"
     , "  cabal-plan-submit inspect-graph PATH_TO_PLAN_JSON"
+    , "  cabal-plan-submit inspect-locals PATH_TO_PLAN_JSON"
     , "  cabal-plan-submit render-snapshot PATH_TO_PLAN_JSON SHA REF"
     , "  cabal-plan-submit validate-snapshot PATH_TO_SNAPSHOT_JSON"
     , "  cabal-plan-submit inspect-deprecated PATH_TO_PLAN_JSON PATH_TO_DEPRECATED_YAML"
+    , "  cabal-plan-submit inspect-deprecated --production-only PATH_TO_PLAN_JSON PATH_TO_DEPRECATED_YAML"
     , "  cabal-plan-submit inspect-deprecated --fail-on none|direct|any PATH_TO_PLAN_JSON PATH_TO_DEPRECATED_YAML"
+    , "  cabal-plan-submit inspect-deprecated --production-only --fail-on none|direct|any PATH_TO_PLAN_JSON PATH_TO_DEPRECATED_YAML"
     , "  cabal-plan-submit why PATH_TO_PLAN_JSON PACKAGE_NAME"
+    , "  cabal-plan-submit why --production-only PATH_TO_PLAN_JSON PACKAGE_NAME"
     ]

cabal-plan-submit.cabal

@@ -13,6 +13,8 @@ executable cabal-plan-submit
     Hgs.Deprecated
     Hgs.Domain
     Hgs.Extract
+    Hgs.Locals
+    Hgs.LocalUnitFilter
     Hgs.Snapshot
     Hgs.Validate
     Hgs.Input.PlanJson
@@ -40,12 +42,15 @@ test-suite plan-json-test
       Hgs.Domain
       Hgs.Extract
       Hgs.Input.PlanJson
+      Hgs.Locals
+      Hgs.LocalUnitFilter
       Hgs.Snapshot
       Hgs.Validate
       Hgs.Why
       DeprecatedSpec
       PlanJsonSpec
       SnapshotSpec
+      LocalsSpec
       TestSupport
   default-language: GHC2021
   ghc-options:      -Wall

src/Hgs/Deprecated.hs

@@ -8,6 +8,7 @@ module Hgs.Deprecated
   , FailOnDeprecated(..)
   , readDeprecationIndex
   , findDeprecatedPackages
+  , findDeprecatedPackagesFrom
   , renderDeprecatedPackages
   , shouldFailOnDeprecated
   ) where
@@ -31,9 +32,12 @@ import Hgs.Domain
   , Version(..)
   )
 import Hgs.Why
-  ( PackagePath
+  ( PackagePath(..)
   , renderPackagePath
-  , shortestPathsToPackage
+  , shortestPathsToPackageFrom
+  )
+import Hgs.LocalUnitFilter
+  ( LocalUnitFilter(..)
   )
 
 data Deprecation = Deprecation
@@ -210,28 +214,47 @@ arrayField key o =
     _ -> Nothing
 
 findDeprecatedPackages :: Map PackageName Deprecation -> PlanGraph -> [DeprecatedPackage]
-findDeprecatedPackages index graph =
+findDeprecatedPackages =
+  findDeprecatedPackagesFrom AllLocalUnits
+
+findDeprecatedPackagesFrom :: LocalUnitFilter -> Map PackageName Deprecation -> PlanGraph -> [DeprecatedPackage]
+findDeprecatedPackagesFrom filterKind index graph =
   Map.elems $
     Map.fromList
       [ ( (packageName pkg, packageVersion pkg)
         , DeprecatedPackage
             { deprecatedPackageName = packageName pkg
             , deprecatedPackageVersion = packageVersion pkg
             , deprecatedRelationship =
-                if packageIsDirect pkg then "direct" else "indirect"
+                relationshipFromPaths pkg paths
             , deprecatedReplacements =
                 deprecationReplacements dep
             , deprecatedReason =
                 deprecationReason dep
             , deprecatedPath =
-                listToMaybe (shortestPathsToPackage (packageName pkg) graph)
+                listToMaybe paths
             }
         )
       | pkg <- Map.elems (planGraphPackages graph)
       , packageSource pkg == PackageExternal
       , dep <- maybeToList (Map.lookup (packageName pkg) index)
+      , let paths = shortestPathsToPackageFrom filterKind (packageName pkg) graph
+      , not (null paths)
       ]
 
+relationshipFromPaths :: Package -> [PackagePath] -> Text
+relationshipFromPaths pkg paths
+  | any isDirectPath paths = "direct"
+  | otherwise = "indirect"
+ where
+  isDirectPath path =
+    case unPackagePath path of
+      [_localRoot, target] ->
+        packageName target == packageName pkg
+          && packageVersion target == packageVersion pkg
+      _ ->
+        False
+
 shouldFailOnDeprecated :: FailOnDeprecated -> [DeprecatedPackage] -> Bool
 shouldFailOnDeprecated policy deps =
   case policy of

src/Hgs/LocalUnitFilter.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hgs.LocalUnitFilter
+  ( LocalUnitFilter(..)
+  , localUnitAllowed
+  , isTestLikeUnitId
+  , isBenchLikeUnitId
+  ) where
+
+import Data.Text qualified as Text
+import Hgs.Domain
+  ( Package(..)
+  , UnitId(..)
+  )
+
+data LocalUnitFilter
+  = AllLocalUnits
+  | ProductionLocalUnits
+  deriving stock (Eq, Show)
+
+localUnitAllowed :: LocalUnitFilter -> Package -> Bool
+localUnitAllowed filterKind pkg =
+  case filterKind of
+    AllLocalUnits ->
+      True
+
+    ProductionLocalUnits ->
+      not (isTestLikeUnitId unitId || isBenchLikeUnitId unitId)
+ where
+  unitId =
+    packageUnitId pkg
+
+isTestLikeUnitId :: UnitId -> Bool
+isTestLikeUnitId (UnitId unitId) =
+  any (`Text.isInfixOf` unitId)
+    [ "-test"
+    , "-spec"
+    , "-specs"
+    ]
+
+isBenchLikeUnitId :: UnitId -> Bool
+isBenchLikeUnitId (UnitId unitId) =
+  "-bench" `Text.isInfixOf` unitId

src/Hgs/Locals.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hgs.Locals
+  ( LocalPackage(..)
+  , inspectLocals
+  , renderLocals
+  ) where
+
+import Data.Map.Strict qualified as Map
+import Data.Set qualified as Set
+import Data.Text qualified as Text
+import Hgs.Domain
+  ( Package(..)
+  , PackageName(..)
+  , PackageSource(..)
+  , PlanGraph(..)
+  , UnitId(..)
+  , Version(..)
+  )
+
+data LocalPackage = LocalPackage
+  { localPackage       :: Package
+  , localExternalDeps  :: [Package]
+  }
+  deriving stock (Eq, Show)
+
+inspectLocals :: PlanGraph -> [LocalPackage]
+inspectLocals graph =
+  [ LocalPackage
+      { localPackage = pkg
+      , localExternalDeps = directExternalDeps pkg
+      }
+  | pkg <- Map.elems packages
+  , packageSource pkg == PackageLocal
+  ]
+ where
+  packages =
+    planGraphPackages graph
+
+  directExternalDeps pkg =
+    [ depPkg
+    | depUnitId <- Set.toAscList (packageDepends pkg)
+    , depPkg <- maybeToList (Map.lookup depUnitId packages)
+    , packageSource depPkg == PackageExternal
+    ]
+
+renderLocals :: [LocalPackage] -> String
+renderLocals locals =
+  case locals of
+    [] ->
+      "no local packages found\n"
+
+    _ ->
+      unlines $
+        "local packages:"
+          : concatMap renderLocalPackage locals
+
+renderLocalPackage :: LocalPackage -> [String]
+renderLocalPackage local =
+  [ "  " <> renderPackage (localPackage local)
+  , "    unit-id: " <> renderUnitId (localPackage local)
+  , "    direct external deps:"
+  ]
+    <> renderDeps (localExternalDeps local)
+
+renderUnitId :: Package -> String
+renderUnitId =
+  Text.unpack . unUnitId . packageUnitId
+
+renderDeps :: [Package] -> [String]
+renderDeps deps =
+  case deps of
+    [] ->
+      ["      <none>"]
+
+    _ ->
+      map (("      " <>) . renderPackage) deps
+
+renderPackage :: Package -> String
+renderPackage pkg =
+  Text.unpack (unPackageName (packageName pkg))
+    <> "-"
+    <> Text.unpack (unVersion (packageVersion pkg))
+
+maybeToList :: Maybe a -> [a]
+maybeToList =
+  maybe [] pure