blob: 31ee04eb81684e002247aa104cae2b943d3eae44 (
plain)
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
|
{-
Setup.hs: based on code from ghc-paths of Simon Marlow
Fixed to not use the .buildinfo, and use -Dfoo flags for both libraries and executables
-}
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.InstalledPackageInfo
import Distribution.Simple.Program
import Distribution.Simple.PackageIndex as Pkg
import System.Exit
import System.IO
import Data.IORef
import Data.Char
import Data.Maybe
main = defaultMainWithHooks simpleUserHooks {
confHook = myCustomConfHook
}
where
myCustomConfHook :: (Either GenericPackageDescription PackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
myCustomConfHook egpdpdhbi flags = do
-- get the default LBI
lbi <- confHook simpleUserHooks egpdpdhbi flags
let programs = withPrograms lbi
libdir_ <- rawSystemProgramStdoutConf (fromFlag (configVerbosity flags))
ghcProgram programs ["--print-libdir"]
let libdir = reverse $ dropWhile isSpace $ reverse libdir_
ghc_pkg = case lookupProgram ghcPkgProgram programs of
Just p -> programPath p
Nothing -> error "ghc-pkg was not found"
ghc = case lookupProgram ghcProgram programs of
Just p -> programPath p
Nothing -> error "ghc was not found"
-- figure out docdir from base's haddock-html field
base_pkg = case searchByName (installedPkgs lbi) "base" of
None -> error "no base package"
Unambiguous (x:_) -> x
_ -> error "base ambiguous"
base_html = case haddockHTMLs base_pkg of
[] -> ""
(x:_) -> x
docdir = fromMaybe base_html $
fmap reverse (stripPrefix (reverse "/libraries/base")
(reverse base_html))
let programs' = userSpecifyArgs "ghc" ["-DGHC_PATHS_GHC_PKG=" ++ show ghc_pkg,
"-DGHC_PATHS_GHC=" ++ show ghc,
"-DGHC_PATHS_LIBDIR=" ++ show libdir,
"-DGHC_PATHS_DOCDIR=" ++ show docdir
] programs
-- returning our modified LBI that includes the -D definitions
return lbi { withPrograms = programs' }
die :: String -> IO a
die msg = do
hFlush stdout
hPutStr stderr msg
exitWith (ExitFailure 1)
stripPrefix :: Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [] ys = Just ys
stripPrefix (x:xs) (y:ys)
| x == y = stripPrefix xs ys
stripPrefix _ _ = Nothing
|
GitWeb
