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
|
{-# LANGUAGE CPP #-}
-- if MIN_VERSION_Cabal is not defined, then most likely we have old
-- GHC or/and old cabal-install in use.
#ifndef MIN_VERSION_Cabal
#define MIN_VERSION_Cabal(x,y,z) 0
#endif
import Distribution.Simple
import Distribution.Simple.Setup
import Distribution.PackageDescription
import Distribution.Simple.LocalBuildInfo
import Distribution.InstalledPackageInfo
import Distribution.Simple.Program
import qualified Distribution.Simple.PackageIndex as Pkg
import System.Exit
import System.IO
import Data.IORef
import Data.Char
import Data.Maybe
import System.Directory
main = defaultMainWithHooks simpleUserHooks {
postConf = defaultPostConf,
preBuild = readHook,
preCopy = readHook,
preInst = readHook,
preHscolour = readHook,
preHaddock = readHook,
preReg = readHook,
preUnreg = readHook
}
where
defaultPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
defaultPostConf args flags pkgdescr lbi = do
#if MIN_VERSION_Cabal(2,3,0)
libdir_ <- getDbProgramOutput (fromFlag (configVerbosity flags))
#else
libdir_ <- rawSystemProgramStdoutConf (fromFlag (configVerbosity flags))
#endif
ghcProgram (withPrograms lbi) ["--print-libdir"]
let libdir = reverse $ dropWhile isSpace $ reverse libdir_
ghc_pkg = case lookupProgram ghcPkgProgram (withPrograms lbi) of
Just p -> programPath p
Nothing -> error "ghc-pkg was not found"
ghc = case lookupProgram ghcProgram (withPrograms lbi) of
Just p -> programPath p
Nothing -> error "ghc was not found"
-- figure out docdir from base's haddock-html field
base_pkg = case Pkg.searchByName (installedPkgs lbi) "base" of
Pkg.None -> error "no base package"
Pkg.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))
c_ghc_pkg <- canonicalizePath ghc_pkg
c_ghc <- canonicalizePath ghc
let buildinfo = emptyBuildInfo{
cppOptions = ["-DGHC_PATHS_GHC_PKG=" ++ show c_ghc_pkg,
"-DGHC_PATHS_GHC=" ++ show c_ghc,
"-DGHC_PATHS_LIBDIR=" ++ show libdir,
"-DGHC_PATHS_DOCDIR=" ++ show docdir ]
}
writeFile file (show buildinfo)
readHook :: Args -> a -> IO HookedBuildInfo
readHook _ _ = do
str <- readFile file
return (Just (read str), [])
file = "ghc-paths.buildinfo"
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
|
