Deduplicate allow-newer logic to Ghclibgen

Author: dylant-da

CI.hs

@@ -20,6 +20,7 @@ import System.IO.Extra
 import System.IO.Unsafe
 import System.Process.Extra
 import System.Time.Extra
+import Ghclibgen (allowNewerProjectLines, mkAllowNewerFlags)
 
 main :: IO ()
 main = do
@@ -36,18 +37,6 @@ main = do
   version <- buildDists ghcFlavor noGhcCheckout noBuilds versionSuffix allowNewerFlags allowNewerSpecs
   putStrLn version
 
-mkAllowNewerFlags :: [String] -> String
-mkAllowNewerFlags xs =
-  let render = unwords . map (\s -> "--allow-newer=" ++ s)
-      def = ""
-  in case xs of
-       [] -> if null def then "" else " " ++ def
-       _  -> " " ++ render xs
-
-allowNewerProjectLines :: [String] -> [String]
-allowNewerProjectLines [] = []
-allowNewerProjectLines xs = ["allow-newer: " ++ intercalate ", " xs]
-
 data Options = Options
   { ghcFlavor :: GhcFlavor,
     noGhcCheckout :: Bool,
@@ -412,7 +401,7 @@ buildDists ghcFlavor noGhcCheckout noBuilds versionSuffix allowNewerFlags allowN
   system_ $ "cabal build exe:ghc-lib-gen" ++ allowNewerFlags
   system_ $ "cabal run exe:ghc-lib-gen" ++ allowNewerFlags
           ++ " -- ghc ../patches --ghc-lib-parser "
-          ++ ghcFlavorArg ++ " " ++ cppOpts ghcFlavor ++allowNewerFlags
+          ++ ghcFlavorArg ++ " " ++ cppOpts ghcFlavor ++ allowNewerFlags
 
   patchVersion version "ghc/ghc-lib-parser.cabal"
   mkTarball pkg_ghclib_parser
@@ -478,11 +467,11 @@ buildDists ghcFlavor noGhcCheckout noBuilds versionSuffix allowNewerFlags allowN
 
   system_ $ "cd examples/ghc-lib-test-mini-hlint && cabal test " ++
         "--project-dir ../.. --test-show-details direct " ++
-        ("--test-options \"--color always --test-command ../../ghc-lib-test-mini-hlint " ++ ghcFlavorArg ++ "\"")
+        "--test-options \"--color always --test-command ../../ghc-lib-test-mini-hlint " ++ ghcFlavorArg ++ "\""
 
   system_ $ "cd examples/ghc-lib-test-mini-compile && cabal test " ++
         "--project-dir ../.. --test-show-details direct " ++
-        ("--test-options \"--color always --test-command ../../ghc-lib-test-mini-compile " ++ ghcFlavorArg ++ "\"")
+        "--test-options \"--color always --test-command ../../ghc-lib-test-mini-compile " ++ ghcFlavorArg ++ "\""
 
   system_ "cabal -v0 exec -- ghc -ignore-dot-ghci -package=ghc-lib-parser -e \"print 1\""
   system_ "cabal -v0 exec -- ghc -ignore-dot-ghci -package=ghc-lib -e \"print 1\""

ghc-lib-gen.cabal

@@ -60,7 +60,7 @@ executable ghc-lib-build-tool
     else
       build-tool-depends: alex:alex, happy:happy < 2.0
   build-depends:
-    directory, filepath, time, extra, optparse-applicative
+    directory, filepath, time, extra, optparse-applicative, ghc-lib-gen
   if flag(semaphore-compat)
     build-depends: semaphore-compat
   main-is: CI.hs

ghc-lib-gen/src/Ghclibgen.hs

@@ -42,6 +42,8 @@ module Ghclibgen
     generateGhcLibCabal,
     generateGhcLibParserCabal,
     setupModuleDepsPlaceholders,
+    mkAllowNewerFlags,
+    allowNewerProjectLines,
   )
 where
 
@@ -1742,10 +1744,7 @@ generatePrerequisites ghcFlavor allowNewerSpecs = do
   system_ "bash -c \"./configure --enable-tarballs-autodownload\""
   withCurrentDirectory "hadrian" $ do
 
-    let defaultAllowNewer = []
-        effectiveAllowNewer =
-          if null allowNewerSpecs then defaultAllowNewer else allowNewerSpecs
-        allowNewerArgs = concatMap (\s -> ["--allow-newer=" ++ s]) effectiveAllowNewer
+    let allowNewerArgs = mkAllowNewerFlagsList allowNewerSpecs
 
     system_ . unwords . join $
       [ ["cabal", "build", "exe:hadrian", "--ghc-options=-j"]
@@ -1826,3 +1825,14 @@ genPlaceholderModules = loop
           contents <- listDirectory fp
           mapM_ (loop . (fp </>)) contents
         else when (takeExtension fp `elem` [".x", ".y", ".hsc"]) $ genPlaceholderModule fp
+
+mkAllowNewerFlags :: [String] -> String
+mkAllowNewerFlags [] = ""
+mkAllowNewerFlags xs = " " ++ unwords (mkAllowNewerFlagsList xs)
+
+mkAllowNewerFlagsList :: [String] -> [String]
+mkAllowNewerFlagsList = map ("--allow-newer=" ++)
+
+allowNewerProjectLines :: [String] -> [String]
+allowNewerProjectLines [] = []
+allowNewerProjectLines xs = ["allow-newer: " ++ intercalate ", " xs]