X-Git-Url: http://git.megacz.com/?p=ghc-prim.git;a=blobdiff_plain;f=Setup.hs;h=5e736ab6ee099992b92311fbe54e24bac0405d37;hp=d6836e43939555e3da3d9ebde7e3fb38da7c728b;hb=HEAD;hpb=cf62d712253bb8999f691b0bf3846f514c6aa2fd

diff --git a/Setup.hs b/Setup.hs
index d6836e4..5e736ab 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -5,28 +5,59 @@ module Main (main) where
 
 import Control.Monad
 import Data.List
+import Data.Maybe
 import Distribution.PackageDescription
 import Distribution.Simple
 import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Program
 import Distribution.Simple.Utils
+import Distribution.Text
 import System.Cmd
 import System.FilePath
 import System.Exit
 import System.Directory
-import Control.Exception (try)
 
 main :: IO ()
-main = do let hooks = defaultUserHooks {
+main = do let hooks = simpleUserHooks {
+                  regHook = addPrimModule
+                          $ regHook simpleUserHooks,
                   buildHook = build_primitive_sources
-                            $ buildHook defaultUserHooks,
+                            $ buildHook simpleUserHooks,
                   makefileHook = build_primitive_sources
-                               $ makefileHook defaultUserHooks,
-                  haddockHook = build_primitive_sources
-                               $ haddockHook defaultUserHooks }
+                               $ makefileHook simpleUserHooks,
+                  haddockHook = addPrimModuleForHaddock
+                              $ build_primitive_sources
+                              $ haddockHook simpleUserHooks }
           defaultMainWithHooks hooks
 
 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
 
+addPrimModule :: Hook a -> Hook a
+addPrimModule f pd lbi uhs x =
+    do let -- I'm not sure which one of these we actually need to change.
+           -- It seems bad that there are two.
+           pd' = addPrimModuleToPD pd
+           lpd = addPrimModuleToPD (localPkgDescr lbi)
+           lbi' = lbi { localPkgDescr = lpd }
+       f pd' lbi' uhs x
+
+addPrimModuleForHaddock :: Hook a -> Hook a
+addPrimModuleForHaddock f pd lbi uhs x =
+    do let pc = withPrograms lbi
+           pc' = userSpecifyArgs "haddock" ["GHC/Prim.hs"] pc
+           lbi' = lbi { withPrograms = pc' }
+       f pd lbi' uhs x
+
+addPrimModuleToPD :: PackageDescription -> PackageDescription
+addPrimModuleToPD pd =
+    case library pd of
+    Just lib ->
+        let ems = fromJust (simpleParse "GHC.Prim") : exposedModules lib
+            lib' = lib { exposedModules = ems }
+        in pd { library = Just lib' }
+    Nothing ->
+        error "Expected a library, but none found"
+
 build_primitive_sources :: Hook a -> Hook a
 build_primitive_sources f pd lbi uhs x
  = do when (compilerFlavor (compiler lbi) == GHC) $ do
@@ -53,5 +84,7 @@ maybeUpdateFile source target = do
   r <- rawSystem "cmp" ["-s" {-quiet-}, source, target]
   case r of
     ExitSuccess   -> removeFile source
-    ExitFailure _ -> do try (removeFile target); renameFile source target
+    ExitFailure _ -> do exists <- doesFileExist target
+                        when exists $ removeFile target
+                        renameFile source target