Add testcase for #14251
[ghc.git] / libraries / ghc-prim / Setup.hs
1
2 -- We need to do some ugly hacks here because of GHC magic
3
4 module Main (main) where
5
6 import Control.Monad
7 import Data.List
8 import Data.Maybe
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
15 import System.Cmd
16 import System.FilePath
17 import System.Exit
18 import System.Directory
19
20 main :: IO ()
21 main = do let hooks = autoconfUserHooks {
22 regHook = addPrimModule
23 $ regHook simpleUserHooks,
24 buildHook = build_primitive_sources
25 $ buildHook simpleUserHooks,
26 haddockHook = addPrimModuleForHaddock
27 $ build_primitive_sources
28 $ haddockHook simpleUserHooks }
29 defaultMainWithHooks hooks
30
31 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
32
33 addPrimModule :: Hook a -> Hook a
34 addPrimModule f pd lbi uhs x =
35 do let -- I'm not sure which one of these we actually need to change.
36 -- It seems bad that there are two.
37 pd' = addPrimModuleToPD pd
38 lpd = addPrimModuleToPD (localPkgDescr lbi)
39 lbi' = lbi { localPkgDescr = lpd }
40 f pd' lbi' uhs x
41
42 addPrimModuleForHaddock :: Hook a -> Hook a
43 addPrimModuleForHaddock f pd lbi uhs x =
44 do let pc = withPrograms lbi
45 pc' = userSpecifyArgs "haddock" ["GHC/Prim.hs"] pc
46 lbi' = lbi { withPrograms = pc' }
47 f pd lbi' uhs x
48
49 addPrimModuleToPD :: PackageDescription -> PackageDescription
50 addPrimModuleToPD pd =
51 case library pd of
52 Just lib ->
53 let ems = fromJust (simpleParse "GHC.Prim") : exposedModules lib
54 lib' = lib { exposedModules = ems }
55 in pd { library = Just lib' }
56 Nothing ->
57 error "Expected a library, but none found"
58
59 build_primitive_sources :: Hook a -> Hook a
60 build_primitive_sources f pd lbi uhs x
61 = do when (compilerFlavor (compiler lbi) == GHC) $ do
62 let genprimopcode = joinPath ["..", "..", "utils",
63 "genprimopcode", "genprimopcode"]
64 primops = joinPath ["..", "..", "compiler", "prelude",
65 "primops.txt"]
66 primhs = joinPath ["GHC", "Prim.hs"]
67 primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"]
68 primhs_tmp = addExtension primhs "tmp"
69 primopwrappers_tmp = addExtension primopwrappers "tmp"
70 maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
71 ++ primops ++ " > " ++ primhs_tmp)
72 maybeUpdateFile primhs_tmp primhs
73 maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
74 ++ primops ++ " > " ++ primopwrappers_tmp)
75 maybeUpdateFile primopwrappers_tmp primopwrappers
76 f pd lbi uhs x
77
78 -- Replace a file only if the new version is different from the old.
79 -- This prevents make from doing unnecessary work after we run 'setup makefile'
80 maybeUpdateFile :: FilePath -> FilePath -> IO ()
81 maybeUpdateFile source target = do
82 r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
83 case r of
84 ExitSuccess -> removeFile source
85 ExitFailure _ -> do exists <- doesFileExist target
86 when exists $ removeFile target
87 renameFile source target
88