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