-
Notifications
You must be signed in to change notification settings - Fork 9
/
Copy pathCI.hs
executable file
·603 lines (563 loc) · 21.3 KB
/
CI.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
-- Copyright (c) 2019-2025 Digital Asset (Switzerland) GmbH and/or
-- its affiliates. All rights reserved. SPDX-License-Identifier:
-- (Apache-2.0 OR BSD-3-Clause)
-- CI script, compatible with all of Travis, Appveyor and Azure.
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
import Control.Monad.Extra
import Data.Foldable
import Data.List.Extra
import Data.Time.Calendar
import Data.Time.Clock
import GHC.Stack
import qualified Options.Applicative as Opts
import System.Directory
import System.Exit
import System.FilePath
import System.IO.Extra
import System.IO.Unsafe
import System.Process.Extra
import System.Time.Extra
main :: IO ()
main = do
let opts =
Opts.info
(parseOptions Opts.<**> Opts.helper)
( Opts.fullDesc
<> Opts.progDesc "Build ghc-lib and ghc-lib-parser tarballs."
<> Opts.header "CI - CI script for ghc-lib"
)
Options {ghcFlavor, noGhcCheckout, noBuilds, versionSuffix} <- Opts.execParser opts
version <- buildDists ghcFlavor noGhcCheckout noBuilds versionSuffix
putStrLn version
data Options = Options
{ ghcFlavor :: GhcFlavor,
noGhcCheckout :: Bool,
noBuilds :: Bool,
versionSuffix :: Maybe String
}
deriving (Show)
data GhcFlavor
= Da DaFlavor
| GhcMaster String
| Ghc9122
| Ghc9121
| Ghc9101
| Ghc985
| Ghc984
| Ghc983
| Ghc982
| Ghc981
| Ghc967
| Ghc966
| Ghc965
| Ghc964
| Ghc963
| Ghc962
| Ghc961
| Ghc948
| Ghc947
| Ghc946
| Ghc945
| Ghc944
| Ghc943
| Ghc942
| Ghc941
| Ghc928
| Ghc927
| Ghc926
| Ghc925
| Ghc924
| Ghc923
| Ghc922
| Ghc921
| Ghc902
| Ghc901
| Ghc8107
| Ghc8106
| Ghc8105
| Ghc8104
| Ghc8103
| Ghc8102
| Ghc8101
| Ghc881
| Ghc884
| Ghc883
| Ghc882
deriving (Eq, Show)
data DaFlavor = DaFlavor
{ mergeBaseSha :: String,
patches :: [String],
cpp :: [String],
flavor :: String,
upstream :: String
}
deriving (Eq, Show)
-- Last tested gitlab.haskell.org/ghc/ghc.git at
current :: String
current = "2fdd0be9747e2014102c1dd002425ce2f0a5db4e" -- 2025-03-30
ghcFlavorOpt :: GhcFlavor -> String
ghcFlavorOpt = \case
Ghc9122 -> "--ghc-flavor ghc-9.12.2"
Ghc9121 -> "--ghc-flavor ghc-9.12.1"
Ghc9101 -> "--ghc-flavor ghc-9.10.1"
Ghc985 -> "--ghc-flavor ghc-9.8.5"
Ghc984 -> "--ghc-flavor ghc-9.8.4"
Ghc983 -> "--ghc-flavor ghc-9.8.3"
Ghc982 -> "--ghc-flavor ghc-9.8.2"
Ghc981 -> "--ghc-flavor ghc-9.8.1"
Ghc967 -> "--ghc-flavor ghc-9.6.7"
Ghc966 -> "--ghc-flavor ghc-9.6.6"
Ghc965 -> "--ghc-flavor ghc-9.6.5"
Ghc964 -> "--ghc-flavor ghc-9.6.4"
Ghc963 -> "--ghc-flavor ghc-9.6.3"
Ghc962 -> "--ghc-flavor ghc-9.6.2"
Ghc961 -> "--ghc-flavor ghc-9.6.1"
Ghc948 -> "--ghc-flavor ghc-9.4.8"
Ghc947 -> "--ghc-flavor ghc-9.4.7"
Ghc946 -> "--ghc-flavor ghc-9.4.6"
Ghc945 -> "--ghc-flavor ghc-9.4.5"
Ghc944 -> "--ghc-flavor ghc-9.4.4"
Ghc943 -> "--ghc-flavor ghc-9.4.3"
Ghc942 -> "--ghc-flavor ghc-9.4.2"
Ghc941 -> "--ghc-flavor ghc-9.4.1"
Ghc928 -> "--ghc-flavor ghc-9.2.8"
Ghc927 -> "--ghc-flavor ghc-9.2.7"
Ghc926 -> "--ghc-flavor ghc-9.2.6"
Ghc925 -> "--ghc-flavor ghc-9.2.5"
Ghc924 -> "--ghc-flavor ghc-9.2.4"
Ghc923 -> "--ghc-flavor ghc-9.2.3"
Ghc922 -> "--ghc-flavor ghc-9.2.2"
Ghc921 -> "--ghc-flavor ghc-9.2.1"
Ghc901 -> "--ghc-flavor ghc-9.0.1"
Ghc902 -> "--ghc-flavor ghc-9.0.2"
Ghc8101 -> "--ghc-flavor ghc-8.10.1"
Ghc8102 -> "--ghc-flavor ghc-8.10.2"
Ghc8103 -> "--ghc-flavor ghc-8.10.3"
Ghc8104 -> "--ghc-flavor ghc-8.10.4"
Ghc8105 -> "--ghc-flavor ghc-8.10.5"
Ghc8106 -> "--ghc-flavor ghc-8.10.6"
Ghc8107 -> "--ghc-flavor ghc-8.10.7"
Ghc881 -> "--ghc-flavor ghc-8.8.1"
Ghc882 -> "--ghc-flavor ghc-8.8.2"
Ghc883 -> "--ghc-flavor ghc-8.8.3"
Ghc884 -> "--ghc-flavor ghc-8.8.4"
Da DaFlavor {flavor} -> "--ghc-flavor " <> flavor
GhcMaster _hash -> "--ghc-flavor ghc-master"
-- The git SHA1 hash is not passed to ghc-lib-gen at this time.
cppOpts :: GhcFlavor -> String
cppOpts (Da DaFlavor {cpp}) = unwords $ concat [["--cpp", v] | v <- cpp]
cppOpts _ = ""
genDateSuffix :: IO String
genDateSuffix = do
UTCTime day _ <- getCurrentTime
pure $ replace "-" "" (showGregorian day)
-- Calculate a version string based on a ghc flavor and a suffix.
genVersionStr :: GhcFlavor -> String -> String
genVersionStr flavor suffix =
base <> case suffix of
"" -> ""
_ -> "." <> suffix
where
base = case flavor of
Da {} -> "8.8.1"
GhcMaster _ -> "0"
Ghc9122 -> "9.12.2"
Ghc9121 -> "9.12.1"
Ghc9101 -> "9.10.1"
Ghc985 -> "9.8.5"
Ghc984 -> "9.8.4"
Ghc983 -> "9.8.3"
Ghc982 -> "9.8.2"
Ghc981 -> "9.8.1"
Ghc967 -> "9.6.7"
Ghc966 -> "9.6.6"
Ghc965 -> "9.6.5"
Ghc964 -> "9.6.4"
Ghc963 -> "9.6.3"
Ghc962 -> "9.6.2"
Ghc961 -> "9.6.1"
Ghc948 -> "9.4.8"
Ghc947 -> "9.4.7"
Ghc946 -> "9.4.6"
Ghc945 -> "9.4.5"
Ghc944 -> "9.4.4"
Ghc943 -> "9.4.3"
Ghc942 -> "9.4.2"
Ghc941 -> "9.4.1"
Ghc928 -> "9.2.8"
Ghc927 -> "9.2.7"
Ghc926 -> "9.2.6"
Ghc925 -> "9.2.5"
Ghc924 -> "9.2.4"
Ghc923 -> "9.2.3"
Ghc922 -> "9.2.2"
Ghc921 -> "9.2.1"
Ghc901 -> "9.0.1"
Ghc902 -> "9.0.2"
Ghc8101 -> "8.10.1"
Ghc8102 -> "8.10.2"
Ghc8103 -> "8.10.3"
Ghc8104 -> "8.10.4"
Ghc8105 -> "8.10.5"
Ghc8106 -> "8.10.6"
Ghc8107 -> "8.10.7"
Ghc881 -> "8.8.1"
Ghc882 -> "8.8.2"
Ghc883 -> "8.8.3"
Ghc884 -> "8.8.4"
parseOptions :: Opts.Parser Options
parseOptions =
Options
<$> ( (Da <$> parseDaOptions)
Opts.<|> Opts.option
readFlavor
( Opts.long "ghc-flavor"
<> Opts.help "The ghc-flavor to test against"
)
)
<*> Opts.switch
( Opts.long "no-checkout"
<> Opts.help "If enabled, don't perform a GHC checkout"
)
<*> Opts.switch
( Opts.long "no-builds"
<> Opts.help "If enabled, don't build & test packages & examples"
)
<*> Opts.optional
( Opts.strOption
( Opts.long "version-suffix"
<> Opts.help "If specified, append to version string for generated ghc-lib. Otherwise use current date."
)
)
where
readFlavor :: Opts.ReadM GhcFlavor
readFlavor = Opts.eitherReader $ \case
"ghc-9.12.2" -> Right Ghc9122
"ghc-9.12.1" -> Right Ghc9121
"ghc-9.10.1" -> Right Ghc9101
"ghc-9.8.5" -> Right Ghc985
"ghc-9.8.4" -> Right Ghc984
"ghc-9.8.3" -> Right Ghc983
"ghc-9.8.2" -> Right Ghc982
"ghc-9.8.1" -> Right Ghc981
"ghc-9.6.7" -> Right Ghc967
"ghc-9.6.6" -> Right Ghc966
"ghc-9.6.5" -> Right Ghc965
"ghc-9.6.4" -> Right Ghc964
"ghc-9.6.3" -> Right Ghc963
"ghc-9.6.2" -> Right Ghc962
"ghc-9.6.1" -> Right Ghc961
"ghc-9.4.8" -> Right Ghc948
"ghc-9.4.7" -> Right Ghc947
"ghc-9.4.6" -> Right Ghc946
"ghc-9.4.5" -> Right Ghc945
"ghc-9.4.4" -> Right Ghc944
"ghc-9.4.3" -> Right Ghc943
"ghc-9.4.2" -> Right Ghc942
"ghc-9.4.1" -> Right Ghc941
"ghc-9.2.8" -> Right Ghc928
"ghc-9.2.7" -> Right Ghc927
"ghc-9.2.6" -> Right Ghc926
"ghc-9.2.5" -> Right Ghc925
"ghc-9.2.4" -> Right Ghc924
"ghc-9.2.3" -> Right Ghc923
"ghc-9.2.2" -> Right Ghc922
"ghc-9.2.1" -> Right Ghc921
"ghc-9.0.1" -> Right Ghc901
"ghc-9.0.2" -> Right Ghc902
"ghc-8.10.1" -> Right Ghc8101
"ghc-8.10.2" -> Right Ghc8102
"ghc-8.10.3" -> Right Ghc8103
"ghc-8.10.4" -> Right Ghc8104
"ghc-8.10.5" -> Right Ghc8105
"ghc-8.10.6" -> Right Ghc8106
"ghc-8.10.7" -> Right Ghc8107
"ghc-8.8.1" -> Right Ghc881
"ghc-8.8.2" -> Right Ghc882
"ghc-8.8.3" -> Right Ghc883
"ghc-8.8.4" -> Right Ghc884
"ghc-master" -> Right (GhcMaster current)
hash -> Right (GhcMaster hash)
parseDaOptions :: Opts.Parser DaFlavor
parseDaOptions =
Opts.flag' DaFlavor (Opts.long "da" <> Opts.help "Enables DA custom build.")
<*> Opts.strOption
( Opts.long "merge-base-sha"
<> Opts.help "DA flavor only. Base commit to use from the GHC repo."
<> Opts.showDefault
<> Opts.value "ghc-8.8.1-release"
)
<*> ( Opts.some
( Opts.strOption
( Opts.long "patch"
<> Opts.help "DA flavor only. Commits to merge in from the DA GHC fork, referenced as 'upstream'. Can be specified multiple times. If no patch is specified, default will be equivalent to `--patch upstream/da-master-8.8.1`. Specifying any patch will overwrite the default (i.e. replace, not add)."
)
)
Opts.<|> pure ["upstream/da-master-8.8.1"]
)
<*> ( Opts.some
( Opts.strOption
( Opts.long "cpp"
<> Opts.help "DA flavor only. CPP flags to pass on to ghc-lib-gen. Can be specified multiple times. If no flags are specified, default will be equivalent to `--cpp -DDAML_PRIM`. Specifying any flag will overwrite the default (i.e. replace, not add)."
)
)
Opts.<|> pure ["-DDAML_PRIM"]
)
<*> Opts.strOption
( Opts.long "gen-flavor"
<> Opts.help "DA flavor only. Flavor to pass on to ghc-lib-gen."
<> Opts.showDefault
<> Opts.value "da-ghc-8.8.1"
)
<*> Opts.strOption
( Opts.long "upstream"
<> Opts.help "DA flavor only. URL for the git remote add command."
<> Opts.showDefault
<> Opts.value "https://github.com/digital-asset/ghc.git"
)
buildDists :: GhcFlavor -> Bool -> Bool -> Maybe String -> IO String
buildDists ghcFlavor noGhcCheckout noBuilds versionSuffix = do
filesInDot <- getDirectoryContents "."
let lockFiles = filter (isExtensionOf ".lock") filesInDot
tarBalls = filter (isExtensionOf ".tar.gz") filesInDot
ghcDirs = ["ghc" | not noGhcCheckout] ++ ["ghc-lib", "ghc-lib-parser"]
toDelete = ghcDirs ++ tarBalls ++ lockFiles
forM_ toDelete removePath
system_ "rm -f cabal.project"
system_ "git checkout ghc-lib-gen.cabal examples"
-- If '--no-checkout' is given, it's on the caller to get the GHC
-- clone with e.g.
-- git clone https://gitlab.haskell.org/ghc/ghc.git && \
-- git fetch --tags && git submodule update --init --recursive
-- and it won't be deleted between runs.
if noGhcCheckout
then do
system_ "{ cd ghc; git remote remove upstream || true; }"
system_ "cd ghc && git clean -xdf && git submodule foreach git clean -xdf && git submodule foreach git checkout . && git checkout ."
else do
system_ "git clone https://gitlab.haskell.org/ghc/ghc.git"
case ghcFlavor of
GhcMaster hash -> system_ ("cd ghc && git fetch origin" ++ " " ++ hash)
_ -> system_ "cd ghc && git fetch origin --tags"
gitCheckout ghcFlavor
system_ "cd ghc && git checkout ."
-- Move this directory so that we can include/exclude it from
-- hs-source-dirs conditionally depdending on the build compiler
-- version.
ghcBootThGHCInternalDirExists <- doesDirectoryExist "ghc/libraries/ghc-boot-th/GHC/Internal"
when ghcBootThGHCInternalDirExists $ do
system_ "bash -c \"mkdir -p ghc/libraries/ghc-boot-th-internal/GHC\""
system_ "bash -c \"mv ghc/libraries/ghc-boot-th/GHC/Internal ghc/libraries/ghc-boot-th-internal/GHC\""
version <- tag
let pkg_ghclib = "ghc-lib-" ++ version
pkg_ghclib_parser = "ghc-lib-parser-" ++ version
ghcFlavorArg = ghcFlavorOpt ghcFlavor
system_ $ "cabal build " ++ "exe:ghc-lib-gen"
system_ $ "cabal run " ++ "exe:ghc-lib-gen -- ghc ../patches --ghc-lib-parser " ++ ghcFlavorArg ++ " " ++ cppOpts ghcFlavor
patchVersion version "ghc/ghc-lib-parser.cabal"
mkTarball pkg_ghclib_parser
renameDirectory pkg_ghclib_parser "ghc-lib-parser"
removeFile "ghc/ghc-lib-parser.cabal"
system_ $ "cabal run " ++ "exe:ghc-lib-gen -- ghc ../patches --ghc-lib " ++ ghcFlavorArg ++ " " ++ cppOpts ghcFlavor ++ " --skip-init"
patchVersion version "ghc/ghc-lib.cabal"
patchConstraints version "ghc/ghc-lib.cabal"
mkTarball pkg_ghclib
renameDirectory pkg_ghclib "ghc-lib"
removeFile "ghc/ghc-lib.cabal"
copyDirectoryRecursive
"ghc-lib-gen/ghc-lib-parser"
"examples/ghc-lib-test-mini-hlint/extra-source-files"
copyDirectoryRecursive
"ghc-lib-gen/ghc-lib-parser"
"examples/ghc-lib-test-mini-compile/extra-source-files/ghc-lib-parser"
copyDirectoryRecursive
"ghc-lib-gen/ghc-lib"
"examples/ghc-lib-test-mini-compile/extra-source-files/ghc-lib"
patchVersion version "ghc-lib-gen.cabal"
patchVersion version "examples/ghc-lib-test-utils/ghc-lib-test-utils.cabal"
patchConstraints version "examples/ghc-lib-test-utils/ghc-lib-test-utils.cabal"
patchVersion version "examples/ghc-lib-test-mini-hlint/ghc-lib-test-mini-hlint.cabal"
patchConstraints version "examples/ghc-lib-test-mini-hlint/ghc-lib-test-mini-hlint.cabal"
patchVersion version "examples/ghc-lib-test-mini-compile/ghc-lib-test-mini-compile.cabal"
patchConstraints version "examples/ghc-lib-test-mini-compile/ghc-lib-test-mini-compile.cabal"
verifyConstraint "ghc-lib-parser == " version "ghc-lib/ghc-lib.cabal"
verifyConstraint "ghc-lib-parser == " version "examples/ghc-lib-test-mini-hlint/ghc-lib-test-mini-hlint.cabal"
verifyConstraint "ghc-lib-test-utils == " version "examples/ghc-lib-test-mini-hlint/ghc-lib-test-mini-hlint.cabal"
verifyConstraint "ghc-lib-parser == " version "examples/ghc-lib-test-mini-compile/ghc-lib-test-mini-compile.cabal"
verifyConstraint "ghc-lib == " version "examples/ghc-lib-test-mini-compile/ghc-lib-test-mini-compile.cabal"
system_ "cabal sdist -o ."
system_ "(cd examples/ghc-lib-test-utils && cabal sdist -o ../..)"
system_ "(cd examples/ghc-lib-test-mini-hlint && cabal sdist -o ../..)"
system_ "(cd examples/ghc-lib-test-mini-compile && cabal sdist -o ../..)"
when noBuilds exitSuccess
writeFile
"cabal.project"
( unlines $
[ "packages: ",
" ghc-lib-parser/ghc-lib-parser.cabal",
" ghc-lib/ghc-lib.cabal",
" examples/ghc-lib-test-utils/ghc-lib-test-utils.cabal",
" examples/ghc-lib-test-mini-hlint/ghc-lib-test-mini-hlint.cabal",
" examples/ghc-lib-test-mini-compile/ghc-lib-test-mini-compile.cabal"
]
++ ["constraints: ghc-lib-test-mini-compile +daml-unit-ids" | Da {} <- [ghcFlavor]]
)
writeCabalCmdFile "ghc-lib-test-mini-hlint"
writeCabalCmdFile "ghc-lib-test-mini-compile"
cmd "cabal build --ghc-options=-j all"
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 ++ "\""
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 ++ "\""
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\""
-- Something like, "8.8.1.20190828".
tag -- The return value of type 'IO string'.
where
writeCabalCmdFile :: String -> IO ()
writeCabalCmdFile exe = do
let filename = exe
cmd = "cabal -v0 run exe:" ++ exe ++ " --project-dir ../.. -- "
writeFile filename cmd
cmd :: String -> IO ()
cmd x = do
putStrLn $ "\n\n# Running: " ++ x
hFlush stdout
(t, _) <- duration $ system_ x
putStrLn $ "# Completed in " ++ showDuration t ++ ": " ++ x ++ "\n"
hFlush stdout
mkTarball :: String -> IO ()
mkTarball target = do
system_ "(cd ghc && cabal sdist -o ..)"
system_ $ "tar -xvf " ++ target ++ ".tar.gz"
tag :: IO String
tag = do
suffix <- maybe genDateSuffix pure versionSuffix
return $ genVersionStr ghcFlavor suffix
patchVersion :: String -> FilePath -> IO ()
patchVersion version file =
writeFile file
.
-- ghc-lib, ghc-lib-parser
replace "version: 0.1.0" ("version: " ++ version)
.
-- ghc-lib-test-mini-hlint, ghc-lib-test-mini-compile
replace "version: 0.1.0.0" ("version: " ++ version)
=<< readFile' file
patchConstraints :: String -> FilePath -> IO ()
patchConstraints version file =
writeFile file
.
-- affects ghc-lib.cabal
replace " ghc-lib-parser\n" (" ghc-lib-parser == " ++ version ++ "\n")
.
-- affects ghc-lib-test-utils, ghc-lib-test-mini-hlint, ghc-lib-test-mini-compile
replace ", ghc-lib-test-utils" (", ghc-lib-test-utils == " ++ version ++ "\n")
. replace ", ghc-lib\n" (", ghc-lib == " ++ version ++ "\n")
. replace ", ghc-lib-parser\n" (", ghc-lib-parser == " ++ version ++ "\n")
=<< readFile' file
verifyConstraint :: String -> String -> String -> IO ()
verifyConstraint constraint version file = do
res <- stripInfix constraint <$> readFile' file
case res of
Just (_, r) -> do
case words r of
v : _ -> unless (v == version) exitError
_ -> exitError
Nothing -> exitError
where
exitError = die $ file ++ ": " ++ constraint ++ version ++ " not satisfied"
removePath :: FilePath -> IO ()
removePath p =
whenM (doesPathExist p) $ do
putStrLn $ "# Removing " ++ p
removePathForcibly p
gitCheckout :: GhcFlavor -> IO ()
gitCheckout ghcFlavor = do
system_ $ "cd ghc && git checkout -f " <> branch ghcFlavor
case ghcFlavor of
Da DaFlavor {patches, upstream} -> do
system_ $ "cd ghc && git remote add upstream " <> upstream
system_ "cd ghc && git fetch upstream"
system_ $ "cd ghc && git -c user.name=\"Cookie Monster\" -c [email protected] merge --no-edit " <> unwords patches
_ -> pure ()
system_ "cd ghc && git submodule update --init --recursive"
branch :: GhcFlavor -> String
branch = \case
Ghc9122 -> "ghc-9.12.2-release"
Ghc9121 -> "ghc-9.12.1-release"
Ghc9101 -> "ghc-9.10.1-release"
Ghc985 -> "ghc-9.8"
Ghc984 -> "ghc-9.8.4-release"
Ghc983 -> "ghc-9.8.3-release"
Ghc982 -> "ghc-9.8.2-release"
Ghc981 -> "ghc-9.8.1-release"
Ghc967 -> "ghc-9.6.7-release"
Ghc966 -> "ghc-9.6.6-release"
Ghc965 -> "ghc-9.6.5-release"
Ghc964 -> "ghc-9.6.4-release"
Ghc963 -> "ghc-9.6.3-release"
Ghc962 -> "ghc-9.6.2-release"
Ghc961 -> "ghc-9.6.1-release"
Ghc948 -> "ghc-9.4.8-release"
Ghc947 -> "ghc-9.4.7-release"
Ghc946 -> "ghc-9.4.6-release"
Ghc945 -> "ghc-9.4.5-release"
Ghc944 -> "ghc-9.4.4-release"
Ghc943 -> "ghc-9.4.3-release"
Ghc942 -> "ghc-9.4.2-release"
Ghc941 -> "ghc-9.4.1-release"
Ghc928 -> "ghc-9.2.8-release"
Ghc927 -> "ghc-9.2.7-release"
Ghc926 -> "ghc-9.2.6-release"
Ghc925 -> "ghc-9.2.5-release"
Ghc924 -> "ghc-9.2.4-release"
Ghc923 -> "ghc-9.2.3-release"
Ghc922 -> "ghc-9.2.2-release"
Ghc921 -> "ghc-9.2.1-release"
Ghc901 -> "ghc-9.0.1-release"
Ghc902 -> "ghc-9.0.2-release"
Ghc8101 -> "ghc-8.10.1-release"
Ghc8102 -> "ghc-8.10.2-release"
Ghc8103 -> "ghc-8.10.3-release"
Ghc8104 -> "ghc-8.10.4-release"
Ghc8105 -> "ghc-8.10.5-release"
Ghc8106 -> "ghc-8.10.6-release"
Ghc8107 -> "ghc-8.10.7-release"
Ghc881 -> "ghc-8.8.1-release"
Ghc882 -> "ghc-8.8.2-release"
Ghc883 -> "ghc-8.8.3-release"
Ghc884 -> "ghc-8.8.4-release"
Da DaFlavor {mergeBaseSha} -> mergeBaseSha
GhcMaster hash -> hash
copyDirectoryRecursive :: FilePath -> FilePath -> IO ()
copyDirectoryRecursive srcDir destDir = withFrozenCallStack $ do
srcFiles <- getDirectoryContentsRecursive srcDir
copyFilesWith copyFile destDir [(srcDir, f) | f <- srcFiles]
getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive topdir = recurseDirectories [""]
where
recurseDirectories :: [FilePath] -> IO [FilePath]
recurseDirectories [] = return []
recurseDirectories (dir : dirs) = unsafeInterleaveIO $ do
(files, dirs') <- collect [] [] =<< listDirectory (topdir </> dir)
files' <- recurseDirectories (dirs' ++ dirs)
return (files ++ files')
where
collect files dirs' [] = return (reverse files, reverse dirs')
collect files dirs' (entry : entries) = do
let dirEntry = dir </> entry
isDirectory <- doesDirectoryExist (topdir </> dirEntry)
if isDirectory
then collect files (dirEntry : dirs') entries
else collect (dirEntry : files) dirs' entries
copyFilesWith :: (FilePath -> FilePath -> IO ()) -> FilePath -> [(FilePath, FilePath)] -> IO ()
copyFilesWith doCopy targetDir srcFiles = withFrozenCallStack $ do
let dirs = map (targetDir </>) . nub . map (takeDirectory . snd) $ srcFiles
traverse_ (createDirectoryIfMissing True) dirs
sequence_
[ let src = srcBase </> srcFile
dest = targetDir </> srcFile
in doCopy src dest
| (srcBase, srcFile) <- srcFiles
]