Cabal upstream API change -- installPackage to use installDirTemplates
[ghc-hetmet.git] / libraries / installPackage.hs
1
2 import Distribution.PackageDescription
3 import Distribution.Setup
4 import Distribution.Simple
5 import Distribution.Simple.Configure
6 import Distribution.Simple.LocalBuildInfo
7 import Distribution.Verbosity
8 import System.Environment
9
10 main :: IO ()
11 main = do args <- getArgs
12           case args of
13               pref : ghcpkg : args' ->
14                   let verbosity = case args' of
15                               [] -> normal
16                               ['-':'v':v] ->
17                                   let m = case v of
18                                               "" -> Nothing
19                                               _ -> Just v
20                                   in flagToVerbosity m
21                               _ -> error ("Bad arguments: " ++ show args)
22                   in doit pref ghcpkg verbosity
23               _ ->
24                   error "Missing arguments"
25
26 doit :: FilePath -> FilePath -> Verbosity -> IO ()
27 doit pref ghcpkg verbosity =
28        do let userHooks = simpleUserHooks
29               copyFlags = (emptyCopyFlags NoCopyDest) {
30                               copyVerbose = verbosity
31                           }
32               registerFlags = emptyRegisterFlags {
33                                   regUser = MaybeUserGlobal,
34                                   regVerbose = verbosity,
35                                   regGenScript = False,
36                                   regInPlace = False,
37                                   regWithHcPkg = Just ghcpkg
38                               }
39           lbi <- getPersistBuildConfig
40           let pd = localPkgDescr lbi
41               -- XXX This is an almighty hack, shadowing the base
42               -- Setup.hs hack
43               mkLib filt = case library pd of
44                            Just lib ->
45                                let ems = filter filt $ exposedModules lib
46                                in lib {
47                                       exposedModules = ems
48                                    }
49                            Nothing ->
50                                error "Expected a library, but none found"
51               -- There's no files for GHC.Prim, so we will fail if we
52               -- try to copy them
53               pd_copy = pd { library = Just (mkLib ("GHC.Prim" /=)) }
54               pd_reg  = pd { library = Just (mkLib (const True)) }
55               -- When coying, we need to actually give a concrete
56               -- directory to copy to rather than "$topdir"
57               lbi_copy = lbi { installDirTemplates = (installDirTemplates lbi) { prefixDirTemplate = toPathTemplate pref } }
58               -- When we run GHC we give it a $topdir that includes the
59               -- $compiler/lib/ part of libsubdir, so we only want the
60               -- $pkgid part in the package.conf file. This is a bit of
61               -- a hack, really.
62               lbi_reg = lbi { installDirTemplates = (installDirTemplates lbi) { libSubdirTemplate = toPathTemplate "$pkgid" } }
63           (copyHook simpleUserHooks) pd_copy lbi_copy userHooks copyFlags
64           (regHook simpleUserHooks)  pd_reg  lbi_reg  userHooks registerFlags
65           return ()
66