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
|
#!/usr/bin/runghc
\begin{code}
import Data.Maybe(fromMaybe)
import Distribution.PackageDescription
import Distribution.Setup
import Distribution.Simple
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.Utils(rawSystemVerbose)
import System.Info
import System.Exit
import System.Directory
import System.Process(runInteractiveProcess, waitForProcess)
import System.IO(hClose, hGetContents, hPutStr, stderr)
import Control.Monad(when)
import Control.Exception(try)
main = defaultMainWithHooks defaultUserHooks{preConf=preConf, postConf=postConf}
where
preConf :: [String] -> ConfigFlags -> IO HookedBuildInfo
preConf args flags = do
try (removeFile "MySQL.buildinfo")
return emptyHookedBuildInfo
postConf :: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ExitCode
postConf args flags _ localbuildinfo = do
mb_bi <- mysqlConfigBuildInfo (configVerbose flags)
writeHookedBuildInfo "MySQL.buildinfo" (Just (fromMaybe emptyBuildInfo{extraLibs=["mysqlclient"]} mb_bi),[])
return ExitSuccess
\end{code}
The following code is derived from Distribution.Simple.Configure
\begin{code}
findProgram
:: String -- ^ program name
-> Maybe FilePath -- ^ optional explicit path
-> IO (Maybe FilePath)
findProgram name Nothing = do
mb_path <- findExecutable name
case mb_path of
Nothing -> message ("No " ++ name ++ " found")
Just path -> message ("Using " ++ name ++ ": " ++ path)
return mb_path
findProgram name (Just path) = do
message ("Using " ++ name ++ ": " ++ path)
return (Just path)
rawSystemGrabOutput :: Int -> FilePath -> [String] -> IO String
rawSystemGrabOutput verbose path args = do
when (verbose > 0) $
putStrLn (path ++ concatMap (' ':) args)
(inp,out,err,pid) <- runInteractiveProcess path args Nothing Nothing
exitCode <- waitForProcess pid
if exitCode /= ExitSuccess
then do errMsg <- hGetContents err
hPutStr stderr errMsg
exitWith exitCode
else return ()
hClose inp
hClose err
hGetContents out
message :: String -> IO ()
message s = putStrLn $ "configure: " ++ s
\end{code}
Populate BuildInfo using pkg-config tool.
\begin{code}
mysqlConfigBuildInfo :: Int -> IO (Maybe BuildInfo)
mysqlConfigBuildInfo verbose = do
mb_mysql_config_path <- findProgram "mysql_config" Nothing
case mb_mysql_config_path of
Just mysql_config_path -> do
message ("configuring mysqlclient library")
res <- rawSystemGrabOutput verbose mysql_config_path ["--libs"]
let (lib_dirs,libs,ld_opts) = splitLibsFlags (words res)
res <- rawSystemGrabOutput verbose mysql_config_path ["--cflags"]
let (inc_dirs,cc_opts) = splitCFlags (words res)
let bi = emptyBuildInfo{extraLibDirs=lib_dirs, extraLibs=libs, ldOptions=ld_opts, includeDirs=inc_dirs, ccOptions=cc_opts}
return (Just bi)
Nothing -> do
message ("The package will be built using default settings for mysqlclient library")
return Nothing
where
splitLibsFlags [] = ([],[],[])
splitLibsFlags (arg:args) =
case arg of
('-':'L':lib_dir) -> let (lib_dirs,libs,ld_opts) = splitLibsFlags args
in (lib_dir:lib_dirs,libs,ld_opts)
('-':'l':lib) -> let (lib_dirs,libs,ld_opts) = splitLibsFlags args
in (lib_dirs,lib:libs,ld_opts)
ld_opt -> let (lib_dirs,libs,ld_opts) = splitLibsFlags args
in (lib_dirs,libs,ld_opt:ld_opts)
splitCFlags [] = ([],[])
splitCFlags (arg:args) =
case arg of
('-':'I':inc_dir) -> let (inc_dirs,c_opts) = splitCFlags args
in (inc_dir:inc_dirs,c_opts)
c_opt -> let (inc_dirs,c_opts) = splitCFlags args
in (inc_dirs,c_opt:c_opts)
\end{code}
|
