Make PackageName into a proper newtype

src/GHC.hs

+{-# LANGUAGE OverloadedStrings #-}
 module GHC (
     array, base, binary, bytestring, cabal, compiler, containers, compareSizes,
     deepseq, deriveConstants, directory, dllSplit, filepath, genapply,
@@ -103,11 +104,11 @@ defaultProgramPath :: Stage -> Package -> Maybe FilePath
 defaultProgramPath stage pkg
     | pkg == ghc     = Just . inplaceProgram $ "ghc-stage" ++ show (fromEnum stage + 1)
     | pkg == haddock || pkg == ghcTags = case stage of
-        Stage2 -> Just . inplaceProgram $ pkgName pkg
+        Stage2 -> Just . inplaceProgram $ pkgNameString pkg
         _      -> Nothing
     | isProgram pkg  = case stage of
-        Stage0 -> Just . inplaceProgram $ pkgName pkg
-        _      -> Just . installProgram $ pkgName pkg
+        Stage0 -> Just . inplaceProgram $ pkgNameString pkg
+        _      -> Just . installProgram $ pkgNameString pkg
     | otherwise = Nothing
   where
     inplaceProgram name = programInplacePath -/- name <.> exe

src/Oracles/ModuleFiles.hs

@@ -64,7 +64,7 @@ packageInfo pkg
 moduleFilesOracle :: Rules ()
 moduleFilesOracle = do
     answer <- newCache $ \(pkg, extraDirs) -> do
-        putOracle $ "Searching module files of package " ++ pkgName pkg ++ "..."
+        putOracle $ "Searching module files of package " ++ pkgNameString pkg ++ "..."
         unless (null extraDirs) $ putOracle $ "Extra directory = " ++ show extraDirs
 
         (srcDirs, modules) <- packageInfo pkg

src/Oracles/PackageDeps.hs

@@ -23,6 +23,6 @@ packageDepsOracle = do
         putOracle $ "Reading package dependencies..."
         contents <- readFileLines packageDependencies
         return . Map.fromList
-               $ [ (head ps, tail ps) | line <- contents, let ps = words line ]
+               $ [ (head ps, tail ps) | line <- contents, let ps = map PackageName $ words line ]
     _ <- addOracle $ \(PackageDepsKey pkg) -> Map.lookup pkg <$> deps ()
     return ()

src/Package.hs

 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 module Package (
-    Package (..), PackageName, PackageType (..),
+    Package (..), PackageName(..), PackageType (..),
     -- * Queries
+    pkgNameString,
     pkgCabalFile,
     matchPackageNames,
     -- * Helpers for constructing and using 'Package's
@@ -10,9 +13,15 @@ module Package (
 
 import Base
 import GHC.Generics (Generic)
+import Data.String
+
+-- | The name of a Cabal package
+newtype PackageName = PackageName { getPackageName :: String }
+                    deriving ( Eq, Ord, IsString, Generic, Binary, Hashable
+                             , NFData)
 
--- | It is helpful to distinguish package names from strings.
-type PackageName = String
+instance Show PackageName where
+    show (PackageName name) = name
 
 -- | We regard packages as either being libraries or programs. This is
 -- bit of a convenient lie as Cabal packages can be both, but it works
@@ -29,18 +38,21 @@ data Package = Package
      }
      deriving Generic
 
--- Relative path to cabal file, e.g.: "libraries/Cabal/Cabal/Cabal.cabal"
+pkgNameString :: Package -> String
+pkgNameString = getPackageName . pkgName
+
+-- | Relative path to cabal file, e.g.: "libraries/Cabal/Cabal/Cabal.cabal"
 pkgCabalFile :: Package -> FilePath
-pkgCabalFile pkg = pkgPath pkg -/- pkgName pkg <.> "cabal"
+pkgCabalFile pkg = pkgPath pkg -/- getPackageName (pkgName pkg) <.> "cabal"
 
 topLevel :: PackageName -> Package
-topLevel name = Package name name Library
+topLevel name = Package name (getPackageName name) Library
 
 library :: PackageName -> Package
-library name = Package name ("libraries" -/- name) Library
+library name = Package name ("libraries" -/- getPackageName name) Library
 
 utility :: PackageName -> Package
-utility name = Package name ("utils" -/- name) Program
+utility name = Package name ("utils" -/- getPackageName name) Program
 
 setPath :: Package -> FilePath -> Package
 setPath pkg path = pkg { pkgPath = path }
@@ -57,7 +69,7 @@ isProgram (Package {pkgType=Program}) = True
 isProgram _ = False
 
 instance Show Package where
-    show = pkgName
+    show = show . pkgName
 
 instance Eq Package where
     (==) = (==) `on` pkgName

src/Rules/Cabal.hs

 module Rules.Cabal (cabalRules) where
 
 import Data.Version
-import Distribution.Package hiding (Package)
+import Distribution.Package as DP hiding (Package)
 import Distribution.PackageDescription
 import Distribution.PackageDescription.Parse
 import Distribution.Verbosity
@@ -19,9 +19,9 @@ cabalRules = do
         constraints <- forM (sort pkgs) $ \pkg -> do
             need [pkgCabalFile pkg]
             pd <- liftIO . readPackageDescription silent $ pkgCabalFile pkg
-            let identifier       = package . packageDescription $ pd
-                version          = showVersion . pkgVersion $ identifier
-                PackageName name = Distribution.Package.pkgName identifier
+            let identifier          = package . packageDescription $ pd
+                version             = showVersion . pkgVersion $ identifier
+                DP.PackageName name = DP.pkgName identifier
             return $ name ++ " == " ++ version
         writeFileChanged out . unlines $ constraints
 
@@ -34,8 +34,8 @@ cabalRules = do
             let depsLib  = collectDeps $ condLibrary pd
                 depsExes = map (collectDeps . Just . snd) $ condExecutables pd
                 deps     = concat $ depsLib : depsExes
-                depNames = [ name | Dependency (PackageName name) _ <- deps ]
-            return . unwords $ Package.pkgName pkg : sort depNames
+                depNames = [ name | Dependency (DP.PackageName name) _ <- deps ]
+            return . unwords $ pkgNameString pkg : sort depNames
         writeFileChanged out . unlines $ pkgDeps
 
 collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]

src/Rules/Documentation.hs

@@ -16,7 +16,7 @@ buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
     in when (stage == Stage1) $ do
         haddockFile %> \file -> do
             srcs <- interpretPartial target getPackageSources
-            deps <- interpretPartial target $ getPkgDataList DepNames
+            deps <- map PackageName <$> interpretPartial target (getPkgDataList DepNames)
             let haddocks = [ pkgHaddockFile depPkg
                            | Just depPkg <- map findKnownPackage deps ]
             need $ srcs ++ haddocks

src/Rules/Generate.hs

@@ -147,7 +147,7 @@ generateConfigHs = do
         , "cStage                :: String"
         , "cStage                = show (STAGE :: Int)"
         , "cIntegerLibrary       :: String"
-        , "cIntegerLibrary       = " ++ quote (pkgName integerLibrary)
+        , "cIntegerLibrary       = " ++ quote (pkgNameString integerLibrary)
         , "cIntegerLibraryType   :: IntegerLibrary"
         , "cIntegerLibraryType   = " ++ cIntegerLibraryType
         , "cSupportsSplitObjs    :: String"

src/Rules/Library.hs

@@ -49,7 +49,7 @@ buildPackageLibrary _ target @ (PartialTarget stage pkg) = do
         synopsis <- interpretPartial target $ getPkgData Synopsis
         unless isLib0 . putSuccess $ renderBox
             [ "Successfully built package library '"
-              ++ pkgName pkg
+              ++ pkgNameString pkg
               ++ "' (" ++ show stage ++ ", way "++ show way ++ ")."
             , "Package synopsis: " ++ dropWhileEnd isPunctuation synopsis ++ "." ]
 

src/Rules/Program.hs

@@ -33,7 +33,7 @@ buildProgram _ target @ (PartialTarget stage pkg) = do
             libTarget = PartialTarget libStage pkg
         pkgs     <- interpretPartial libTarget getPackages
         ghciFlag <- interpretPartial libTarget $ getPkgData BuildGhciLib
-        let deps = matchPackageNames (sort pkgs) (sort depNames)
+        let deps = matchPackageNames (sort pkgs) (map PackageName $ sort depNames)
             ghci = ghciFlag == "YES" && stage == Stage1
         libs <- fmap concat . forM deps $ \dep -> do
             let depTarget = PartialTarget libStage dep
@@ -52,6 +52,6 @@ buildProgram _ target @ (PartialTarget stage pkg) = do
         synopsis <- interpretPartial target $ getPkgData Synopsis
         putSuccess $ renderBox
             [ "Successfully built program '"
-              ++ pkgName pkg ++ "' (" ++ show stage ++ ")."
+              ++ pkgNameString pkg ++ "' (" ++ show stage ++ ")."
             , "Executable: " ++ bin
             , "Package synopsis: " ++ dropWhileEnd isPunctuation synopsis ++ "." ]

src/Settings/Builders/Haddock.hs

@@ -24,14 +24,14 @@ haddockArgs = builder Haddock ? do
         , arg $ "--dump-interface=" ++ output
         , arg "--html"
         , arg "--hoogle"
-        , arg $ "--title=" ++ pkgName pkg ++ "-" ++ version ++ ": " ++ synopsis
+        , arg $ "--title=" ++ pkgNameString pkg ++ "-" ++ version ++ ": " ++ synopsis
         , arg $ "--prologue=" ++ path -/- "haddock-prologue.txt"
         , append $ map ("--hide=" ++) hidden
         , append $ [ "--read-interface=../" ++ dep
                      ++ ",../" ++ dep ++ "/src/%{MODULE/./-}.html\\#%{NAME},"
                      ++ pkgHaddockFile depPkg
                    | (dep, depName) <- zip deps depNames
-                   , Just depPkg <- [findKnownPackage depName] ]
+                   , Just depPkg <- [findKnownPackage $ PackageName depName] ]
         , append [ "--optghc=" ++ opt | opt <- ghcOpts ]
         , specified HsColour ?
           arg "--source-module=src/%{MODULE/./-}.html"

src/Settings/TargetDirectory.hs

@@ -22,8 +22,9 @@ pkgDataFile stage pkg = targetPath stage pkg -/- "package-data.mk"
 -- Relative path to a package haddock file, e.g.:
 -- "libraries/array/dist-install/doc/html/array/array.haddock"
 pkgHaddockFile :: Package -> FilePath
-pkgHaddockFile pkg @ (Package name _ _) =
+pkgHaddockFile pkg =
     targetPath Stage1 pkg -/- "doc/html" -/- name -/- name <.> "haddock"
+  where name = pkgNameString pkg
 
 -- Relative path to a package library file, e.g.:
 -- "libraries/array/dist-install/build/libHSarray-0.5.1.0.a"