Make 'count-deps' a ghc/util standalone program

- Move 'count-deps' into 'ghc/utils' so that it can be called standalone.
- Move 'testsuite/tests/parser/should_run/' tests 'CountParserDeps' and
'CountAstDeps' to 'testsuite/tests/count-deps' and reimplement in terms
of calling the utility
- Document how to use 'count-deps' in 'ghc/utils/count-deps/README'

18 files changed, 161 insertions, 64 deletions

diff --git a/ghc.mk b/ghc.mk
index 070ddfe45b..a244c1b53c 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -569,6 +569,7 @@ ghc/stage2/package-data.mk: compiler/stage2/package-data.mk
 utils/haddock/dist/package-data.mk: compiler/stage2/package-data.mk
 utils/check-ppr/dist-install/package-data.mk: compiler/stage2/package-data.mk
 utils/check-exact/dist-install/package-data.mk: compiler/stage2/package-data.mk
+utils/count-deps/dist-install/package-data.mk: compiler/stage2/package-data.mk
 
 # add the final package.conf dependency: ghc-prim depends on RTS
 libraries/ghc-prim/dist-install/package-data.mk : rts/dist/package.conf.inplace
@@ -667,6 +668,7 @@ BUILD_DIRS += utils/ghc-pkg
 BUILD_DIRS += utils/testremove
 BUILD_DIRS += utils/check-ppr
 BUILD_DIRS += utils/check-exact
+BUILD_DIRS += utils/count-deps
 BUILD_DIRS += utils/ghc-cabal
 BUILD_DIRS += utils/hpc
 BUILD_DIRS += utils/runghc
@@ -709,6 +711,7 @@ ifneq "$(CrossCompiling) $(Stage1Only)" "NO NO"
 # See Note [Stage1Only vs stage=1] in mk/config.mk.in.
 BUILD_DIRS := $(filter-out utils/check-ppr,$(BUILD_DIRS))
 BUILD_DIRS := $(filter-out utils/check-exact,$(BUILD_DIRS))
+BUILD_DIRS := $(filter-out utils/count-deps,$(BUILD_DIRS))
 endif
 endif # CLEANING
 
diff --git a/hadrian/src/Packages.hs b/hadrian/src/Packages.hs
index c56feae796..f75236cd9a 100644
--- a/hadrian/src/Packages.hs
+++ b/hadrian/src/Packages.hs
@@ -2,7 +2,7 @@
 module Packages (
     -- * GHC packages
     array, base, binary, bytestring, cabal, checkPpr,
-    checkExact,
+    checkExact, countDeps,
     compareSizes, compiler, containers, deepseq, deriveConstants, directory,
     exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh,
     ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline,
@@ -32,7 +32,7 @@ import Oracles.Setting
 -- packages and modify build default build conditions in "UserSettings".
 ghcPackages :: [Package]
 ghcPackages =
-    [ array, base, binary, bytestring, cabal, checkPpr, checkExact
+    [ array, base, binary, bytestring, cabal, checkPpr, checkExact, countDeps
     , compareSizes, compiler, containers, deepseq, deriveConstants, directory
     , exceptions, filepath, genapply, genprimopcode, ghc, ghcBignum, ghcBoot, ghcBootTh
     , ghcCompact, ghcHeap, ghci, ghciWrapper, ghcPkg, ghcPrim, haddock, haskeline, hsc2hs
@@ -53,6 +53,7 @@ bytestring          = lib  "bytestring"
 cabal               = lib  "Cabal"           `setPath` "libraries/Cabal/Cabal"
 checkPpr            = util "check-ppr"
 checkExact          = util "check-exact"
+countDeps           = util "count-deps"
 compareSizes        = util "compareSizes"    `setPath` "utils/compare_sizes"
 compiler            = top  "ghc"             `setPath` "compiler"
 containers          = lib  "containers"      `setPath` "libraries/containers/containers"
diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs
index 2c90b3fe5c..75178e2fef 100644
--- a/hadrian/src/Rules/BinaryDist.hs
+++ b/hadrian/src/Rules/BinaryDist.hs
@@ -172,7 +172,7 @@ bindistRules = do
         need $ map (bindistFilesDir -/-)
                    (["configure", "Makefile"] ++ bindistInstallFiles)
         need $ map ((bindistFilesDir -/- "wrappers") -/-)
-                   [ "check-ppr", "check-exact", "ghc", "ghc-iserv", "ghc-pkg"
+                   [ "check-ppr", "check-exact", "count-deps", "ghc", "ghc-iserv", "ghc-pkg"
                    , "ghci-script", "haddock", "hpc", "hp2ps", "hsc2hs"
                    , "runghc"]
 
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
index 495ec3b7cb..ff986f879e 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -37,11 +37,17 @@ checkExactSourcePath = "utils/check-exact/Main.hs"
 checkExactExtra :: Maybe String
 checkExactExtra = Just "-iutils/check-exact"
 
+countDepsProgPath, countDepsSourcePath :: FilePath
+countDepsProgPath = "test/bin/count-deps" <.> exe
+countDepsSourcePath = "utils/count-deps/Main.hs"
+countDepsExtra :: Maybe String
+countDepsExtra = Just "-iutils/count-deps"
 
 checkPrograms :: [(FilePath, FilePath, Maybe String, Package)]
 checkPrograms =
     [ (checkPprProgPath, checkPprSourcePath, checkPprExtra, checkPpr)
     , (checkExactProgPath, checkExactSourcePath, checkExactExtra, checkExact)
+    , (countDepsProgPath, countDepsSourcePath, countDepsExtra, countDeps)
     ]
 
 ghcConfigPath :: FilePath
@@ -132,7 +138,9 @@ testRules = do
 
         pythonPath      <- builderPath Python
         need [ root -/- checkPprProgPath
-             , root -/- checkExactProgPath ]
+             , root -/- checkExactProgPath
+             , root -/- countDepsProgPath
+             ]
 
         -- Set environment variables for test's Makefile.
         -- TODO: Ideally we would define all those env vars in 'env', so that
@@ -149,6 +157,7 @@ testRules = do
             setEnv "TEST_HC_OPTS_INTERACTIVE" ghciFlags
             setEnv "CHECK_PPR" (top -/- root -/- checkPprProgPath)
             setEnv "CHECK_EXACT" (top -/- root -/- checkExactProgPath)
+            setEnv "COUNT_DEPS" (top -/- root -/- countDepsProgPath)
 
             -- This lets us bypass the need to generate a config
             -- through Make, which happens in testsuite/mk/boilerplate.mk
diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs
index 9efea20275..f00aab9776 100644
--- a/hadrian/src/Settings/Builders/Make.hs
+++ b/hadrian/src/Settings/Builders/Make.hs
@@ -26,12 +26,14 @@ validateBuilderArgs = builder (Make "testsuite/tests") ? do
     compiler            <- expr $ fullpath ghc
     checkPpr            <- expr $ fullpath checkPpr
     checkExact          <- expr $ fullpath checkExact
+    countDeps          <- expr $ fullpath countDeps
     args                <- expr $ userSetting defaultTestArgs
     return [ setTestSpeed $ testSpeed args
            , "THREADS=" ++ show threads
            , "TEST_HC=" ++ (top -/- compiler)
            , "CHECK_PPR=" ++ (top -/- checkPpr)
            , "CHECK_EXACT=" ++ (top -/- checkExact)
+           , "COUNT_DEPS=" ++ (top -/- countDeps)
            ]
   where
     fullpath :: Package -> Action FilePath
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index 1a28e1ca72..2da096efdb 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -135,7 +135,7 @@ stage2Packages = stage1Packages
 
 -- | Packages that are built only for the testsuite.
 testsuitePackages :: Action [Package]
-testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact ])
+testsuitePackages = return ([ timeout | windowsHost ] ++ [ checkPpr, checkExact, countDeps ])
 
 -- | Default build ways for library packages:
 -- * We always build 'vanilla' way.
diff --git a/testsuite/mk/boilerplate.mk b/testsuite/mk/boilerplate.mk
index a2fb56d1ba..942e6e32c2 100644
--- a/testsuite/mk/boilerplate.mk
+++ b/testsuite/mk/boilerplate.mk
@@ -227,6 +227,10 @@ ifeq "$(CHECK_EXACT)" ""
 CHECK_EXACT := $(abspath $(TOP)/../inplace/bin/check-exact)
 endif
 
+ifeq "$(COUNT_DEPS)" ""
+COUNT_DEPS := $(abspath $(TOP)/../inplace/bin/count-deps)
+endif
+
 # -----------------------------------------------------------------------------
 # configuration of TEST_HC
 
@@ -296,4 +300,3 @@ FREEBSD = YES
 else
 FREEBSD = NO
 endif
-
diff --git a/testsuite/tests/parser/should_run/CountAstDeps.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index 4b33ad2982..4b33ad2982 100644
--- a/testsuite/tests/parser/should_run/CountAstDeps.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index 16dbb8e185..16dbb8e185 100644
--- a/testsuite/tests/parser/should_run/CountParserDeps.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
diff --git a/testsuite/tests/count-deps/Makefile b/testsuite/tests/count-deps/Makefile
new file mode 100644
index 0000000000..41911c47df
--- /dev/null
+++ b/testsuite/tests/count-deps/Makefile
@@ -0,0 +1,23 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+LIBDIR := "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
+
+# Calculate the number of module dependencies of 'Parser.' If that
+# number exceeds a threshold, that indicates that the dependencies
+# have significantly gone up via the commit under test (and the test
+# is deemed to fail). In that case, this most likely means a cycle
+# has arisen that pulls in modules for Core generation. The
+# motivation for not allowing that to happen is so that the
+# 'ghc-lib-parser' package subset of the GHC API can continue to be
+# provided with as small a number of modules as possible for when the
+# need exists to produce ASTs and nothing more.
+
+.PHONY: count-deps-parser
+count-deps-parser:
+	$(COUNT_DEPS) $(LIBDIR) "GHC.Parser"
+
+.PHONY: count-deps-ast
+count-deps-ast:
+	$(COUNT_DEPS) $(LIBDIR) "Language.Haskell.Syntax"
diff --git a/testsuite/tests/count-deps/all.T b/testsuite/tests/count-deps/all.T
new file mode 100644
index 0000000000..6b8abd9c95
--- /dev/null
+++ b/testsuite/tests/count-deps/all.T
@@ -0,0 +1,2 @@
+test('CountDepsAst', [], makefile_test, ['count-deps-ast'])
+test('CountDepsParser', [], makefile_test, ['count-deps-parser'])
diff --git a/testsuite/tests/parser/should_run/CountAstDeps.hs b/testsuite/tests/parser/should_run/CountAstDeps.hs
deleted file mode 100644
index ba7f0c50f9..0000000000
--- a/testsuite/tests/parser/should_run/CountAstDeps.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Main(main) where
-
--- Calculate the number of module dependencies of 'Parser.' If that
--- number exceeds a threshold, that indicates that the dependencies
--- have significantly gone up via the commit under test (and the test
--- is deemed to fail). In that case, this most likely means a cycle
--- has arisen that pulls in modules for Core generation. The
--- motivation for not allowing that to happen is so that the
--- 'ghc-lib-parser' package subset of the GHC API can continue to be
--- provided with as small a number of modules as possible for when the
--- need exists to produce ASTs and nothing more.
-
-import CountDeps
-
-main :: IO ()
-main = printDeps "Language.Haskell.Syntax"
diff --git a/testsuite/tests/parser/should_run/CountParserDeps.hs b/testsuite/tests/parser/should_run/CountParserDeps.hs
deleted file mode 100644
index f1dacb1d62..0000000000
--- a/testsuite/tests/parser/should_run/CountParserDeps.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-module Main(main) where
-
--- Calculate the number of module dependencies of 'Parser.' If that
--- number exceeds a threshold, that indicates that the dependencies
--- have significantly gone up via the commit under test (and the test
--- is deemed to fail). In that case, this most likely means a cycle
--- has arisen that pulls in modules for Core generation. The
--- motivation for not allowing that to happen is so that the
--- 'ghc-lib-parser' package subset of the GHC API can continue to be
--- provided with as small a number of modules as possible for when the
--- need exists to produce ASTs and nothing more.
-
-import CountDeps
-
-main :: IO ()
-main = printDeps "GHC.Parser"
diff --git a/testsuite/tests/parser/should_run/all.T b/testsuite/tests/parser/should_run/all.T
index 5c2112057e..92c6d0fcb3 100644
--- a/testsuite/tests/parser/should_run/all.T
+++ b/testsuite/tests/parser/should_run/all.T
@@ -14,14 +14,6 @@ test('NegativeZero', normal, compile_and_run, [''])
 test('HexFloatLiterals', normal, compile_and_run, [''])
 test('NumericUnderscores0', normal, compile_and_run, [''])
 test('NumericUnderscores1', normal, compile_and_run, [''])
-test('CountAstDeps',
-     [ extra_files(['CountDeps.hs']), only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ],
-     compile_and_run,
-     ['-package ghc'])
-test('CountParserDeps',
-     [ extra_files(['CountDeps.hs']), only_ways(['normal']), extra_run_opts('"' + config.libdir + '"') ],
-     compile_and_run,
-     ['-package ghc'])
 test('LexNegLit', normal, compile_and_run, [''])
 test('RecordDotSyntax1', normal, compile_and_run, [''])
 test('RecordDotSyntax2', normal, compile_and_run, [''])
diff --git a/testsuite/tests/parser/should_run/CountDeps.hs b/utils/count-deps/Main.hs
index fab36de4a8..2ce6ea9f5b 100644
--- a/testsuite/tests/parser/should_run/CountDeps.hs
+++ b/utils/count-deps/Main.hs
@@ -1,19 +1,29 @@
-module CountDeps (printDeps) where
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Main where
 
 import GHC.Driver.Env
 import GHC.Unit.Module
 import GHC.Driver.Session
 import GHC.Driver.Main
 import GHC
-import GHC.Utils.Misc
-import Data.Maybe
 import Control.Monad
 import Control.Monad.IO.Class
 import System.Environment
-import System.Exit
 import GHC.Unit.Module.Deps
 import Data.Map.Strict qualified as Map
 
+-- Example invocation:
+--  inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser"
+main :: IO ()
+main = do
+  args <- getArgs
+  case args of
+    [libdir, modName, "--dot"] -> printDeps libdir modName True
+    [libdir, modName] -> printDeps libdir modName False
+    _ -> fail "usage: count-deps libdir module [--dot]"
+
 dotSpec :: String -> Map.Map String [String] -> String
 dotSpec name g =
  "digraph \"" ++ name ++ "\" {\n" ++
@@ -21,23 +31,22 @@ dotSpec name g =
   where
     f acc k ns = acc ++ concat ["  " ++ show k ++ " -> " ++ show n ++ ";\n" | n <- ns]
 
-printDeps :: String -> IO ()
-printDeps modName = do
-  [libdir] <- getArgs
+printDeps :: String -> String -> Bool -> IO ()
+printDeps libdir modName dot = do
   modGraph <-
     Map.map (map moduleNameString) .
       Map.mapKeys moduleNameString <$> calcDeps modName libdir
-  let modules = Map.keys modGraph
-      num = length modules
-  putStrLn $ "Found " ++ show num ++ " " ++ modName ++ " module dependencies"
-  forM_ modules putStrLn
-  -- Uncomment the next line to print a dependency graph in dot
-  -- format:
-  -- putStr $ dotSpec modName modGraph
-  -- Then,
-  -- * Copy the digraph output to a file ('deps.dot' say)
-  -- * To render it, use a command along the lines of
-  --   'tred deps.dot > deps-tred.dot && dot -Tpdf -o deps.pdf deps-tred.dot'
+  if not dot then
+    do
+      let modules = Map.keys modGraph
+          num = length modules
+      putStrLn $ "Found " ++ show num ++ " " ++ modName ++ " module dependencies"
+      forM_ modules putStrLn
+  else
+    -- * Copy the digraph output to a file ('deps.dot' say)
+    -- * To render it, use a command along the lines of
+    --   'tred deps.dot > deps-tred.dot && dot -Tpdf -o deps.pdf deps-tred.dot'
+    putStr $ dotSpec modName modGraph
 
 calcDeps :: String -> FilePath -> IO (Map.Map ModuleName [ModuleName])
 calcDeps modName libdir =
diff --git a/utils/count-deps/README.md b/utils/count-deps/README.md
new file mode 100644
index 0000000000..67d8ed4842
--- /dev/null
+++ b/utils/count-deps/README.md
@@ -0,0 +1,43 @@
+# README
+
+The `count-deps` executable is used in the test-suite to detect when
+the number of dependencies of certain modules change ([this blog
+post](https://blog.shaynefletcher.org/2020/10/ghc-lib-parser-module-count.html)
+gives one example of where and why this can be useful).
+
+More generally it's useful for obtaining insight into a modules'
+dependency graph. As used in the tests it produces (1) a count of a
+modules' dependencies together with the list of depended upon modules
+. However, it can also (2), print a modules' dependency graph in dot
+language syntax suitable for rendering with "graphviz" (open source
+graph visualization software).
+
+## Installing graphviz
+
+To render graphs generated by `count-deps`, first visit [the graphviz
+downloads page](https://graphviz.org/download/) to download and
+install graphviz on your system.
+
+## `count-deps` usage examples:
+
+  - `make`:
+
+    (1) ``inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser"``
+    (2) ``inplace/bin/count-deps `inplace/bin/ghc-stage2 --print-libdir` "GHC.Parser" --dot``
+
+  - `hadrian`:
+    (1) ``_build/stage1/bin/count-deps `_build/stage1/bin/ghc --print-libdir` "GHC.Parser"``
+    (2) ``_build/stage1/bin/count-deps `_build/stage1/bin/ghc --print-libdir` "GHC.Parser" --dot``
+
+## Rendering dependency graphs
+
+To render a graph obtained using a type (2) command:
+
+  - Copy the output to a file ('`deps.dot`' say)
+
+  - Render it with a command like (preprocess with `tred` to remove
+    edges implied by transitivity)
+
+    ```bash
+    tred deps.dot > deps-tred.dot&& dot -Tpdf -o deps.pdf deps-tred.dot
+    ```
diff --git a/utils/count-deps/count-deps.cabal b/utils/count-deps/count-deps.cabal
new file mode 100644
index 0000000000..38a7621aaa
--- /dev/null
+++ b/utils/count-deps/count-deps.cabal
@@ -0,0 +1,24 @@
+Name: count-deps
+Version: 0.1
+Copyright: XXX
+License: BSD3
+-- XXX License-File: LICENSE
+Author: XXX
+Maintainer: XXX
+Synopsis: A utilities for analyzing module dependencies
+Description:
+    This utility is used inspect the dependencies of a module
+    @utils/count-deps/README@ in GHC's source distribution for
+    details.
+Category: Development
+build-type: Simple
+cabal-version: >=1.10
+
+Executable count-deps
+    Default-Language: Haskell2010
+    Main-Is: Main.hs
+    Ghc-Options: -Wall
+    other-modules:
+    Build-Depends: base >= 4   && < 5,
+                   containers,
+                   ghc
diff --git a/utils/count-deps/ghc.mk b/utils/count-deps/ghc.mk
new file mode 100644
index 0000000000..45259efee6
--- /dev/null
+++ b/utils/count-deps/ghc.mk
@@ -0,0 +1,18 @@
+# -----------------------------------------------------------------------------
+#
+# (c) 2009 The University of Glasgow
+#
+# This file is part of the GHC build system.
+#
+# To understand how the build system works and how to modify it, see
+#      https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture
+#      https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying
+#
+# -----------------------------------------------------------------------------
+
+utils/count-deps_USES_CABAL                   = YES
+utils/count-deps_PACKAGE                      = count-deps
+utils/count-deps_dist-install_PROGNAME        = count-deps
+utils/count-deps_dist-install_INSTALL         = NO
+utils/count-deps_dist-install_INSTALL_INPLACE = YES
+$(eval $(call build-prog,utils/count-deps,dist-install,2))