installPackage.hs 2.94 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11

import Distribution.PackageDescription
import Distribution.Setup
import Distribution.Simple
import Distribution.Simple.Configure
import Distribution.Simple.LocalBuildInfo
import Distribution.Verbosity
import System.Environment

main :: IO ()
main = do args <- getArgs
Ian Lynagh's avatar
Ian Lynagh committed
12 13 14
          case args of
              pref : ghcpkg : args' ->
                  let verbosity = case args' of
15 16 17 18 19 20 21
                              [] -> normal
                              ['-':'v':v] ->
                                  let m = case v of
                                              "" -> Nothing
                                              _ -> Just v
                                  in flagToVerbosity m
                              _ -> error ("Bad arguments: " ++ show args)
Ian Lynagh's avatar
Ian Lynagh committed
22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
                  in doit pref ghcpkg verbosity
              _ ->
                  error "Missing arguments"

doit :: FilePath -> FilePath -> Verbosity -> IO ()
doit pref ghcpkg verbosity =
       do let userHooks = simpleUserHooks
              copyFlags = CopyFlags {
                              copyDest = NoCopyDest,
                              copyVerbose = verbosity
                          }
              registerFlags = RegisterFlags {
                                  regUser = MaybeUserGlobal,
                                  regGenScript = False,
                                  regInPlace = False,
                                  regWithHcPkg = Just ghcpkg,
                                  regVerbose = verbosity
                              }
40
          lbi <- getPersistBuildConfig
41 42 43
          let pd = localPkgDescr lbi
              -- XXX This is an almighty hack, shadowing the base
              -- Setup.hs hack
44 45 46 47
              mkLib filt = case library pd of
                           Just lib ->
                               let ems = filter filt $ exposedModules lib
                               in lib {
48
                                      exposedModules = ems
49 50 51 52 53 54 55
                                   }
                           Nothing ->
                               error "Expected a library, but none found"
              -- There's no files for GHC.Prim, so we will fail if we
              -- try to copy them
              pd_copy = pd { library = Just (mkLib ("GHC.Prim" /=)) }
              pd_reg  = pd { library = Just (mkLib (const True)) }
Ian Lynagh's avatar
Ian Lynagh committed
56 57 58 59 60 61 62
              -- When coying, we need to actually give a concrete
              -- directory to copy to rather than "$topdir"
              lbi_copy = lbi { prefix = pref }
              -- When we run GHC we give it a $topdir that includes the
              -- $compiler/lib/ part of libsubdir, so we only want the
              -- $pkgid part in the package.conf file. This is a bit of
              -- a hack, really.
63 64 65
              lbi_reg = lbi { libsubdir = "$pkgid" }
          (copyHook simpleUserHooks) pd_copy lbi_copy userHooks copyFlags
          (regHook simpleUserHooks)  pd_reg  lbi_reg  userHooks registerFlags
Ian Lynagh's avatar
Ian Lynagh committed
66
          return ()
67