X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=libraries%2FinstallPackage.hs;h=451fda1046f77a6d62df2595368040f5e1c6595f;hb=d3b882ae7fc0d4b499f194cc1914cc4562ebbd7c;hp=3d190d6432eddfb1225d159d448ca32f36271077;hpb=b4a94ccf25eea5377e4f0c214225c3d7e2c35bde;p=ghc-hetmet.git diff --git a/libraries/installPackage.hs b/libraries/installPackage.hs index 3d190d6..451fda1 100644 --- a/libraries/installPackage.hs +++ b/libraries/installPackage.hs @@ -1,41 +1,49 @@ import Distribution.PackageDescription -import Distribution.Setup import Distribution.Simple import Distribution.Simple.Configure import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.Program +import Distribution.Simple.Setup import Distribution.Verbosity import System.Environment main :: IO () -main = do args <- getArgs - case args of - pref : ghcpkg : args' -> - let verbosity = case args' of - [] -> normal - ['-':'v':v] -> - let m = case v of - "" -> Nothing - _ -> Just v - in flagToVerbosity m - _ -> error ("Bad arguments: " ++ show args) - in doit pref ghcpkg verbosity - _ -> - error "Missing arguments" +main + = do args <- getArgs + case args of + destdir : pref : idatadir : idocdir : ghcpkg : ghcpkgconf : args' -> + let verbosity = case args' of + [] -> normal + ['-':'v':v] -> + let m = case v of + "" -> Nothing + _ -> Just v + in flagToVerbosity m + _ -> error ("Bad arguments: " ++ show args) + in doit destdir pref idatadir idocdir ghcpkg ghcpkgconf + verbosity + _ -> + error "Missing arguments" -doit :: FilePath -> FilePath -> Verbosity -> IO () -doit pref ghcpkg verbosity = +doit :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath + -> Verbosity + -> IO () +doit destdir pref idatadir idocdir ghcpkg ghcpkgconf verbosity = do let userHooks = simpleUserHooks - copyFlags = emptyCopyFlags { - copyDest = NoCopyDest, + copyto = if null destdir then NoCopyDest else CopyTo destdir + copyFlags = (emptyCopyFlags copyto) { copyVerbose = verbosity } registerFlags = emptyRegisterFlags { regUser = MaybeUserGlobal, - regVerbose = verbosity + regVerbose = verbosity, + regGenScript = False, + regInPlace = False } lbi <- getPersistBuildConfig let pd = localPkgDescr lbi + i = installDirTemplates lbi -- XXX This is an almighty hack, shadowing the base -- Setup.hs hack mkLib filt = case library pd of @@ -52,12 +60,26 @@ doit pref ghcpkg verbosity = pd_reg = pd { library = Just (mkLib (const True)) } -- When coying, we need to actually give a concrete -- directory to copy to rather than "$topdir" - lbi_copy = lbi { prefix = pref } + i_copy = i { prefixDirTemplate = toPathTemplate pref, + dataDirTemplate = toPathTemplate idatadir, + docDirTemplate = toPathTemplate idocdir + } + lbi_copy = lbi { installDirTemplates = i_copy } -- 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. - lbi_reg = lbi { libsubdir = "$pkgid" } + progs = withPrograms lbi + prog = ConfiguredProgram { + programId = programName ghcPkgProgram, + programVersion = Nothing, + programArgs = ["--global-conf", ghcpkgconf], + programLocation = UserSpecified ghcpkg + } + progs' = updateProgram prog progs + i_reg = i { libSubdirTemplate = toPathTemplate "$pkgid" } + lbi_reg = lbi { installDirTemplates = i_reg, + withPrograms = progs' } (copyHook simpleUserHooks) pd_copy lbi_copy userHooks copyFlags (regHook simpleUserHooks) pd_reg lbi_reg userHooks registerFlags return ()