the "unknown" types are no longer required
[packages/old-time.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.Setup
14 import Distribution.Simple.LocalBuildInfo
15 import System.Environment
16 import System.Info
17
18 main :: IO ()
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
28 $ filter_modules_hook
29 $ buildHook defaultUserHooks,
30 makefileHook = add_ghc_options ghcArgs
31 $ filter_modules_hook
32 $ makefileHook defaultUserHooks,
33 regHook = add_extra_libs
34 $ regHook defaultUserHooks,
35 instHook = filter_modules_hook
36 $ instHook defaultUserHooks }
37 withArgs args'' $ defaultMainWithHooks hooks
38
39 extractGhcArgs :: [String] -> ([String], [String])
40 extractGhcArgs = extractPrefixArgs "--ghc-option="
41
42 extractConfigureArgs :: [String] -> ([String], [String])
43 extractConfigureArgs = extractPrefixArgs "--configure-option="
44
45 extractPrefixArgs :: String -> [String] -> ([String], [String])
46 extractPrefixArgs the_prefix args
47 = let f [] = ([], [])
48 f (x:xs) = case f xs of
49 (wantedArgs, otherArgs) ->
50 case removePrefix the_prefix x of
51 Just wantedArg ->
52 (wantedArg:wantedArgs, otherArgs)
53 Nothing ->
54 (wantedArgs, x:otherArgs)
55 in f args
56
57 removePrefix :: String -> String -> Maybe String
58 removePrefix "" ys = Just ys
59 removePrefix _ "" = Nothing
60 removePrefix (x:xs) (y:ys)
61 | x == y = removePrefix xs ys
62 | otherwise = Nothing
63
64 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
65 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
66 type PostConfHook = Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo
67 -> IO ()
68
69 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
70
71 add_ghc_options :: [String] -> Hook a -> Hook a
72 add_ghc_options args f pd lbi uhs x
73 = do let lib' = case library pd of
74 Just lib ->
75 let bi = libBuildInfo lib
76 opts = options bi ++ [(GHC, args)]
77 bi' = bi { options = opts }
78 in lib { libBuildInfo = bi' }
79 Nothing -> error "Expected a library"
80 pd' = pd { library = Just lib' }
81 f pd' lbi uhs x
82
83 add_configure_options :: [String] -> PostConfHook -> PostConfHook
84 add_configure_options args f as cfs pd lbi
85 = f (as ++ args) cfs pd lbi
86
87 filter_modules_hook :: Hook a -> Hook a
88 filter_modules_hook f pd lbi uhs x
89 = let build_filter = case compilerFlavor $ compiler lbi of
90 GHC -> forGHCBuild
91 _ -> isPortableBuild
92 lib' = case library pd of
93 Just lib ->
94 let ems = filter build_filter (exposedModules lib)
95 in lib { exposedModules = ems }
96 Nothing -> error "Expected a library"
97 pd' = pd { library = Just lib' }
98 in f pd' lbi uhs x
99
100 isPortableBuild :: String -> Bool
101 isPortableBuild s
102 | "GHC" `isPrefixOf` s = False
103 | "Data.Generics" `isPrefixOf` s = False
104 | otherwise = s `notElem` ["Foreign.Concurrent", "System.Process"]
105
106 forGHCBuild :: String -> Bool
107 forGHCBuild = ("GHC.Prim" /=)
108
109 add_extra_deps :: ConfHook -> ConfHook
110 add_extra_deps f pd cf
111 = do lbi <- f pd cf
112 case compilerFlavor (compiler lbi) of
113 GHC ->
114 do -- Euch. We should just add the right thing to the lbi
115 -- ourselves rather than rerunning configure.
116 let pd' = pd { buildDepends = Dependency "rts" AnyVersion
117 : buildDepends pd }
118 f pd' cf
119 _ ->
120 return lbi
121
122 add_extra_libs :: Hook a -> Hook a
123 add_extra_libs f pd lbi uhs x
124 = let pd' = if (os == "mingw32") && (compilerFlavor (compiler lbi) == GHC)
125 then case library pd of
126 Just lib ->
127 let lib_bi = libBuildInfo lib
128 lib_bi' = lib_bi { extraLibs = "wsock32"
129 : "msvcrt"
130 : "kernel32"
131 : "user32"
132 : "shell32"
133 : extraLibs lib_bi }
134 lib' = lib { libBuildInfo = lib_bi' }
135 in pd { library = Just lib' }
136 Nothing -> error "Expected a library"
137 else pd
138 in f pd' lbi uhs x
139