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.PackageDescription
12 import Distribution.Setup
13 import Distribution.Simple
14 import Distribution.Simple.LocalBuildInfo
15 import Distribution.Simple.Utils
17 import System.Environment
18 import System.FilePath
22 main = do args <- getArgs
23 let (ghcArgs, args') = extractGhcArgs args
24 (confArgs, args'') = extractConfigureArgs args'
25 hooks = defaultUserHooks {
26 confHook = add_extra_deps
27 $ confHook defaultUserHooks,
28 postConf = add_configure_options confArgs
29 $ postConf defaultUserHooks,
30 buildHook = build_primitive_sources
31 $ add_ghc_options ghcArgs
33 $ buildHook defaultUserHooks,
34 makefileHook = add_ghc_options ghcArgs
36 $ makefileHook defaultUserHooks,
37 regHook = add_extra_libs
38 $ regHook defaultUserHooks,
39 instHook = filter_modules_hook
40 $ instHook defaultUserHooks }
41 withArgs args'' $ defaultMainWithHooks hooks
43 extractGhcArgs :: [String] -> ([String], [String])
44 extractGhcArgs = extractPrefixArgs "--ghc-option="
46 extractConfigureArgs :: [String] -> ([String], [String])
47 extractConfigureArgs = extractPrefixArgs "--configure-option="
49 extractPrefixArgs :: String -> [String] -> ([String], [String])
50 extractPrefixArgs the_prefix args
52 f (x:xs) = case f xs of
53 (wantedArgs, otherArgs) ->
54 case removePrefix the_prefix x of
56 (wantedArg:wantedArgs, otherArgs)
58 (wantedArgs, x:otherArgs)
61 removePrefix :: String -> String -> Maybe String
62 removePrefix "" ys = Just ys
63 removePrefix _ "" = Nothing
64 removePrefix (x:xs) (y:ys)
65 | x == y = removePrefix xs ys
68 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
69 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
70 type PostConfHook = Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo
73 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
75 build_primitive_sources :: Hook a -> Hook a
76 build_primitive_sources f pd lbi uhs x
77 = do when (compilerFlavor (compiler lbi) == GHC) $ do
78 let genprimopcode = joinPath ["..", "..", "utils",
79 "genprimopcode", "genprimopcode"]
80 primops = joinPath ["..", "..", "compiler", "prelude",
82 primhs = joinPath ["GHC", "Prim.hs"]
83 primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"]
84 maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
85 ++ primops ++ " > " ++ primhs)
86 maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
87 ++ primops ++ " > " ++ primopwrappers)
90 add_ghc_options :: [String] -> Hook a -> Hook a
91 add_ghc_options args f pd lbi uhs x
92 = do let lib' = case library pd of
94 let bi = libBuildInfo lib
95 opts = options bi ++ [(GHC, args)]
96 bi' = bi { options = opts }
97 in lib { libBuildInfo = bi' }
98 Nothing -> error "Expected a library"
99 pd' = pd { library = Just lib' }
102 add_configure_options :: [String] -> PostConfHook -> PostConfHook
103 add_configure_options args f as cfs pd lbi
104 = f (as ++ args) cfs pd lbi
106 filter_modules_hook :: Hook a -> Hook a
107 filter_modules_hook f pd lbi uhs x
108 = let build_filter = case compilerFlavor $ compiler lbi of
111 lib' = case library pd of
113 let ems = filter build_filter (exposedModules lib)
114 in lib { exposedModules = ems }
115 Nothing -> error "Expected a library"
116 pd' = pd { library = Just lib' }
119 isPortableBuild :: String -> Bool
121 | "GHC" `isPrefixOf` s = False
122 | "Data.Generics" `isPrefixOf` s = False
123 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
125 forGHCBuild :: String -> Bool
126 forGHCBuild = ("GHC.Prim" /=)
128 add_extra_deps :: ConfHook -> ConfHook
129 add_extra_deps f pd cf
131 case compilerFlavor (compiler lbi) of
133 do -- Euch. We should just add the right thing to the lbi
134 -- ourselves rather than rerunning configure.
135 let pd' = pd { buildDepends = Dependency "rts" AnyVersion
141 add_extra_libs :: Hook a -> Hook a
142 add_extra_libs f pd lbi uhs x
143 = let pd' = if (os == "mingw32") && (compilerFlavor (compiler lbi) == GHC)
144 then case library pd of
146 let lib_bi = libBuildInfo lib
147 lib_bi' = lib_bi { extraLibs = "wsock32"
153 lib' = lib { libBuildInfo = lib_bi' }
154 in pd { library = Just lib' }
155 Nothing -> error "Expected a library"