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.
7 module Main (main) where
11 import Distribution.Simple
12 import Distribution.PackageDescription
13 import Distribution.Setup
14 import Distribution.Simple.LocalBuildInfo
15 import System.Environment
19 main = do args <- getArgs
20 let (ghcArgs, args') = extractGhcArgs args
21 (confArgs, args'') = extractConfigureArgs args'
22 hooks = defaultUserHooks {
23 confHook = add_extra_deps
24 $ confHook defaultUserHooks,
25 postConf = add_configure_options confArgs
26 $ postConf defaultUserHooks,
27 buildHook = add_ghc_options ghcArgs
29 $ buildHook defaultUserHooks,
30 instHook = filter_modules_hook
31 $ instHook defaultUserHooks }
32 withArgs args'' $ defaultMainWithHooks hooks
34 extractGhcArgs :: [String] -> ([String], [String])
35 extractGhcArgs = extractPrefixArgs "--ghc-option="
37 extractConfigureArgs :: [String] -> ([String], [String])
38 extractConfigureArgs = extractPrefixArgs "--configure-option="
40 extractPrefixArgs :: String -> [String] -> ([String], [String])
41 extractPrefixArgs the_prefix args
43 f (x:xs) = case f xs of
44 (wantedArgs, otherArgs) ->
45 case removePrefix the_prefix x of
47 (wantedArg:wantedArgs, otherArgs)
49 (wantedArgs, x:otherArgs)
52 removePrefix :: String -> String -> Maybe String
53 removePrefix "" ys = Just ys
54 removePrefix _ "" = Nothing
55 removePrefix (x:xs) (y:ys)
56 | x == y = removePrefix xs ys
59 type Hook a = PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> a
61 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
62 type PostConfHook = Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo
65 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
67 add_ghc_options :: [String] -> Hook a -> Hook a
68 add_ghc_options args f pd lbi muhs x
69 = do let lib' = case library pd of
71 let bi = libBuildInfo lib
72 opts = options bi ++ [(GHC, args)]
73 bi' = bi { options = opts }
74 in lib { libBuildInfo = bi' }
75 Nothing -> error "Expected a library"
76 pd' = pd { library = Just lib' }
79 add_configure_options :: [String] -> PostConfHook -> PostConfHook
80 add_configure_options args f as cfs pd lbi
81 = f (as ++ args) cfs pd lbi
83 filter_modules_hook :: Hook a -> Hook a
84 filter_modules_hook f pd lbi muhs x
85 = let build_filter = case compilerFlavor $ compiler lbi of
88 lib' = case library pd of
90 let ems = filter build_filter (exposedModules lib)
91 in lib { exposedModules = ems }
92 Nothing -> error "Expected a library"
93 pd' = pd { library = Just lib' }
96 isPortableBuild :: String -> Bool
98 | "GHC" `isPrefixOf` s = False
99 | "Data.Generics" `isPrefixOf` s = False
100 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
102 forGHCBuild :: String -> Bool
103 forGHCBuild = ("GHC.Prim" /=)
105 add_extra_deps :: ConfHook -> ConfHook
106 add_extra_deps f pd cf
108 case compilerFlavor (compiler lbi) of
110 do -- Euch. We should just add the right thing to the lbi
111 -- ourselves rather than rerunning configure.
112 let pd' = pd { buildDepends = Dependency "rts" AnyVersion