fix isPortableBuild test
[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.PreProcess
14 import Distribution.Setup
15 import Distribution.Simple.Configure
16 import Distribution.Simple.LocalBuildInfo
17 import System.Environment
18 import System.Exit
19
20 main :: IO ()
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
27 $ filter_modules_hook
28 $ buildHook defaultUserHooks,
29 instHook = filter_modules_hook
30 $ instHook defaultUserHooks }
31 withArgs args' $ defaultMainWithHooks hooks
32
33 extractGhcArgs :: [String] -> ([String], [String])
34 extractGhcArgs args
35 = let f [] = ([], [])
36 f (x:xs) = case f xs of
37 (ghcArgs, otherArgs) ->
38 case removePrefix "--ghc-option=" x of
39 Just ghcArg ->
40 (ghcArg:ghcArgs, otherArgs)
41 Nothing ->
42 (ghcArgs, x:otherArgs)
43 in f args
44
45 removePrefix :: String -> String -> Maybe String
46 removePrefix "" ys = Just ys
47 removePrefix (x:xs) (y:ys)
48 | x == y = removePrefix xs ys
49 | otherwise = Nothing
50
51 type Hook a = PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> a
52 -> IO ()
53 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
54
55 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
56
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
60 Just lib ->
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' }
67 f pd' lbi muhs x
68
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
72 GHC -> forGHCBuild
73 _ -> isPortableBuild
74 lib' = case library pd of
75 Just lib ->
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' }
80 in f pd' lbi muhs x
81
82 isPortableBuild :: String -> Bool
83 isPortableBuild s
84 | "GHC" `isPrefixOf` s = False
85 | "Data.Generics" `isPrefixOf` s = False
86 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
87
88 forGHCBuild :: String -> Bool
89 forGHCBuild = ("GHC.Prim" /=)
90
91 add_extra_deps :: ConfHook -> ConfHook
92 add_extra_deps f pd cf
93 = do lbi <- f pd cf
94 case compilerFlavor (compiler lbi) of
95 GHC ->
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
99 : buildDepends pd }
100 f pd' cf
101 _ ->
102 return lbi
103