Make (GHC) version mapping configurable

phadej · phadej · commit ad0f8c44dbb6 · 2024-11-17T16:37:51.000+02:00
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -6,8 +6,6 @@ module HaskellCI.VersionInfo (
 
 import HaskellCI.Prelude
 
-import Data.Map (Map)
-
 import qualified Data.Map as Map
 
 haskellCIVerStr :: String

Original file line number	Diff line number	Diff line change
`@@ -8,6 +8,7 @@ module HaskellCI.Config.History (`
`8`	`8`	`import HaskellCI.Prelude`
`9`	`9`
`10`	`10`	`import qualified Distribution.Version as C`
	`11`	`+import qualified Data.Map.Strict as Map`
`11`	`12`
`12`	`13`	`import HaskellCI.Config.Initial`
`13`	`14`	`import HaskellCI.Config.Type`
`@@ -45,6 +46,8 @@ configHistory =`
`45`	`46`	`, ghcupVanilla = C.withinVersion (C.mkVersion [9,8,3])`
`46`	`47`	`, ghcupPrerelease = C.orLaterVersion (C.mkVersion [9,12])`
`47`	`48`	`}`
	`49`	`+ , ver 0 19 20241117 := \cfg -> cfg`
	`50`	`+ & field @"cfgVersionMapping" .~ Map.singleton (mkVersion [9,12,1]) (mkVersion [9,12,0,20241031])`
`48`	`51`	`]`
`49`	`52`	`where`
`50`	`53`	`ver x y z = [x, y, z]`
Original file line number	Diff line number	Diff line change
`@@ -81,4 +81,5 @@ initialConfig = Config`
`81`	`81`	`, cfgRawTravis = ""`
`82`	`82`	`, cfgGitHubActionName = Nothing`
`83`	`83`	`, cfgTimeoutMinutes = 60`
	`84`	`+ , cfgVersionMapping = mempty`
`84`	`85`	`}`
Original file line number	Diff line number	Diff line change
`@@ -81,6 +81,7 @@ data Config = Config`
`81`	`81`	`, cfgRawTravis :: !String`
`82`	`82`	`, cfgGitHubActionName :: !(Maybe String)`
`83`	`83`	`, cfgTimeoutMinutes :: !Natural`
	`84`	`+ , cfgVersionMapping :: !(Map Version Version)`
`84`	`85`	`}`
`85`	`86`	`deriving (Show, Generic)`
`86`	`87`