From ad0f8c44dbb65d17b8d00e7b3c07f5fc48d660ef Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 17 Nov 2024 16:05:41 +0200 Subject: [PATCH] Make (GHC) version mapping configurable --- .github/workflows/haskell-ci.yml | 4 ++-- cabal.haskell-ci | 3 +++ src/HaskellCI.hs | 1 - src/HaskellCI/Auxiliary.hs | 4 ---- src/HaskellCI/Compiler.hs | 22 +----------------- src/HaskellCI/Config/Grammar.hs | 2 ++ src/HaskellCI/Config/History.hs | 3 +++ src/HaskellCI/Config/Initial.hs | 1 + src/HaskellCI/Config/Type.hs | 1 + src/HaskellCI/GitHub.hs | 6 ++++- src/HaskellCI/Newtypes.hs | 38 ++++++++++++++++++++++++++++++++ src/HaskellCI/OptionsGrammar.hs | 1 + src/HaskellCI/Prelude.hs | 1 + src/HaskellCI/VersionInfo.hs | 2 -- 14 files changed, 58 insertions(+), 31 deletions(-) diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index b0033e20..fd1f34f4 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -181,7 +181,7 @@ jobs: - name: cache (tools) uses: actions/cache/restore@v4 with: - key: ${{ runner.os }}-${{ matrix.compiler }}-tools-1e9b3b69 + key: ${{ runner.os }}-${{ matrix.compiler }}-tools-ff63ec70 path: ~/.haskell-ci-tools - name: install cabal-plan run: | @@ -209,7 +209,7 @@ jobs: if: always() uses: actions/cache/save@v4 with: - key: ${{ runner.os }}-${{ matrix.compiler }}-tools-1e9b3b69 + key: ${{ runner.os }}-${{ matrix.compiler }}-tools-ff63ec70 path: ~/.haskell-ci-tools - name: checkout uses: actions/checkout@v4 diff --git a/cabal.haskell-ci b/cabal.haskell-ci index 8a9a71fc..4ee70509 100644 --- a/cabal.haskell-ci +++ b/cabal.haskell-ci @@ -145,3 +145,6 @@ raw-project keep-going: False package bytestring tests: False + +-- Mapping of GHC versions (used for prereleases) +ghc-version-mapping: 9.12.1:9.12.0.20241114 diff --git a/src/HaskellCI.hs b/src/HaskellCI.hs index 705a2a3e..cae69fc0 100644 --- a/src/HaskellCI.hs +++ b/src/HaskellCI.hs @@ -549,7 +549,6 @@ configFromCabalFile cfg (cabalFile, gpd) = do lastStableGhcVers = nubBy ((==) `on` ghcMajVer) $ sortBy (flip compare) - $ filter (not . isPreviewGHC . GHC) $ knownGhcVersions isTwoDigitGhcVersion :: VersionRange -> Maybe Version diff --git a/src/HaskellCI/Auxiliary.hs b/src/HaskellCI/Auxiliary.hs index 181297c7..036a47b3 100644 --- a/src/HaskellCI/Auxiliary.hs +++ b/src/HaskellCI/Auxiliary.hs @@ -46,7 +46,6 @@ data Auxiliary = Auxiliary , extraCabalProjectFields :: FilePath -> [C.PrettyField ()] , testShowDetails :: String , anyJobUsesHeadHackage :: Bool - , anyJobUsesPreviewGHC :: Bool , runHaddock :: Bool , haddockFlags :: String } @@ -139,9 +138,6 @@ auxiliary Config {..} prj JobVersions {..} = Auxiliary {..} anyJobUsesHeadHackage :: Bool anyJobUsesHeadHackage = not $ null headGhcVers - anyJobUsesPreviewGHC :: Bool - anyJobUsesPreviewGHC = not $ null $ S.filter isPreviewGHC allVersions - pkgNameDirVariable' :: String -> String pkgNameDirVariable' n = "PKGDIR_" ++ map f n where f '-' = '_' diff --git a/src/HaskellCI/Compiler.hs b/src/HaskellCI/Compiler.hs index 9c3e0ad4..f4411fdf 100644 --- a/src/HaskellCI/Compiler.hs +++ b/src/HaskellCI/Compiler.hs @@ -9,7 +9,6 @@ module HaskellCI.Compiler ( -- ** Predicates isGHCHead, usesHeadHackage, - isPreviewGHC, -- ** Selectors compilerKind, compilerVersion, @@ -31,8 +30,7 @@ module HaskellCI.Compiler ( previewCabal, -- * Misc ghcMajVer, - translateCompilerVersion, - ) where +) where import HaskellCI.Prelude @@ -189,9 +187,6 @@ dispGhcVersionShort (GHCJS v) = "ghcjs-" ++ C.prettyShow v dispCabalVersion :: Maybe Version -> String dispCabalVersion = maybe "head" C.prettyShow -ghcAlpha :: Maybe (Version, Version) -ghcAlpha = Just (mkVersion [9,12,1], mkVersion [9,12,0,20241031]) - -- | GHC HEAD, and versions specified by head.hackage option. usesHeadHackage :: VersionRange -- ^ head.hackage range @@ -201,11 +196,6 @@ usesHeadHackage _vr GHCHead = True usesHeadHackage vr (GHC v) = withinRange v vr usesHeadHackage _vr (GHCJS _) = False -isPreviewGHC :: CompilerVersion -> Bool -isPreviewGHC GHCHead = True -isPreviewGHC (GHC v) = maybe False (\(v', _) -> v /= v') ghcAlpha -isPreviewGHC (GHCJS _) = False - isGHCHead :: CompilerVersion -> Bool isGHCHead GHCHead = True isGHCHead _ = False @@ -222,13 +212,3 @@ ghcMajVer :: Version -> (Int,Int) ghcMajVer v | x:y:_ <- versionNumbers v = (x,y) | otherwise = error $ "panic: ghcMajVer called with " ++ show v - --- | Map compiler version to one available to download. --- --- This way we can map e.g. 9.4.1 to 9.4.0.20220501 i.e. a prerelease. -translateCompilerVersion :: CompilerVersion -> CompilerVersion -translateCompilerVersion (GHC v) - | Just (u, w) <- ghcAlpha - , v == u - = GHC w -translateCompilerVersion v = v diff --git a/src/HaskellCI/Config/Grammar.hs b/src/HaskellCI/Config/Grammar.hs index 17c69e9a..785917bb 100644 --- a/src/HaskellCI/Config/Grammar.hs +++ b/src/HaskellCI/Config/Grammar.hs @@ -173,6 +173,8 @@ configGrammar = Config ^^^ help "The name of GitHub Action" <*> optionalFieldDef "timeout-minutes" (field @"cfgTimeoutMinutes") defaultConfig ^^^ metahelp "MINUTES" "The maximum number of minutes to let a job run" + <*> optionalFieldDefAla "ghc-version-mapping" (alaMap' C.NoCommaFSep VersionPair) (field @"cfgVersionMapping") defaultConfig + ^^^ metahelp "VERSIONS" "Mapping of GHC versions (used for prereleases)" ------------------------------------------------------------------------------- -- Env diff --git a/src/HaskellCI/Config/History.hs b/src/HaskellCI/Config/History.hs index e2e027b7..e13fcfad 100644 --- a/src/HaskellCI/Config/History.hs +++ b/src/HaskellCI/Config/History.hs @@ -8,6 +8,7 @@ module HaskellCI.Config.History ( import HaskellCI.Prelude import qualified Distribution.Version as C +import qualified Data.Map.Strict as Map import HaskellCI.Config.Initial import HaskellCI.Config.Type @@ -45,6 +46,8 @@ configHistory = , ghcupVanilla = C.withinVersion (C.mkVersion [9,8,3]) , ghcupPrerelease = C.orLaterVersion (C.mkVersion [9,12]) } + , ver 0 19 20241117 := \cfg -> cfg + & field @"cfgVersionMapping" .~ Map.singleton (mkVersion [9,12,1]) (mkVersion [9,12,0,20241031]) ] where ver x y z = [x, y, z] diff --git a/src/HaskellCI/Config/Initial.hs b/src/HaskellCI/Config/Initial.hs index b310569a..74c36e22 100644 --- a/src/HaskellCI/Config/Initial.hs +++ b/src/HaskellCI/Config/Initial.hs @@ -81,4 +81,5 @@ initialConfig = Config , cfgRawTravis = "" , cfgGitHubActionName = Nothing , cfgTimeoutMinutes = 60 + , cfgVersionMapping = mempty } diff --git a/src/HaskellCI/Config/Type.hs b/src/HaskellCI/Config/Type.hs index c98f3da5..e16f8c5a 100644 --- a/src/HaskellCI/Config/Type.hs +++ b/src/HaskellCI/Config/Type.hs @@ -81,6 +81,7 @@ data Config = Config , cfgRawTravis :: !String , cfgGitHubActionName :: !(Maybe String) , cfgTimeoutMinutes :: !Natural + , cfgVersionMapping :: !(Map Version Version) } deriving (Show, Generic) diff --git a/src/HaskellCI/GitHub.hs b/src/HaskellCI/GitHub.hs index ed701cbf..d952d987 100644 --- a/src/HaskellCI/GitHub.hs +++ b/src/HaskellCI/GitHub.hs @@ -533,7 +533,7 @@ makeGitHub _argv config@Config {..} gitconfig prj jobs@JobVersions {..} = do -- we can have multiple setup methods for the same -- compiler version, if jobs overlap. [ [ GitHubMatrixEntry - { ghmeCompiler = translateCompilerVersion $ compiler + { ghmeCompiler = translateCompilerVersion cfgVersionMapping $ compiler , ghmeAllowFailure = isGHCHead compiler || maybeGHC False (`C.withinRange` cfgAllowFailures) compiler @@ -777,3 +777,7 @@ parseGitHubRepo t = -- runners support. ghcRunsOnVer :: String ghcRunsOnVer = "ubuntu-20.04" + +translateCompilerVersion :: Map Version Version -> CompilerVersion -> CompilerVersion +translateCompilerVersion m (GHC v) = GHC (Map.findWithDefault v v m) +translateCompilerVersion _ x = x diff --git a/src/HaskellCI/Newtypes.hs b/src/HaskellCI/Newtypes.hs index caf8a77a..c8f2dfa5 100644 --- a/src/HaskellCI/Newtypes.hs +++ b/src/HaskellCI/Newtypes.hs @@ -5,6 +5,7 @@ module HaskellCI.Newtypes where import HaskellCI.Prelude import qualified Data.Set as S +import qualified Data.Map as Map import qualified Distribution.Compat.CharParsing as C import qualified Distribution.Compat.Newtype as C import qualified Distribution.FieldGrammar.Newtypes as C @@ -134,6 +135,43 @@ instance (C.Newtype a b, Ord a, C.Sep sep, C.Parsec b) => C.Parsec (AlaSet sep b instance (C.Newtype a b, C.Sep sep, C.Pretty b) => C.Pretty (AlaSet sep b a) where pretty = C.prettySep (hack (Proxy :: Proxy sep)) . map (C.pretty . (C.pack :: a -> b)) . S.toList . C.unpack +------------------------------------------------------------------------------- +-- AlaMap +------------------------------------------------------------------------------- + +newtype AlaMap sep b k v = AlaMap { getAlaMap :: Map k v } + deriving anyclass (C.Newtype (Map k v)) + +alaMap' :: sep -> ((k, v) -> b) -> Map k v -> AlaMap sep b k v +alaMap' _ _ = AlaMap + +instance (C.Newtype (k, v) b, Ord k, C.Sep sep, C.Parsec b) => C.Parsec (AlaMap sep b k v) where + parsec = C.pack . Map.fromList . map (C.unpack :: b -> (k, v)) <$> C.parseSep (hack (Proxy :: Proxy sep)) C.parsec + +instance (C.Newtype (k, v) b, C.Sep sep, C.Pretty b) => C.Pretty (AlaMap sep b k v) where + pretty = C.prettySep (hack (Proxy :: Proxy sep)) . map (C.pretty . (C.pack :: (k, v) -> b)) . Map.toList . C.unpack + +------------------------------------------------------------------------------- +-- VersionPair +------------------------------------------------------------------------------- + +newtype VersionPair = VersionPair (C.Version, C.Version) + deriving anyclass (C.Newtype (C.Version, C.Version)) + +instance C.Parsec VersionPair where + parsec = do + a <- C.parsec + _ <- C.char ':' + b <- C.parsec + return (VersionPair (a, b)) + +instance C.Pretty VersionPair where + pretty (VersionPair (a, b)) = C.pretty a <> PP.text ":" <> C.pretty b + +------------------------------------------------------------------------------- +-- AlaMap +------------------------------------------------------------------------------- + -- Someone (= me) forgot to export Distribution.Parsec.Newtypes.P hack :: Proxy a -> proxy a hack _ = undefined diff --git a/src/HaskellCI/OptionsGrammar.hs b/src/HaskellCI/OptionsGrammar.hs index ee509479..5648d545 100644 --- a/src/HaskellCI/OptionsGrammar.hs +++ b/src/HaskellCI/OptionsGrammar.hs @@ -44,6 +44,7 @@ class , c (C.List C.CommaVCat NoCommas String) , c (C.List C.NoCommaFSep (Identity C.PackageName) C.PackageName) , c (C.List C.FSep (Identity C.PackageName) C.PackageName) + , c (AlaMap C.NoCommaFSep VersionPair Version Version) ) => OptionsGrammar c p | p -> c where diff --git a/src/HaskellCI/Prelude.hs b/src/HaskellCI/Prelude.hs index 5a8137a8..444f673b 100644 --- a/src/HaskellCI/Prelude.hs +++ b/src/HaskellCI/Prelude.hs @@ -31,6 +31,7 @@ import Data.Functor.Identity as X (Identity (..)) import Data.List as X (intercalate, isPrefixOf, nub, stripPrefix, tails) import Data.List.NonEmpty as X (NonEmpty (..), groupBy) import Data.Maybe as X (fromMaybe, isJust, isNothing, listToMaybe, mapMaybe) +import Data.Map.Strict as X (Map) import Data.Proxy as X (Proxy (..)) import Data.Set as X (Set) import Data.String as X (IsString (fromString)) diff --git a/src/HaskellCI/VersionInfo.hs b/src/HaskellCI/VersionInfo.hs index fa8b1cc4..f15546d6 100644 --- a/src/HaskellCI/VersionInfo.hs +++ b/src/HaskellCI/VersionInfo.hs @@ -6,8 +6,6 @@ module HaskellCI.VersionInfo ( import HaskellCI.Prelude -import Data.Map (Map) - import qualified Data.Map as Map haskellCIVerStr :: String