Skip to content

Commit

Permalink
Implement --matrix-extra for more matrix dimensions
Browse files Browse the repository at this point in the history
Sometimes you need to test your project along more dimensions than
just GHC version.  This is particularly important for
programs/libraries that use FFI to bind to libraries - they might
need to be tested against a range of library versions.

In general, you want to test all the combinations of GHC versions
and other properties, i.e. the cartesian product.  It is burdensome
for maintainers that need such a strategy to manually adjust the
matrix after every (re)generation of the CI script/spec.  Better
tool support for this scenario is warranted.

This commit implements a new --matrix-extra option, which adds
additional matrix dimensions.  The option value format is:

  --matrix-extra libfoo:2.6,3.0;libbar:0.1,0.2

haskell-ci adds all the combinations of GHC version and the
--matrix-extra fields to the matrix.  Corresponding build/test steps
can be introduced via --github-patches (or --travis-patches).

This commit implements this feature for GitHub actions only.  It can
be implemented for Travis in a subsequent commit, if desired.
  • Loading branch information
frasertweedale committed Mar 11, 2021
1 parent c76a268 commit ed550d6
Show file tree
Hide file tree
Showing 3 changed files with 55 additions and 12 deletions.
28 changes: 27 additions & 1 deletion src/HaskellCI/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,7 @@ data Config = Config
, cfgPostgres :: !Bool
, cfgGoogleChrome :: !Bool
, cfgEnv :: M.Map Version String
, cfgMatrixExtra :: M.Map String (S.Set String)
, cfgAllowFailures :: !VersionRange
, cfgLastInSeries :: !Bool
, cfgOsx :: S.Set Version
Expand Down Expand Up @@ -134,6 +135,7 @@ emptyConfig = Config
, cfgPostgres = False
, cfgGoogleChrome = False
, cfgEnv = M.empty
, cfgMatrixExtra = M.empty
, cfgAllowFailures = noVersion
, cfgLastInSeries = False
, cfgOsx = S.empty
Expand All @@ -159,7 +161,7 @@ configGrammar
, c (Identity Ubuntu)
, c (Identity Jobs)
, c (Identity CopyFields)
, c Env, c Folds, c CopyFields, c HeadVersion
, c Env, c MatrixExtra, c Folds, c CopyFields, c HeadVersion
, c (C.List C.FSep (Identity Installed) Installed)
, Applicative (g DoctestConfig)
, Applicative (g DocspecConfig)
Expand Down Expand Up @@ -228,6 +230,8 @@ configGrammar = Config
^^^ help "Add google-chrome service"
<*> C.monoidalFieldAla "env" Env (field @"cfgEnv")
^^^ metahelp "ENV" "Environment variables per job (e.g. `8.0.2:HADDOCK=false`)"
<*> C.monoidalFieldAla "matrix-extra" MatrixExtra (field @"cfgMatrixExtra")
^^^ metahelp "MATRIX" "Extra matrix dimensions (e.g. `libfoo:2.6,3.0,git`)"
<*> C.optionalFieldDefAla "allow-failures" Range (field @"cfgAllowFailures") noVersion
^^^ metahelp "JOB" "Allow failures of particular GHC version"
<*> C.booleanFieldDef "last-in-series" (field @"cfgLastInSeries") False
Expand Down Expand Up @@ -302,6 +306,28 @@ instance C.Pretty Env where
pretty (Env m) = PP.fsep . PP.punctuate PP.comma . map p . M.toList $ m where
p (v, s) = C.pretty v PP.<> PP.colon PP.<> PP.text s


-------------------------------------------------------------------------------
-- MatrixExtra
-------------------------------------------------------------------------------

newtype MatrixExtra = MatrixExtra (M.Map String (S.Set String))
deriving anyclass (C.Newtype (M.Map String (S.Set String)))

instance C.Parsec MatrixExtra where
parsec = MatrixExtra . M.fromList . toList <$> C.sepByNonEmpty p (C.char ';')
where
p = do
k <- C.munch1 (/= ':')
_ <- C.char ':'
v <- foldMap S.singleton <$> C.sepByNonEmpty (C.munch1 (`notElem` [',', ';'])) (C.char ',')
pure (k, v)

instance C.Pretty MatrixExtra where
pretty (MatrixExtra m) = PP.fsep . PP.punctuate PP.semi . map p . M.toList $ m where
p (k, v) = PP.text k PP.<> PP.colon PP.<> PP.fsep (PP.punctuate PP.comma (map PP.text (toList v)))


-------------------------------------------------------------------------------
-- From Cabal
-------------------------------------------------------------------------------
Expand Down
34 changes: 25 additions & 9 deletions src/HaskellCI/GitHub.hs
Original file line number Diff line number Diff line change
Expand Up @@ -462,15 +462,7 @@ makeGitHub _argv config@Config {..} gitconfig prj jobs@JobVersions {..} = do
, ghjContinueOnError = Just "${{ matrix.allow-failure }}"
, ghjServices = mconcat
[ Map.singleton "postgres" postgresService | cfgPostgres ]
, ghjMatrix =
[ GitHubMatrixEntry
{ ghmeGhcVersion = v
, ghmeAllowFailure =
previewGHC cfgHeadHackage compiler
|| maybeGHC False (`C.withinRange` cfgAllowFailures) compiler
}
| compiler@(GHC v) <- reverse $ toList versions
]
, ghjMatrix = matrix
})
unless (null cfgIrcChannels) $
ircJob actionName mainJobName projectName config gitconfig
Expand All @@ -487,6 +479,30 @@ makeGitHub _argv config@Config {..} gitconfig prj jobs@JobVersions {..} = do
headGhcVers :: Set CompilerVersion
headGhcVers = S.filter (previewGHC cfgHeadHackage) versions

-- extra matrix fields
matrixExtra :: [[(String, String)]]
matrixExtra =
sequence
$ (\(k, vs) -> fmap (\v -> (k, v)) (toList vs))
<$> Map.toList cfgMatrixExtra

mkMatrixEntries :: [(String, String)] -> [GitHubMatrixEntry]
mkMatrixEntries extra =
[ GitHubMatrixEntry
{ ghmeGhcVersion = v
, ghmeAllowFailure =
previewGHC cfgHeadHackage compiler
|| maybeGHC False (`C.withinRange` cfgAllowFailures) compiler
, ghmeMatrixExtra = extra
}
| compiler@(GHC v) <- reverse $ toList versions
]

matrix :: [GitHubMatrixEntry]
matrix = case matrixExtra of
[] -> mkMatrixEntries []
xs -> xs >>= mkMatrixEntries

-- step primitives
githubRun' :: String -> Map.Map String String -> ShM () -> ListBuilder (Either ShError GitHubStep) ()
githubRun' name env shm = item $ do
Expand Down
5 changes: 3 additions & 2 deletions src/HaskellCI/GitHub/Yaml.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,7 @@ data GitHubJob = GitHubJob
data GitHubMatrixEntry = GitHubMatrixEntry
{ ghmeGhcVersion :: Version
, ghmeAllowFailure :: Bool
, ghmeMatrixExtra :: [(String, String)]
}
deriving (Show)

Expand Down Expand Up @@ -123,10 +124,10 @@ instance ToYaml GitHubJob where
item $ "steps" ~> ylistFilt [] (map toYaml $ filter notEmptyStep ghjSteps)

instance ToYaml GitHubMatrixEntry where
toYaml GitHubMatrixEntry {..} = ykeyValuesFilt []
toYaml GitHubMatrixEntry {..} = ykeyValuesFilt [] $
[ "ghc" ~> fromString (prettyShow ghmeGhcVersion)
, "allow-failure" ~> toYaml ghmeAllowFailure
]
] ++ fmap (\(k, v) -> k ~> fromString v) ghmeMatrixExtra

instance ToYaml GitHubStep where
toYaml GitHubStep {..} = ykeyValuesFilt [] $
Expand Down

0 comments on commit ed550d6

Please sign in to comment.