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.Setup
  12 import Distribution.Simple
  13 import Distribution.Simple.LocalBuildInfo
  14 import Distribution.Simple.Utils
  15 import System.Cmd
  16 import System.FilePath
  17 import System.Info
  18
  19 main :: IO ()
  20 main = do let hooks = defaultUserHooks {
  21                   confHook = add_extra_deps
  22                            $ confHook defaultUserHooks,
  23                   buildHook = build_primitive_sources
  24                             $ filter_modules_hook
  25                             $ buildHook defaultUserHooks,
  26                   makefileHook = build_primitive_sources
  27                                $ filter_modules_hook
  28                                $ makefileHook defaultUserHooks,
  29                   regHook = add_extra_libs
  30                           $ regHook defaultUserHooks,
  31                   instHook = filter_modules_hook
  32                            $ instHook defaultUserHooks }
  33           defaultMainWithHooks hooks
  34
  35 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
  36 type ConfHook = PackageDescription -> ConfigFlags -> IO LocalBuildInfo
  37
  38 -- type PDHook = PackageDescription -> ConfigFlags -> IO ()
  39
  40 build_primitive_sources :: Hook a -> Hook a
  41 build_primitive_sources f pd lbi uhs x
  42  = do when (compilerFlavor (compiler lbi) == GHC) $ do
  43           let genprimopcode = joinPath ["..", "..", "utils",
  44                                         "genprimopcode", "genprimopcode"]
  45               primops = joinPath ["..", "..", "compiler", "prelude",
  46                                   "primops.txt"]
  47               primhs = joinPath ["GHC", "Prim.hs"]
  48               primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"]
  49           maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
  50                            ++ primops ++ " > " ++ primhs)
  51           maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
  52                            ++ primops ++ " > " ++ primopwrappers)
  53       f pd lbi uhs x
  54
  55 filter_modules_hook :: Hook a -> Hook a
  56 filter_modules_hook f pd lbi uhs x
  57  = let build_filter = case compilerFlavor $ compiler lbi of
  58                           GHC -> forGHCBuild
  59                           _ -> isPortableBuild
  60        lib' = case library pd of
  61                   Just lib ->
  62                       let ems = filter build_filter (exposedModules lib)
  63                       in lib { exposedModules = ems }
  64                   Nothing -> error "Expected a library"
  65        pd' = pd { library = Just lib' }
  66    in f pd' lbi uhs x
  67
  68 isPortableBuild :: String -> Bool
  69 isPortableBuild s
  70  | "GHC" `isPrefixOf` s = False
  71  | "Data.Generics" `isPrefixOf` s = False
  72  | otherwise = s `notElem` ["Foreign.Concurrent", "System.Timeout"]
  73
  74 forGHCBuild :: String -> Bool
  75 forGHCBuild = ("GHC.Prim" /=)
  76
  77 add_extra_deps :: ConfHook -> ConfHook
  78 add_extra_deps f pd cf
  79  = do lbi <- f pd cf
  80       case compilerFlavor (compiler lbi) of
  81           GHC ->
  82               do -- Euch. We should just add the right thing to the lbi
  83                  -- ourselves rather than rerunning configure.
  84                  let pd' = pd { buildDepends = Dependency "rts" AnyVersion
  85                                              : buildDepends pd }
  86                  f pd' cf
  87           _ ->
  88               return lbi
  89
  90 add_extra_libs :: Hook a -> Hook a
  91 add_extra_libs f pd lbi uhs x
  92  = let pd' = if (os == "mingw32") && (compilerFlavor (compiler lbi) == GHC)
  93              then case library pd of
  94                   Just lib ->
  95                       let lib_bi = libBuildInfo lib
  96                           lib_bi' = lib_bi { extraLibs = "wsock32"
  97                                                        : "msvcrt"
  98                                                        : "kernel32"
  99                                                        : "user32"
 100                                                        : "shell32"
 101                                                        : extraLibs lib_bi }
 102                           lib' = lib { libBuildInfo = lib_bi' }
 103                       in pd { library = Just lib' }
 104                   Nothing -> error "Expected a library"
 105              else pd
 106    in f pd' lbi uhs x