X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=libraries%2FinstallPackage.hs;h=4f5b5baee8b1d82e050e2b4be0cb661abaa4aa31;hb=3f1b316d7035c55cd712cd39a9981339bcef2e8c;hp=5946a6b3dbfce2a9d4c6add784245a7dafc08d4f;hpb=6cc7a2957040c2d751a14c3776cf144152be4dd0;p=ghc-hetmet.git diff --git a/libraries/installPackage.hs b/libraries/installPackage.hs index 5946a6b..4f5b5ba 100644 --- a/libraries/installPackage.hs +++ b/libraries/installPackage.hs @@ -13,9 +13,10 @@ main :: IO () main = do args <- getArgs case args of - destdir : ipref : ibindir : ilibdir : ilibexecdir - : idatadir : idocdir : ihtmldir_copy : ihtmldir_reg - : ghcpkg : ghcpkgconf : args' -> + ghcpkg : ghcpkgconf : destdir : topdir : + iprefix : ibindir : ilibdir : ilibexecdir : + idatadir : idocdir : ihtmldir : iinterfacedir : + args' -> let verbosity = case args' of [] -> normal ['-':'v':v] -> @@ -24,20 +25,19 @@ main _ -> Just v in flagToVerbosity m _ -> error ("Bad arguments: " ++ show args) - in doit destdir ipref ibindir ilibdir - ilibexecdir idatadir idocdir - ihtmldir_copy ihtmldir_reg - ghcpkg ghcpkgconf verbosity + in doit verbosity ghcpkg ghcpkgconf destdir topdir + iprefix ibindir ilibdir ilibexecdir idatadir + idocdir ihtmldir iinterfacedir _ -> error "Missing arguments" -doit :: FilePath -> FilePath -> FilePath -> FilePath -> FilePath +doit :: Verbosity -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath -> FilePath - -> FilePath - -> Verbosity + -> FilePath -> FilePath -> FilePath -> IO () -doit destdir ipref ibindir ilibdir ilibexecdir idatadir idocdir - ihtmldir_copy ihtmldir_reg ghcpkg ghcpkgconf verbosity = +doit verbosity ghcpkg ghcpkgconf destdir topdir + iprefix ibindir ilibdir ilibexecdir idatadir + idocdir ihtmldir iinterfacedir = do let userHooks = simpleUserHooks copyto = if null destdir then NoCopyDest else CopyTo destdir copyFlags = (emptyCopyFlags copyto) { @@ -68,13 +68,15 @@ doit destdir ipref ibindir ilibdir ilibexecdir idatadir idocdir pd_reg = pd { library = Just (mkLib (const True)) } -- When coying, we need to actually give a concrete -- directory to copy to rather than "$topdir" - i_copy = i { prefixDirTemplate = toPathTemplate ipref, - binDirTemplate = toPathTemplate ibindir, - libDirTemplate = toPathTemplate ilibdir, - libexecDirTemplate = toPathTemplate ilibexecdir, - dataDirTemplate = toPathTemplate idatadir, - docDirTemplate = toPathTemplate idocdir, - htmlDirTemplate = toPathTemplate ihtmldir_copy + toPathTemplate' = toPathTemplate . replaceTopdir topdir + i_copy = i { prefixDirTemplate = toPathTemplate' iprefix, + binDirTemplate = toPathTemplate' ibindir, + libDirTemplate = toPathTemplate' ilibdir, + libexecDirTemplate = toPathTemplate' ilibexecdir, + dataDirTemplate = toPathTemplate' idatadir, + docDirTemplate = toPathTemplate' idocdir, + htmlDirTemplate = toPathTemplate' ihtmldir, + interfaceDirTemplate = toPathTemplate' iinterfacedir } lbi_copy = lbi { installDirTemplates = i_copy } -- When we run GHC we give it a $topdir that includes the @@ -89,13 +91,14 @@ doit destdir ipref ibindir ilibdir ilibexecdir idatadir idocdir programLocation = UserSpecified ghcpkg } progs' = updateProgram prog progs - i_reg = i { prefixDirTemplate = toPathTemplate ipref, - binDirTemplate = toPathTemplate ibindir, - libDirTemplate = toPathTemplate ilibdir, - libexecDirTemplate = toPathTemplate ilibexecdir, - dataDirTemplate = toPathTemplate idatadir, - docDirTemplate = toPathTemplate idocdir, - htmlDirTemplate = toPathTemplate ihtmldir_reg + i_reg = i { prefixDirTemplate = toPathTemplate iprefix, + binDirTemplate = toPathTemplate ibindir, + libDirTemplate = toPathTemplate ilibdir, + libexecDirTemplate = toPathTemplate ilibexecdir, + dataDirTemplate = toPathTemplate idatadir, + docDirTemplate = toPathTemplate idocdir, + htmlDirTemplate = toPathTemplate ihtmldir, + interfaceDirTemplate = toPathTemplate iinterfacedir } lbi_reg = lbi { installDirTemplates = i_reg, withPrograms = progs' } @@ -103,6 +106,12 @@ doit destdir ipref ibindir ilibdir ilibexecdir idatadir idocdir (regHook simpleUserHooks) pd_reg lbi_reg userHooks registerFlags return () +replaceTopdir :: FilePath -> FilePath -> FilePath +replaceTopdir topdir ('$':'t':'o':'p':'d':'i':'r':p) = topdir ++ p +replaceTopdir topdir ('$':'h':'t':'t':'p':'t':'o':'p':'d':'i':'r':p) + = topdir ++ p +replaceTopdir _ p = p + -- Get the build info, merging the setup-config and buildinfo files. getConfig :: Verbosity -> IO LocalBuildInfo getConfig verbosity = do