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
  18 main :: IO ()
  19 main = do let hooks = defaultUserHooks {
  20                   buildHook = build_primitive_sources
  21                             $ filter_modules_hook
  22                             $ buildHook defaultUserHooks,
  23                   makefileHook = build_primitive_sources
  24                                $ filter_modules_hook
  25                                $ makefileHook defaultUserHooks,
  26                   instHook = filter_modules_hook
  27                            $ instHook 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           maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
  42                            ++ primops ++ " > " ++ primhs)
  43           maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
  44                            ++ primops ++ " > " ++ primopwrappers)
  45       f pd lbi uhs x
  46
  47 filter_modules_hook :: Hook a -> Hook a
  48 filter_modules_hook f pd lbi uhs x
  49  = let lib' = case library pd of
  50                   Just lib ->
  51                       let ems = filter ("GHC.Prim" /=) (exposedModules lib)
  52                       in lib { exposedModules = ems }
  53                   Nothing -> error "Expected a library"
  54        pd' = pd { library = Just lib' }
  55    in f pd' lbi uhs x
  56