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