2 We need to do some ugly hacks here as base mix of portable and
3 unportable stuff, as well as home to some GHC magic.
6 module Main (main) where
10 import Distribution.PackageDescription
11 import Distribution.Simple
12 import Distribution.Simple.LocalBuildInfo
13 import Distribution.Simple.Utils
15 import System.FilePath
17 import System.Directory
20 main = do let hooks = defaultUserHooks {
21 buildHook = build_primitive_sources
23 $ buildHook defaultUserHooks,
24 makefileHook = build_primitive_sources
26 $ makefileHook defaultUserHooks,
27 haddockHook = build_primitive_sources
29 $ haddockHook defaultUserHooks,
30 instHook = filter_modules_hook
31 $ instHook defaultUserHooks }
32 defaultMainWithHooks hooks
34 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
36 build_primitive_sources :: Hook a -> Hook a
37 build_primitive_sources f pd lbi uhs x
38 = do when (compilerFlavor (compiler lbi) == GHC) $ do
39 let genprimopcode = joinPath ["..", "..", "utils",
40 "genprimopcode", "genprimopcode"]
41 primops = joinPath ["..", "..", "compiler", "prelude",
43 primhs = joinPath ["GHC", "Prim.hs"]
44 primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"]
45 primhs_tmp = addExtension primhs "tmp"
46 primopwrappers_tmp = addExtension primopwrappers "tmp"
47 maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
48 ++ primops ++ " > " ++ primhs_tmp)
49 maybeUpdateFile primhs_tmp primhs
50 maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
51 ++ primops ++ " > " ++ primopwrappers_tmp)
52 maybeUpdateFile primopwrappers_tmp primopwrappers
55 -- Replace a file only if the new version is different from the old.
56 -- This prevents make from doing unnecessary work after we run 'setup makefile'
57 maybeUpdateFile :: FilePath -> FilePath -> IO ()
58 maybeUpdateFile source target = do
59 r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
61 ExitSuccess -> return ()
62 ExitFailure _ -> copyFile source target
65 filter_modules_hook :: Hook a -> Hook a
66 filter_modules_hook f pd lbi uhs x
67 = let lib' = case library pd of
69 let ems = filter ("GHC.Prim" /=) (exposedModules lib)
70 in lib { exposedModules = ems }
71 Nothing -> error "Expected a library"
72 pd' = pd { library = Just lib' }