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.

2 files changed, 34 insertions, 38 deletions

diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index 3124e292c1..038291d6b3 100644
--- a/compiler/main/PackageConfig.hs
+++ b/compiler/main/PackageConfig.hs
@@ -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
 
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index af2d3fe952..37ddd846ee 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -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