Follow Cabal changes in Setup.hs
[packages/random.git] / Setup.hs
1
2 {-
3 We need to do some ugly hacks here as base mix of portable and
4 unportable stuff, as well as home to some GHC magic.
5 -}
6
7 module Main (main) where
8
9 import Control.Monad
10 import Data.List
11 import Distribution.Simple
12 import Distribution.PackageDescription
13 import Distribution.Setup
14 import Distribution.Simple.LocalBuildInfo
15 import System.Environment
16
17 main :: IO ()
18 main = do args <- getArgs
19 let (ghcArgs, args') = extractGhcArgs args
20 (confArgs, args'') = extractConfigureArgs args'
21 hooks = defaultUserHooks {
22 confHook = add_extra_deps
23 $ confHook defaultUserHooks,
24 postConf = add_configure_options confArgs
25 $ postConf defaultUserHooks,
26 buildHook = add_ghc_options ghcArgs
27 $ filter_modules_hook
28 $ buildHook defaultUserHooks,
29 makefileHook = add_ghc_options ghcArgs
30 $ filter_modules_hook
31 $ makefileHook defaultUserHooks,
32 instHook = filter_modules_hook
33 $ instHook defaultUserHooks }
34 withArgs args'' $ defaultMainWithHooks hooks
35
36 extractGhcArgs :: [String] -> ([String], [String])
37 extractGhcArgs = extractPrefixArgs "--ghc-option="
38
39 extractConfigureArgs :: [String] -> ([String], [String])
40 extractConfigureArgs = extractPrefixArgs "--configure-option="
41
42 extractPrefixArgs :: String -> [String] -> ([String], [String])
43 extractPrefixArgs the_prefix args
44 = let f [] = ([], [])
45 f (x:xs) = case f xs of
46 (wantedArgs, otherArgs) ->
47 case removePrefix the_prefix x of
48 Just wantedArg ->
49 (wantedArg:wantedArgs, otherArgs)
50 Nothing ->
51 (wantedArgs, x:otherArgs)
52 in f args
53
54 removePrefix :: String -> String -> Maybe String
55 removePrefix "" ys = Just ys
56 removePrefix _ "" = Nothing
57 removePrefix (x:xs) (y:ys)
58 | x == y = removePrefix xs ys
59 | otherwise = Nothing
60
61 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
62 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
63 type PostConfHook = Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo
64 -> IO ()
65
66 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
67
68 add_ghc_options :: [String] -> Hook a -> Hook a
69 add_ghc_options args f pd lbi uhs x
70 = do let lib' = case library pd of
71 Just lib ->
72 let bi = libBuildInfo lib
73 opts = options bi ++ [(GHC, args)]
74 bi' = bi { options = opts }
75 in lib { libBuildInfo = bi' }
76 Nothing -> error "Expected a library"
77 pd' = pd { library = Just lib' }
78 f pd' lbi uhs x
79
80 add_configure_options :: [String] -> PostConfHook -> PostConfHook
81 add_configure_options args f as cfs pd lbi
82 = f (as ++ args) cfs pd lbi
83
84 filter_modules_hook :: Hook a -> Hook a
85 filter_modules_hook f pd lbi uhs x
86 = let build_filter = case compilerFlavor $ compiler lbi of
87 GHC -> forGHCBuild
88 _ -> isPortableBuild
89 lib' = case library pd of
90 Just lib ->
91 let ems = filter build_filter (exposedModules lib)
92 in lib { exposedModules = ems }
93 Nothing -> error "Expected a library"
94 pd' = pd { library = Just lib' }
95 in f pd' lbi uhs x
96
97 isPortableBuild :: String -> Bool
98 isPortableBuild s
99 | "GHC" `isPrefixOf` s = False
100 | "Data.Generics" `isPrefixOf` s = False
101 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
102
103 forGHCBuild :: String -> Bool
104 forGHCBuild = ("GHC.Prim" /=)
105
106 add_extra_deps :: ConfHook -> ConfHook
107 add_extra_deps f pd cf
108 = do lbi <- f pd cf
109 case compilerFlavor (compiler lbi) of
110 GHC ->
111 do -- Euch. We should just add the right thing to the lbi
112 -- ourselves rather than rerunning configure.
113 let pd' = pd { buildDepends = Dependency "rts" AnyVersion
114 : buildDepends pd }
115 f pd' cf
116 _ ->
117 return lbi
118