cabal-matrix 1.0.1.0 → 1.0.2.0

raw patch · 8 files changed

+464/−93 lines, 8 filesdep ~aesondep ~basedep ~vtyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, base, vty, vty-crossplatform

API changes (from Hackage documentation)

Files

• CHANGELOG.md +21/−0
• README.md +46/−12
• cabal-matrix.cabal +1/−1
• src/Cabal/Matrix/CabalArgs.hs +194/−5
• src/Cabal/Matrix/Cli.hs +63/−9
• src/Cabal/Matrix/Files.hs +47/−2
• src/Cabal/Matrix/Matrix.hs +25/−17
• src/Cabal/Matrix/Scheduler.hs +67/−47

@@ -1,3 +1,24 @@+# 1.0.2.0++- `--blank-project` is a new mode for building packages directly from hackage,+  and is a much faster alternative to `--install-lib`. It works by creating a+  temporary `cabal.project` file, whose contents are simply+  ```+  extra-packages: target1, target2, ...+  ```+  This causes `target1`... to be interpreted as simultaneously a package to be+  downloaded from hackage, and a package to be considered local, i.e. included+  in the "build" step and excluded from the "deps" step.+- `--constraints` is a new option for specifying build constraints. It allows+  specifying one or more constraints on package versions with+  `--constraints "foo >1 , bar <2"`. It also allows specifying implication+  constraints such as `--constraints "foo >1 :- bar <2"` e.g. as if all versions+  `foo >1` were revised to include a `bar <2` constraint. More generally it+  allows specifying disjunction constraints separated with `;`, such as+  `--constraints "foo >1 ; bar <2 ; baz ==3"`. Disjunction/implication+  constraints are translated to constraints guarded behind automatic cabal+  flags.+ # 1.0.1.0  - Binary operator options can now be parsed/formatted as JSON in a more compact

@@ -42,7 +42,7 @@ figure this out, we can simply try building our package with each version of `bytestring` and see if it works or not! This can be achieved by running: ```sh-cabal-matrix -j1 foo --package bytestring=">= 0"+cabal-matrix -j1 foo --package bytestring ```  This may take a while to complete, and you can try using a higher value of `-j`@@ -90,7 +90,7 @@ ```sh cabal-matrix -j1 foo --package bytestring=">=0.11.4 && <0.13" ```-You could even run the same command as before (`bytestring=">= 0"`), but this+You could even run the same command as before (`--package bytestring`), but this will save time (and table space!) by not focusing on configurations that are definitely outside the possible range. @@ -221,32 +221,31 @@  You could run e.g.: ```sh-cabal-matrix -j1 text --package text=">=0" --times --package bytestring=">=0"+cabal-matrix -j1 text --package text --times --package bytestring ``` to try every `text` version against every `bytestring` version. However if you're running this from your project folder, then the constraints coming from your project's packages will prevent some versions from being available, possibly masking some `build fail`s as `no plan`s. -Instead you can move out of your project folder into a temporary directory, and-use `--install-lib`:+Instead you can ask `cabal-matrix` to create a blank project for building `text`+using `--blank-project`: ```sh-cd /tmp-cabal-matrix -j1 --install-lib text \-  --package text=">=0" --times --package bytestring=">=0"+cabal-matrix -j1 --blank-project text \+  --package text --times --package bytestring ```  For a typical yet concrete example, we can time travel to the past using `--option --index-state=2025-10-01T00:00:00Z`, and try building `tar` against `directory`: ```sh-cabal-matrix -j1 --install-lib tar \+cabal-matrix -j1 --blank-project tar \   --option --index-state=2025-10-01T00:00:00Z \   --compiler ghc-9.2.8 \   --times \-  --package tar='>=0.6' \+  --package tar=">=0.6" \   --times \-  --package directory='>=1.3'+  --package directory=">=1.3" ```  There is a clear cut corner of `build fail`s at `tar >=0.6.4` and@@ -299,7 +298,7 @@ can/should be relaxed, you can forward (using `--option`) `--allow-newer` and `--allow-older` to cabal: ```sh-cabal-matrix -j1 foo --package bytestring=">= 0" \+cabal-matrix -j1 foo --package bytestring \   --option --allow-newer=foo:bytestring --option --allow-older=foo:bytestring ``` This will tell cabal to ignore the `build-depends` constraints that your package@@ -311,3 +310,38 @@ relaxed to include those. Finally, some `no plan`s may remain as such, meaning the configuration was excluded for some other reason. You can read the `no plan` output to find out in more detail.++# Validating Hackage Revisions++If you have a hackage revision that you would like to apply, you can see how it+would affect the build plans by using a `--constraints` option with an+implication constraint. If as in the above example, we would like to revise+`tar >=0.6.4.0 && <=0.7.0.0` to tighten the bound on `directory` to `>=1.3.8`,+we can do so with:+```sh+cabal-matrix -j1 --blank-project tar \+  --option --index-state=2025-10-01T00:00:00Z \+  --compiler ghc-9.2.8 \+  --times \+  --package tar=">=0.6" \+  --times \+  --package directory=">=1.3" \+  --times \+  --constraints "tar >=0.6.4.0 && <=0.7.0.0 :- directory >=1.3.8"+```++Note that `--constraints` acts as a singleton list, so it needs to be+`--times`'ed with the rest of the build matrix. This allows, if necessary, to+apply different fixes to different parts of the build matrix.++This implication constraint will work even when we're not directly enumerating+every `tar` or `directory` version, and even when neither of them is our build+target. So if you're trying to build your package `foo`, and encouter a+`deps fail` because of e.g. `tar`/`directory`, after figuring out which versions+of `tar` and `directory` are conflicting, you can get back to building your+`foo` package by adding the same+`--constraints "tar >=0.6.4.0 && <=0.7.0.0 :- directory >=1.3.8"` option to your+build.++Note that there's currently no easy way to preview a revision that *relaxes* a+constraint.

@@ -1,6 +1,6 @@ cabal-version:   3.0 name:            cabal-matrix-version:         1.0.1.0+version:         1.0.2.0 author:          mniip maintainer:      mniip license:         BSD-3-Clause

@@ -1,4 +1,6 @@ -- | Converting high-level build matrix concepts into @cabal@ commandlines.+-- Some instructions cannot be passed via the command line, and instead have to+-- be passed through a temporary @cabal.project@ file. module Cabal.Matrix.CabalArgs   ( CabalArgs(..)   , CabalStep(..)@@ -9,18 +11,34 @@   , setCabalStep   , CabalMode(..)   , Flavor(..)+  , Conjunction(..)+  , Disjunction(..)+  , Constraint(..)   , renderCabalArgs-  , environmentFilePath+  , UserProjectFiles+  , detectUserProjectFiles+  , prepareFilesForCabal   ) where +import Control.Exception.Safe+import Control.Monad+import Data.Either+import Data.Foldable+import Data.Functor import Data.Hashable import Data.List.NonEmpty (NonEmpty(..))+import Data.List.NonEmpty qualified as NonEmpty import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text+import Data.Text.IO qualified as Text+import Distribution.Package+import Distribution.Pretty+import Distribution.Version import GHC.Generics import System.FilePath+import System.Directory   -- | Cabal allows interrupting the build process at multiple points, which is@@ -88,32 +106,69 @@ data CabalMode   = ProjectBuild -- | Assume that we're in a cabal project and run @cabal build@     -- targeting the project's packages and their dependencies.+  | BlankProjectBuild -- | Create a temporary cabal project containing the+    -- targets as @extra-packages@ (meaning they are considered local packages,+    -- not included in 'OnlyDependencies') and run @cabal build@ with that+    -- project. This is a much faster alternative to 'InstallLib', because cabal+    -- doesn't need to read the installed package store.   | InstallLib -- | Use @cabal install --lib@, which doesn't require to be in a     -- cabal project. If we are in a project, the project's packages will be     -- sdisted first.+  deriving stock (Eq) +data Constraint = Constraint+  { package :: PackageName+  , versions :: VersionRange+  } deriving stock (Eq, Show, Generic)++-- Cabal-syntax 3.8 doesn't have @Ord Constraint@+instance Ord Constraint where+  compare c1 c2 = compare c1.package c2.package+    <> compare (prettyShow c1.versions) (prettyShow c2.versions)++instance Hashable Constraint where+  hashWithSalt salt constr = salt+    `hashWithSalt` unPackageName constr.package+    `hashWithSalt` prettyShow constr.versions++-- | All of these must be satisfied.+newtype Conjunction a = Conjunction { unConjunction :: Set a }+  deriving newtype (Eq, Ord, Hashable)+  deriving stock (Show)++-- | Any of these must be satisfied. To specify a disjunction of cabal+-- constraints we have to express them as cabal flags on a fake package.+newtype Disjunction a = Disjunction { unDisjunction :: Set a }+  deriving newtype (Eq, Ord, Hashable)+  deriving stock (Show)+ -- | Options defining what cell in the build matrix we're in. data Flavor = Flavor-  { unorderedOptions :: Set Text+  { constraints :: Conjunction (Disjunction (Conjunction Constraint))+  , unorderedOptions :: Set Text   , orderedOptions :: [Text]   } deriving stock (Eq, Show, Generic)     deriving anyclass (Hashable)  instance Semigroup Flavor where   f1 <> f2 = Flavor-    { unorderedOptions = Set.union f1.unorderedOptions f2.unorderedOptions+    { constraints = Conjunction+      $ Set.union f1.constraints.unConjunction f2.constraints.unConjunction+    , unorderedOptions = Set.union f1.unorderedOptions f2.unorderedOptions     , orderedOptions = f1.orderedOptions ++ f2.orderedOptions     }  instance Monoid Flavor where   mempty = Flavor-    { unorderedOptions = Set.empty+    { constraints = Conjunction Set.empty+    , unorderedOptions = Set.empty     , orderedOptions = []     }  -- | A single invocation of @cabal@. data CabalArgs = CabalArgs   { cabalExecutable :: FilePath+  , userProjectFiles :: UserProjectFiles   , mode :: CabalMode   , step :: CabalStep   , options :: [Text]@@ -127,6 +182,8 @@     -- ^ @--builddir@, where build artifacts will be placed. Different     -- flavors using the same compiler must use different 'buildDir'.   , mode :: CabalMode+  , projectFile :: Maybe FilePath+    -- ^ A project file to use with @cabal build@.   , envFile :: Maybe FilePath     -- ^ An environment file to use with @install --lib@. The file needs to not     -- yet exist, so that its contents don't conflict with the install plan, but@@ -141,7 +198,11 @@ renderRawCabalArgs ca = "cabal" :| mconcat   [ case ca.mode of     ProjectBuild -> ["build"]+    BlankProjectBuild -> ["build"]     InstallLib -> ["install", "--lib"]+  , case ca.projectFile of+    Nothing -> []+    Just path -> ["--project-file", Text.pack path]   , case ca.envFile of     Nothing -> []     Just path -> ["--package-env", Text.pack path]@@ -162,14 +223,18 @@   , buildDir = buildDirFor flavor   , mode   , envFile = environmentFilePath args+  , projectFile = fst . (.projectFile) <$> mProjectFile   , step   , options = concat     [ options     , Set.toList flavor.unorderedOptions+    , projectArgs     , flavor.orderedOptions     ]   , targets   }+  where+    (projectArgs, mProjectFile) = projectOrArgs args  -- TODO: there probably needs to be some mechanism to clean up these at some -- point.@@ -180,7 +245,131 @@ renderCabalArgs :: CabalArgs -> NonEmpty Text renderCabalArgs = renderRawCabalArgs . argsToRaw +data ProjectData = ProjectData+  { projectFile :: (FilePath, Text)+  , auxCabalFile :: Maybe (FilePath, Text)+  }++-- | Do we need a project file, or will some CLI args suffice?+projectOrArgs :: CabalArgs -> ([Text], Maybe ProjectData)+projectOrArgs args =+  ( cliConstraints+  , guard (args.mode == BlankProjectBuild || needAuxCabalFile)+    >> Just ProjectData+      { projectFile = (projectFile, projectFileContents)+      , auxCabalFile = guard needAuxCabalFile >> Just+        ( auxCabalFile+        , auxCabalFileContents+        )+      }+  )+  where+    (Set.unions -> simpleConstraints, complexConstraints) = partitionEithers+      $ Set.toList args.flavor.constraints.unConjunction <&> \disj+        -> case NonEmpty.nonEmpty $ Set.toList disj.unDisjunction of+          Nothing -> Left $ Set.singleton Constraint+            { package = "base"+            , versions = noVersion+            } -- An empty disjunction is an unsatisfiable constraint.+          Just (conj :| []) -> Left conj.unConjunction+          Just conjs -> Right conjs++    cliConstraints =+      [ "--constraint=" <> Text.pack (unPackageName package)+        <> Text.pack (prettyShow versions)+      | Constraint{ package, versions } <- Set.toList simpleConstraints+      ]++    needAuxCabalFile = not $ null complexConstraints++    projectFile = buildDirFor args.flavor </> "cabal.project"+    projectFileContents = Text.unlines $+      [ "import: " <> Text.pack userProjectFile+      | args.mode /= BlankProjectBuild+      , userProjectFile <- args.userProjectFiles.unUserProjectFiles+      ] <>+      [ "extra-packages: " <> Text.intercalate ", " args.targets+      | args.mode == BlankProjectBuild+      ] <>+      [ "packages: " <> Text.pack auxCabalFile+      | needAuxCabalFile+      ]++    auxCabalFile = buildDirFor args.flavor+      </> "cabal-matrix-constraints-fake-package.cabal"+    (flags, buildDepends) = complexConstraintsToFlags complexConstraints+    auxCabalFileContents = Text.unlines $+      [ "cabal-version: >=1.8"+      , "name: cabal-matrix-constraints-fake-package"+      , "version: 0"+      , "build-type: Simple"+      ] <>+      [ "flag " <> flag <> " {}"+      | flag <- flags+      ] <>+      [ "library"+      ] <>+      buildDepends++complexConstraintsToFlags+  :: [NonEmpty (Conjunction Constraint)] -> ([Text], [Text])+complexConstraintsToFlags complexConstraints =+  ( [ flag i j+    | (i, conjs) <- zip [0..] complexConstraints+    , j <- [1 .. NonEmpty.length conjs - 1]+    ]+  , concat $ zipWith (goDisj 1 1) [0..] complexConstraints+  )+  where+    goDisj !indent !_j !_i (conj :| []) = goConj indent conj+    goDisj indent j i (conj :| conj' : conjs) =+      [ Text.replicate indent "  " <> "if flag(" <> flag i j <> ") {"+      ] <> goConj (indent + 1) conj <>+      [ Text.replicate indent "  " <> "} else {"+      ] <> goDisj (indent + 1) (j + 1) i (conj' :| conjs) <>+      [ Text.replicate indent "  " <> "}"+      ]++    goConj !indent (Conjunction constrs) =+      [ Text.replicate indent "  " <> "build-depends:"+        <> Text.intercalate ", "+        [ Text.pack $ prettyShow constr.package <> prettyShow constr.versions+        | constr <- Set.toList constrs+        ]+      ]++    flag :: Int -> Int -> Text+    flag i j = "cabal-matrix-disjunction-"+      <> Text.pack (show i) <> "-" <> Text.pack (show j)+ environmentFilePath :: CabalArgs -> Maybe FilePath environmentFilePath CabalArgs{..} = case mode of-  ProjectBuild -> Nothing   InstallLib -> Just $ buildDirFor flavor </> "env"+  ProjectBuild -> Nothing+  BlankProjectBuild -> Nothing++newtype UserProjectFiles = UserProjectFiles { unUserProjectFiles :: [FilePath] }++detectUserProjectFiles :: IO UserProjectFiles+detectUserProjectFiles = UserProjectFiles <$> (getCurrentDirectory >>= go)+  where+    go dir = doesFileExist projectFile >>= \case+      False -> if takeDirectory dir /= dir+        then go $ takeDirectory dir+        else pure []+      True -> (projectFile:) <$> filterM doesFileExist [localFile, freezeFile]+      where+        projectFile = dir </> "cabal.project"+        localFile = dir </> "cabal.project.local"+        freezeFile = dir </> "cabal.project.freeze"++prepareFilesForCabal :: CabalArgs -> IO ()+prepareFilesForCabal args = do+  for_ (snd $ projectOrArgs args) \project -> do+    createDirectoryIfMissing True $ takeDirectory $ fst project.projectFile+    uncurry Text.writeFile project.projectFile+    for_ project.auxCabalFile \auxCabalFile -> do+      createDirectoryIfMissing True $ takeDirectory $ fst auxCabalFile+      uncurry Text.writeFile auxCabalFile+  for_ (environmentFilePath args) \environmentFile -> do+    void $ try @_ @IOError $ removeFile environmentFile

@@ -14,11 +14,15 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Data.Char+import Data.Functor+import Data.List.NonEmpty qualified as NonEmpty import Data.List.Split import Data.Maybe+import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as Text import Data.Traversable+import Distribution.Compat.CharParsing (sepByNonEmpty, spaces, string, try) import Distribution.Package import Distribution.Parsec import Distribution.Version@@ -46,6 +50,7 @@   cabalExecutable <- case cabalOverride of     Just override -> pure override     Nothing -> fromMaybe "cabal" <$> lookupEnv "CABAL"+  userProjectFiles <- detectUserProjectFiles   pure SchedulerConfig{..}  data CliOptions@@ -184,9 +189,15 @@   <*> targetsOptions   <*> modeOption   where-    modeOption = flag ProjectBuild InstallLib (long "install-lib"-      <> help "Use cabal install --lib instead of cabal build, allowing \-        \targeting libraries directly from hackage, without a local project")+    modeOption+      = flag' BlankProjectBuild (long "blank-project"+        <> help "Create a blank project for the build, with the given targets \+          \specified as extra-packages, allowing targeting libraries directly \+          \from hackage"  )+      <|> flag' InstallLib (long "install-lib"+        <> help "Use cabal install --lib instead of cabal build instead of \+          \using a local project")+      <|> pure ProjectBuild     jobsOption = option auto (long "jobs" <> short 'j' <> metavar "N"       <> help "How many instances of cabal to run concurrently")     optionsOptions = many $ option str (long "option" <> metavar "--OPTION"@@ -306,6 +317,14 @@             <> help "A single build with the provided options, for options \               \that are order-sensitive. The provided options are appended \               \after all other options.")+        , Expr "--constraints" . ConstraintsExpr+          <$> option readConstraints+          (long "constraints" <> metavar "CONSTRAINTS"+            <> help "Specify constraints to use in the build. A basic \+            \constraint consists of a package name and a version range, such \+            \as 'foo >=1.0 && <2.0'. Constraints can be AND-ed with ',' and \+            \OR-ed with ';'. An implication constraint can be specified as \+            \'ANTECEDENT :- CONSEQUENT'.")         ]       , flag' OpenParen         (long "[" <> style (\_ -> "--[ LIST --]")@@ -317,10 +336,10 @@  readCompilers :: ReadM [Compiler] readCompilers-  = map Compiler . filter (not . null) <$> commaSeparated (strip <$> str)+  = map Compiler . filter (not . null) <$> separatedBy "," (strip <$> str)  readPrefer :: ReadM [Prefer]-readPrefer = commaSeparated $ maybeReader \(map toLower . strip -> s) -> if+readPrefer = separatedBy "," $ maybeReader \(map toLower . strip -> s) -> if   | s `elem` ["newest", "newer", "new"] -> Just PreferNewest   | s `elem` ["oldest", "older", "old"] -> Just PreferOldest   | otherwise -> Nothing@@ -331,7 +350,7 @@   if '=' `elem` s   then byEquals     (mkPackageName . strip <$> str)-    (SomeVersions <$> commaSeparated versionOrRange)+    (SomeVersions <$> separatedBy "," versionOrRange)   else ((, AllVersions) . mkPackageName . strip <$> str)   where     versionOrRange = ReadM $ ReaderT \s -> case eitherParsec @Version s of@@ -344,15 +363,50 @@ readCustom :: ReadM (Text, [Text]) readCustom = byEquals   (Text.strip <$> str)-  (filter (not . Text.null) <$> commaSeparated (Text.strip <$> str))+  (filter (not . Text.null) <$> separatedBy "," (Text.strip <$> str)) +readConstraints :: ReadM (Disjunction (Conjunction Constraint))+readConstraints = ReadM $ ReaderT \s -> case explicitEitherParsec impl s of+  Right constr -> pure constr+  Left err -> throwE $ ErrorMsg $ "Expected package names followed by version \+    \constraints, separated by \",\", \";\", and \":-\": " <> err+  where+    atom = (\package versions -> Constraint{..})+      <$> (spaces *> parsec @PackageName)+      <*> (spaces *> try (parsec @VersionRange))+    term = sepByNonEmpty atom (spaces *> string ",")+      <&> \as -> Conjunction $ Set.fromList $ NonEmpty.toList as+    expr = sepByNonEmpty term (spaces *> string ";")+      <&> \ts -> Disjunction $ Set.fromList $ NonEmpty.toList ts+    impl = try (mkImplication <$> term <*> (spaces *> string ":-" *> expr))+      <|> expr++    mkImplication (Conjunction constrs) (Disjunction disj)+      = Disjunction $ Set.map invertConstr constrs `Set.union` disj+    invertConstr Constraint{ package, versions }+      = Conjunction $ Set.singleton Constraint+        { package+        , versions = flip cataVersionRange versions \case+          ThisVersionF ver -> notThisVersion ver+          LaterVersionF ver -> orEarlierVersion ver+          OrLaterVersionF ver -> earlierVersion ver+          EarlierVersionF ver -> orLaterVersion ver+          OrEarlierVersionF ver -> laterVersion ver+          MajorBoundVersionF ver -> unionVersionRanges+            (earlierVersion ver)+            (orLaterVersion $ majorUpperBound ver)+          UnionVersionRangesF vs1 vs2 -> intersectVersionRanges vs1 vs2+          IntersectVersionRangesF vs1 vs2 -> unionVersionRanges vs1 vs2+        }+ byEquals :: ReadM a -> ReadM b -> ReadM (a, b) byEquals (ReadM (ReaderT pk)) (ReadM (ReaderT pv)) = ReadM $ ReaderT \s -> if   | (prefix, _:suffix) <- break (=='=') s -> (,) <$> pk prefix <*> pv suffix   | otherwise -> throwE $ ErrorMsg "Expected key=value pair" -commaSeparated :: ReadM a -> ReadM [a]-commaSeparated (ReadM (ReaderT p)) = ReadM $ ReaderT \s -> for (splitOn "," s) p+separatedBy :: String -> ReadM a -> ReadM [a]+separatedBy separator (ReadM (ReaderT p))+  = ReadM $ ReaderT \s -> for (splitOn separator s) p  strip :: String -> String strip = Text.unpack . Text.strip . Text.pack

@@ -61,6 +61,23 @@         Left err2 -> fail $ unlines           ["Expected a version or a version range: ", err1, err2] +newtype ConstraintJSON = ConstraintJSON Constraint++instance ToJSON ConstraintJSON where+  toJSON (ConstraintJSON constr) = object+    [ "package" .= unPackageName constr.package+    , "versions" .= prettyShow constr.versions+    ]++instance FromJSON ConstraintJSON where+  parseJSON = withObject "Constraint" \o -> do+    package <- mkPackageName <$> o .: "package"+    versions <- explicitParseField parseVersion o "versions"+    pure $ ConstraintJSON Constraint{..}+    where+      parseVersion = withText "Version" \txt -> do+        either fail pure $ eitherParsec @VersionRange $ Text.unpack txt+ newtype MatrixExprJSON = MatrixExprJSON MatrixExpr  instance ToJSON MatrixExprJSON where@@ -94,6 +111,12 @@           [ "custom_ordered" .= key           , "options" .= toJSON options           ]+        ConstraintsExpr disj -> object+          [ "constraints" .=+            [ [ConstraintJSON constr | constr <- Set.toList conj.unConjunction]+            | conj <- Set.toList disj.unDisjunction+            ]+          ]       goTimes (TimesExpr x y) ys = goTimes x (MatrixExprJSON y : ys)       goTimes y xs = object         [ "times" .= toJSON (MatrixExprJSON y : xs)@@ -147,12 +170,18 @@           Just options -> pure $ Just $ CustomOrderedExpr key options           Nothing -> fail             "Expected \"custom_ordered\" to be accompanied by \"options\""+      , (o .:? "constraints") <&> fmap @Maybe \disj+        -> ConstraintsExpr $ Disjunction $ Set.fromList+          [ Conjunction $ Set.fromList+            [constr | ConstraintJSON constr <- conj]+          | conj <- disj+          ]       ]     case catMaybes parses of       [x] -> pure $ MatrixExprJSON x       _ -> fail "Expected exactly one of: \"times\", \"add\", \"subtract\", \         \\"seq\", \"compilers\", \"prefer\", \"package\", \-        \\"custom_unordered\", \"custom_ordered\""+        \\"custom_unordered\", \"custom_ordered\", \"constraints\""   parseJSON v = typeMismatch "Object or String" v  writeExprFile :: FilePath -> MatrixExpr -> IO ()@@ -167,13 +196,29 @@  instance ToJSON MatrixRowJSON where   toJSON (MatrixRowJSON (flavor, row)) = object-    [ "ordered_options" .= flavor.orderedOptions+    [ "constraints" .=+      [ [ [ConstraintJSON constr | constr <- Set.toList conj.unConjunction]+        | conj <- Set.toList disj.unDisjunction+        ]+      | disj <- Set.toList flavor.constraints.unConjunction+      ]+    , "ordered_options" .= flavor.orderedOptions     , "unordered_options" .= flavor.unorderedOptions     , "flavor" .= row     ]  instance FromJSON MatrixRowJSON where   parseJSON = withObject "MatrixRow" \o -> do+    mConstraints <- o .:? "constraints"+    let+      constraints = Conjunction $ Set.fromList+        [ Disjunction $ Set.fromList+          [ Conjunction $ Set.fromList+            [constr | ConstraintJSON constr <- conj]+          | conj <- disj+          ]+        | disj <- fromMaybe [] mConstraints+        ]     orderedOptions <- o .: "ordered_options"     unorderedOptions <- o .: "unordered_options"     flavor <- o .: "flavor"

@@ -46,9 +46,8 @@  compilersMatrix :: [Compiler] -> Matrix compilersMatrix compilers = Rectangle.vertical "COMPILER"-  [ ( Flavor+  [ ( mempty       { unorderedOptions = Set.singleton ("--with-compiler=" <> compiler)-      , orderedOptions = []       }     , Just compiler     )@@ -60,11 +59,10 @@  preferMatrix :: [Prefer] -> Matrix preferMatrix values = Rectangle.vertical "PREFER"-  [ ( Flavor+  [ ( mempty       { unorderedOptions = if value == PreferOldest         then Set.singleton "--prefer-oldest"         else Set.empty-      , orderedOptions = []       }     , Just case value of       PreferOldest -> "oldest"@@ -74,23 +72,25 @@   ]  packageVersionMatrix :: PackageName -> [Version] -> Matrix-packageVersionMatrix (Text.pack . unPackageName -> package) versions-  = Rectangle.vertical package-    [ ( Flavor-        { unorderedOptions = Set.singleton-          $ "--constraint=" <> package <> "==" <> version-        , orderedOptions = []+packageVersionMatrix package versions+  = Rectangle.vertical (Text.pack $ unPackageName package)+    [ ( mempty+        { constraints = Conjunction $ Set.singleton+          $ Disjunction $ Set.singleton $ Conjunction $ Set.singleton+          $ Constraint+            { package+            , versions = thisVersion version+            }         }-      , Just version+      , Just $ Text.pack $ prettyShow version       )-    | version <- Text.pack . prettyShow <$> versions+    | version <- versions     ]  customUnorderedOptions :: Text -> [Text] -> Matrix customUnorderedOptions name options = Rectangle.vertical name-  [ ( Flavor+  [ ( mempty       { unorderedOptions = Set.fromList options-      , orderedOptions = []       }     , Just $ Text.unwords options     )@@ -98,14 +98,18 @@  customOrderedOptions :: Text -> [Text] -> Matrix customOrderedOptions name options = Rectangle.vertical name-  [ ( Flavor-      { unorderedOptions = Set.empty-      , orderedOptions = options+  [ ( mempty+      { orderedOptions = options       }     , Just $ Text.unwords options     )   ] +constraintsMatrix :: Disjunction (Conjunction Constraint) -> Matrix+constraintsMatrix disj = Rectangle.unitRow $ mempty+  { constraints = Conjunction $ Set.singleton disj+  }+ data VersionExpr   = AllVersions   | SomeVersions [Either Version VersionRange]@@ -124,6 +128,7 @@   | PackageVersionExpr PackageName VersionExpr   | CustomUnorderedExpr Text [Text]   | CustomOrderedExpr Text [Text]+  | ConstraintsExpr (Disjunction (Conjunction Constraint))  -- | Evaluating the build matrix expression may require access to the source -- package DB, but if it doesn't, we'd like to avoid loading it.@@ -176,6 +181,8 @@         -> EvalPure $ customUnorderedOptions name values       CustomOrderedExpr name values         -> EvalPure $ customOrderedOptions name values+      ConstraintsExpr disjs+        -> EvalPure $ constraintsMatrix disjs  resolveMatrixExpr :: MatrixExpr -> IO MatrixExpr resolveMatrixExpr = runEvalM . go@@ -193,3 +200,4 @@           <$> evalVersionRanges package versions       e@(CustomUnorderedExpr _ _) -> pure e       e@(CustomOrderedExpr _ _) -> pure e+      e@(ConstraintsExpr _) -> pure e

@@ -21,10 +21,8 @@ import Cabal.Matrix.CabalArgs import Cabal.Matrix.ProcessRunner import Control.Concurrent-import Control.Exception.Safe import Control.Monad import Data.ByteString (ByteString)-import Data.Foldable import Data.List import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map@@ -32,7 +30,6 @@ import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text)-import System.Directory import System.Exit  @@ -44,6 +41,7 @@   , targets :: [Text]   , cabalExecutable :: FilePath   , mode :: CabalMode+  , userProjectFiles :: UserProjectFiles   , steps :: PerCabalStep Bool     -- ^ Which build steps to run or skip.   }@@ -105,6 +103,7 @@   { cabalExecutable = input.cabalExecutable   , step   , mode = input.mode+  , userProjectFiles = input.userProjectFiles   , options = input.options   , targets = input.targets   , flavor@@ -127,22 +126,24 @@     waitForNext :: IO ()     waitForNext = do       waitQSem sem-      done <- modifyMVar stateVar \state -> case state.queue of+      (done, signal) <- modifyMVar stateVar \state -> case state.queue of         [] -> do           doneWithFlavor-          pure (state, True)+          pure (state, (True, pure ()))         flavorIndex:queue' -> do-          mProcess <- startSteps flavorIndex+          result <- startSteps flavorIndex             (filter (indexCabalStep input.steps) [minBound..maxBound])           pure             ( state               { processes-                = Map.alter (\_ -> mProcess) flavorIndex state.processes+                = Map.alter (\_ -> fst <$> result) flavorIndex state.processes               , queue = queue'               }-            , False+            , (False, maybe (pure ()) snd result)             ) +      signal -- possibly send the 'OnStepStarted' event+       if done       then waitForDone       else waitForNext@@ -150,17 +151,24 @@     doneWithFlavor :: IO ()     doneWithFlavor = signalQSem sem -    startSteps :: FlavorIndex -> [CabalStep] -> IO (Maybe ProcessHandle)+    startSteps+      :: FlavorIndex -> [CabalStep] -> IO (Maybe (ProcessHandle, IO ()))     startSteps flavorIndex = \case       [] -> Nothing <$ doneWithFlavor       step:nextSteps -> Just <$> do         stdoutClosed <- newEmptyMVar         stderrClosed <- newEmptyMVar-        cb OnStepStarted { flavorIndex, step }+        processStarted <- newEmptyMVar         let args = mkCabalArgs input step (indexArray flavors flavorIndex)-        for_ (environmentFilePath args) $ void . try @_ @IOError . removeFile-        startProcess (renderCabalArgs args)-          (reactStep flavorIndex step nextSteps stdoutClosed stderrClosed)+        prepareFilesForCabal args+        handle <- startProcess (renderCabalArgs args)+          (reactStep flavorIndex step nextSteps stdoutClosed stderrClosed processStarted)+        -- We cannot send 'OnStepStarted' here because we are holding the state+        -- MVar, and a deadlock is possible. Instead we defer sending it until+        -- the MVar is released, and synchronize 'OnOutput' with this event.+        pure $ (handle,) do+          cb OnStepStarted { flavorIndex, step }+          putMVar processStarted ()      reactStep       :: FlavorIndex@@ -168,42 +176,54 @@       -> [CabalStep]       -> MVar ()       -> MVar ()+      -> MVar ()       -> ProcessMessage       -> IO ()-    reactStep flavorIndex step nextSteps stdoutClosed stderrClosed = \case-      OnProcessOutput channel output -> cb OnOutput-        { flavorIndex-        , step-        , channel-        , output-        }-      OnChannelClosed Stdout -> putMVar stdoutClosed ()-      OnChannelClosed Stderr -> putMVar stderrClosed ()-      OnProcessExit exitCode -> do-        -- Synchronize OnStepFinished to be sequenced after OnOutput.-        -- Perhaps ProcessRunner should do this.-        takeMVar stdoutClosed-        takeMVar stderrClosed-        cb OnStepFinished { flavorIndex, step, exitCode }-        modifyMVar_ stateVar \state -> case exitCode of-          ExitSuccess-            -- It's possible that an interrupt signal has been received after-            -- the process has already exited (successfully), but before we got-            -- the 'OnProcessExit' message. So we must check this flag to see if-            -- we shouldn't start subsequent steps.-            | flavorIndex `Set.notMember` state.stopRequested-            -> do-              mProcess <- startSteps flavorIndex nextSteps-              pure state-                { processes-                  = Map.alter (\_ -> mProcess) flavorIndex state.processes-                }-          _ -> do-            doneWithFlavor-            pure state-              { processes = Map.delete flavorIndex state.processes-              , stopRequested = Set.delete flavorIndex state.stopRequested-              }+    reactStep flavorIndex step nextSteps stdoutClosed stderrClosed+      processStarted = \case+        OnProcessOutput channel output -> do+          -- Synchronize OnOutput to be sent after OnStepStarted+          readMVar processStarted+          cb OnOutput+            { flavorIndex+            , step+            , channel+            , output+            }+        OnChannelClosed Stdout -> putMVar stdoutClosed ()+        OnChannelClosed Stderr -> putMVar stderrClosed ()+        OnProcessExit exitCode -> do+          -- Synchronize OnStepFinished to be sequenced after OnOutput.+          -- Perhaps ProcessRunner should do this.+          takeMVar stdoutClosed+          takeMVar stderrClosed+          cb OnStepFinished { flavorIndex, step, exitCode }+          signal <- modifyMVar stateVar \state -> case exitCode of+            ExitSuccess+              -- It's possible that an interrupt signal has been received after+              -- the process has already exited (successfully), but before we got+              -- the 'OnProcessExit' message. So we must check this flag to see if+              -- we shouldn't start subsequent steps.+              | flavorIndex `Set.notMember` state.stopRequested+              -> do+                result <- startSteps flavorIndex nextSteps+                pure+                  ( state+                    { processes = Map.alter+                      (\_ -> fst <$> result) flavorIndex state.processes+                    }+                  , maybe (pure ()) snd result+                  )+            _ -> do+              doneWithFlavor+              pure+                ( state+                  { processes = Map.delete flavorIndex state.processes+                  , stopRequested = Set.delete flavorIndex state.stopRequested+                  }+                , pure ()+                )+          signal -- possibly send the 'OnStepStarted' event      waitForDone :: IO ()     waitForDone = do