Skip to content

Commit 0c4e63b

Browse files
neilmayhewneilmayhew
committed
Write test failure details to the CI job summary
1 parent 304b88c commit 0c4e63b

File tree

12 files changed

+516
-1
lines changed

12 files changed

+516
-1
lines changed

‎.github/workflows/haskell.yml‎

Lines changed: 34 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -334,6 +334,19 @@ jobs:
334334
scripts/cabal-test-with-retries.sh "${{ matrix.package }}" "$TRIES"
335335
fi
336336
337+
- name: Record test failures
338+
if: failure()
339+
run: |
340+
cabal run --project-dir=scripts/cabal-logs -- \
341+
extract-failures -v -o failures.json
342+
343+
- name: Upload test failures artifact
344+
if: failure()
345+
uses: actions/upload-artifact@v7
346+
with:
347+
name: failures-${{ matrix.package }}-${{ matrix.ghc }}-${{ matrix.os }}
348+
path: failures.json
349+
337350
- name: Run doctests
338351
run: scripts/doctest.sh "${{ matrix.package }}"
339352

@@ -342,8 +355,28 @@ jobs:
342355
runs-on: ubuntu-latest
343356
needs: test
344357
if: always()
358+
345359
steps:
346-
- run: |
360+
- uses: actions/checkout@v6
361+
with:
362+
sparse-checkout: scripts/cabal-logs
363+
364+
- name: Download test failures artifacts
365+
if: ${{ needs.test.result == 'failure' }}
366+
uses: actions/download-artifact@v8
367+
with:
368+
pattern: failures-*
369+
path: failures
370+
371+
- name: Summarize failures
372+
if: ${{ needs.test.result == 'failure' }}
373+
run: |
374+
cabal update --project-dir=scripts/cabal-logs
375+
cabal run --project-dir=scripts/cabal-logs -- \
376+
render-failures -o "$GITHUB_STEP_SUMMARY" failures/*/failures.json
377+
378+
- name: Show outcome
379+
run: |
347380
case ${{ needs.test.result }} in
348381
success)
349382
echo 'All tests completed successfully'

‎scripts/cabal-logs/.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
/dist-newstyle/

‎scripts/cabal-logs/LogResults.hs‎

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
3+
module LogResults (
4+
Option (..),
5+
Failure (..),
6+
LogResults,
7+
) where
8+
9+
import Data.Aeson
10+
import Data.List (stripPrefix)
11+
import Data.Map (Map)
12+
import Data.Text (Text)
13+
import GHC.Generics (Generic)
14+
15+
data Option = Option
16+
{ optionName :: !Text
17+
, optionValue :: !Text
18+
}
19+
deriving (Eq, Ord, Show, Generic)
20+
21+
data Failure = Failure
22+
{ failureSelector :: !Option
23+
, failureSeed :: !Option
24+
}
25+
deriving (Eq, Ord, Show, Generic)
26+
27+
type LogResults = Map Text [Failure]
28+
29+
instance ToJSON Option where
30+
toJSON = genericToJSON $ defaultOptions {fieldLabelModifier = relabel "option"}
31+
32+
instance ToJSON Failure where
33+
toJSON = genericToJSON $ defaultOptions {fieldLabelModifier = relabel "failure"}
34+
35+
instance FromJSON Option where
36+
parseJSON = genericParseJSON $ defaultOptions {fieldLabelModifier = relabel "option"}
37+
38+
instance FromJSON Failure where
39+
parseJSON = genericParseJSON $ defaultOptions {fieldLabelModifier = relabel "failure"}
40+
41+
relabel :: String -> String -> String
42+
relabel p f = maybe f (camelTo2 '_') $ stripPrefix p f

‎scripts/cabal-logs/Parse.hs‎

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
{-# LANGUAGE BangPatterns #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
4+
module Parse (parseLog) where
5+
6+
import Control.Exception (evaluate)
7+
import Data.Maybe (mapMaybe)
8+
import Data.Text (Text)
9+
import Data.Text qualified as T
10+
import Data.Text.IO qualified as T
11+
import LogResults
12+
import Text.Regex.Applicative
13+
14+
cons :: a -> [a] -> [a]
15+
!x `cons` !xs = let !y = x : xs in y
16+
17+
parseLog :: FilePath -> IO [Failure]
18+
parseLog fp = do
19+
infos <- mapMaybe findInfo . T.lines <$> T.readFile fp
20+
evaluate $ collectFailures infos
21+
22+
collectFailures :: [ReproInfo] -> [Failure]
23+
collectFailures = go
24+
where
25+
go (Seed seed : Selector sel : infs) =
26+
Failure sel seed `cons` go infs
27+
go (Selector sel : Seed seed : infs) =
28+
Failure sel seed `cons` go infs
29+
go (SelectorAndSeed sel seed : infs) =
30+
Failure sel seed `cons` go infs
31+
go (Selector sel : infs) =
32+
Failure sel def `cons` go infs
33+
go (Seed seed : infs) =
34+
Failure def seed `cons` go infs
35+
go [] = []
36+
def = Option "" ""
37+
38+
data ReproInfo
39+
= Selector !Option
40+
| Seed !Option
41+
| SelectorAndSeed !Option !Option
42+
deriving (Eq, Ord, Show)
43+
44+
findInfo :: Text -> Maybe ReproInfo
45+
findInfo = fmap fst . findLongestPrefixWithUncons T.uncons (few anySym *> reproInfo)
46+
47+
reproInfo :: RE Char ReproInfo
48+
reproInfo =
49+
asum
50+
[ Selector <$ "Use " <*> (option "-p" <* " '" <*> text <* "'")
51+
, Seed <$ "Use " <*> (option "--quickcheck-replay" <* "=\"" <*> text <* "\"")
52+
, SelectorAndSeed
53+
<$ "To rerun use: "
54+
<*> (option "--match" <* " \"" <*> text <* "\" ")
55+
<*> (option "--seed" <* " " <*> text)
56+
]
57+
where
58+
option name = Option . T.pack <$> name
59+
text = T.pack <$> few anySym

‎scripts/cabal-logs/README.md‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
# cabal-logs #
2+
3+
This project contains utilities for examining and summarizing Cabal log files.
4+
5+
## extract-failures ##
6+
7+
`extract-failures` reads the Cabal build plan file and uses it to learn the
8+
target names and log file locations of all tests within the Cabal project. It
9+
then parses any logs that exist and extracts the information needed to
10+
reproduce any failures (seed and pattern). It saves a copy of this information
11+
as JSON.
12+
13+
`extract-failures` understands the output of both Hspec- and Tasty-based tests.
14+
15+
## render-failures ##
16+
17+
`render-failures` reads a set of JSON files created by `extract-failures`,
18+
merges them, and outputs a summary in Markdown format.
19+
20+
This output is suitable for including in a GitHub job summary, so users can
21+
quickly see what failed in a CI run without having to open the log files
22+
themselves.

‎scripts/cabal-logs/cabal-logs.cabal‎

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
cabal-version: 3.0
2+
name: cabal-logs
3+
version: 0.1.0.0
4+
synopsis: Utilities for examining Cabal logs
5+
author: Neil Mayhew <neil.mayhew@iohk.io>
6+
copyright: 2026 IOG
7+
license: Apache-2.0
8+
tested-with:
9+
ghc ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.2
10+
11+
common language
12+
default-language: GHC2021
13+
14+
common warnings
15+
ghc-options:
16+
-Wall
17+
-Wcompat
18+
-Wunused-packages
19+
-Werror
20+
21+
common rts
22+
ghc-options:
23+
-threaded
24+
-rtsopts
25+
-with-rtsopts=-N
26+
27+
executable extract-failures
28+
import: language, warnings, rts
29+
main-is: extract-failures.hs
30+
other-modules:
31+
LogResults
32+
Parse
33+
34+
build-depends:
35+
aeson,
36+
base,
37+
cabal-plan,
38+
containers,
39+
directory,
40+
filepath,
41+
optparse-applicative,
42+
regex-applicative,
43+
terminal-size,
44+
text,
45+
46+
executable render-failures
47+
import: language, warnings, rts
48+
main-is: render-failures.hs
49+
other-modules:
50+
LogResults
51+
52+
build-depends:
53+
aeson,
54+
base,
55+
containers,
56+
optparse-applicative,
57+
terminal-size,
58+
text,

‎scripts/cabal-logs/cabal.project‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
packages: .

‎scripts/cabal-logs/default.nix‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
{ mkDerivation, aeson, base, bytestring, cabal-plan, containers
2+
, directory, filepath, lib, optparse-applicative, regex-applicative
3+
, terminal-size, text
4+
}:
5+
mkDerivation {
6+
pname = "cabal-logs";
7+
version = "0.1.0.0";
8+
src = ./.;
9+
isLibrary = false;
10+
isExecutable = true;
11+
executableHaskellDepends = [
12+
aeson base bytestring cabal-plan containers directory filepath
13+
optparse-applicative regex-applicative terminal-size text
14+
];
15+
description = "Utilities for examining Cabal logs";
16+
license = lib.licensesSpdx."Apache-2.0";
17+
mainProgram = "test-failures";
18+
}

‎scripts/cabal-logs/extract-failures.hs‎

Lines changed: 110 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,110 @@
1+
{-# LANGUAGE ApplicativeDo #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE RecordWildCards #-}
4+
{-# LANGUAGE TypeApplications #-}
5+
6+
import Cabal.Plan
7+
import Control.Monad (guard, unless)
8+
import Data.Aeson qualified as JSON
9+
import Data.Map.Strict qualified as Map
10+
import Data.Text qualified as T
11+
import Data.Traversable (for)
12+
import LogResults
13+
import Options.Applicative hiding (Failure)
14+
import Parse
15+
import System.Console.Terminal.Size qualified as TS
16+
import System.Directory (doesDirectoryExist, doesFileExist)
17+
import System.Exit (die)
18+
import System.FilePath ((<.>), (</>))
19+
import System.IO (hPutStrLn, stderr)
20+
21+
data Options = Options
22+
{ optVerbosity :: Int
23+
, optProjectDir :: FilePath
24+
, optOutput :: FilePath
25+
}
26+
deriving (Show)
27+
28+
main :: IO ()
29+
main = do
30+
cols <- maybe 100 TS.width <$> TS.size
31+
32+
let counter = fmap length . many . flag' ()
33+
34+
Options {..} <-
35+
customExecParser
36+
(prefs $ columns cols)
37+
( info
38+
( helper <*> do
39+
optVerbosity <-
40+
counter $
41+
help "Increase output verbosity (repeatable)"
42+
<> short 'v'
43+
<> long "verbose"
44+
optProjectDir <-
45+
strOption $
46+
help "The project directory, or a subdirectory of it"
47+
<> short 'p'
48+
<> long "project"
49+
<> metavar "DIR"
50+
<> value "."
51+
<> showDefaultWith id
52+
optOutput <-
53+
strOption $
54+
help "Write output to FILE"
55+
<> short 'o'
56+
<> long "output"
57+
<> metavar "FILE"
58+
<> value "/dev/stdout"
59+
<> showDefaultWith id
60+
pure Options {..}
61+
)
62+
(fullDesc <> header "Extract failure information from Cabal test logs")
63+
)
64+
65+
let trace n = if optVerbosity >= n then hPutStrLn stderr else const mempty
66+
67+
-- Avoid confusing behaviour from `findProjectRoot`
68+
doesDirectoryExist optProjectDir
69+
>>= (`unless` die ("Project directory " <> optProjectDir <> " doesn't exist"))
70+
71+
root <-
72+
findProjectRoot optProjectDir
73+
>>= maybe (die $ "Can't find project root in " <> optProjectDir) pure
74+
75+
plan <- findAndDecodePlanJson $ ProjectRelativeToDir root
76+
77+
let
78+
targetLogs = do
79+
-- List monad
80+
unit <- Map.elems $ pjUnits plan
81+
guard $ uType unit == UnitTypeLocal
82+
Just dir <- [uDistDir unit]
83+
comp@(CompNameTest tName) <- Map.keys (uComps unit)
84+
let
85+
pId = uPId unit
86+
PkgId pName _ = pId
87+
PkgName name = pName
88+
target = name <> ":" <> dispCompNameTarget pName comp
89+
file = dir </> "test" </> T.unpack (dispPkgId pId <> "-" <> tName) <.> "log"
90+
pure (target, file)
91+
92+
trace 1 $ show (length targetLogs) <> " Cabal targets found"
93+
94+
targetFailures <-
95+
for targetLogs $ \(target, file) -> do
96+
exists <- doesFileExist file
97+
failures <-
98+
if exists
99+
then do
100+
trace 2 $ "Examining " <> file
101+
parseLog file
102+
else
103+
pure mempty
104+
pure (target, failures)
105+
106+
let logResults = Map.fromList $ filter (not . null . snd) targetFailures
107+
108+
trace 1 $ show (Map.size logResults) <> " logs with failures found"
109+
110+
JSON.encodeFile @LogResults optOutput logResults

0 commit comments

Comments
 (0)