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 (configureArgs, args'') = extractConfigureArgs args'
24 hooks = defaultUserHooks {
25 confHook = add_extra_deps
26 $ confHook defaultUserHooks,
27 postConf = add_configure_options configureArgs
28 $ postConf defaultUserHooks,
29 buildHook = add_ghc_options ghcArgs
31 $ buildHook defaultUserHooks,
32 instHook = filter_modules_hook
33 $ instHook defaultUserHooks }
34 withArgs args'' $ defaultMainWithHooks hooks
36 extractGhcArgs :: [String] -> ([String], [String])
37 extractGhcArgs = extractPrefixArgs "--ghc-option="
39 extractConfigureArgs :: [String] -> ([String], [String])
40 extractConfigureArgs = extractPrefixArgs "--configure-option="
42 extractPrefixArgs :: String -> [String] -> ([String], [String])
43 extractPrefixArgs prefix args
45 f (x:xs) = case f xs of
46 (wantedArgs, otherArgs) ->
47 case removePrefix prefix x of
49 (wantedArg:wantedArgs, otherArgs)
51 (wantedArgs, x:otherArgs)
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
61 type Hook a = PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> a
63 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
64 type PostConfHook = Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo
67 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
69 add_ghc_options :: [String] -> Hook a -> Hook a
70 add_ghc_options args f pd lbi muhs x
71 = do let lib' = case library pd of
73 let bi = libBuildInfo lib
74 opts = options bi ++ [(GHC, args)]
75 bi' = bi { options = opts }
76 in lib { libBuildInfo = bi' }
77 Nothing -> error "Expected a library"
78 pd' = pd { library = Just lib' }
81 add_configure_options :: [String] -> PostConfHook -> PostConfHook
82 add_configure_options args f as cfs pd lbi
83 = f (as ++ args) cfs pd lbi
85 filter_modules_hook :: Hook a -> Hook a
86 filter_modules_hook f pd lbi muhs x
87 = let build_filter = case compilerFlavor $ compiler lbi of
90 lib' = case library pd of
92 let ems = filter build_filter (exposedModules lib)
93 in lib { exposedModules = ems }
94 Nothing -> error "Expected a library"
95 pd' = pd { library = Just lib' }
98 isPortableBuild :: String -> Bool
100 | "GHC" `isPrefixOf` s = False
101 | "Data.Generics" `isPrefixOf` s = False
102 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
104 forGHCBuild :: String -> Bool
105 forGHCBuild = ("GHC.Prim" /=)
107 add_extra_deps :: ConfHook -> ConfHook
108 add_extra_deps f pd cf
110 case compilerFlavor (compiler lbi) of
112 do -- Euch. We should just add the right thing to the lbi
113 -- ourselves rather than rerunning configure.
114 let pd' = pd { buildDepends = Dependency "rts" AnyVersion