Commit 40b6bd47 authored by Duncan Coutts's avatar Duncan Coutts

Implement ${pkgroot} spec, allows relocatable registered packages

Historically ghc implemented relocatable packages by allowing
"$topdir" in the package registration info and having ghc expand
this with its notion of $topdir. The topdir refers to where ghc
itself is installed (specifically the libdir).

The ${pkgroot} spec takes this idea and makes it portable.
(http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
Instead of paths relative to where ghc is installed, they can be
relative to the package database itself. Thus it is no longer a
ghc-specific idea and can work for package collections other than
the global package db.
parent 78185538
......@@ -56,7 +56,8 @@ import ErrUtils ( debugTraceMsg, putMsg, Message )
import Exception
import System.Directory
import System.FilePath
import System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
import Control.Monad
import Data.List as List
import Data.Map (Map)
......@@ -246,7 +247,8 @@ readPackageConfig dflags conf_file = do
let
top_dir = topDir dflags
pkg_configs1 = mungePackagePaths top_dir proto_pkg_configs
pkgroot = takeDirectory conf_file
pkg_configs1 = map (mungePackagePaths top_dir pkgroot) proto_pkg_configs
pkg_configs2 = maybeHidePackages dflags pkg_configs1
--
return pkg_configs2
......@@ -258,27 +260,52 @@ maybeHidePackages dflags pkgs
where
hide pkg = pkg{ exposed = False }
mungePackagePaths :: String -> [PackageConfig] -> [PackageConfig]
-- Replace the string "$topdir" at the beginning of a path
-- with the current topdir (obtained from the -B option).
mungePackagePaths top_dir ps = map munge_pkg ps
where
munge_pkg p = p{ importDirs = munge_paths (importDirs p),
includeDirs = munge_paths (includeDirs p),
libraryDirs = munge_paths (libraryDirs p),
frameworkDirs = munge_paths (frameworkDirs p),
haddockInterfaces = munge_paths (haddockInterfaces p),
haddockHTMLs = munge_paths (haddockHTMLs p)
}
munge_paths = map munge_path
munge_path p
| Just p' <- stripPrefix "$topdir" p = top_dir ++ p'
| Just p' <- stripPrefix "$httptopdir" p = toHttpPath top_dir ++ p'
| otherwise = p
toHttpPath p = "file:///" ++ p
mungePackagePaths :: FilePath -> FilePath -> PackageConfig -> PackageConfig
-- Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
-- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
-- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
-- The "pkgroot" is the directory containing the package database.
--
-- Also perform a similar substitution for the older GHC-specific
-- "$topdir" variable. The "topdir" is the location of the ghc
-- installation (obtained from the -B option).
mungePackagePaths top_dir pkgroot pkg =
pkg {
importDirs = munge_paths (importDirs pkg),
includeDirs = munge_paths (includeDirs pkg),
libraryDirs = munge_paths (libraryDirs pkg),
frameworkDirs = munge_paths (frameworkDirs pkg),
haddockInterfaces = munge_paths (haddockInterfaces pkg),
haddockHTMLs = munge_urls (haddockHTMLs pkg)
}
where
munge_paths = map munge_path
munge_urls = map munge_url
munge_path p
| Just p' <- stripVarPrefix "${pkgroot}" sp = pkgroot </> p'
| Just p' <- stripVarPrefix "$topdir" sp = top_dir </> p'
| otherwise = p
where
sp = splitPath p
munge_url p
| Just p' <- stripVarPrefix "${pkgrooturl}" sp = toUrlPath pkgroot p'
| Just p' <- stripVarPrefix "$httptopdir" sp = toUrlPath top_dir p'
| otherwise = p
where
sp = splitPath p
toUrlPath r p = "file:///"
-- URLs always use posix style '/' separators:
++ FilePath.Posix.joinPath (r : FilePath.splitDirectories p)
stripVarPrefix var (root:path')
| Just [sep] <- stripPrefix var root
, isPathSeparator sep
= Just (joinPath path')
stripVarPrefix _ _ = Nothing
-- -----------------------------------------------------------------------------
......
This diff is collapsed.
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment