where
hide pkg = pkg{ exposed = False }
+-- TODO: This code is duplicated in utils/ghc-pkg/Main.hs
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)
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
+ | Just p' <- stripVarPrefix "${pkgroot}" p = pkgroot ++ p'
+ | Just p' <- stripVarPrefix "$topdir" p = top_dir ++ p'
+ | otherwise = 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
+ | Just p' <- stripVarPrefix "${pkgrooturl}" p = toUrlPath pkgroot p'
+ | Just p' <- stripVarPrefix "$httptopdir" p = toUrlPath top_dir p'
+ | otherwise = 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
+ ++ FilePath.Posix.joinPath
+ (r : -- We need to drop a leading "/" or "\\"
+ -- if there is one:
+ dropWhile (all isPathSeparator)
+ (FilePath.splitDirectories p))
+
+ -- We could drop the separator here, and then use </> above. However,
+ -- by leaving it in and using ++ we keep the same path separator
+ -- rather than letting FilePath change it to use \ as the separator
+ stripVarPrefix var path = case stripPrefix var path of
+ Just [] -> Just []
+ Just cs@(c : _) | isPathSeparator c -> Just cs
+ _ -> Nothing
-- -----------------------------------------------------------------------------