Commit c72efd7c authored by Duncan Coutts's avatar Duncan Coutts Committed by Edward Z. Yang
Browse files

Switch the package id types to use FastString (rather than String)

The conversions should now be correct w.r.t Unicode.

Also move a couple instances to avoid orphan instances.

Strictly speaking there's no need for these types to use FastString as
they do not need the unique feature. They could just use some other
compact string type, but ghc's internal utils don't have much support
for such a type, so we just use FastString.
parent 1bc2a555
......@@ -84,6 +84,7 @@ import FastString
import Binary
import Util
import {-# SOURCE #-} Packages
import GHC.PackageDb (BinaryStringRep(..))
import Data.Data
import Data.Map (Map)
......@@ -181,6 +182,10 @@ instance Binary ModuleName where
put_ bh (ModuleName fs) = put_ bh fs
get bh = do fs <- get bh; return (ModuleName fs)
instance BinaryStringRep ModuleName where
fromStringRep = mkModuleNameFS . mkFastStringByteString
toStringRep = fastStringToByteString . moduleNameFS
instance Data ModuleName where
-- don't traverse?
toConstr _ = abstractConstr "ModuleName"
......@@ -332,6 +337,10 @@ instance Binary PackageKey where
put_ bh pid = put_ bh (packageKeyFS pid)
get bh = do { fs <- get bh; return (fsToPackageKey fs) }
instance BinaryStringRep PackageKey where
fromStringRep = fsToPackageKey . mkFastStringByteString
toStringRep = fastStringToByteString . packageKeyFS
fsToPackageKey :: FastString -> PackageKey
fsToPackageKey = PId
......
......@@ -29,9 +29,9 @@ module PackageConfig (
#include "HsVersions.h"
import GHC.PackageDb
import qualified Data.ByteString.Char8 as BS
import Data.Version
import FastString
import Outputable
import Module
......@@ -46,54 +46,50 @@ type PackageConfig = InstalledPackageInfo
Module.PackageKey
Module.ModuleName
newtype InstalledPackageId = InstalledPackageId String deriving (Eq, Ord, Show)
newtype SourcePackageId = SourcePackageId String deriving (Eq, Ord, Show)
newtype PackageName = PackageName String deriving (Eq, Ord, Show)
-- TODO: there's no need for these to be FastString, as we don't need the uniq
-- feature, but ghc doesn't currently have convenient support for any
-- other compact string types, e.g. plain ByteString or Text.
newtype InstalledPackageId = InstalledPackageId FastString deriving (Eq, Ord)
newtype SourcePackageId = SourcePackageId FastString deriving (Eq, Ord)
newtype PackageName = PackageName FastString deriving (Eq, Ord)
instance BinaryStringRep InstalledPackageId where
fromStringRep = InstalledPackageId . BS.unpack
toStringRep (InstalledPackageId s) = BS.pack s
fromStringRep = InstalledPackageId . mkFastStringByteString
toStringRep (InstalledPackageId s) = fastStringToByteString s
instance BinaryStringRep SourcePackageId where
fromStringRep = SourcePackageId . BS.unpack
toStringRep (SourcePackageId s) = BS.pack s
fromStringRep = SourcePackageId . mkFastStringByteString
toStringRep (SourcePackageId s) = fastStringToByteString s
instance BinaryStringRep PackageName where
fromStringRep = PackageName . BS.unpack
toStringRep (PackageName s) = BS.pack s
instance BinaryStringRep PackageKey where
fromStringRep = Module.stringToPackageKey . BS.unpack
toStringRep = BS.pack . Module.packageKeyString
instance BinaryStringRep Module.ModuleName where
fromStringRep = Module.mkModuleName . BS.unpack
toStringRep = BS.pack . Module.moduleNameString
fromStringRep = PackageName . mkFastStringByteString
toStringRep (PackageName s) = fastStringToByteString s
instance Outputable InstalledPackageId where
ppr (InstalledPackageId str) = text str
ppr (InstalledPackageId str) = ftext str
instance Outputable SourcePackageId where
ppr (SourcePackageId str) = text str
ppr (SourcePackageId str) = ftext str
instance Outputable PackageName where
ppr (PackageName str) = text str
ppr (PackageName str) = ftext str
defaultPackageConfig :: PackageConfig
defaultPackageConfig = emptyInstalledPackageInfo
installedPackageIdString :: PackageConfig -> String
installedPackageIdString pkg = str
installedPackageIdString pkg = unpackFS str
where
InstalledPackageId str = installedPackageId pkg
sourcePackageIdString :: PackageConfig -> String
sourcePackageIdString pkg = str
sourcePackageIdString pkg = unpackFS str
where
SourcePackageId str = sourcePackageId pkg
packageNameString :: PackageConfig -> String
packageNameString pkg = str
packageNameString pkg = unpackFS str
where
PackageName str = packageName pkg
......
......@@ -890,7 +890,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do
ipid_map = Map.fromList [ (installedPackageId p, p) | p <- pkgs0 ]
ipid_selected = depClosure ipid_map
[ InstalledPackageId i
[ InstalledPackageId (mkFastString i)
| ExposePackage (PackageIdArg i) _ <- flags ]
(ignore_flags, other_flags) = partition is_ignore flags
......@@ -965,9 +965,9 @@ mkPackageState dflags pkgs0 preload0 this_package = do
ipid_map = Map.fromList [ (installedPackageId p, packageConfigId p)
| p <- pkgs3 ]
lookupIPID ipid@(InstalledPackageId str)
lookupIPID ipid
| Just pid <- Map.lookup ipid ipid_map = return pid
| otherwise = missingPackageErr dflags str
| otherwise = missingPackageErr dflags ipid
preload2 <- mapM lookupIPID preload1
......@@ -1352,25 +1352,25 @@ add_package pkg_db ipid_map ps (p, mb_parent)
| p `elem` ps = return ps -- Check if we've already added this package
| otherwise =
case lookupPackage' pkg_db p of
Nothing -> Failed (missingPackageMsg (packageKeyString p) <>
Nothing -> Failed (missingPackageMsg p <>
missingDependencyMsg mb_parent)
Just pkg -> do
-- Add the package's dependents also
ps' <- foldM add_package_ipid ps (depends pkg)
return (p : ps')
where
add_package_ipid ps ipid@(InstalledPackageId str)
add_package_ipid ps ipid
| Just pid <- Map.lookup ipid ipid_map
= add_package pkg_db ipid_map ps (pid, Just p)
| otherwise
= Failed (missingPackageMsg str <> missingDependencyMsg mb_parent)
= Failed (missingPackageMsg ipid <> missingDependencyMsg mb_parent)
missingPackageErr :: DynFlags -> String -> IO a
missingPackageErr :: Outputable pkgid => DynFlags -> pkgid -> IO a
missingPackageErr dflags p
= throwGhcExceptionIO (CmdLineError (showSDoc dflags (missingPackageMsg p)))
missingPackageMsg :: String -> SDoc
missingPackageMsg p = ptext (sLit "unknown package:") <+> text p
missingPackageMsg :: Outputable pkgid => pkgid -> SDoc
missingPackageMsg p = ptext (sLit "unknown package:") <+> ppr p
missingDependencyMsg :: Maybe PackageKey -> SDoc
missingDependencyMsg Nothing = empty
......@@ -1435,11 +1435,11 @@ pprPackagesWith pprIPI dflags =
-- The idea is to only print package id, and any information that might
-- be different from the package databases (exposure, trust)
pprPackagesSimple :: DynFlags -> SDoc
pprPackagesSimple = pprPackagesWith (text . showIPI)
where showIPI ipi = let InstalledPackageId i = installedPackageId ipi
e = if exposed ipi then "E" else " "
t = if trusted ipi then "T" else " "
in e ++ t ++ " " ++ i
pprPackagesSimple = pprPackagesWith pprIPI
where pprIPI ipi = let InstalledPackageId i = installedPackageId ipi
e = if exposed ipi then text "E" else text " "
t = if trusted ipi then text "T" else text " "
in e <> t <> text " " <> ftext i
-- | Show the mapping of modules to where they come from.
pprModuleMap :: DynFlags -> SDoc
......
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