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
|
-- A wrapper script for Cabal Setup.hs scripts. Allows compiling the real Setup
-- conditionally depending on the Cabal version.
module SetupWrapper (setupWrapper) where
import Distribution.Package
import Distribution.Compiler
import Distribution.Simple.Utils
import Distribution.Simple.Program
import Distribution.Simple.Compiler
import Distribution.Simple.BuildPaths (exeExtension)
import Distribution.Simple.Configure (configCompiler)
import Distribution.Simple.GHC (getInstalledPackages)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Version
import Distribution.Verbosity
import Distribution.Text
import System.Environment
import System.Process
import System.Exit
import System.FilePath
import System.Directory
import qualified Control.Exception as Exception
import System.IO.Error (isDoesNotExistError)
import Data.List
import Data.Char
import Control.Monad
setupWrapper :: FilePath -> IO ()
setupWrapper setupHsFile = do
args <- getArgs
createDirectoryIfMissingVerbose verbosity True setupDir
compileSetupExecutable
invokeSetupScript args
where
setupDir = "dist/setup-wrapper"
setupVersionFile = setupDir </> "setup" <.> "version"
setupProgFile = setupDir </> "setup" <.> exeExtension
setupMacroFile = setupDir </> "wrapper-macros.h"
useCabalVersion = Version [1,8] []
usePackageDB = [GlobalPackageDB, UserPackageDB]
verbosity = normal
cabalLibVersionToUse comp conf = do
savedVersion <- savedCabalVersion
case savedVersion of
Just version
-> return version
_ -> do version <- installedCabalVersion comp conf
writeFile setupVersionFile (show version ++ "\n")
return version
savedCabalVersion = do
versionString <- readFile setupVersionFile
`Exception.catch` \e -> if isDoesNotExistError e
then return ""
else Exception.throwIO e
case reads versionString of
[(version,s)] | all isSpace s -> return (Just version)
_ -> return Nothing
installedCabalVersion comp conf = do
index <- getInstalledPackages verbosity usePackageDB conf
let cabalDep = Dependency (PackageName "Cabal")
(orLaterVersion useCabalVersion)
case PackageIndex.lookupDependency index cabalDep of
[] -> die $ "The package requires Cabal library version "
++ display useCabalVersion
++ " but no suitable version is installed."
pkgs -> return $ bestVersion (map fst pkgs)
where
bestVersion = maximumBy (comparing preference)
preference version = (sameVersion, sameMajorVersion
,stableVersion, latestVersion)
where
sameVersion = version == cabalVersion
sameMajorVersion = majorVersion version == majorVersion cabalVersion
majorVersion = take 2 . versionBranch
stableVersion = case versionBranch version of
(_:x:_) -> even x
_ -> False
latestVersion = version
-- | If the Setup.hs is out of date wrt the executable then recompile it.
-- Currently this is GHC only. It should really be generalised.
--
compileSetupExecutable = do
setupHsNewer <- setupHsFile `moreRecentFile` setupProgFile
cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile
let outOfDate = setupHsNewer || cabalVersionNewer
when outOfDate $ do
debug verbosity "Setup script is out of date, compiling..."
(comp, conf) <- configCompiler (Just GHC) Nothing Nothing
defaultProgramConfiguration verbosity
cabalLibVersion <- cabalLibVersionToUse comp conf
let cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion
debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion
writeFile setupMacroFile (generateVersionMacro cabalLibVersion)
rawSystemProgramConf verbosity ghcProgram conf $
["--make", setupHsFile, "-o", setupProgFile]
++ ghcPackageDbOptions usePackageDB
++ ["-package", display cabalPkgid
,"-cpp", "-optP-include", "-optP" ++ setupMacroFile
,"-odir", setupDir, "-hidir", setupDir]
where
ghcPackageDbOptions dbstack = case dbstack of
(GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs
(GlobalPackageDB:dbs) -> "-no-user-package-conf"
: concatMap specific dbs
_ -> ierror
where
specific (SpecificPackageDB db) = [ "-package-conf", db ]
specific _ = ierror
ierror = error "internal error: unexpected package db stack"
generateVersionMacro :: Version -> String
generateVersionMacro version =
concat
["/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n"
,"#define CABAL_VERSION_CHECK(major1,major2,minor) (\\\n"
," (major1) < ",major1," || \\\n"
," (major1) == ",major1," && (major2) < ",major2," || \\\n"
," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
,"\n\n"
]
where
(major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)
invokeSetupScript :: [String] -> IO ()
invokeSetupScript args = do
info verbosity $ unwords (setupProgFile : args)
process <- runProcess (currentDir </> setupProgFile) args
Nothing Nothing
Nothing Nothing Nothing
exitCode <- waitForProcess process
unless (exitCode == ExitSuccess) $ exitWith exitCode
moreRecentFile :: FilePath -> FilePath -> IO Bool
moreRecentFile a b = do
exists <- doesFileExist b
if not exists
then return True
else do tb <- getModificationTime b
ta <- getModificationTime a
return (ta > tb)
|
