2 -- We need to do some ugly hacks here because of GHC magic
4 module Main (main) where
8 import Distribution.PackageDescription
9 import Distribution.Simple
10 import Distribution.Simple.LocalBuildInfo
11 import Distribution.Simple.Utils
13 import System.FilePath
15 import System.Directory
16 import Control.Exception (try)
19 main = do let hooks = defaultUserHooks {
20 regHook = addPrimModule
21 $ regHook defaultUserHooks,
22 buildHook = build_primitive_sources
23 $ buildHook defaultUserHooks,
24 makefileHook = build_primitive_sources
25 $ makefileHook defaultUserHooks,
26 haddockHook = build_primitive_sources
27 $ haddockHook defaultUserHooks }
28 defaultMainWithHooks hooks
30 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
32 addPrimModule :: Hook a -> Hook a
33 addPrimModule f pd lbi uhs x =
34 do let -- I'm not sure which one of these we actually need to change.
35 -- It seems bad that there are two.
36 pd' = addPrimModuleToPD pd
37 lpd = addPrimModuleToPD (localPkgDescr lbi)
38 lbi' = lbi { localPkgDescr = lpd }
41 addPrimModuleToPD :: PackageDescription -> PackageDescription
42 addPrimModuleToPD pd =
45 let ems = "GHC.Prim" : exposedModules lib
46 lib' = lib { exposedModules = ems }
47 in pd { library = Just lib' }
49 error "Expected a library, but none found"
51 build_primitive_sources :: Hook a -> Hook a
52 build_primitive_sources f pd lbi uhs x
53 = do when (compilerFlavor (compiler lbi) == GHC) $ do
54 let genprimopcode = joinPath ["..", "..", "utils",
55 "genprimopcode", "genprimopcode"]
56 primops = joinPath ["..", "..", "compiler", "prelude",
58 primhs = joinPath ["GHC", "Prim.hs"]
59 primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"]
60 primhs_tmp = addExtension primhs "tmp"
61 primopwrappers_tmp = addExtension primopwrappers "tmp"
62 maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
63 ++ primops ++ " > " ++ primhs_tmp)
64 maybeUpdateFile primhs_tmp primhs
65 maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
66 ++ primops ++ " > " ++ primopwrappers_tmp)
67 maybeUpdateFile primopwrappers_tmp primopwrappers
70 -- Replace a file only if the new version is different from the old.
71 -- This prevents make from doing unnecessary work after we run 'setup makefile'
72 maybeUpdateFile :: FilePath -> FilePath -> IO ()
73 maybeUpdateFile source target = do
74 r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
76 ExitSuccess -> removeFile source
77 ExitFailure _ -> do try (removeFile target); renameFile source target