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