Merge pull request #10320 from 9999years/validate-haskell

Convert `validate.sh` to a Haskell script

.github/workflows/format.yml

@@ -17,3 +17,4 @@ jobs:
           Cabal/**/*.hs
           Cabal-syntax/**/*.hs
           cabal-install/**/*.hs
+          cabal-validate/**/*.hs

Makefile

@@ -29,16 +29,16 @@ init: ## Set up git hooks and ignored revisions
 
 .PHONY: style
 style: ## Run the code styler
-	@fourmolu -q -i Cabal Cabal-syntax cabal-install
+	@fourmolu -q -i Cabal Cabal-syntax cabal-install cabal-validate
 
 .PHONY: style-modified
 style-modified: ## Run the code styler on modified files
-	@git ls-files --modified Cabal Cabal-syntax cabal-install \
+	@git ls-files --modified Cabal Cabal-syntax cabal-install cabal-validate \
 		| grep '.hs$$' | xargs -P $(PROCS) -I {} fourmolu -q -i {}
 
 .PHONY: style-commit
 style-commit: ## Run the code styler on the previous commit
-	@git diff --name-only HEAD $(COMMIT) Cabal Cabal-syntax cabal-install \
+	@git diff --name-only HEAD $(COMMIT) Cabal Cabal-syntax cabal-install cabal-validate \
 		| grep '.hs$$' | xargs -P $(PROCS) -I {} fourmolu -q -i {}
 
 .PHONY: whitespace

cabal-validate/README.md

@@ -0,0 +1,23 @@
+# cabal-validate
+
+`cabal-validate` is a script that builds and tests `Cabal` and `cabal-install`.
+`cabal-validate` can be run with `validate.sh` in the repository root;
+arguments passed to `validate.sh` will be forwarded to `cabal-validate`.
+
+Notable arguments include:
+
+- `-v`/`--verbose` to display build and test output in real-time, instead of
+  only if commands fail.
+- `-s`/`--step` to run a specific step (e.g. `-s build -s lib-tests` will only
+  run the `build` and `lib-tests` steps).
+- `-p`/`--pattern` to filter tests by a pattern.
+
+## Hacking on cabal-validate
+
+Overview of important modules:
+
+- `Main.hs` encodes all the commands that are run for each step.
+- `Cli.hs` parses the CLI arguments and resolves default values from the
+  environment, like determining which steps are run by default or the `--jobs`
+  argument to pass to test suites.
+- `Step.hs` lists the available steps.

cabal-validate/cabal-validate.cabal

@@ -0,0 +1,47 @@
+cabal-version: 3.0
+name:          cabal-validate
+version:       1.0.0
+copyright:     2024-2024, Cabal Development Team (see AUTHORS file)
+license:       BSD-3-Clause
+author:        Cabal Development Team <[email protected]>
+synopsis:      An internal tool for building and testing the Cabal package manager
+build-type:    Simple
+
+common common
+    ghc-options: -Wall
+
+    if impl(ghc <9.6)
+        -- Pattern exhaustiveness checker is not as good, misses a case.
+        ghc-options: -Wno-incomplete-patterns
+
+    default-language: Haskell2010
+    default-extensions:
+        OverloadedStrings
+        , TypeApplications
+
+executable cabal-validate
+    import: common
+    ghc-options: -O -threaded -rtsopts -with-rtsopts=-N
+
+    main-is: Main.hs
+    hs-source-dirs: src
+
+    other-modules:
+        , ANSI
+        , Cli
+        , ClockUtil
+        , OutputUtil
+        , ProcessUtil
+        , Step
+
+    build-depends:
+        , base >=4 && <5
+        , bytestring >=0.11 && <1
+        , containers >=0.6 && <1
+        , directory >=1.0 && <2
+        , filepath >=1 && <2
+        , optparse-applicative >=0.18 && <1
+        , terminal-size >=0.3 && <1
+        , text >=2 && <3
+        , time >=1 && <2
+        , typed-process >=0.2 && <1

cabal-validate/src/ANSI.hs

@@ -0,0 +1,105 @@
+-- | ANSI escape sequences.
+--
+-- This is a stripped-down version of the parts of the @ansi-terminal@ package
+-- we use.
+--
+-- See: <https://gist.github.com/fnky/458719343aabd01cfb17a3a4f7296797>
+module ANSI
+  ( SGR (..)
+  , setSGR
+  ) where
+
+-- | Render a single numeric SGR sequence.
+rawSGR :: Int -> String
+rawSGR code = "\x1b[" <> show code <> "m"
+
+-- | Render a series of `SGR` escape sequences.
+setSGR :: [SGR] -> String
+setSGR = concat . map renderSGR
+
+-- | All of the SGR sequences we want to use.
+data SGR
+  = Reset
+  | Bold
+  | Dim
+  | Italic
+  | Underline
+  | Black
+  | Red
+  | Green
+  | Yellow
+  | Blue
+  | Magenta
+  | Cyan
+  | White
+  | Default
+  | OnBlack
+  | OnRed
+  | OnGreen
+  | OnYellow
+  | OnBlue
+  | OnMagenta
+  | OnCyan
+  | OnWhite
+  | OnDefault
+  | BrightBlack
+  | BrightRed
+  | BrightGreen
+  | BrightYellow
+  | BrightBlue
+  | BrightMagenta
+  | BrightCyan
+  | BrightWhite
+  | OnBrightBlack
+  | OnBrightRed
+  | OnBrightGreen
+  | OnBrightYellow
+  | OnBrightBlue
+  | OnBrightMagenta
+  | OnBrightCyan
+  | OnBrightWhite
+  deriving (Show)
+
+-- Render a single `SGR` sequence.
+renderSGR :: SGR -> String
+renderSGR code =
+  case code of
+    Reset -> rawSGR 0
+    Bold -> rawSGR 1
+    Dim -> rawSGR 2
+    Italic -> rawSGR 3
+    Underline -> rawSGR 4
+    Black -> rawSGR 30
+    Red -> rawSGR 31
+    Green -> rawSGR 32
+    Yellow -> rawSGR 33
+    Blue -> rawSGR 34
+    Magenta -> rawSGR 35
+    Cyan -> rawSGR 36
+    White -> rawSGR 37
+    Default -> rawSGR 39
+    OnBlack -> rawSGR 40
+    OnRed -> rawSGR 41
+    OnGreen -> rawSGR 42
+    OnYellow -> rawSGR 43
+    OnBlue -> rawSGR 44
+    OnMagenta -> rawSGR 45
+    OnCyan -> rawSGR 46
+    OnWhite -> rawSGR 47
+    OnDefault -> rawSGR 49
+    BrightBlack -> rawSGR 90
+    BrightRed -> rawSGR 91
+    BrightGreen -> rawSGR 92
+    BrightYellow -> rawSGR 93
+    BrightBlue -> rawSGR 94
+    BrightMagenta -> rawSGR 95
+    BrightCyan -> rawSGR 96
+    BrightWhite -> rawSGR 97
+    OnBrightBlack -> rawSGR 100
+    OnBrightRed -> rawSGR 101
+    OnBrightGreen -> rawSGR 102
+    OnBrightYellow -> rawSGR 103
+    OnBrightBlue -> rawSGR 104
+    OnBrightMagenta -> rawSGR 105
+    OnBrightCyan -> rawSGR 106
+    OnBrightWhite -> rawSGR 107