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
  17 main :: IO ()
  18 main = do let hooks = defaultUserHooks {
  19                   buildHook = build_primitive_sources
  20                             $ filter_modules_hook
  21                             $ buildHook defaultUserHooks,
  22                   makefileHook = build_primitive_sources
  23                                $ filter_modules_hook
  24                                $ makefileHook defaultUserHooks,
  25                   instHook = filter_modules_hook
  26                            $ instHook defaultUserHooks }
  27           defaultMainWithHooks hooks
  28
  29 type Hook a = PackageDescription -> LocalBuildInfo -> UserHooks -> a -> IO ()
  30
  31 build_primitive_sources :: Hook a -> Hook a
  32 build_primitive_sources f pd lbi uhs x
  33  = do when (compilerFlavor (compiler lbi) == GHC) $ do
  34           let genprimopcode = joinPath ["..", "..", "utils",
  35                                         "genprimopcode", "genprimopcode"]
  36               primops = joinPath ["..", "..", "compiler", "prelude",
  37                                   "primops.txt"]
  38               primhs = joinPath ["GHC", "Prim.hs"]
  39               primopwrappers = joinPath ["GHC", "PrimopWrappers.hs"]
  40           maybeExit $ system (genprimopcode ++ " --make-haskell-source < "
  41                            ++ primops ++ " > " ++ primhs)
  42           maybeExit $ system (genprimopcode ++ " --make-haskell-wrappers < "
  43                            ++ primops ++ " > " ++ primopwrappers)
  44       f pd lbi uhs x
  45
  46 filter_modules_hook :: Hook a -> Hook a
  47 filter_modules_hook f pd lbi uhs x
  48  = let lib' = case library pd of
  49                   Just lib ->
  50                       let ems = filter ("GHC.Prim" /=) (exposedModules lib)
  51                       in lib { exposedModules = ems }
  52                   Nothing -> error "Expected a library"
  53        pd' = pd { library = Just lib' }
  54    in f pd' lbi uhs x
  55