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