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
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE PatternGuards #-}
import System.Directory
import System.Environment
import System.FilePath
import System.Info
import Control.Monad
import Data.Char ( isSpace )
import Data.List
import Data.Maybe
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.InstalledPackageInfo
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Install
import Distribution.Simple.Register
import Distribution.Simple.Utils
import Distribution.Text ( display )
main = do
let hooks = autoconfUserHooks { postConf = if os == "mingw32"
then generateBuildInfo
else postConf autoconfUserHooks
, instHook = installHookWithExtraGhciLibraries
, regHook = regHookWithExtraGhciLibraries
}
defaultMainWithHooks hooks
-- On Windows we can't count on the configure script, so generate the
-- llvm.buildinfo from a template.
generateBuildInfo _ conf _ _ = do
let args = configConfigureArgs conf
let pref = "--with-llvm-prefix="
let path = case [ p | arg <- args, Just p <- [stripPrefix pref arg] ] of
[p] -> p
_ -> error $ "Use '--configure-option " ++ pref ++ "PATH' to give LLVM installation path"
info <- readFile "llvm.buildinfo.windows.in"
writeFile "llvm.buildinfo" $ subst "@llvm_path@" path info
subst from to [] = []
subst from to xs | Just r <- stripPrefix from xs = to ++ subst from to r
subst from to (x:xs) = x : subst from to xs
{-
To compensate for Cabal's current design,
we need to replicate the default registration hook code here,
to inject a value for extra-ghci-libraries into the package registration info.
(Inspired by 'Gtk2HsSetup.hs'.)
This only works for Cabal 1.10,
thus we added an according constraint to llvm.cabal.
We define an extension field 'x-extra-ghci-libraries' in the .buildinfo file
in order to communicate the version information of the LLVM dynamic library
from the configure script to the registration code.
-}
installHookWithExtraGhciLibraries :: PackageDescription -> LocalBuildInfo
-> UserHooks -> InstallFlags -> IO ()
installHookWithExtraGhciLibraries pkg_descr localbuildinfo _ flags = do
let copyFlags = defaultCopyFlags {
copyDistPref = installDistPref flags,
copyDest = toFlag NoCopyDest,
copyVerbosity = installVerbosity flags
}
install pkg_descr localbuildinfo copyFlags
let registerFlags = defaultRegisterFlags {
regDistPref = installDistPref flags,
regInPlace = installInPlace flags,
regPackageDB = installPackageDB flags,
regVerbosity = installVerbosity flags
}
when (hasLibs pkg_descr) $ register' pkg_descr localbuildinfo registerFlags
regHookWithExtraGhciLibraries :: PackageDescription -> LocalBuildInfo
-> UserHooks -> RegisterFlags -> IO ()
regHookWithExtraGhciLibraries pkg_descr localbuildinfo _ flags =
if hasLibs pkg_descr
then register' pkg_descr localbuildinfo flags
else setupMessage verbosity
"Package contains no library to register:" (packageId pkg_descr)
where verbosity = fromFlag (regVerbosity flags)
register' :: PackageDescription -> LocalBuildInfo
-> RegisterFlags -- ^Install in the user's database?; verbose
-> IO ()
register' pkg@PackageDescription { library = Just lib }
lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags
= do
installedPkgInfoRaw <- generateRegistrationInfo
verbosity pkg lib lbi clbi inplace distPref
let ghciLibraries = case lookup "x-extra-ghci-libraries" (customFieldsBI (libBuildInfo lib)) of
Just s | not (all isSpace s) -> [s]
_ -> []
installedPkgInfo = installedPkgInfoRaw {
extraGHCiLibraries = ghciLibraries }
-- Three different modes:
case () of
_ | modeGenerateRegFile -> writeRegistrationFile installedPkgInfo
| modeGenerateRegScript -> die "Generate Reg Script not supported"
| otherwise -> registerPackage verbosity
installedPkgInfo pkg lbi inplace
(withPackageDB lbi)
where
modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
modeGenerateRegScript = fromFlag (regGenScript regFlags)
inplace = fromFlag (regInPlace regFlags)
packageDb = nub $ withPackageDB lbi ++
maybeToList (flagToMaybe (regPackageDB regFlags))
distPref = fromFlag (regDistPref regFlags)
verbosity = fromFlag (regVerbosity regFlags)
regFile = fromMaybe (display (packageId pkg) <.> "conf")
(fromFlag (regGenPkgConf regFlags))
writeRegistrationFile installedPkgInfo = do
notice verbosity ("Creating package registration file: " ++ regFile)
writeUTF8File regFile (showInstalledPackageInfo installedPkgInfo)
register' _ _ regFlags = notice verbosity "No package to register"
where
verbosity = fromFlag (regVerbosity regFlags)
|