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.PreProcess
14 import Distribution.Setup
15 import Distribution.Simple.Configure
16 import Distribution.Simple.LocalBuildInfo
17 import System.Environment
21 main = do args <- getArgs
22 let (ghcArgs, args') = extractGhcArgs args
23 let hooks = defaultUserHooks {
24 confHook = add_extra_deps
25 $ confHook defaultUserHooks,
26 buildHook = add_ghc_options ghcArgs
28 $ buildHook defaultUserHooks,
29 instHook = filter_modules_hook
30 $ instHook defaultUserHooks }
31 withArgs args' $ defaultMainWithHooks hooks
33 extractGhcArgs :: [String] -> ([String], [String])
36 f (x:xs) = case f xs of
37 (ghcArgs, otherArgs) ->
38 case removePrefix "--ghc-option=" x of
40 (ghcArg:ghcArgs, otherArgs)
42 (ghcArgs, x:otherArgs)
45 removePrefix :: String -> String -> Maybe String
46 removePrefix "" ys = Just ys
47 removePrefix (x:xs) (y:ys)
48 | x == y = removePrefix xs ys
51 type Hook a = PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> a
53 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
55 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
57 add_ghc_options :: [String] -> Hook a -> Hook a
58 add_ghc_options args f pd lbi muhs x
59 = do let lib' = case library pd of
61 let bi = libBuildInfo lib
62 opts = options bi ++ [(GHC, args)]
63 bi' = bi { options = opts }
64 in lib { libBuildInfo = bi' }
65 Nothing -> error "Expected a library"
66 pd' = pd { library = Just lib' }
69 filter_modules_hook :: Hook a -> Hook a
70 filter_modules_hook f pd lbi muhs x
71 = let build_filter = case compilerFlavor $ compiler lbi of
74 lib' = case library pd of
76 let ems = filter build_filter (exposedModules lib)
77 in lib { exposedModules = ems }
78 Nothing -> error "Expected a library"
79 pd' = pd { library = Just lib' }
82 isPortableBuild :: String -> Bool
84 | "GHC" `isPrefixOf` s = False
85 | "Data.Generics" `isPrefixOf` s = False
86 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
88 forGHCBuild :: String -> Bool
89 forGHCBuild = ("GHC.Prim" /=)
91 add_extra_deps :: ConfHook -> ConfHook
92 add_extra_deps f pd cf
94 case compilerFlavor (compiler lbi) of
96 do -- Euch. We should just add the right thing to the lbi
97 -- ourselves rather than rerunning configure.
98 let pd' = pd { buildDepends = Dependency "rts" AnyVersion