Add support for expecting some packages to fail

This adds a `--expect-broken` option to the CI driver executable along
with a simple shell script containing the list of packages which we
expect to fail for a given GHC version.

.gitlab-ci.yml

@@ -93,6 +93,9 @@ build-8.8:
       --out-link ghc \
       ghcHEAD
     - GHC=`pwd`/ghc/bin/ghc
+    - |
+      source ci/broken-packages.sh
+      EXTRA_OPTS="$EXTRA_OPTS $BROKEN_ARGS"
     - rm -Rf $HOME/.cabal/pacakages/local tmp; mkdir -p tmp; cd tmp
     - |
       EXTRA_OPTS="--cabal-option=-j$CPUS" # Use cabal's build parallelism

ci/TestPatches.hs

 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 
 module TestPatches
   ( testPatches
@@ -45,6 +46,12 @@ import Types
 import MakeConstraints
 import Utils
 
+newtype BrokenPackages = BrokenPackages { getBrokenPackageNames :: S.Set PkgName }
+  deriving (Semigroup, Monoid)
+
+failureExpected :: BrokenPackages -> PkgName -> Bool
+failureExpected (BrokenPackages pkgs) name = name `S.member` pkgs
+
 data Config = Config { configPatchDir :: FilePath
                      , configCompiler :: FilePath
                      , configGhcOptions :: [String]
@@ -52,6 +59,7 @@ data Config = Config { configPatchDir :: FilePath
                      , configOnlyPackages :: Maybe (S.Set Cabal.PackageName)
                      , configConcurrency :: Int
                      , configExtraCabalFragments :: [FilePath]
+                     , configExpectedBrokenPkgs :: BrokenPackages
                      }
 
 cabalOptions :: Config -> [String]
@@ -70,6 +78,7 @@ config =
     <*> onlyPackages
     <*> concurrency
     <*> extraCabalFragments
+    <*> expectedBrokenPkgs
   where
     patchDir = option str (short 'p' <> long "patches" <> help "patch directory" <> value "./patches")
     compiler = option str (short 'w' <> long "with-compiler" <> help "path of compiler")
@@ -80,6 +89,11 @@ config =
       <|> pure Nothing
     concurrency = option auto (short 'j' <> long "concurrency" <> value 1 <> help "number of concurrent builds")
     extraCabalFragments = many $ option str (long "extra-cabal-fragment" <> help "path of extra configuration to include in cabal project files")
+    expectedBrokenPkgs =
+      fmap (BrokenPackages . S.fromList) $ many
+      $ option
+          (fmap toPkgName pkgName)
+          (short 'b' <> long "expect-broken" <> metavar "PKGNAME" <> help "expect the given package to fail to build")
 
     pkgName :: ReadM Cabal.PackageName
     pkgName = str >>= maybe (fail "invalid package name") pure . simpleParse
@@ -106,14 +120,17 @@ testPatches cfg = do
   testedPatches <- fold <$> mapConcurrentlyN (fromIntegral $ configConcurrency cfg) build (S.toList packages')
   let runResult = RunResult testedPatches
 
-  print $ resultSummary runResult
+  print $ resultSummary (configExpectedBrokenPkgs cfg) runResult
   BSL.writeFile "results.json" $ encode runResult
-  exitWith $ if anyFailures runResult then ExitFailure 1 else ExitSuccess
+  exitWith $ if anyFailures (configExpectedBrokenPkgs cfg) runResult then ExitFailure 1 else ExitSuccess
 
-anyFailures :: RunResult -> Bool
-anyFailures (RunResult testedPatches) =
-    any patchFailed testedPatches
+anyFailures :: BrokenPackages -> RunResult -> Bool
+anyFailures broken (RunResult testedPatches) =
+    any failed testedPatches
   where
+    failed tp =
+      patchFailed tp /= failureExpected broken (patchedPackageName tp)
+
     patchFailed :: TestedPatch -> Bool
     patchFailed tp =
       case patchedPackageResult tp of
@@ -121,17 +138,21 @@ anyFailures (RunResult testedPatches) =
         PackageResult False _ -> True
         _ -> False
 
-resultSummary :: RunResult -> Doc
-resultSummary runResult = vcat
+resultSummary :: BrokenPackages -> RunResult -> Doc
+resultSummary broken runResult = vcat
   [ "Total units built:" <+> pshow (length allUnits)
   , ""
   , pshow (length planningErrors) <+> "had no valid install plan:"
   , PP.indent 4 $ vcat $ map (uncurry prettyPkgVer) planningErrors
   , ""
   , pshow (length failedUnits) <+> "units failed to build:"
-  , PP.indent 4 $ vcat [ prettyPkgVer (pkgName binfo) (version binfo)
-                     | (binfo, _) <- M.elems failedUnits
-                     ]
+  , PP.indent 4 $ vcat
+    [ prettyPkgVer (pkgName binfo) (version binfo) <+> expectedDoc
+    | (binfo, _) <- M.elems failedUnits
+    , let expectedDoc
+            | failureExpected broken (pkgName binfo) = PP.parens $ PP.yellow $ PP.text "expected"
+            | otherwise = mempty
+    ]
   , ""
   , pshow (length failedDependsUnits) <+> "units failed to build due to unbuildable dependencies."
   ]

ci/broken-packages.sh

+# vi: set filetype=sh
+
+# Packages expected not to build due to GHC bugs. This is `source`'d by the CI
+# script and the arguments in BROKEN_ARGS are added to the hackage-ci
+# command-line.
+
+# Mark the named package as broken.
+#
+# Usage:
+#    broken $pkg_name $ghc_ticket_number
+#
+function broken() {
+  pkg_name="$1"
+  ticket="$2"
+  echo "Marking $pkg_name as broken due to #$ticket"
+  BROKEN_ARGS="$BROKEN_ARGS --expect-broken=$pkg_name"
+}
+
+if [ -z "$GHC" ]; then GHC=ghc; fi
+
+function ghc_version() {
+  $GHC --version | sed 's/.*version \([0-9]*\.\([0-9]*\.\)*\)/\1/'
+}
+
+# ======================================================================
+# The lists begin here
+#
+# For instance:
+#
+#    broken "lens" 17988
+
+version="$(ghc_version)"
+case $version in
+  8.8.*)
+    ;;
+
+  8.9.*)
+    #       package             ticket
+    broken "singletons"         17405
+    broken "vinyl"              17405
+    ;;
+
+  *)
+    echo "No broken packages for GHC $version"
+    ;;
+esac