untabify
[packages/base.git] / Setup.hs
1 {-
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.
4 -}
5
6 module Main (main) where
7
8 import Control.Monad
9 import Data.List
10 import Distribution.PackageDescription
11 import Distribution.Simple
12 import Distribution.Simple.LocalBuildInfo
13 import Distribution.Simple.Utils
14 import System.Cmd
15 import System.FilePath
16 import System.Exit
17 import System.Directory
18 import Control.Exception (try)
19
20 main :: IO ()
21 main = do let hooks = 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
29
30 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
31
32 build_primitive_sources :: Hook a -> Hook a
33 build_primitive_sources f pd lbi uhs x
34 = do when (compilerFlavor (compiler lbi) == GHC) $ do
35 let genprimopcode = joinPath ["..", "..", "utils",
36 "genprimopcode", "genprimopcode"]
37 primops = joinPath ["..", "..", "compiler", "prelude",
38 "primops.txt"]
39 primhs = joinPath ["GHC", "Prim.hs"]
40 primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"]
41 primhs_tmp = addExtension primhs "tmp"
42 primopwrappers_tmp = addExtension primopwrappers "tmp"
43 maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
44 ++ primops ++ " > " ++ primhs_tmp)
45 maybeUpdateFile primhs_tmp primhs
46 maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
47 ++ primops ++ " > " ++ primopwrappers_tmp)
48 maybeUpdateFile primopwrappers_tmp primopwrappers
49 f pd lbi uhs x
50
51 -- Replace a file only if the new version is different from the old.
52 -- This prevents make from doing unnecessary work after we run 'setup makefile'
53 maybeUpdateFile :: FilePath -> FilePath -> IO ()
54 maybeUpdateFile source target = do
55 r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
56 case r of
57 ExitSuccess -> removeFile source
58 ExitFailure _ -> do try (removeFile target); renameFile source target
59