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
|
import Distribution.Helper
import System.Environment.Extra (lookupEnv)
import System.Posix.Env (setEnv)
import System.Process
import System.Exit
import Data.Maybe
import Data.Version
import Data.Functor
import Control.Exception as E
import Control.Arrow
import Prelude
import CabalHelper.Common
import CabalHelper.Compile
import CabalHelper.Types
main :: IO ()
main = do
flip (setEnv "HOME") True =<< fromMaybe "/tmp" <$> lookupEnv "TMPDIR"
_ <- rawSystem "cabal" ["update"]
writeAutogenFiles' $ defaultQueryEnv "." "./dist"
let parseVer' "HEAD" = Left HEAD
parseVer' v = Right $ parseVer v
let vers :: [(Version, [Either HEAD Version])]
vers = map (parseVer *** map parseVer') [
("7.4", [ -- "1.14.0" -- not supported at runtime
]),
("7.6", [ "1.16.0"
, "1.16.0.1"
, "1.16.0.2"
, "1.16.0.3"
]),
("7.8", [
"1.18.0"
, "1.18.1"
, "1.18.1.1"
, "1.18.1.2"
, "1.18.1.3"
, "1.18.1.4"
, "1.18.1.5"
, "1.18.1.6"
, "1.18.1.7"
, "1.20.0.0"
, "1.20.0.1"
, "1.20.0.2"
, "1.20.0.3"
, "1.20.0.4"
, "1.22.0.0"
, "1.22.1.0"
, "1.22.1.1"
]),
("7.10", [
"1.22.2.0"
, "1.22.3.0"
, "1.22.4.0"
, "1.22.5.0"
, "1.22.6.0"
, "1.22.7.0"
, "1.22.8.0"
]),
("8.0", [
"1.24.0.0"
, "1.24.1.0"
, "1.24.2.0"
-- , "HEAD"
])
]
ghcVer <- majorVer <$> ghcVersion defaultOptions
let cabalVers = reverse $ concat $ map snd $ dropWhile ((<ghcVer) . fst) vers
rvs <- mapM compilePrivatePkgDb cabalVers
let printStatus (cv, rv) = putStrLn $ "- Cabal "++show cv++" "++status
where status = case rv of
Right _ ->
"suceeded"
Left rvc ->
"failed (exit code "++show rvc++")"
let drvs = cabalVers `zip` rvs
mapM_ printStatus (cabalVers `zip` rvs)
if any isLeft' $ map snd $ filter ((/=Left HEAD) . fst) drvs
then exitFailure
else exitSuccess
where
isLeft' (Left _) = True
isLeft' (Right _) = False
data HEAD = HEAD deriving (Eq, Show)
compilePrivatePkgDb :: Either HEAD Version -> IO (Either ExitCode FilePath)
compilePrivatePkgDb (Left HEAD) = do
_ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ]
(db, commit) <- installCabalHEAD defaultOptions { verbose = True } `E.catch`
\(SomeException ex) ->
error $ "Installing cabal HEAD failed: " ++ show ex
compileWithPkg "." (Just db) (Left commit)
compilePrivatePkgDb (Right cabalVer) = do
_ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ]
db <- installCabal defaultOptions { verbose = True } cabalVer `E.catch`
\(SomeException _) ->
errorInstallCabal cabalVer "dist"
compileWithPkg "." (Just db) (Right cabalVer)
compileWithPkg :: FilePath
-> Maybe FilePath
-> Either String Version
-> IO (Either ExitCode FilePath)
compileWithPkg chdir mdb ver =
compile "dist" defaultOptions { verbose = True } $
Compile chdir Nothing mdb ver [cabalPkgId ver]
cabalPkgId :: Either String Version -> String
cabalPkgId (Left _commitid) = "Cabal"
cabalPkgId (Right v) = "Cabal-" ++ showVersion v
|
